Yet another try to support Stack.
This commit is contained in:
parent
e360f7eb44
commit
320b404a8c
@ -20,6 +20,7 @@ module Language.Haskell.GhcMod.CabalHelper
|
|||||||
( getComponents
|
( getComponents
|
||||||
, getGhcMergedPkgOptions
|
, getGhcMergedPkgOptions
|
||||||
, getCabalPackageDbStack
|
, getCabalPackageDbStack
|
||||||
|
, getStackPackageDbStack
|
||||||
, getCustomPkgDbStack
|
, getCustomPkgDbStack
|
||||||
, prepareCabalHelper
|
, prepareCabalHelper
|
||||||
)
|
)
|
||||||
@ -43,6 +44,7 @@ import Language.Haskell.GhcMod.PathsAndFiles
|
|||||||
import Language.Haskell.GhcMod.Logging
|
import Language.Haskell.GhcMod.Logging
|
||||||
import Language.Haskell.GhcMod.Output
|
import Language.Haskell.GhcMod.Output
|
||||||
import System.FilePath
|
import System.FilePath
|
||||||
|
import System.Directory (findExecutable)
|
||||||
import Prelude hiding ((.))
|
import Prelude hiding ((.))
|
||||||
|
|
||||||
import Paths_ghc_mod as GhcMod
|
import Paths_ghc_mod as GhcMod
|
||||||
@ -132,6 +134,16 @@ getCustomPkgDbStack = do
|
|||||||
mCusPkgDbFile <- liftIO . (traverse readFile <=< findCustomPackageDbFile) . cradleRootDir =<< cradle
|
mCusPkgDbFile <- liftIO . (traverse readFile <=< findCustomPackageDbFile) . cradleRootDir =<< cradle
|
||||||
return $ parseCustomPackageDb <$> mCusPkgDbFile
|
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 :: (IOish m, GmEnv m, GmLog m) => m a -> m a
|
||||||
withCabal action = do
|
withCabal action = do
|
||||||
crdl <- cradle
|
crdl <- cradle
|
||||||
|
@ -29,7 +29,7 @@ findCradle = findCradle' =<< getCurrentDirectory
|
|||||||
|
|
||||||
findCradle' :: FilePath -> IO Cradle
|
findCradle' :: FilePath -> IO Cradle
|
||||||
findCradle' dir = run $ do
|
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)
|
where run a = fillTempDir =<< (fromJust <$> runMaybeT a)
|
||||||
|
|
||||||
findSpecCradle :: FilePath -> IO Cradle
|
findSpecCradle :: FilePath -> IO Cradle
|
||||||
@ -67,6 +67,22 @@ cabalCradle wdir = do
|
|||||||
, cradleCabalFile = Just cabalFile
|
, cradleCabalFile = Just cabalFile
|
||||||
}
|
}
|
||||||
|
|
||||||
|
stackCradle :: FilePath -> MaybeT IO Cradle
|
||||||
|
stackCradle wdir = do
|
||||||
|
cabalFile <- MaybeT $ findCabalFile wdir
|
||||||
|
|
||||||
|
let cabalDir = takeDirectory cabalFile
|
||||||
|
|
||||||
|
stackConfigFile <- MaybeT $ findStackConfigFile cabalDir
|
||||||
|
|
||||||
|
return Cradle {
|
||||||
|
cradleProjectType = StackProject
|
||||||
|
, cradleCurrentDir = wdir
|
||||||
|
, cradleRootDir = cabalDir
|
||||||
|
, cradleTempDir = error "tmpDir"
|
||||||
|
, cradleCabalFile = Just cabalFile
|
||||||
|
}
|
||||||
|
|
||||||
sandboxCradle :: FilePath -> MaybeT IO Cradle
|
sandboxCradle :: FilePath -> MaybeT IO Cradle
|
||||||
sandboxCradle wdir = do
|
sandboxCradle wdir = do
|
||||||
sbDir <- MaybeT $ findCabalSandboxDir wdir
|
sbDir <- MaybeT $ findCabalSandboxDir wdir
|
||||||
|
@ -71,6 +71,8 @@ getPackageDbStack = do
|
|||||||
return $ [GlobalDb, db]
|
return $ [GlobalDb, db]
|
||||||
CabalProject ->
|
CabalProject ->
|
||||||
getCabalPackageDbStack
|
getCabalPackageDbStack
|
||||||
|
StackProject ->
|
||||||
|
getStackPackageDbStack
|
||||||
return $ fromMaybe stack mCusPkgStack
|
return $ fromMaybe stack mCusPkgStack
|
||||||
|
|
||||||
getPackageCachePaths :: IOish m => FilePath -> GhcModT m [FilePath]
|
getPackageCachePaths :: IOish m => FilePath -> GhcModT m [FilePath]
|
||||||
|
@ -71,6 +71,9 @@ findCabalFile dir = do
|
|||||||
appendDir :: DirPath -> [FileName] -> [FilePath]
|
appendDir :: DirPath -> [FileName] -> [FilePath]
|
||||||
appendDir d fs = (d </>) `map` fs
|
appendDir d fs = (d </>) `map` fs
|
||||||
|
|
||||||
|
findStackConfigFile :: FilePath -> IO (Maybe FilePath)
|
||||||
|
findStackConfigFile dir = mightExist (dir </> "stack.yaml")
|
||||||
|
|
||||||
-- | Get path to sandbox config file
|
-- | Get path to sandbox config file
|
||||||
getSandboxDb :: FilePath
|
getSandboxDb :: FilePath
|
||||||
-- ^ Path to the cabal package root directory (containing the
|
-- ^ Path to the cabal package root directory (containing the
|
||||||
|
@ -149,6 +149,7 @@ targetGhcOptions crdl sefnmn = do
|
|||||||
|
|
||||||
case cradleProjectType crdl of
|
case cradleProjectType crdl of
|
||||||
CabalProject -> cabalOpts crdl
|
CabalProject -> cabalOpts crdl
|
||||||
|
StackProject -> stackOpts crdl
|
||||||
_ -> sandboxOpts crdl
|
_ -> sandboxOpts crdl
|
||||||
where
|
where
|
||||||
zipMap f l = l `zip` (f `map` l)
|
zipMap f l = l `zip` (f `map` l)
|
||||||
@ -264,8 +265,17 @@ packageGhcOptions = do
|
|||||||
crdl <- cradle
|
crdl <- cradle
|
||||||
case cradleProjectType crdl of
|
case cradleProjectType crdl of
|
||||||
CabalProject -> getGhcMergedPkgOptions
|
CabalProject -> getGhcMergedPkgOptions
|
||||||
|
StackProject -> stackOpts crdl
|
||||||
_ -> sandboxOpts crdl
|
_ -> sandboxOpts crdl
|
||||||
|
|
||||||
|
stackOpts :: MonadIO m => Cradle -> m [String]
|
||||||
|
stackOpts crdl = do
|
||||||
|
pkgDbStack <- liftIO getStackPackageDbStack
|
||||||
|
let pkgOpts = ghcDbStackOpts pkgDbStack
|
||||||
|
return $ ["-i" ++ d | d <- [wdir,rdir]] ++ pkgOpts ++ ["-Wall"]
|
||||||
|
where
|
||||||
|
(wdir, rdir) = (cradleCurrentDir crdl, cradleRootDir crdl)
|
||||||
|
|
||||||
-- also works for plain projects!
|
-- also works for plain projects!
|
||||||
sandboxOpts :: MonadIO m => Cradle -> m [String]
|
sandboxOpts :: MonadIO m => Cradle -> m [String]
|
||||||
sandboxOpts crdl = do
|
sandboxOpts crdl = do
|
||||||
|
@ -121,7 +121,7 @@ defaultOptions = Options {
|
|||||||
|
|
||||||
----------------------------------------------------------------
|
----------------------------------------------------------------
|
||||||
|
|
||||||
data ProjectType = CabalProject | SandboxProject | PlainProject
|
data ProjectType = CabalProject | SandboxProject | PlainProject | StackProject
|
||||||
deriving (Eq, Show)
|
deriving (Eq, Show)
|
||||||
|
|
||||||
-- | The environment where this library is used.
|
-- | The environment where this library is used.
|
||||||
|
Loading…
Reference in New Issue
Block a user