module Hhp.Cradle (
findCradle
, findCradleWithoutSandbox
) where
import Control.Applicative ((<|>))
import qualified Control.Exception as E
import Control.Monad (filterM)
import Data.List (isSuffixOf)
import System.Directory (getCurrentDirectory, getDirectoryContents, doesFileExist)
import System.FilePath ((</>), takeDirectory)
import Hhp.Types
import Hhp.GhcPkg
findCradle :: IO Cradle
findCradle :: IO Cradle
findCradle = do
FilePath
wdir <- IO FilePath
getCurrentDirectory
FilePath -> IO Cradle
cabalCradle FilePath
wdir forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> FilePath -> IO Cradle
sandboxCradle FilePath
wdir forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> FilePath -> IO Cradle
plainCradle FilePath
wdir
cabalCradle :: FilePath -> IO Cradle
cabalCradle :: FilePath -> IO Cradle
cabalCradle FilePath
wdir = do
(FilePath
rdir,FilePath
cfile) <- FilePath -> IO (FilePath, FilePath)
cabalDir FilePath
wdir
[GhcPkgDb]
pkgDbStack <- FilePath -> IO [GhcPkgDb]
getPackageDbStack FilePath
rdir
forall (m :: * -> *) a. Monad m => a -> m a
return Cradle {
cradleCurrentDir :: FilePath
cradleCurrentDir = FilePath
wdir
, cradleRootDir :: FilePath
cradleRootDir = FilePath
rdir
, cradleCabalFile :: Maybe FilePath
cradleCabalFile = forall a. a -> Maybe a
Just FilePath
cfile
, cradlePkgDbStack :: [GhcPkgDb]
cradlePkgDbStack = [GhcPkgDb]
pkgDbStack
}
sandboxCradle :: FilePath -> IO Cradle
sandboxCradle :: FilePath -> IO Cradle
sandboxCradle FilePath
wdir = do
FilePath
rdir <- FilePath -> IO FilePath
getSandboxDir FilePath
wdir
[GhcPkgDb]
pkgDbStack <- FilePath -> IO [GhcPkgDb]
getPackageDbStack FilePath
rdir
forall (m :: * -> *) a. Monad m => a -> m a
return Cradle {
cradleCurrentDir :: FilePath
cradleCurrentDir = FilePath
wdir
, cradleRootDir :: FilePath
cradleRootDir = FilePath
rdir
, cradleCabalFile :: Maybe FilePath
cradleCabalFile = forall a. Maybe a
Nothing
, cradlePkgDbStack :: [GhcPkgDb]
cradlePkgDbStack = [GhcPkgDb]
pkgDbStack
}
plainCradle :: FilePath -> IO Cradle
plainCradle :: FilePath -> IO Cradle
plainCradle FilePath
wdir = forall (m :: * -> *) a. Monad m => a -> m a
return Cradle {
cradleCurrentDir :: FilePath
cradleCurrentDir = FilePath
wdir
, cradleRootDir :: FilePath
cradleRootDir = FilePath
wdir
, cradleCabalFile :: Maybe FilePath
cradleCabalFile = forall a. Maybe a
Nothing
, cradlePkgDbStack :: [GhcPkgDb]
cradlePkgDbStack = [GhcPkgDb
GlobalDb]
}
findCradleWithoutSandbox :: IO Cradle
findCradleWithoutSandbox :: IO Cradle
findCradleWithoutSandbox = do
Cradle
cradle <- IO Cradle
findCradle
forall (m :: * -> *) a. Monad m => a -> m a
return Cradle
cradle { cradlePkgDbStack :: [GhcPkgDb]
cradlePkgDbStack = [GhcPkgDb
GlobalDb]}
cabalSuffix :: String
cabalSuffix :: FilePath
cabalSuffix = FilePath
".cabal"
cabalSuffixLength :: Int
cabalSuffixLength :: Int
cabalSuffixLength = forall (t :: * -> *) a. Foldable t => t a -> Int
length FilePath
cabalSuffix
cabalDir :: FilePath -> IO (FilePath,FilePath)
cabalDir :: FilePath -> IO (FilePath, FilePath)
cabalDir FilePath
dir = do
[FilePath]
cnts <- FilePath -> IO [FilePath]
getCabalFiles FilePath
dir
case [FilePath]
cnts of
[] | FilePath
dir' forall a. Eq a => a -> a -> Bool
== FilePath
dir -> forall e a. Exception e => e -> IO a
E.throwIO forall a b. (a -> b) -> a -> b
$ FilePath -> IOError
userError FilePath
"cabal files not found"
| Bool
otherwise -> FilePath -> IO (FilePath, FilePath)
cabalDir FilePath
dir'
FilePath
cfile:[FilePath]
_ -> forall (m :: * -> *) a. Monad m => a -> m a
return (FilePath
dir,FilePath
dir FilePath -> FilePath -> FilePath
</> FilePath
cfile)
where
dir' :: FilePath
dir' = FilePath -> FilePath
takeDirectory FilePath
dir
getCabalFiles :: FilePath -> IO [FilePath]
getCabalFiles :: FilePath -> IO [FilePath]
getCabalFiles FilePath
dir = IO [FilePath]
getFiles forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall (m :: * -> *) a.
Applicative m =>
(a -> m Bool) -> [a] -> m [a]
filterM FilePath -> IO Bool
doesCabalFileExist
where
isCabal :: FilePath -> Bool
isCabal FilePath
name = FilePath
cabalSuffix forall a. Eq a => [a] -> [a] -> Bool
`isSuffixOf` FilePath
name
Bool -> Bool -> Bool
&& forall (t :: * -> *) a. Foldable t => t a -> Int
length FilePath
name forall a. Ord a => a -> a -> Bool
> Int
cabalSuffixLength
getFiles :: IO [FilePath]
getFiles = forall a. (a -> Bool) -> [a] -> [a]
filter FilePath -> Bool
isCabal forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FilePath -> IO [FilePath]
getDirectoryContents FilePath
dir
doesCabalFileExist :: FilePath -> IO Bool
doesCabalFileExist FilePath
file = FilePath -> IO Bool
doesFileExist forall a b. (a -> b) -> a -> b
$ FilePath
dir FilePath -> FilePath -> FilePath
</> FilePath
file
getSandboxDir :: FilePath -> IO FilePath
getSandboxDir :: FilePath -> IO FilePath
getSandboxDir FilePath
dir = do
Bool
exist <- FilePath -> IO Bool
doesFileExist FilePath
sfile
if Bool
exist then
forall (m :: * -> *) a. Monad m => a -> m a
return FilePath
dir
else if FilePath
dir forall a. Eq a => a -> a -> Bool
== FilePath
dir' then
forall e a. Exception e => e -> IO a
E.throwIO forall a b. (a -> b) -> a -> b
$ FilePath -> IOError
userError FilePath
"sandbox not found"
else
FilePath -> IO FilePath
getSandboxDir FilePath
dir'
where
sfile :: FilePath
sfile = FilePath
dir FilePath -> FilePath -> FilePath
</> FilePath
"cabal.sandbox.config"
dir' :: FilePath
dir' = FilePath -> FilePath
takeDirectory FilePath
dir