ghc-mod/Cradle.hs

74 lines
2.4 KiB
Haskell
Raw Normal View History

2013-03-04 09:17:01 +00:00
module 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)
import System.Directory
import System.FilePath ((</>),takeDirectory)
import Types
-- An error would be thrown
2013-03-04 09:11:09 +00:00
findCradle :: Maybe FilePath -> String -> IO Cradle
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"