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

77 lines
2.6 KiB
Haskell
Raw Normal View History

2013-05-17 01:00:01 +00:00
module Language.Haskell.GhcMod.Cradle (findCradle) where
import Control.Applicative ((<$>))
import Control.Exception (throwIO)
import Control.Monad
2013-03-04 04:55:03 +00:00
import Data.List (isSuffixOf)
2013-05-17 01:00:01 +00:00
import Language.Haskell.GhcMod.Types
import System.Directory
import System.FilePath ((</>),takeDirectory)
2013-05-20 05:28:56 +00:00
-- | Finding 'Cradle'.
-- An error would be thrown.
findCradle :: Maybe FilePath -- ^ A 'FilePath' for a sandbox
-> GHCVersion
-> IO Cradle
2013-03-04 09:11:09 +00:00
findCradle (Just sbox) strver = do
pkgConf <- checkPackageConf sbox strver
wdir <- getCurrentDirectory
cfiles <- cabalDir wdir
return $ case cfiles of
Nothing -> Cradle {
2013-04-10 05:46:58 +00:00
cradleCurrentDir = wdir
, cradleCabalDir = Nothing
, cradleCabalFile = Nothing
2013-03-04 09:11:09 +00:00
, cradlePackageConf = Just pkgConf
}
Just (cdir,cfile) -> Cradle {
2013-04-10 05:46:58 +00:00
cradleCurrentDir = wdir
, cradleCabalDir = Just cdir
, cradleCabalFile = Just cfile
2013-03-04 09:11:09 +00:00
, cradlePackageConf = Just pkgConf
}
2013-03-04 09:11:09 +00:00
findCradle Nothing strver = do
wdir <- getCurrentDirectory
cfiles <- cabalDir wdir
case cfiles of
2013-03-03 06:57:31 +00:00
Nothing -> return Cradle {
2013-03-04 09:11:09 +00:00
cradleCurrentDir = wdir
, cradleCabalDir = Nothing
, cradleCabalFile = Nothing
, cradlePackageConf = Nothing
}
Just (cdir,cfile) -> do
2013-03-31 14:12:34 +00:00
let sbox = cdir </> "cabal-dev"
2013-03-04 09:11:09 +00:00
pkgConf = packageConfName sbox strver
2013-03-07 11:50:04 +00:00
exist <- doesDirectoryExist pkgConf
2013-03-03 06:57:31 +00:00
return Cradle {
2013-03-04 09:11:09 +00:00
cradleCurrentDir = wdir
, cradleCabalDir = Just cdir
, cradleCabalFile = Just cfile
, cradlePackageConf = if exist then Just pkgConf else Nothing
}
cabalDir :: FilePath -> IO (Maybe (FilePath,FilePath))
cabalDir dir = do
cnts <- (filter isCabal <$> getDirectoryContents dir)
>>= filterM (\file -> doesFileExist (dir </> file))
let dir' = takeDirectory dir
case cnts of
[] | dir' == dir -> return Nothing
| otherwise -> cabalDir dir'
cfile:_ -> return $ Just (dir,dir </> cfile)
where
isCabal name = ".cabal" `isSuffixOf` name && length name > 6
packageConfName :: FilePath -> String -> FilePath
packageConfName path ver = path </> "packages-" ++ ver ++ ".conf"
checkPackageConf :: FilePath -> String -> IO FilePath
checkPackageConf path ver = do
let conf = packageConfName path ver
2013-03-07 11:50:04 +00:00
exist <- doesDirectoryExist conf
if exist then
return conf
else
throwIO $ userError $ conf ++ " not found"