82bb0090c0
This turned out to be quite involved but save for this huge commit it's actually quite awesome and squashes quite a few bugs and nasty problems (hopefully). Most importantly we now have native cabal component support without the user having to do anything to get it! To do this we traverse imports starting from each component's entrypoints (library modules or Main source file for executables) and use this information to find which component's options each module will build with. Under the assumption that these modules have to build with every component they're used in we can now just pick one. Quite a few internal assumptions have been invalidated by this change. Most importantly the runGhcModT* family of cuntions now change the current working directory to `cradleRootDir`.
98 lines
3.0 KiB
Haskell
98 lines
3.0 KiB
Haskell
module Language.Haskell.GhcMod.Cradle (
|
|
findCradle
|
|
, findCradle'
|
|
, findSpecCradle
|
|
, cleanupCradle
|
|
) where
|
|
|
|
import Language.Haskell.GhcMod.PathsAndFiles
|
|
import Language.Haskell.GhcMod.Monad.Types
|
|
import Language.Haskell.GhcMod.Types
|
|
import Language.Haskell.GhcMod.Utils
|
|
|
|
import Control.Applicative
|
|
import Control.Monad
|
|
import Control.Monad.Trans.Maybe
|
|
import Data.Maybe
|
|
import System.Directory
|
|
import System.FilePath
|
|
|
|
----------------------------------------------------------------
|
|
|
|
-- | Finding 'Cradle'.
|
|
-- Find a cabal file by tracing ancestor directories.
|
|
-- Find a sandbox according to a cabal sandbox config
|
|
-- in a cabal directory.
|
|
findCradle :: IO Cradle
|
|
findCradle = findCradle' =<< getCurrentDirectory
|
|
|
|
findCradle' :: FilePath -> IO Cradle
|
|
findCradle' dir = run $ do
|
|
(cabalCradle dir `mplus` sandboxCradle dir `mplus` plainCradle dir)
|
|
where run a = fillTempDir =<< (fromJust <$> runMaybeT a)
|
|
|
|
findSpecCradle :: FilePath -> IO Cradle
|
|
findSpecCradle dir = do
|
|
let cfs = [cabalCradle, sandboxCradle]
|
|
cs <- catMaybes <$> mapM (runMaybeT . ($ dir)) cfs
|
|
gcs <- filterM isNotGmCradle cs
|
|
fillTempDir =<< case gcs of
|
|
[] -> fromJust <$> runMaybeT (plainCradle dir)
|
|
c:_ -> return c
|
|
where
|
|
isNotGmCradle :: Cradle -> IO Bool
|
|
isNotGmCradle crdl = do
|
|
not <$> doesFileExist (cradleRootDir crdl </> "ghc-mod.cabal")
|
|
|
|
cleanupCradle :: Cradle -> IO ()
|
|
cleanupCradle crdl = removeDirectoryRecursive $ cradleTempDir crdl
|
|
|
|
fillTempDir :: MonadIO m => Cradle -> m Cradle
|
|
fillTempDir crdl = do
|
|
tmpDir <- liftIO $ newTempDir (cradleRootDir crdl)
|
|
return crdl { cradleTempDir = tmpDir }
|
|
|
|
cabalCradle :: FilePath -> MaybeT IO Cradle
|
|
cabalCradle wdir = do
|
|
cabalFile <- MaybeT $ findCabalFile wdir
|
|
|
|
let cabalDir = takeDirectory cabalFile
|
|
pkgDbStack <- liftIO $ getPackageDbStack cabalDir
|
|
|
|
return Cradle {
|
|
cradleCurrentDir = wdir
|
|
, cradleRootDir = cabalDir
|
|
, cradleTempDir = error "tmpDir"
|
|
, cradleCabalFile = Just cabalFile
|
|
, cradlePkgDbStack = pkgDbStack
|
|
}
|
|
|
|
sandboxCradle :: FilePath -> MaybeT IO Cradle
|
|
sandboxCradle wdir = do
|
|
sbDir <- MaybeT $ findCabalSandboxDir wdir
|
|
pkgDbStack <- liftIO $ getPackageDbStack sbDir
|
|
return Cradle {
|
|
cradleCurrentDir = wdir
|
|
, cradleRootDir = sbDir
|
|
, cradleTempDir = error "tmpDir"
|
|
, cradleCabalFile = Nothing
|
|
, cradlePkgDbStack = pkgDbStack
|
|
}
|
|
|
|
plainCradle :: FilePath -> MaybeT IO Cradle
|
|
plainCradle wdir = do
|
|
return $ Cradle {
|
|
cradleCurrentDir = wdir
|
|
, cradleRootDir = wdir
|
|
, cradleTempDir = error "tmpDir"
|
|
, cradleCabalFile = Nothing
|
|
, cradlePkgDbStack = [GlobalDb, UserDb]
|
|
}
|
|
|
|
getPackageDbStack :: FilePath -- ^ Project Directory (where the
|
|
-- cabal.sandbox.config file would be if it
|
|
-- exists)
|
|
-> IO [GhcPkgDb]
|
|
getPackageDbStack cdir =
|
|
([GlobalDb] ++) . maybe [UserDb] return <$> getSandboxDb cdir
|