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
|