hasufell/ghc-mod
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

Refactor the hard-coding "dist"

Browse Source
This commit is contained in:
scturtle 2015-08-18 17:41:14 +08:00 committed by Daniel Gröber
parent cbb8feb0ad
commit a285b42206
5 changed files with 47 additions and 29 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

33
Language/Haskell/GhcMod/CabalHelper.hs
View File

@ -53,24 +53,24 @@ import Paths_ghc_mod as GhcMod
-- access home modules
getGhcMergedPkgOptions :: (Applicative m, IOish m, GmEnv m, GmState m, GmLog m)
=> m [GHCOption]
getGhcMergedPkgOptions = chCached Cached {
getGhcMergedPkgOptions = chCached $ \distDir -> Cached {
cacheLens = Just (lGmcMergedPkgOptions . lGmCaches),
cacheFile = mergedPkgOptsCacheFile,
cacheFile = distDir </> mergedPkgOptsCacheFile,
cachedAction = \ _tcf (progs, rootdir, distdir, _) _ma -> do
readProc <- gmReadProcess
opts <- withCabal $ runQuery'' readProc progs rootdir distdir $
ghcMergedPkgOptions
return ([setupConfigPath], opts)
return ([distDir </> setupConfigPath], opts)
}
getCabalPackageDbStack :: (IOish m, GmEnv m, GmState m, GmLog m) => m [GhcPkgDb]
getCabalPackageDbStack = chCached Cached {
getCabalPackageDbStack = chCached $ \distDir -> Cached {
cacheLens = Just (lGmcPackageDbStack . lGmCaches),
cacheFile = pkgDbStackCacheFile,
cacheFile = distDir </> pkgDbStackCacheFile,
cachedAction = \ _tcf (progs, rootdir, distdir, _) _ma -> do
readProc <- gmReadProcess
dbs <- withCabal $ map chPkgToGhcPkg <$> runQuery'' readProc progs rootdir distdir packageDbStack
return ([setupConfigPath, sandboxConfigFile], dbs)
return ([distDir </> setupConfigPath, sandboxConfigFile], dbs)
}
chPkgToGhcPkg :: ChPkgDb -> GhcPkgDb
@ -85,9 +85,9 @@ chPkgToGhcPkg (ChPkgSpecific f) = PackageDb f
-- 'resolveGmComponents'.
getComponents :: (Applicative m, IOish m, GmEnv m, GmState m, GmLog m)
=> m [GmComponent 'GMCRaw ChEntrypoint]
getComponents = chCached Cached {
getComponents = chCached$ \distDir -> Cached {
cacheLens = Just (lGmcComponents . lGmCaches),
cacheFile = cabalHelperCacheFile,
cacheFile = distDir </> cabalHelperCacheFile,
cachedAction = \ _tcf (progs, rootdir, distdir, _vers) _ma -> do
readProc <- gmReadProcess
runQuery'' readProc progs rootdir distdir $ do
@ -100,7 +100,7 @@ getComponents = chCached Cached {
<*> entrypoints
<*> sourceDirs
let cs = flip map q $ curry8 (GmComponent mempty)
return ([setupConfigPath], cs)
return ([distDir </> setupConfigPath], cs)
}
where
curry8 fn (a, (b, (c, (d, (e, (f, (g, h))))))) = fn a b c d e f g h
@ -117,7 +117,7 @@ prepareCabalHelper :: (IOish m, GmEnv m, GmLog m) => m ()
prepareCabalHelper = do
crdl <- cradle
let projdir = cradleRootDir crdl
distdir = projdir </> "dist"
distdir = projdir </> cradleDistDir crdl
readProc <- gmReadProcess
when (cradleProjectType crdl == CabalProject) $
withCabal $ liftIO $ prepare readProc projdir distdir
@ -151,7 +151,7 @@ withCabal action = do
readProc <- gmReadProcess
let projdir = cradleRootDir crdl
distdir = projdir </> "dist"
distdir = projdir </> cradleDistDir crdl
mCabalFile <- liftIO $ timeFile `traverse` cradleCabalFile crdl
mCabalConfig <- liftIO $ timeMaybe (setupConfigFile crdl)
@ -222,17 +222,18 @@ helperProgs opts = Programs {
}
chCached :: (Applicative m, IOish m, GmEnv m, GmState m, GmLog m, Serialize a)
=> Cached m GhcModState ChCacheData a -> m a
=> (FilePath -> Cached m GhcModState ChCacheData a) -> m a
chCached c = do
root <- cradleRootDir <$> cradle
d <- cacheInputData root
withCabal $ cached root c d
dist <- cradleDistDir <$> cradle
d <- cacheInputData root dist
withCabal $ cached root (c dist) d
where
cacheInputData root = do
cacheInputData root dist = do
opt <- options
return $ ( helperProgs opt
, root
, root </> "dist"
, root </> dist
, (gmVer, chVer)
)

5
Language/Haskell/GhcMod/Cradle.hs
View File

@ -65,6 +65,7 @@ cabalCradle wdir = do
, cradleRootDir = cabalDir
, cradleTempDir = error "tmpDir"
, cradleCabalFile = Just cabalFile
, cradleDistDir = "dist"
}
stackCradle :: FilePath -> MaybeT IO Cradle
@ -74,6 +75,7 @@ stackCradle wdir = do
let cabalDir = takeDirectory cabalFile
_stackConfigFile <- MaybeT $ findStackConfigFile cabalDir
distDir <- liftIO $ findStackDistDir cabalDir
return Cradle {
cradleProjectType = StackProject
@ -81,6 +83,7 @@ stackCradle wdir = do
, cradleRootDir = cabalDir
, cradleTempDir = error "tmpDir"
, cradleCabalFile = Just cabalFile
, cradleDistDir = distDir
}
sandboxCradle :: FilePath -> MaybeT IO Cradle
@ -92,6 +95,7 @@ sandboxCradle wdir = do
, cradleRootDir = sbDir
, cradleTempDir = error "tmpDir"
, cradleCabalFile = Nothing
, cradleDistDir = "dist"
}
plainCradle :: FilePath -> MaybeT IO Cradle
@ -102,4 +106,5 @@ plainCradle wdir = do
, cradleRootDir = wdir
, cradleTempDir = error "tmpDir"
, cradleCabalFile = Nothing
, cradleDistDir = "dist"
}

14
Language/Haskell/GhcMod/PathsAndFiles.hs
View File

@ -74,6 +74,14 @@ findCabalFile dir = do
findStackConfigFile :: FilePath -> IO (Maybe FilePath)
findStackConfigFile dir = mightExist (dir </> "stack.yaml")
findStackDistDir :: FilePath -> IO FilePath
findStackDistDir dir = U.withDirectory_ dir $ do
mstack <- liftIO $ findExecutable "stack"
case mstack of
Nothing -> return "dist"
Just stack ->
takeWhile (/='\n') <$> readProcess stack ["path", "--dist-dir"] ""
-- | Get path to sandbox config file
getSandboxDb :: FilePath
-- ^ Path to the cabal package root directory (containing the
@ -182,17 +190,17 @@ parents dir' =
----------------------------------------------------------------
setupConfigFile :: Cradle -> FilePath
setupConfigFile crdl = cradleRootDir crdl </> setupConfigPath
setupConfigFile crdl = cradleRootDir crdl </> cradleDistDir crdl </> setupConfigPath
sandboxConfigFile :: FilePath
sandboxConfigFile = "cabal.sandbox.config"
-- | Path to 'LocalBuildInfo' file, usually @dist/setup-config@
setupConfigPath :: FilePath
setupConfigPath = "dist/setup-config" -- localBuildInfoFile defaultDistPref
setupConfigPath = "setup-config" -- localBuildInfoFile defaultDistPref
macrosHeaderPath :: FilePath
macrosHeaderPath = "dist/build/autogen/cabal_macros.h"
macrosHeaderPath = "build/autogen/cabal_macros.h"
ghcSandboxPkgDbDir :: String -> String
ghcSandboxPkgDbDir buildPlatf = do

22
Language/Haskell/GhcMod/Target.hs
View File

@ -178,12 +178,13 @@ targetGhcOptions crdl sefnmn = do
let cn = pickComponent candidates
return $ gmcGhcOpts $ fromJust $ Map.lookup cn mcs
resolvedComponentsCache :: IOish m => Cached (GhcModT m) GhcModState
resolvedComponentsCache :: IOish m => FilePath ->
Cached (GhcModT m) GhcModState
[GmComponent 'GMCRaw (Set.Set ModulePath)]
(Map.Map ChComponentName (GmComponent 'GMCResolved (Set.Set ModulePath)))
resolvedComponentsCache = Cached {
resolvedComponentsCache distDir = Cached {
cacheLens = Just (lGmcResolvedComponents . lGmCaches),
cacheFile = resolvedComponentsCacheFile,
cacheFile = distDir </> resolvedComponentsCacheFile,
cachedAction = \tcfs comps ma -> do
Cradle {..} <- cradle
let iifsM = invalidatingInputFiles tcfs
@ -194,13 +195,13 @@ resolvedComponentsCache = Cached {
Just iifs ->
let
filterOutSetupCfg =
filter (/= cradleRootDir </> setupConfigPath)
filter (/= cradleRootDir </> cradleDistDir </> setupConfigPath)
changedFiles = filterOutSetupCfg iifs
in if null changedFiles
then Nothing
else Just $ map Left changedFiles
setupChanged = maybe False
(elem $ cradleRootDir </> setupConfigPath)
(elem $ cradleRootDir </> cradleDistDir </> setupConfigPath)
iifsM
case (setupChanged, ma) of
(False, Just mcs) -> gmsGet >>= \s -> gmsPut s { gmComponents = mcs }
@ -217,7 +218,7 @@ resolvedComponentsCache = Cached {
text "files changed" <+>: changedDoc
mcs <- resolveGmComponents mums comps
return (setupConfigPath:flatten mcs , mcs)
return ((cradleDistDir </> setupConfigPath) : flatten mcs , mcs)
}
where
@ -298,7 +299,8 @@ resolveGmComponent :: (IOish m, GmLog m, GmEnv m, GmState m)
-> GmComponent 'GMCRaw (Set ModulePath)
-> m (GmComponent 'GMCResolved (Set ModulePath))
resolveGmComponent mums c@GmComponent {..} = do
withLightHscEnv ghcOpts $ \env -> do
distDir <- cradleDistDir <$> cradle
withLightHscEnv (ghcOpts distDir) $ \env -> do
let srcDirs = if null gmcSourceDirs then [""] else gmcSourceDirs
let mg = gmcHomeModuleGraph
let simp = gmcEntrypoints
@ -312,10 +314,10 @@ resolveGmComponent mums c@GmComponent {..} = do
return $ c { gmcEntrypoints = simp, gmcHomeModuleGraph = mg' }
where ghcOpts = concat [
where ghcOpts distDir = concat [
gmcGhcSrcOpts,
gmcGhcLangOpts,
[ "-optP-include", "-optP" ++ macrosHeaderPath ]
[ "-optP-include", "-optP" ++ distDir </> macrosHeaderPath ]
]
resolveEntrypoint :: (IOish m, GmEnv m, GmLog m, GmState m)
@ -482,4 +484,4 @@ cabalResolvedComponents :: (IOish m) =>
cabalResolvedComponents = do
crdl@(Cradle{..}) <- cradle
comps <- mapM (resolveEntrypoint crdl) =<< getComponents
cached cradleRootDir resolvedComponentsCache comps
cached cradleRootDir (resolvedComponentsCache cradleDistDir) comps

2
Language/Haskell/GhcMod/Types.hs
View File

@ -135,6 +135,8 @@ data Cradle = Cradle {
, cradleTempDir :: FilePath
-- | The file name of the found cabal file.
, cradleCabalFile :: Maybe FilePath
-- | The build info directory.
, cradleDistDir :: FilePath
} deriving (Eq, Show)