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

Merge branch 'stack-support'

This commit is contained in:
Daniel Gröber 2015-08-20 02:14:55 +02:00
parent 91f0c50b20 74feac1791
commit b25dbc2416
21 changed files with 279 additions and 92 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

10
.travis.yml
View File

@ -16,10 +16,20 @@ cache:
directories:
- ~/.cabal
- ~/.ghc
- ~/.stack
before_cache:
- rm -f $HOME/.cabal/logs $HOME/.cabal/packages/*/build-reports.log
before_install:
- wget https://github.com/commercialhaskell/stack/releases/download/v0.1.3.1/stack-0.1.3.1-x86_64-linux.gz
- mkdir stack-bin
- gunzip stack-0.1.3.1-x86_64-linux.gz
- mv stack-0.1.3.1-x86_64-linux stack-bin/stack
- chmod +x stack-bin/stack
- export PATH=$(pwd)/stack-bin:$PATH
- stack --version
install:
- cabal update
# - ( $CABAL122 && cabal install cabal-install --constraint "Cabal >= 1.22" && ghc-pkg unregister Cabal ) || true

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

@ -20,6 +20,7 @@ module Language.Haskell.GhcMod.CabalHelper
( getComponents
, getGhcMergedPkgOptions
, getCabalPackageDbStack
, getStackPackageDbStack
, getCustomPkgDbStack
, prepareCabalHelper
)
@ -43,6 +44,7 @@ import Language.Haskell.GhcMod.PathsAndFiles
import Language.Haskell.GhcMod.Logging
import Language.Haskell.GhcMod.Output
import System.FilePath
import System.Directory (findExecutable)
import Prelude hiding ((.))
import Paths_ghc_mod as GhcMod
@ -51,24 +53,25 @@ 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,
cachedAction = \ _tcf (progs, rootdir, distdir, _) _ma -> do
cacheFile = mergedPkgOptsCacheFile distdir,
cachedAction = \ _tcf (progs, rootdir, _) _ma -> do
readProc <- gmReadProcess
opts <- withCabal $ runQuery'' readProc progs rootdir distdir $
ghcMergedPkgOptions
return ([setupConfigPath], opts)
return ([setupConfigPath distdir], 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,
cachedAction = \ _tcf (progs, rootdir, distdir, _) _ma -> do
cacheFile = pkgDbStackCacheFile distdir,
cachedAction = \ _tcf (progs, rootdir, _) _ma -> do
crdl <- cradle
readProc <- gmReadProcess
dbs <- withCabal $ map chPkgToGhcPkg <$> runQuery'' readProc progs rootdir distdir packageDbStack
return ([setupConfigPath, sandboxConfigFile], dbs)
return ([setupConfigFile crdl, sandboxConfigFile crdl], dbs)
}
chPkgToGhcPkg :: ChPkgDb -> GhcPkgDb
@ -83,10 +86,10 @@ 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,
cachedAction = \ _tcf (progs, rootdir, distdir, _vers) _ma -> do
cacheFile = cabalHelperCacheFile distdir,
cachedAction = \ _tcf (progs, rootdir, _vers) _ma -> do
readProc <- gmReadProcess
runQuery'' readProc progs rootdir distdir $ do
q <- join7
@ -98,7 +101,7 @@ getComponents = chCached Cached {
<*> entrypoints
<*> sourceDirs
let cs = flip map q $ curry8 (GmComponent mempty)
return ([setupConfigPath], cs)
return ([setupConfigPath distdir], cs)
}
where
curry8 fn (a, (b, (c, (d, (e, (f, (g, h))))))) = fn a b c d e f g h
@ -115,9 +118,9 @@ 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) $
when (cradleProjectType crdl == CabalProject || cradleProjectType crdl == StackProject) $
withCabal $ liftIO $ prepare readProc projdir distdir
parseCustomPackageDb :: String -> [GhcPkgDb]
@ -132,6 +135,16 @@ getCustomPkgDbStack = do
mCusPkgDbFile <- liftIO . (traverse readFile <=< findCustomPackageDbFile) . cradleRootDir =<< cradle
return $ parseCustomPackageDb <$> mCusPkgDbFile
getStackPackageDbStack :: IOish m => m [GhcPkgDb]
getStackPackageDbStack = do
mstack <- liftIO $ findExecutable "stack"
case mstack of
Nothing -> return []
Just stack -> do
snapshotDb <- liftIO $ readProcess stack ["path", "--snapshot-pkg-db"] ""
localDb <- liftIO $ readProcess stack ["path", "--local-pkg-db"] ""
return $ map (PackageDb . takeWhile (/='\n')) [snapshotDb, localDb]
withCabal :: (IOish m, GmEnv m, GmLog m) => m a -> m a
withCabal action = do
crdl <- cradle
@ -139,10 +152,11 @@ 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)
mCabalFile <- liftIO $ timeFile `traverse` cradleCabalFile crdl
mCabalConfig <- liftIO $ timeMaybe (setupConfigFile crdl)
mCabalSandboxConfig <- liftIO $ timeMaybe (sandboxConfigFile crdl)
mCusPkgDbStack <- getCustomPkgDbStack
@ -155,30 +169,48 @@ withCabal action = do
Nothing -> return False
cusPkgStack <- maybe [] ((PackageDb "clear"):) <$> getCustomPkgDbStack
--TODO: also invalidate when sandboxConfig file changed
projType <- cradleProjectType <$> cradle
when (isSetupConfigOutOfDate mCabalFile mCabalConfig) $
gmLog GmDebug "" $ strDoc $ "setup configuration is out of date, reconfiguring Cabal project."
when (isSetupConfigOutOfDate mCabalSandboxConfig mCabalConfig) $
gmLog GmDebug "" $ strDoc $ "sandbox 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 ]
-- Only pass ghc-pkg if it was actually set otherwise we
-- might break cabal's guessing logic
++ 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
when ( isSetupConfigOutOfDate mCabalFile mCabalConfig
|| pkgDbStackOutOfSync
|| isSetupConfigOutOfDate mCabalSandboxConfig mCabalConfig) $
case projType of
CabalProject ->
cabalReconfigure readProc opts crdl projdir distdir
StackProject ->
-- https://github.com/commercialhaskell/stack/issues/820
gmLog GmWarning "" $ strDoc $ "Stack project configuration is out of date, please reconfigure manually using 'stack build'"
_ ->
error $ "withCabal: unsupported project type: " ++ show projType
action
where
cabalReconfigure readProc opts crdl projdir distdir = do
withDirectory_ (cradleRootDir crdl) $ do
cusPkgStack <- maybe [] ((PackageDb "clear"):) <$> getCustomPkgDbStack
let progOpts =
[ "--with-ghc=" ++ T.ghcProgram opts ]
-- Only pass ghc-pkg if it was actually set otherwise we
-- might break cabal's guessing logic
++ 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
pkgDbArg :: GhcPkgDb -> String
pkgDbArg GlobalDb = "--package-db=global"
pkgDbArg UserDb = "--package-db=user"
@ -188,9 +220,9 @@ pkgDbArg (PackageDb p) = "--package-db=" ++ p
-- @Nothing < Nothing = False@
-- (since we don't need to @cabal configure@ when no cabal file exists.)
--
-- * Cabal file doesn't exist (unlikely case) -> should return False
-- * Cabal file doesn't exist (impossible since cabal-helper is only used with
-- cabal projects) -> should return False
-- @Just cc < Nothing = False@
-- TODO: should we delete dist/setup-config?
--
-- * dist/setup-config doesn't exist yet -> should return True:
-- @Nothing < Just cf = True@
@ -201,7 +233,6 @@ isSetupConfigOutOfDate :: Maybe TimedFile -> Maybe TimedFile -> Bool
isSetupConfigOutOfDate worldCabalFile worldCabalConfig = do
worldCabalConfig < worldCabalFile
helperProgs :: Options -> Programs
helperProgs opts = Programs {
cabalProgram = T.cabalProgram opts,
@ -210,17 +241,19 @@ 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
dist <- cradleDistDir <$> cradle
d <- cacheInputData root
withCabal $ cached root c d
withCabal $ cached root (c dist) d
where
-- we don't need to include the disdir in the cache input because when it
-- changes the cache files will be gone anyways ;)
cacheInputData root = do
opt <- options
return $ ( helperProgs opt
, root
, root </> "dist"
, (gmVer, chVer)
)

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

@ -49,4 +49,4 @@ data TimedCacheFiles = TimedCacheFiles {
-- ^ Timestamped files returned by the cached action
} deriving (Eq, Ord, Show)
type ChCacheData = (Programs, FilePath, FilePath, (Version, [Char]))
type ChCacheData = (Programs, FilePath, (Version, [Char]))

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

@ -1,9 +1,14 @@
module Language.Haskell.GhcMod.Cradle (
{-# LANGUAGE CPP #-}
module Language.Haskell.GhcMod.Cradle
#ifndef SPEC
(
findCradle
, findCradle'
, findSpecCradle
, cleanupCradle
) where
)
#endif
where
import Language.Haskell.GhcMod.PathsAndFiles
import Language.Haskell.GhcMod.Monad.Types
@ -29,7 +34,7 @@ findCradle = findCradle' =<< getCurrentDirectory
findCradle' :: FilePath -> IO Cradle
findCradle' dir = run $ do
(cabalCradle dir `mplus` sandboxCradle dir `mplus` plainCradle dir)
(stackCradle dir `mplus` cabalCradle dir `mplus` sandboxCradle dir `mplus` plainCradle dir)
where run a = fillTempDir =<< (fromJust <$> runMaybeT a)
findSpecCradle :: FilePath -> IO Cradle
@ -65,6 +70,25 @@ cabalCradle wdir = do
, cradleRootDir = cabalDir
, cradleTempDir = error "tmpDir"
, cradleCabalFile = Just cabalFile
, cradleDistDir = "dist"
}
stackCradle :: FilePath -> MaybeT IO Cradle
stackCradle wdir = do
cabalFile <- MaybeT $ findCabalFile wdir
let cabalDir = takeDirectory cabalFile
_stackConfigFile <- MaybeT $ findStackConfigFile cabalDir
distDir <- MaybeT $ getStackDistDir cabalDir
return Cradle {
cradleProjectType = StackProject
, cradleCurrentDir = wdir
, cradleRootDir = cabalDir
, cradleTempDir = error "tmpDir"
, cradleCabalFile = Just cabalFile
, cradleDistDir = distDir
}
sandboxCradle :: FilePath -> MaybeT IO Cradle
@ -76,6 +100,7 @@ sandboxCradle wdir = do
, cradleRootDir = sbDir
, cradleTempDir = error "tmpDir"
, cradleCabalFile = Nothing
, cradleDistDir = "dist"
}
plainCradle :: FilePath -> MaybeT IO Cradle
@ -86,4 +111,5 @@ plainCradle wdir = do
, cradleRootDir = wdir
, cradleTempDir = error "tmpDir"
, cradleCabalFile = Nothing
, cradleDistDir = "dist"
}

1
Language/Haskell/GhcMod/Debug.hs
View File

@ -27,6 +27,7 @@ debugInfo = do
cabal <-
case cradleProjectType of
CabalProject -> cabalDebug
StackProject -> cabalDebug
_ -> return []
pkgOpts <- packageGhcOptions

4
Language/Haskell/GhcMod/GhcPkg.hs
View File

@ -67,10 +67,12 @@ getPackageDbStack = do
PlainProject ->
return [GlobalDb, UserDb]
SandboxProject -> do
Just db <- liftIO $ getSandboxDb $ cradleRootDir crdl
Just db <- liftIO $ getSandboxDb crdl
return $ [GlobalDb, db]
CabalProject ->
getCabalPackageDbStack
StackProject ->
getStackPackageDbStack
return $ fromMaybe stack mCusPkgStack
getPackageCachePaths :: IOish m => FilePath -> GhcModT m [FilePath]

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

@ -22,6 +22,7 @@ module Language.Haskell.GhcMod.PathsAndFiles (
import Config (cProjectVersion)
import Control.Applicative
import Control.Monad
import Control.Monad.Trans.Maybe
import Data.List
import Data.Char
import Data.Maybe
@ -71,13 +72,18 @@ findCabalFile dir = do
appendDir :: DirPath -> [FileName] -> [FilePath]
appendDir d fs = (d </>) `map` fs
findStackConfigFile :: FilePath -> IO (Maybe FilePath)
findStackConfigFile dir = mightExist (dir </> "stack.yaml")
getStackDistDir :: FilePath -> IO (Maybe FilePath)
getStackDistDir dir = U.withDirectory_ dir $ runMaybeT $ do
stack <- MaybeT $ findExecutable "stack"
liftIO $ takeWhile (/='\n') <$> readProcess stack ["path", "--dist-dir"] ""
-- | Get path to sandbox config file
getSandboxDb :: FilePath
-- ^ Path to the cabal package root directory (containing the
-- @cabal.sandbox.config@ file)
-> IO (Maybe GhcPkgDb)
getSandboxDb d = do
mConf <- traverse readFile =<< mightExist (d </> "cabal.sandbox.config")
getSandboxDb :: Cradle -> IO (Maybe GhcPkgDb)
getSandboxDb crdl = do
mConf <-traverse readFile =<< mightExist (sandboxConfigFile crdl)
bp <- buildPlatform readProcess
return $ PackageDb . fixPkgDbVer bp <$> (extractSandboxDbDir =<< mConf)
@ -145,7 +151,7 @@ findCabalSandboxDir dir = do
_ -> Nothing
where
isSandboxConfig = (==sandboxConfigFile)
isSandboxConfig = (==sandboxConfigFileName)
zipMapM :: Monad m => (a -> m c) -> [a] -> m [(a,c)]
zipMapM f as = mapM (\a -> liftM ((,) a) $ f a) as
@ -179,17 +185,22 @@ parents dir' =
----------------------------------------------------------------
setupConfigFile :: Cradle -> FilePath
setupConfigFile crdl = cradleRootDir crdl </> setupConfigPath
setupConfigFile crdl =
cradleRootDir crdl </> setupConfigPath (cradleDistDir crdl)
sandboxConfigFile :: FilePath
sandboxConfigFile = "cabal.sandbox.config"
sandboxConfigFile :: Cradle -> FilePath
sandboxConfigFile crdl = cradleRootDir crdl </> sandboxConfigFileName
sandboxConfigFileName :: String
sandboxConfigFileName = "cabal.sandbox.config"
-- | Path to 'LocalBuildInfo' file, usually @dist/setup-config@
setupConfigPath :: FilePath
setupConfigPath = "dist/setup-config" -- localBuildInfoFile defaultDistPref
setupConfigPath :: FilePath -> FilePath
setupConfigPath dist = dist </> "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
@ -205,17 +216,21 @@ symbolCache crdl = cradleTempDir crdl </> symbolCacheFile
symbolCacheFile :: String
symbolCacheFile = "ghc-mod.symbol-cache"
resolvedComponentsCacheFile :: String
resolvedComponentsCacheFile = setupConfigPath <.> "ghc-mod.resolved-components"
resolvedComponentsCacheFile :: FilePath -> FilePath
resolvedComponentsCacheFile dist =
setupConfigPath dist <.> "ghc-mod.resolved-components"
cabalHelperCacheFile :: String
cabalHelperCacheFile = setupConfigPath <.> "ghc-mod.cabal-components"
cabalHelperCacheFile :: FilePath -> FilePath
cabalHelperCacheFile dist =
setupConfigPath dist <.> "ghc-mod.cabal-components"
mergedPkgOptsCacheFile :: String
mergedPkgOptsCacheFile = setupConfigPath <.> "ghc-mod.package-options"
mergedPkgOptsCacheFile :: FilePath -> FilePath
mergedPkgOptsCacheFile dist =
setupConfigPath dist <.> "ghc-mod.package-options"
pkgDbStackCacheFile :: String
pkgDbStackCacheFile = setupConfigPath <.> "ghc-mod.package-db-stack"
pkgDbStackCacheFile :: FilePath -> FilePath
pkgDbStackCacheFile dist =
setupConfigPath dist <.> "ghc-mod.package-db-stack"
-- | @findCustomPackageDbFile dir@. Searches for a @.ghc-mod.cradle@ file in @dir@.
-- If it exists in the given directory it is returned otherwise @findCradleFile@ returns @Nothing@

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

@ -149,6 +149,7 @@ targetGhcOptions crdl sefnmn = do
case cradleProjectType crdl of
CabalProject -> cabalOpts crdl
StackProject -> cabalOpts crdl
_ -> sandboxOpts crdl
where
zipMap f l = l `zip` (f `map` l)
@ -177,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 = resolvedComponentsCacheFile distdir,
cachedAction = \tcfs comps ma -> do
Cradle {..} <- cradle
let iifsM = invalidatingInputFiles tcfs
@ -193,13 +195,13 @@ resolvedComponentsCache = Cached {
Just iifs ->
let
filterOutSetupCfg =
filter (/= cradleRootDir </> setupConfigPath)
filter (/= cradleRootDir </> setupConfigPath distdir)
changedFiles = filterOutSetupCfg iifs
in if null changedFiles
then Nothing
else Just $ map Left changedFiles
setupChanged = maybe False
(elem $ cradleRootDir </> setupConfigPath)
(elem $ cradleRootDir </> setupConfigPath distdir)
iifsM
case (setupChanged, ma) of
(False, Just mcs) -> gmsGet >>= \s -> gmsPut s { gmComponents = mcs }
@ -216,7 +218,7 @@ resolvedComponentsCache = Cached {
text "files changed" <+>: changedDoc
mcs <- resolveGmComponents mums comps
return (setupConfigPath:flatten mcs , mcs)
return (setupConfigPath distdir : flatten mcs , mcs)
}
where
@ -264,31 +266,29 @@ packageGhcOptions = do
crdl <- cradle
case cradleProjectType crdl of
CabalProject -> getGhcMergedPkgOptions
StackProject -> getGhcMergedPkgOptions
_ -> sandboxOpts crdl
-- also works for plain projects!
sandboxOpts :: MonadIO m => Cradle -> m [String]
sandboxOpts crdl = do
pkgDbStack <- liftIO $ getSandboxPackageDbStack $ cradleRootDir crdl
pkgDbStack <- liftIO $ getSandboxPackageDbStack
let pkgOpts = ghcDbStackOpts pkgDbStack
return $ ["-i" ++ d | d <- [wdir,rdir]] ++ pkgOpts ++ ["-Wall"]
where
(wdir, rdir) = (cradleCurrentDir crdl, cradleRootDir crdl)
getSandboxPackageDbStack
:: FilePath
-- ^ Project Directory (where the cabal.sandbox.config file would be if
-- it exists)
-> IO [GhcPkgDb]
getSandboxPackageDbStack cdir =
([GlobalDb] ++) . maybe [UserDb] return <$> getSandboxDb cdir
getSandboxPackageDbStack :: IO [GhcPkgDb]
getSandboxPackageDbStack =
([GlobalDb] ++) . maybe [UserDb] return <$> getSandboxDb crdl
resolveGmComponent :: (IOish m, GmLog m, GmEnv m, GmState m)
=> Maybe [CompilationUnit] -- ^ Updated modules
-> 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
@ -302,10 +302,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)
@ -472,4 +472,4 @@ cabalResolvedComponents :: (IOish m) =>
cabalResolvedComponents = do
crdl@(Cradle{..}) <- cradle
comps <- mapM (resolveEntrypoint crdl) =<< getComponents
cached cradleRootDir resolvedComponentsCache comps
cached cradleRootDir (resolvedComponentsCache cradleDistDir) comps

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

@ -121,7 +121,7 @@ defaultOptions = Options {
----------------------------------------------------------------
data ProjectType = CabalProject | SandboxProject | PlainProject
data ProjectType = CabalProject | SandboxProject | PlainProject | StackProject
deriving (Eq, Show)
-- | The environment where this library is used.
@ -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)

3
Language/Haskell/GhcMod/World.hs
View File

@ -18,6 +18,7 @@ data World = World {
worldPackageCaches :: [TimedFile]
, worldCabalFile :: Maybe TimedFile
, worldCabalConfig :: Maybe TimedFile
, worldCabalSandboxConfig :: Maybe TimedFile
, worldSymbolCache :: Maybe TimedFile
} deriving (Eq, Show)
@ -33,12 +34,14 @@ getCurrentWorld = do
pkgCaches <- timedPackageCaches
mCabalFile <- liftIO $ timeFile `traverse` cradleCabalFile crdl
mCabalConfig <- liftIO $ timeMaybe (setupConfigFile crdl)
mCabalSandboxConfig <- liftIO $ timeMaybe (sandboxConfigFile crdl)
mSymbolCache <- liftIO $ timeMaybe (symbolCache crdl)
return World {
worldPackageCaches = pkgCaches
, worldCabalFile = mCabalFile
, worldCabalConfig = mCabalConfig
, worldCabalSandboxConfig = mCabalSandboxConfig
, worldSymbolCache = mSymbolCache
}

6
ghc-mod.cabal
View File

@ -85,6 +85,12 @@ Extra-Source-Files: ChangeLog
test/data/file-mapping/preprocessor/*.hs
test/data/file-mapping/lhs/*.lhs
test/data/nice-qualification/*.hs
test/data/stack-project/stack.yaml
test/data/stack-project/new-template.cabal
test/data/stack-project/*.hs
test/data/stack-project/app/*.hs
test/data/stack-project/src/*.hs
test/data/stack-project/test/*.hs
Library
Default-Language: Haskell2010

5
src/GHCMod.hs
View File

@ -669,9 +669,10 @@ nukeCaches = do
chdir <- liftIO $ (</> "cabal-helper") <$> getAppUserDataDirectory "ghc-mod"
c <- cradle
when (cradleProjectType c == CabalProject) $ do
when (cradleProjectType c == CabalProject || cradleProjectType c == StackProject) $ do
let root = cradleRootDir c
liftIO $ (trySome . removeDirectoryRecursive) `mapM_` [chdir, root </> "dist"]
let dist = cradleDistDir c
liftIO $ (trySome . removeDirectoryRecursive) `mapM_` [chdir, root </> dist]
trySome :: IO a -> IO (Either SomeException a)
trySome = try

6
test/CabalHelperSpec.hs
View File

@ -56,6 +56,12 @@ spec = do
then forM_ opts (\o -> o `shouldContain` ["-no-user-package-conf","-package-conf", cwd </> "test/data/cabal-project/.cabal-sandbox/"++ghcSandboxPkgDbDir bp])
else forM_ opts (\o -> o `shouldContain` ["-no-user-package-db","-package-db",cwd </> "test/data/cabal-project/.cabal-sandbox/"++ghcSandboxPkgDbDir bp])
it "handles stack project" $ do
let tdir = "test/data/stack-project"
[ghcOpts] <- map gmcGhcOpts . filter ((==ChExeName "new-template-exe") . gmcName) <$> runD' tdir getComponents
let pkgs = pkgOptions ghcOpts
pkgs `shouldBe` ["base", "bytestring"]
it "extracts build dependencies" $ do
let tdir = "test/data/cabal-project"
opts <- map gmcGhcOpts <$> runD' tdir getComponents

16
test/Main.hs
View File

@ -36,16 +36,26 @@ main = do
, "setup-config.ghc-mod.package-db-stack"
, "ghc-mod.cache"
]
cachesFindExp :: String
cachesFindExp = unwords $ intersperse "-o " $ map ("-name "++) caches
findExp = unwords $ intersperse "-o " $ concat [
stackWorkFindExp,
cachesFindExp
]
cachesFindExp = map ("-name "++) caches
stackWorkFindExp = ["-name .stack-work -type d"]
cleanCmd = "find test \\( "++ cachesFindExp ++" \\) -exec rm {} \\;"
cleanCmd = "find test \\( "++ findExp ++" \\) -exec rm -r {} \\;"
putStrLn $ "$ " ++ cleanCmd
void $ system cleanCmd
void $ system "cabal --version"
void $ system "ghc --version"
let stackDir = "test/data/stack-project"
void $ withDirectory_ stackDir $ do
-- void $ system "stack init --force"
void $ system "stack setup"
void $ system "stack build"
(putStrLn =<< runD debugInfo)
`E.catch` (\(_ :: E.SomeException) -> return () )

15
test/PathsAndFilesSpec.hs
View File

@ -1,7 +1,10 @@
module PathsAndFilesSpec where
import Language.Haskell.GhcMod.PathsAndFiles
import Language.Haskell.GhcMod.PathsAndFiles
import Language.Haskell.GhcMod.Cradle
import Control.Monad.Trans.Maybe
import System.Directory
import System.FilePath
import Test.Hspec
@ -12,11 +15,13 @@ spec = do
describe "getSandboxDb" $ do
it "can parse a config file and extract the sandbox package-db" $ do
cwd <- getCurrentDirectory
Just db <- getSandboxDb "test/data/cabal-project"
Just crdl <- runMaybeT $ plainCradle "test/data/cabal-project"
Just db <- getSandboxDb crdl
db `shouldSatisfy` isPkgDbAt (cwd </> "test/data/cabal-project/.cabal-sandbox")
it "returns Nothing if the sandbox config file is broken" $ do
getSandboxDb "test/data/broken-sandbox" `shouldReturn` Nothing
Just crdl <- runMaybeT $ plainCradle "test/data/broken-sandbox"
getSandboxDb crdl `shouldReturn` Nothing
describe "findCabalFile" $ do
it "works" $ do
@ -25,6 +30,10 @@ spec = do
it "finds cabal files in parent directories" $ do
findCabalFile "test/data/cabal-project/subdir1/subdir2" `shouldReturn` Just "test/data/cabal-project/cabalapi.cabal"
describe "findStackConfigFile" $ do
it "works" $ do
findStackConfigFile "test/data/stack-project" `shouldReturn` Just "test/data/stack-project/stack.yaml"
describe "findCabalSandboxDir" $ do
it "works" $ do
findCabalSandboxDir "test/data/cabal-project" `shouldReturn` Just "test/data/cabal-project"

2
test/data/stack-project/Setup.hs Normal file
View File

@ -0,0 +1,2 @@
import Distribution.Simple
main = defaultMain

6
test/data/stack-project/app/Main.hs Normal file
View File

@ -0,0 +1,6 @@
module Main where
import Lib
main :: IO ()
main = someFunc

42
test/data/stack-project/new-template.cabal Normal file
View File

@ -0,0 +1,42 @@
name: new-template
version: 0.1.0.0
synopsis: Initial project template from stack
description: Please see README.md
homepage: http://github.com/name/project
-- license: BSD3
-- license-file: LICENSE
author: Your name here
maintainer: your.address@example.com
-- copyright:
category: Web
build-type: Simple
-- extra-source-files:
cabal-version: >=1.10
library
hs-source-dirs: src
exposed-modules: Lib
build-depends: base >= 4.7 && < 5
default-language: Haskell2010
executable new-template-exe
hs-source-dirs: app
main-is: Main.hs
ghc-options: -threaded -rtsopts -with-rtsopts=-N
build-depends: base
, new-template
, bytestring
default-language: Haskell2010
test-suite new-template-test
type: exitcode-stdio-1.0
hs-source-dirs: test
main-is: Spec.hs
build-depends: base
, new-template
ghc-options: -threaded -rtsopts -with-rtsopts=-N
default-language: Haskell2010
source-repository head
type: git
location: https://github.com/name/project

6
test/data/stack-project/src/Lib.hs Normal file
View File

@ -0,0 +1,6 @@
module Lib
( someFunc
) where
someFunc :: IO ()
someFunc = putStrLn "someFunc"

5
test/data/stack-project/stack.yaml Normal file
View File

@ -0,0 +1,5 @@
flags: {}
packages:
- '.'
extra-deps: []
resolver: lts-2.17

2
test/data/stack-project/test/Spec.hs Normal file
View File

@ -0,0 +1,2 @@
main :: IO ()
main = putStrLn "Test suite not yet implemented"