Some debug logging for `cabal configure` etc.

This commit is contained in:
Daniel Gröber 2015-08-03 05:20:14 +02:00
parent ec008fbd1e
commit 75d4a2a9d6
3 changed files with 14 additions and 11 deletions

View File

@ -33,6 +33,7 @@ import Language.Haskell.GhcMod.Monad.Types
import Language.Haskell.GhcMod.Utils import Language.Haskell.GhcMod.Utils
import Language.Haskell.GhcMod.World import Language.Haskell.GhcMod.World
import Language.Haskell.GhcMod.PathsAndFiles import Language.Haskell.GhcMod.PathsAndFiles
import Language.Haskell.GhcMod.Logging
import System.FilePath import System.FilePath
import Prelude import Prelude
@ -40,11 +41,11 @@ import Paths_ghc_mod as GhcMod
-- | Only package related GHC options, sufficient for things that don't need to -- | Only package related GHC options, sufficient for things that don't need to
-- access home modules -- access home modules
getGhcMergedPkgOptions :: (Applicative m, MonadIO m, GmEnv m, GmLog m) getGhcMergedPkgOptions :: (Applicative m, IOish m, GmEnv m, GmLog m)
=> m [GHCOption] => m [GHCOption]
getGhcMergedPkgOptions = chCached Cached { getGhcMergedPkgOptions = chCached Cached {
cacheFile = mergedPkgOptsCacheFile, cacheFile = mergedPkgOptsCacheFile,
cachedAction = \ _ (progs, root, _) _ -> do cachedAction = \ _tcf (progs, root, _) _ma -> do
opts <- withCabal $ runQuery' progs root $ ghcMergedPkgOptions opts <- withCabal $ runQuery' progs root $ ghcMergedPkgOptions
return ([setupConfigPath], opts) return ([setupConfigPath], opts)
} }
@ -61,11 +62,11 @@ helperProgs opts = Programs {
-- --
-- The Component\'s 'gmcHomeModuleGraph' will be empty and has to be resolved by -- The Component\'s 'gmcHomeModuleGraph' will be empty and has to be resolved by
-- 'resolveGmComponents'. -- 'resolveGmComponents'.
getComponents :: (Applicative m, MonadIO m, GmEnv m, GmLog m) getComponents :: (Applicative m, IOish m, GmEnv m, GmLog m)
=> m [GmComponent 'GMCRaw ChEntrypoint] => m [GmComponent 'GMCRaw ChEntrypoint]
getComponents = chCached cabalHelperCache getComponents = chCached cabalHelperCache
chCached :: (Applicative m, MonadIO m, GmEnv m, GmLog m, Serialize a) chCached :: (Applicative m, IOish m, GmEnv m, GmLog m, Serialize a)
=> Cached m (Programs, FilePath, (Version, [Char])) a -> m a => Cached m (Programs, FilePath, (Version, [Char])) a -> m a
chCached c = do chCached c = do
root <- cradleRootDir <$> cradle root <- cradleRootDir <$> cradle
@ -87,7 +88,7 @@ cabalHelperCache
=> Cached m (Programs, FilePath, (Version, String)) [GmComponent 'GMCRaw ChEntrypoint] => Cached m (Programs, FilePath, (Version, String)) [GmComponent 'GMCRaw ChEntrypoint]
cabalHelperCache = Cached { cabalHelperCache = Cached {
cacheFile = cabalHelperCacheFile, cacheFile = cabalHelperCacheFile,
cachedAction = \ _ (progs, root, _) _ -> cachedAction = \ _tcf (progs, root, _vers) _ma ->
runQuery' progs root $ do runQuery' progs root $ do
q <- join7 q <- join7
<$> ghcOptions <$> ghcOptions
@ -111,11 +112,11 @@ cabalHelperCache = Cached {
, a == a' , a == a'
] ]
withCabal :: (MonadIO m, GmEnv m) => m a -> m a withCabal :: (IOish m, GmEnv m, GmLog m) => m a -> m a
withCabal action = do withCabal action = do
crdl <- cradle crdl <- cradle
opts <- options opts <- options
liftIO $ whenM (isSetupConfigOutOfDate <$> getCurrentWorld crdl) $ whenM (liftIO $ isSetupConfigOutOfDate <$> getCurrentWorld crdl) $
withDirectory_ (cradleRootDir crdl) $ do withDirectory_ (cradleRootDir crdl) $ do
let pkgDbArgs = "--package-db=clear" : map pkgDbArg (cradlePkgDbStack crdl) let pkgDbArgs = "--package-db=clear" : map pkgDbArg (cradlePkgDbStack crdl)
progOpts = progOpts =
@ -126,8 +127,10 @@ withCabal action = do
then [ "--with-ghc-pkg=" ++ T.ghcPkgProgram opts ] then [ "--with-ghc-pkg=" ++ T.ghcPkgProgram opts ]
else [] else []
++ pkgDbArgs ++ pkgDbArgs
void $ readProcess (T.cabalProgram opts) ("configure":progOpts) "" gmLog GmDebug "" $ strDoc $ "setup configuration is out of date, reconfiguring Cabal project."
writeAutogenFiles $ cradleRootDir crdl </> "dist" liftIO $ void $ readProcess (T.cabalProgram opts) ("configure":progOpts) ""
gmLog GmDebug "" $ strDoc $ "writing Cabal autogen files"
liftIO $ writeAutogenFiles $ cradleRootDir crdl </> "dist"
action action
pkgDbArg :: GhcPkgDb -> String pkgDbArg :: GhcPkgDb -> String

View File

@ -261,7 +261,7 @@ findCandidates scns = foldl1 Set.intersection scns
pickComponent :: Set ChComponentName -> ChComponentName pickComponent :: Set ChComponentName -> ChComponentName
pickComponent scn = Set.findMin scn pickComponent scn = Set.findMin scn
packageGhcOptions :: (Applicative m, MonadIO m, GmEnv m, GmLog m) => m [GHCOption] packageGhcOptions :: (Applicative m, IOish m, GmEnv m, GmLog m) => m [GHCOption]
packageGhcOptions = do packageGhcOptions = do
crdl <- cradle crdl <- cradle
case cradleCabalFile crdl of case cradleCabalFile crdl of

View File

@ -70,7 +70,7 @@ newTempDir :: FilePath -> IO FilePath
newTempDir dir = newTempDir dir =
flip createTempDirectory (uniqTempDirName dir) =<< getTemporaryDirectory flip createTempDirectory (uniqTempDirName dir) =<< getTemporaryDirectory
whenM :: IO Bool -> IO () -> IO () whenM :: Monad m => m Bool -> m () -> m ()
whenM mb ma = mb >>= flip when ma whenM mb ma = mb >>= flip when ma
-- | Returns the path to the currently running ghc-mod executable. With ghc<7.6 -- | Returns the path to the currently running ghc-mod executable. With ghc<7.6