ghc-mod/Language/Haskell/GhcMod/Cradle.hs
2013-05-20 14:28:56 +09:00

77 lines
2.6 KiB
Haskell

module Language.Haskell.GhcMod.Cradle (findCradle) where
import Control.Applicative ((<$>))
import Control.Exception (throwIO)
import Control.Monad
import Data.List (isSuffixOf)
import Language.Haskell.GhcMod.Types
import System.Directory
import System.FilePath ((</>),takeDirectory)
-- | Finding 'Cradle'.
-- An error would be thrown.
findCradle :: Maybe FilePath -- ^ A 'FilePath' for a sandbox
-> GHCVersion
-> IO Cradle
findCradle (Just sbox) strver = do
pkgConf <- checkPackageConf sbox strver
wdir <- getCurrentDirectory
cfiles <- cabalDir wdir
return $ case cfiles of
Nothing -> Cradle {
cradleCurrentDir = wdir
, cradleCabalDir = Nothing
, cradleCabalFile = Nothing
, cradlePackageConf = Just pkgConf
}
Just (cdir,cfile) -> Cradle {
cradleCurrentDir = wdir
, cradleCabalDir = Just cdir
, cradleCabalFile = Just cfile
, cradlePackageConf = Just pkgConf
}
findCradle Nothing strver = do
wdir <- getCurrentDirectory
cfiles <- cabalDir wdir
case cfiles of
Nothing -> return Cradle {
cradleCurrentDir = wdir
, cradleCabalDir = Nothing
, cradleCabalFile = Nothing
, cradlePackageConf = Nothing
}
Just (cdir,cfile) -> do
let sbox = cdir </> "cabal-dev"
pkgConf = packageConfName sbox strver
exist <- doesDirectoryExist pkgConf
return Cradle {
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
exist <- doesDirectoryExist conf
if exist then
return conf
else
throwIO $ userError $ conf ++ " not found"