ghc-mod/Language/Haskell/GhcMod/Cradle.hs
Daniel Gröber 30b8366526 Refactor the way packages databases are handled
- cradle now stores a list of active package databases instead of only
  the user store (if present).

- rename `cradlePackageDb` -> `cradlePkgDbStack` as that`s what the ghc
  documentaion calls this kind of thing

- `getPackageDbPackages` now returns names of all visible packages in
  the given directory. Also the implementation now uses `ghc-pkg`
  instead of manually looking at the package database
2014-04-15 05:15:50 +02:00

113 lines
3.3 KiB
Haskell

{-# LANGUAGE BangPatterns #-}
module Language.Haskell.GhcMod.Cradle (
findCradle
, findCradleWithoutSandbox
) where
import Language.Haskell.GhcMod.Types
import Language.Haskell.GhcMod.GhcPkg
import Control.Applicative ((<$>))
import qualified Control.Exception as E
import Control.Exception.IOChoice ((||>))
import Control.Monad (filterM)
import Data.List (isSuffixOf)
import System.Directory (getCurrentDirectory, getDirectoryContents, doesFileExist)
import System.FilePath ((</>), takeDirectory)
----------------------------------------------------------------
-- | Finding 'Cradle'.
-- Find a cabal file by tracing ancestor directories.
-- Find a sandbox according to a cabal sandbox config
-- in a cabal directory.
findCradle :: IO Cradle
findCradle = do
wdir <- getCurrentDirectory
cabalCradle wdir ||> sandboxCradle wdir ||> plainCradle wdir
cabalCradle :: FilePath -> IO Cradle
cabalCradle wdir = do
(rdir,cfile) <- cabalDir wdir
pkgDbStack <- getPackageDbStack rdir
return Cradle {
cradleCurrentDir = wdir
, cradleRootDir = rdir
, cradleCabalFile = Just cfile
, cradlePkgDbStack = pkgDbStack
, cradlePackages = []
}
sandboxCradle :: FilePath -> IO Cradle
sandboxCradle wdir = do
rdir <- getSandboxDir wdir
pkgDbStack <- getPackageDbStack rdir
return Cradle {
cradleCurrentDir = wdir
, cradleRootDir = rdir
, cradleCabalFile = Nothing
, cradlePkgDbStack = pkgDbStack
, cradlePackages = []
}
plainCradle :: FilePath -> IO Cradle
plainCradle wdir = return Cradle {
cradleCurrentDir = wdir
, cradleRootDir = wdir
, cradleCabalFile = Nothing
, cradlePkgDbStack = [GlobalDb]
, cradlePackages = []
}
-- Just for testing
findCradleWithoutSandbox :: IO Cradle
findCradleWithoutSandbox = do
cradle <- findCradle
return cradle { cradlePkgDbStack = [GlobalDb], cradlePackages = [] }
----------------------------------------------------------------
cabalSuffix :: String
cabalSuffix = ".cabal"
cabalSuffixLength :: Int
cabalSuffixLength = length cabalSuffix
-- Finding a Cabal file up to the root directory
-- Input: a directly to investigate
-- Output: (the path to the directory containing a Cabal file
-- ,the path to the Cabal file)
cabalDir :: FilePath -> IO (FilePath,FilePath)
cabalDir dir = do
cnts <- getCabalFiles dir
case cnts of
[] | dir' == dir -> E.throwIO $ userError "cabal files not found"
| otherwise -> cabalDir dir'
cfile:_ -> return (dir,dir </> cfile)
where
dir' = takeDirectory dir
getCabalFiles :: FilePath -> IO [FilePath]
getCabalFiles dir = getFiles >>= filterM doesCabalFileExist
where
isCabal name = cabalSuffix `isSuffixOf` name
&& length name > cabalSuffixLength
getFiles = filter isCabal <$> getDirectoryContents dir
doesCabalFileExist file = doesFileExist $ dir </> file
----------------------------------------------------------------
getSandboxDir :: FilePath -> IO FilePath
getSandboxDir dir = do
exist <- doesFileExist sfile
if exist then
return dir
else if dir == dir' then
E.throwIO $ userError "sandbox not found"
else
getSandboxDir dir'
where
sfile = dir </> "cabal.sandbox.config"
dir' = takeDirectory dir