module Language.Haskell.GhcMod.CabalHelper
#ifndef SPEC
( getComponents
, getGhcMergedPkgOptions
, getCabalPackageDbStack
, getCustomPkgDbStack
, prepareCabalHelper
)
#endif
where
import Control.Applicative
import Control.Monad
import Control.Category ((.))
import Data.Maybe
import Data.Monoid
import Data.Serialize (Serialize)
import Data.Traversable
import Distribution.Helper
import qualified Language.Haskell.GhcMod.Types as T
import Language.Haskell.GhcMod.Types hiding (ghcProgram, ghcPkgProgram,
cabalProgram)
import Language.Haskell.GhcMod.Monad.Types
import Language.Haskell.GhcMod.Utils
import Language.Haskell.GhcMod.PathsAndFiles
import Language.Haskell.GhcMod.Logging
import Language.Haskell.GhcMod.Output
import System.FilePath
import Prelude hiding ((.))
import Paths_ghc_mod as GhcMod
getGhcMergedPkgOptions :: (Applicative m, IOish m, GmEnv m, GmState m, GmLog m)
=> m [GHCOption]
getGhcMergedPkgOptions = chCached Cached {
cacheLens = Just (lGmcMergedPkgOptions . lGmCaches),
cacheFile = mergedPkgOptsCacheFile,
cachedAction = \ _tcf (progs, rootdir, distdir, _) _ma -> do
readProc <- gmReadProcess
opts <- withCabal $ runQuery'' readProc progs rootdir distdir $
ghcMergedPkgOptions
return ([setupConfigPath], opts)
}
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
readProc <- gmReadProcess
dbs <- withCabal $ map chPkgToGhcPkg <$> runQuery'' readProc progs rootdir distdir packageDbStack
return ([setupConfigPath, sandboxConfigFile], dbs)
}
chPkgToGhcPkg :: ChPkgDb -> GhcPkgDb
chPkgToGhcPkg ChPkgGlobal = GlobalDb
chPkgToGhcPkg ChPkgUser = UserDb
chPkgToGhcPkg (ChPkgSpecific f) = PackageDb f
getComponents :: (Applicative m, IOish m, GmEnv m, GmState m, GmLog m)
=> m [GmComponent 'GMCRaw ChEntrypoint]
getComponents = chCached Cached {
cacheLens = Just (lGmcComponents . lGmCaches),
cacheFile = cabalHelperCacheFile,
cachedAction = \ _tcf (progs, rootdir, distdir, _vers) _ma -> do
readProc <- gmReadProcess
runQuery'' readProc progs rootdir distdir $ do
q <- join7
<$> ghcOptions
<*> ghcPkgOptions
<*> ghcSrcOptions
<*> ghcLangOptions
<*> entrypoints
<*> entrypoints
<*> sourceDirs
let cs = flip map q $ curry8 (GmComponent mempty)
return ([setupConfigPath], cs)
}
where
curry8 fn (a, (b, (c, (d, (e, (f, (g, h))))))) = fn a b c d e f g h
join7 a b c d e f = join' a . join' b . join' c . join' d . join' e . join' f
join' :: Eq a => [(a,b)] -> [(a,c)] -> [(a,(b,c))]
join' lb lc = [ (a, (b, c))
| (a, b) <- lb
, (a', c) <- lc
, a == a'
]
prepareCabalHelper :: (IOish m, GmEnv m, GmLog m) => m ()
prepareCabalHelper = do
crdl <- cradle
let projdir = cradleRootDir crdl
distdir = projdir </> "dist"
readProc <- gmReadProcess
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
opts <- options
readProc <- gmReadProcess
let projdir = cradleRootDir crdl
distdir = projdir </> "dist"
mCabalFile <- liftIO $ timeFile `traverse` cradleCabalFile crdl
mCabalConfig <- liftIO $ timeMaybe (setupConfigFile crdl)
mCusPkgDbStack <- getCustomPkgDbStack
pkgDbStackOutOfSync <-
case mCusPkgDbStack of
Just cusPkgDbStack -> do
pkgDb <- runQuery'' readProc (helperProgs opts) projdir distdir $
map chPkgToGhcPkg <$> packageDbStack
return $ pkgDb /= cusPkgDbStack
Nothing -> return False
cusPkgStack <- maybe [] ((PackageDb "clear"):) <$> getCustomPkgDbStack
when (isSetupConfigOutOfDate mCabalFile mCabalConfig) $
gmLog GmDebug "" $ strDoc $ "setup configuration is out of date, reconfiguring Cabal project."
when pkgDbStackOutOfSync $
gmLog GmDebug "" $ strDoc $ "package-db stack out of sync with ghc-mod.package-db-stack, reconfiguring Cabal project."
when (isSetupConfigOutOfDate mCabalFile mCabalConfig || pkgDbStackOutOfSync) $
withDirectory_ (cradleRootDir crdl) $ do
let progOpts =
[ "--with-ghc=" ++ T.ghcProgram opts ]
++ if T.ghcPkgProgram opts /= T.ghcPkgProgram defaultOptions
then [ "--with-ghc-pkg=" ++ T.ghcPkgProgram opts ]
else []
++ map pkgDbArg cusPkgStack
liftIO $ void $ readProc (T.cabalProgram opts) ("configure":progOpts) ""
gmLog GmDebug "" $ strDoc $ "writing Cabal autogen files"
liftIO $ writeAutogenFiles readProc projdir distdir
action
pkgDbArg :: GhcPkgDb -> String
pkgDbArg GlobalDb = "--package-db=global"
pkgDbArg UserDb = "--package-db=user"
pkgDbArg (PackageDb p) = "--package-db=" ++ p
isSetupConfigOutOfDate :: Maybe TimedFile -> Maybe TimedFile -> Bool
isSetupConfigOutOfDate worldCabalFile worldCabalConfig = do
worldCabalConfig < worldCabalFile
helperProgs :: Options -> Programs
helperProgs opts = Programs {
cabalProgram = T.cabalProgram opts,
ghcProgram = T.ghcProgram opts,
ghcPkgProgram = T.ghcPkgProgram opts
}
chCached :: (Applicative m, IOish m, GmEnv m, GmState m, GmLog m, Serialize a)
=> Cached m GhcModState ChCacheData a -> m a
chCached c = do
root <- cradleRootDir <$> cradle
d <- cacheInputData root
withCabal $ cached root c d
where
cacheInputData root = do
opt <- options
return $ ( helperProgs opt
, root
, root </> "dist"
, (gmVer, chVer)
)
gmVer = GhcMod.version
chVer = VERSION_cabal_helper