Some debug logging for cabal configure
etc.
This commit is contained in:
parent
ec008fbd1e
commit
75d4a2a9d6
@ -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
|
||||||
|
@ -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
|
||||||
|
@ -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
|
||||||
|
Loading…
Reference in New Issue
Block a user