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

Merge branch 'stack-support'

Browse Source
This commit is contained in:
Daniel Gröber 2015-08-20 02:14:55 +02:00
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"