ghc-mod/Language/Haskell/GhcMod/Cradle.hs

138 lines
4.1 KiB
Haskell
Raw Normal View History

{-# LANGUAGE CPP #-}
module Language.Haskell.GhcMod.Cradle
#ifndef SPEC
(
2013-09-21 09:37:33 +00:00
findCradle
, findCradle'
, findSpecCradle
, cleanupCradle
)
#endif
where
2014-11-01 21:02:47 +00:00
import Language.Haskell.GhcMod.PathsAndFiles
import Language.Haskell.GhcMod.Monad.Types
2014-11-01 21:02:47 +00:00
import Language.Haskell.GhcMod.Types
2014-11-02 18:00:25 +00:00
import Language.Haskell.GhcMod.Utils
2015-09-15 03:25:00 +00:00
import Language.Haskell.GhcMod.Stack
import Control.Applicative
import Control.Monad
import Control.Monad.Trans.Maybe
import Data.Maybe
import System.Directory
import System.FilePath
2015-08-03 01:09:56 +00:00
import Prelude
----------------------------------------------------------------
2013-05-20 05:28:56 +00:00
-- | Finding 'Cradle'.
2013-09-20 06:53:51 +00:00
-- Find a cabal file by tracing ancestor directories.
-- Find a sandbox according to a cabal sandbox config
-- in a cabal directory.
findCradle :: (IOish m, GmOut m) => m Cradle
findCradle = findCradle' =<< liftIO getCurrentDirectory
findCradle' :: (IOish m, GmOut m) => FilePath -> m Cradle
findCradle' dir = run $
msum [ stackCradle dir
, cabalCradle dir
, sandboxCradle dir
, plainCradle dir
]
where run a = fillTempDir =<< (fromJust <$> runMaybeT a)
2015-09-14 03:59:01 +00:00
findSpecCradle :: (IOish m, GmOut m) => FilePath -> m Cradle
findSpecCradle dir = do
2015-09-14 05:11:45 +00:00
let cfs = [stackCradleSpec, cabalCradle, sandboxCradle]
cs <- catMaybes <$> mapM (runMaybeT . ($ dir)) cfs
gcs <- filterM isNotGmCradle cs
fillTempDir =<< case gcs of
[] -> fromJust <$> runMaybeT (plainCradle dir)
c:_ -> return c
where
2015-09-14 03:59:01 +00:00
isNotGmCradle crdl =
liftIO $ not <$> doesFileExist (cradleRootDir crdl </> "ghc-mod.cabal")
cleanupCradle :: Cradle -> IO ()
cleanupCradle crdl = removeDirectoryRecursive $ cradleTempDir crdl
fillTempDir :: IOish m => Cradle -> m Cradle
fillTempDir crdl = do
tmpDir <- liftIO $ newTempDir (cradleRootDir crdl)
return crdl { cradleTempDir = tmpDir }
cabalCradle :: IOish m => FilePath -> MaybeT m Cradle
cabalCradle wdir = do
cabalFile <- MaybeT $ liftIO $ findCabalFile wdir
2014-11-01 21:02:47 +00:00
let cabalDir = takeDirectory cabalFile
return Cradle {
cradleProject = CabalProject
2015-08-12 07:25:13 +00:00
, cradleCurrentDir = wdir
2014-11-01 21:02:47 +00:00
, cradleRootDir = cabalDir
, cradleTempDir = error "tmpDir"
2014-11-01 21:02:47 +00:00
, cradleCabalFile = Just cabalFile
2015-08-18 09:41:14 +00:00
, cradleDistDir = "dist"
}
stackCradle :: (IOish m, GmOut m) => FilePath -> MaybeT m Cradle
stackCradle wdir = do
cabalFile <- MaybeT $ liftIO $ findCabalFile wdir
2015-08-17 05:41:46 +00:00
let cabalDir = takeDirectory cabalFile
_stackConfigFile <- MaybeT $ liftIO $ findStackConfigFile cabalDir
-- If dist/setup-config already exists the user probably wants to use cabal
-- rather than stack, or maybe that's just me ;)
2015-08-24 13:11:05 +00:00
whenM (liftIO $ doesFileExist $ setupConfigPath "dist") $ mzero
senv <- MaybeT $ getStackEnv cabalDir
2015-08-17 05:41:46 +00:00
return Cradle {
cradleProject = StackProject senv
2015-08-17 05:41:46 +00:00
, cradleCurrentDir = wdir
, cradleRootDir = cabalDir
, cradleTempDir = error "tmpDir"
, cradleCabalFile = Just cabalFile
, cradleDistDir = seDistDir senv
2015-08-17 05:41:46 +00:00
}
2015-09-14 05:11:45 +00:00
stackCradleSpec :: (IOish m, GmOut m) => FilePath -> MaybeT m Cradle
stackCradleSpec wdir = do
crdl <- stackCradle wdir
case crdl of
Cradle { cradleProject = StackProject StackEnv { seDistDir } } -> do
b <- isGmDistDir seDistDir
when b mzero
return crdl
_ -> error "stackCradleSpec"
where
isGmDistDir dir =
liftIO $ not <$> doesFileExist (dir </> ".." </> "ghc-mod.cabal")
sandboxCradle :: IOish m => FilePath -> MaybeT m Cradle
sandboxCradle wdir = do
sbDir <- MaybeT $ liftIO $ findCabalSandboxDir wdir
return Cradle {
cradleProject = SandboxProject
2015-08-12 07:25:13 +00:00
, cradleCurrentDir = wdir
2014-11-01 21:02:47 +00:00
, cradleRootDir = sbDir
, cradleTempDir = error "tmpDir"
, cradleCabalFile = Nothing
2015-08-18 09:41:14 +00:00
, cradleDistDir = "dist"
}
plainCradle :: IOish m => FilePath -> MaybeT m Cradle
plainCradle wdir = do
return $ Cradle {
cradleProject = PlainProject
2015-08-12 07:25:13 +00:00
, cradleCurrentDir = wdir
, cradleRootDir = wdir
, cradleTempDir = error "tmpDir"
, cradleCabalFile = Nothing
2015-08-18 09:41:14 +00:00
, cradleDistDir = "dist"
}