diff --git a/Language/Haskell/GhcMod/CabalHelper.hs b/Language/Haskell/GhcMod/CabalHelper.hs index c9076bb..ef6f501 100644 --- a/Language/Haskell/GhcMod/CabalHelper.hs +++ b/Language/Haskell/GhcMod/CabalHelper.hs @@ -19,7 +19,8 @@ module Language.Haskell.GhcMod.CabalHelper #ifndef SPEC ( getComponents , getGhcMergedPkgOptions - , getPackageDbStack + , getCabalPackageDbStack + , getCustomPkgDbStack , prepareCabalHelper ) #endif @@ -60,25 +61,8 @@ getGhcMergedPkgOptions = chCached Cached { return ([setupConfigPath], opts) } -parseCustomPackageDb :: String -> [GhcPkgDb] -parseCustomPackageDb src = map parsePkgDb $ filter (not . null) $ lines src - where - parsePkgDb "global" = GlobalDb - parsePkgDb "user" = UserDb - parsePkgDb s = PackageDb s - -getCustomPkgDbStack :: (IOish m, GmEnv m) => m (Maybe [GhcPkgDb]) -getCustomPkgDbStack = do - mCusPkgDbFile <- liftIO . (traverse readFile <=< findCustomPackageDbFile) . cradleRootDir =<< cradle - return $ parseCustomPackageDb <$> mCusPkgDbFile - -getPackageDbStack :: (IOish m, GmEnv m, GmState m, GmLog m) => m [GhcPkgDb] -getPackageDbStack = do - mCusPkgStack <- getCustomPkgDbStack - flip fromMaybe mCusPkgStack <$> getPackageDbStack' - -getPackageDbStack' :: (IOish m, GmEnv m, GmState m, GmLog m) => m [GhcPkgDb] -getPackageDbStack' = chCached Cached { +getCabalPackageDbStack :: (IOish m, GmEnv m, GmState m, GmLog m) => m [GhcPkgDb] +getCabalPackageDbStack = chCached Cached { cacheLens = Just (lGmcPackageDbStack . lGmCaches), cacheFile = pkgDbStackCacheFile, cachedAction = \ _tcf (progs, rootdir, distdir, _) _ma -> do @@ -136,6 +120,18 @@ prepareCabalHelper = do when (cradleProjectType crdl == CabalProject) $ withCabal $ liftIO $ prepare readProc projdir distdir +parseCustomPackageDb :: String -> [GhcPkgDb] +parseCustomPackageDb src = map parsePkgDb $ filter (not . null) $ lines src + where + parsePkgDb "global" = GlobalDb + parsePkgDb "user" = UserDb + parsePkgDb s = PackageDb s + +getCustomPkgDbStack :: (IOish m, GmEnv m) => m (Maybe [GhcPkgDb]) +getCustomPkgDbStack = do + mCusPkgDbFile <- liftIO . (traverse readFile <=< findCustomPackageDbFile) . cradleRootDir =<< cradle + return $ parseCustomPackageDb <$> mCusPkgDbFile + withCabal :: (IOish m, GmEnv m, GmLog m) => m a -> m a withCabal action = do crdl <- cradle diff --git a/Language/Haskell/GhcMod/GhcPkg.hs b/Language/Haskell/GhcMod/GhcPkg.hs index 2908c82..f6c281b 100644 --- a/Language/Haskell/GhcMod/GhcPkg.hs +++ b/Language/Haskell/GhcMod/GhcPkg.hs @@ -4,6 +4,7 @@ module Language.Haskell.GhcMod.GhcPkg ( , ghcPkgDbStackOpts , ghcDbStackOpts , ghcDbOpt + , getPackageDbStack , getPackageCachePaths ) where @@ -58,18 +59,23 @@ ghcDbOpt (PackageDb pkgDb) ---------------------------------------------------------------- -getPackageCachePaths :: IOish m => FilePath -> GhcModT m [FilePath] -getPackageCachePaths sysPkgCfg = do +getPackageDbStack :: IOish m => GhcModT m [GhcPkgDb] +getPackageDbStack = do crdl <- cradle - pkgDbStack <- case cradleProjectType crdl of + mCusPkgStack <- getCustomPkgDbStack + stack <- case cradleProjectType crdl of PlainProject -> return [GlobalDb, UserDb] SandboxProject -> do Just db <- liftIO $ getSandboxDb $ cradleRootDir crdl return $ [GlobalDb, db] CabalProject -> - getPackageDbStack + getCabalPackageDbStack + return $ fromMaybe stack mCusPkgStack +getPackageCachePaths :: IOish m => FilePath -> GhcModT m [FilePath] +getPackageCachePaths sysPkgCfg = do + pkgDbStack <- getPackageDbStack catMaybes <$> (liftIO . resolvePackageConfig sysPkgCfg) `mapM` pkgDbStack -- TODO: use PkgConfRef diff --git a/Language/Haskell/GhcMod/PkgDoc.hs b/Language/Haskell/GhcMod/PkgDoc.hs index ddc4a06..b469f87 100644 --- a/Language/Haskell/GhcMod/PkgDoc.hs +++ b/Language/Haskell/GhcMod/PkgDoc.hs @@ -4,7 +4,6 @@ import Language.Haskell.GhcMod.Types import Language.Haskell.GhcMod.GhcPkg import Language.Haskell.GhcMod.Monad import Language.Haskell.GhcMod.Utils -import Language.Haskell.GhcMod.CabalHelper import Control.Applicative import Prelude diff --git a/test/CabalHelperSpec.hs b/test/CabalHelperSpec.hs index 8e4ba64..42211d8 100644 --- a/test/CabalHelperSpec.hs +++ b/test/CabalHelperSpec.hs @@ -91,6 +91,6 @@ spec = do (s, s') <- runD $ do Just stack <- getCustomPkgDbStack withCabal $ do - stack' <- getPackageDbStack' + stack' <- getCabalPackageDbStack return (stack, stack') s' `shouldBe` s diff --git a/test/GhcPkgSpec.hs b/test/GhcPkgSpec.hs new file mode 100644 index 0000000..6f93404 --- /dev/null +++ b/test/GhcPkgSpec.hs @@ -0,0 +1,30 @@ +module GhcPkgSpec where + +import Control.Arrow +import Control.Applicative +import Distribution.Helper +import Language.Haskell.GhcMod.GhcPkg +import Language.Haskell.GhcMod.PathsAndFiles +import Language.Haskell.GhcMod.CabalHelper +import Language.Haskell.GhcMod.Error +import Test.Hspec +import System.Directory +import System.FilePath +import System.Process (readProcess, system) + +import Dir +import TestUtils +import Data.List + +spec :: Spec +spec = do + describe "getPackageDbStack'" $ do + it "fixes out of sync custom pkg-db stack" $ do + withDirectory_ "test/data/custom-cradle" $ do + _ <- system "cabal configure" + (s, s') <- runD $ do + Just stack <- getCustomPkgDbStack + withCabal $ do + stack' <- getPackageDbStack + return (stack, stack') + s' `shouldBe` s