ghc-mod/Cradle.hs

88 lines
3.0 KiB
Haskell
Raw Normal View History

module Cradle where
2013-03-04 04:55:03 +00:00
import CabalApi (getGHCVersion)
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-02 07:14:55 +00:00
findCradle :: Maybe FilePath -> IO Cradle
findCradle (Just sbox) = do
2013-03-04 04:55:03 +00:00
(strver, ver) <- getGHCVersion
conf <- checkPackageConf sbox strver
let confOpts = ghcPackageConfOptions ver conf
wdir <- getCurrentDirectory
cfiles <- cabalDir wdir
return $ case cfiles of
Nothing -> Cradle {
2013-03-04 01:40:06 +00:00
cradleCurrentDir = wdir
, cradleCabalDir = Nothing
, cradleCabalFile = Nothing
, cradlePackageConfOpts = Just confOpts
2013-03-04 01:40:06 +00:00
, cradleGHCVersion = strver
}
Just (cdir,cfile) -> Cradle {
2013-03-04 01:40:06 +00:00
cradleCurrentDir = wdir
, cradleCabalDir = Just cdir
, cradleCabalFile = Just cfile
, cradlePackageConfOpts = Just confOpts
2013-03-04 01:40:06 +00:00
, cradleGHCVersion = strver
}
2013-03-02 07:14:55 +00:00
findCradle Nothing = do
2013-03-04 04:55:03 +00:00
(strver, ver) <- getGHCVersion
wdir <- getCurrentDirectory
cfiles <- cabalDir wdir
case cfiles of
2013-03-03 06:57:31 +00:00
Nothing -> return Cradle {
2013-03-04 01:40:06 +00:00
cradleCurrentDir = wdir
, cradleCabalDir = Nothing
, cradleCabalFile = Nothing
, cradlePackageConfOpts = Nothing
2013-03-04 01:40:06 +00:00
, cradleGHCVersion = strver
}
Just (cdir,cfile) -> do
let sbox = cdir </> "cabal-dev/"
conf = packageConfName sbox strver
confOpts = ghcPackageConfOptions ver conf
exist <- doesFileExist conf
2013-03-03 06:57:31 +00:00
return Cradle {
cradleCurrentDir = wdir
, cradleCabalDir = Just cdir
, cradleCabalFile = Just cfile
, cradlePackageConfOpts = if exist then Just confOpts else Nothing
2013-03-04 01:40:06 +00:00
, cradleGHCVersion = strver
}
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 <- doesFileExist conf
if exist then
return conf
else
throwIO $ userError $ conf ++ " not found"
ghcPackageConfOptions :: Int -> String -> [String]
ghcPackageConfOptions ver file
| ver >= 706 = ["-package-db", file, "-no-user-package-conf"]
| otherwise = ["-package-conf", file, "-no-user-package-conf"]