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 (
doesFileExist,
getCurrentDirectory,
getDirectoryContents,
)
import System.FilePath (takeDirectory, (</>))
import Hhp.GhcPkg
import Hhp.Types
findCradle :: IO Cradle
findCradle :: IO Cradle
findCradle = do
FilePath
wdir <- IO FilePath
getCurrentDirectory
FilePath -> IO Cradle
cabalCradle FilePath
wdir IO Cradle -> IO Cradle -> IO Cradle
forall a. IO a -> IO a -> IO a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> FilePath -> IO Cradle
sandboxCradle FilePath
wdir IO Cradle -> IO Cradle -> IO Cradle
forall a. IO a -> IO a -> IO a
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
Cradle -> IO Cradle
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return
Cradle
{ cradleCurrentDir :: FilePath
cradleCurrentDir = FilePath
wdir
, cradleRootDir :: FilePath
cradleRootDir = FilePath
rdir
, cradleCabalFile :: Maybe FilePath
cradleCabalFile = FilePath -> Maybe FilePath
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
Cradle -> IO Cradle
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return
Cradle
{ cradleCurrentDir :: FilePath
cradleCurrentDir = FilePath
wdir
, cradleRootDir :: FilePath
cradleRootDir = FilePath
rdir
, cradleCabalFile :: Maybe FilePath
cradleCabalFile = Maybe FilePath
forall a. Maybe a
Nothing
, cradlePkgDbStack :: [GhcPkgDb]
cradlePkgDbStack = [GhcPkgDb]
pkgDbStack
}
plainCradle :: FilePath -> IO Cradle
plainCradle :: FilePath -> IO Cradle
plainCradle FilePath
wdir =
Cradle -> IO Cradle
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return
Cradle
{ cradleCurrentDir :: FilePath
cradleCurrentDir = FilePath
wdir
, cradleRootDir :: FilePath
cradleRootDir = FilePath
wdir
, cradleCabalFile :: Maybe FilePath
cradleCabalFile = Maybe FilePath
forall a. Maybe a
Nothing
, cradlePkgDbStack :: [GhcPkgDb]
cradlePkgDbStack = [GhcPkgDb
GlobalDb]
}
findCradleWithoutSandbox :: IO Cradle
findCradleWithoutSandbox :: IO Cradle
findCradleWithoutSandbox = do
Cradle
cradle <- IO Cradle
findCradle
Cradle -> IO Cradle
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Cradle
cradle{cradlePkgDbStack = [GlobalDb]}
cabalSuffix :: String
cabalSuffix :: FilePath
cabalSuffix = FilePath
".cabal"
cabalSuffixLength :: Int
cabalSuffixLength :: Int
cabalSuffixLength = FilePath -> Int
forall a. [a] -> Int
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' FilePath -> FilePath -> Bool
forall a. Eq a => a -> a -> Bool
== FilePath
dir -> IOError -> IO (FilePath, FilePath)
forall e a. Exception e => e -> IO a
E.throwIO (IOError -> IO (FilePath, FilePath))
-> IOError -> IO (FilePath, FilePath)
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]
_ -> (FilePath, FilePath) -> IO (FilePath, FilePath)
forall a. a -> IO a
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 IO [FilePath] -> ([FilePath] -> IO [FilePath]) -> IO [FilePath]
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (FilePath -> IO Bool) -> [FilePath] -> IO [FilePath]
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 FilePath -> FilePath -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isSuffixOf` FilePath
name
Bool -> Bool -> Bool
&& FilePath -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length FilePath
name Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
cabalSuffixLength
getFiles :: IO [FilePath]
getFiles = (FilePath -> Bool) -> [FilePath] -> [FilePath]
forall a. (a -> Bool) -> [a] -> [a]
filter FilePath -> Bool
isCabal ([FilePath] -> [FilePath]) -> IO [FilePath] -> IO [FilePath]
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 (FilePath -> IO Bool) -> FilePath -> IO Bool
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 FilePath -> IO FilePath
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return FilePath
dir
else
if FilePath
dir FilePath -> FilePath -> Bool
forall a. Eq a => a -> a -> Bool
== FilePath
dir'
then IOError -> IO FilePath
forall e a. Exception e => e -> IO a
E.throwIO (IOError -> IO FilePath) -> IOError -> IO FilePath
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