module Development.IDE.Session.Implicit
( loadImplicitCradle
) where
import Control.Applicative ((<|>))
import Control.Exception (handleJust)
import Control.Monad
import Control.Monad.IO.Class
import Control.Monad.Trans.Maybe
import Data.Bifunctor
import Data.Functor ((<&>))
import Data.Maybe
import Data.Void
import System.Directory hiding (findFile)
import System.FilePath
import System.IO.Error
import Colog.Core (LogAction (..), WithSeverity (..))
import HIE.Bios.Config
import HIE.Bios.Cradle (defaultCradle, getCradle)
import HIE.Bios.Types hiding (ActionName (..))
import Hie.Cabal.Parser
import Hie.Locate
import qualified Hie.Yaml as Implicit
loadImplicitCradle :: Show a => LogAction IO (WithSeverity Log) -> FilePath -> IO (Cradle a)
loadImplicitCradle :: forall a.
Show a =>
LogAction IO (WithSeverity Log) -> FilePath -> IO (Cradle a)
loadImplicitCradle LogAction IO (WithSeverity Log)
l FilePath
wfile = do
Bool
is_dir <- FilePath -> IO Bool
doesDirectoryExist FilePath
wfile
let wdir :: FilePath
wdir | Bool
is_dir = FilePath
wfile
| Bool
otherwise = FilePath -> FilePath
takeDirectory FilePath
wfile
Maybe (CradleConfig Void, FilePath)
cfg <- MaybeT IO (CradleConfig Void, FilePath)
-> IO (Maybe (CradleConfig Void, FilePath))
forall (m :: * -> *) a. MaybeT m a -> m (Maybe a)
runMaybeT (FilePath -> MaybeT IO (CradleConfig Void, FilePath)
forall a. FilePath -> MaybeT IO (CradleConfig a, FilePath)
implicitConfig FilePath
wdir)
case Maybe (CradleConfig Void, FilePath)
cfg of
Just (CradleConfig Void, FilePath)
bc -> LogAction IO (WithSeverity Log)
-> (Void -> CradleAction a)
-> (CradleConfig Void, FilePath)
-> IO (Cradle a)
forall a b.
Show a =>
LogAction IO (WithSeverity Log)
-> (b -> CradleAction a)
-> (CradleConfig b, FilePath)
-> IO (Cradle a)
getCradle LogAction IO (WithSeverity Log)
l Void -> CradleAction a
forall a. Void -> a
absurd (CradleConfig Void, FilePath)
bc
Maybe (CradleConfig Void, FilePath)
Nothing -> Cradle a -> IO (Cradle a)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Cradle a -> IO (Cradle a)) -> Cradle a -> IO (Cradle a)
forall a b. (a -> b) -> a -> b
$ LogAction IO (WithSeverity Log) -> FilePath -> Cradle a
forall a. LogAction IO (WithSeverity Log) -> FilePath -> Cradle a
defaultCradle LogAction IO (WithSeverity Log)
l FilePath
wdir
implicitConfig :: FilePath -> MaybeT IO (CradleConfig a, FilePath)
implicitConfig :: forall a. FilePath -> MaybeT IO (CradleConfig a, FilePath)
implicitConfig = (((CradleTree a, FilePath) -> (CradleConfig a, FilePath))
-> MaybeT IO (CradleTree a, FilePath)
-> MaybeT IO (CradleConfig a, FilePath)
forall a b. (a -> b) -> MaybeT IO a -> MaybeT IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (((CradleTree a, FilePath) -> (CradleConfig a, FilePath))
-> MaybeT IO (CradleTree a, FilePath)
-> MaybeT IO (CradleConfig a, FilePath))
-> ((CradleTree a -> CradleConfig a)
-> (CradleTree a, FilePath) -> (CradleConfig a, FilePath))
-> (CradleTree a -> CradleConfig a)
-> MaybeT IO (CradleTree a, FilePath)
-> MaybeT IO (CradleConfig a, FilePath)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (CradleTree a -> CradleConfig a)
-> (CradleTree a, FilePath) -> (CradleConfig a, FilePath)
forall a b c. (a -> b) -> (a, c) -> (b, c)
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first) ([FilePath] -> CradleTree a -> CradleConfig a
forall a. [FilePath] -> CradleTree a -> CradleConfig a
CradleConfig [FilePath]
noDeps) (MaybeT IO (CradleTree a, FilePath)
-> MaybeT IO (CradleConfig a, FilePath))
-> (FilePath -> MaybeT IO (CradleTree a, FilePath))
-> FilePath
-> MaybeT IO (CradleConfig a, FilePath)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> MaybeT IO (CradleTree a, FilePath)
forall a. FilePath -> MaybeT IO (CradleTree a, FilePath)
inferCradleTree
where
noDeps :: [FilePath]
noDeps :: [FilePath]
noDeps = []
inferCradleTree :: FilePath -> MaybeT IO (CradleTree a, FilePath)
inferCradleTree :: forall a. FilePath -> MaybeT IO (CradleTree a, FilePath)
inferCradleTree FilePath
start_dir =
MaybeT IO (CradleTree a, FilePath)
forall {a}. MaybeT IO (CradleTree a, FilePath)
maybeItsBios
MaybeT IO (CradleTree a, FilePath)
-> MaybeT IO (CradleTree a, FilePath)
-> MaybeT IO (CradleTree a, FilePath)
forall a. MaybeT IO a -> MaybeT IO a -> MaybeT IO a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (MaybeT IO FilePath
cabalExecutable MaybeT IO FilePath -> MaybeT IO FilePath -> MaybeT IO FilePath
forall a b. MaybeT IO a -> MaybeT IO b -> MaybeT IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> FilePath -> MaybeT IO FilePath
cabalConfigDir FilePath
start_dir MaybeT IO FilePath
-> (FilePath -> MaybeT IO (CradleTree a, FilePath))
-> MaybeT IO (CradleTree a, FilePath)
forall a b. MaybeT IO a -> (a -> MaybeT IO b) -> MaybeT IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \FilePath
dir -> FilePath -> MaybeT IO ()
cabalWorkDir FilePath
dir MaybeT IO ()
-> MaybeT IO (CradleTree a, FilePath)
-> MaybeT IO (CradleTree a, FilePath)
forall a b. MaybeT IO a -> MaybeT IO b -> MaybeT IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> (CradleTree a, FilePath) -> MaybeT IO (CradleTree a, FilePath)
forall a. a -> MaybeT IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (FilePath -> (CradleTree a, FilePath)
forall a. FilePath -> (CradleTree a, FilePath)
simpleCabalCradle FilePath
dir))
MaybeT IO (CradleTree a, FilePath)
-> MaybeT IO (CradleTree a, FilePath)
-> MaybeT IO (CradleTree a, FilePath)
forall a. MaybeT IO a -> MaybeT IO a -> MaybeT IO a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (MaybeT IO FilePath
stackExecutable MaybeT IO FilePath -> MaybeT IO FilePath -> MaybeT IO FilePath
forall a b. MaybeT IO a -> MaybeT IO b -> MaybeT IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> FilePath -> MaybeT IO FilePath
stackConfigDir FilePath
start_dir MaybeT IO FilePath
-> (FilePath -> MaybeT IO (CradleTree a, FilePath))
-> MaybeT IO (CradleTree a, FilePath)
forall a b. MaybeT IO a -> (a -> MaybeT IO b) -> MaybeT IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \FilePath
dir -> FilePath -> MaybeT IO ()
stackWorkDir FilePath
dir MaybeT IO ()
-> MaybeT IO (CradleTree a, FilePath)
-> MaybeT IO (CradleTree a, FilePath)
forall a b. MaybeT IO a -> MaybeT IO b -> MaybeT IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> FilePath -> MaybeT IO (CradleTree a, FilePath)
forall a. FilePath -> MaybeT IO (CradleTree a, FilePath)
stackCradle FilePath
dir)
MaybeT IO (CradleTree a, FilePath)
-> MaybeT IO (CradleTree a, FilePath)
-> MaybeT IO (CradleTree a, FilePath)
forall a. MaybeT IO a -> MaybeT IO a -> MaybeT IO a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (MaybeT IO FilePath
cabalExecutable MaybeT IO FilePath -> MaybeT IO FilePath -> MaybeT IO FilePath
forall a b. MaybeT IO a -> MaybeT IO b -> MaybeT IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> (FilePath -> MaybeT IO FilePath
cabalConfigDir FilePath
start_dir MaybeT IO FilePath -> MaybeT IO FilePath -> MaybeT IO FilePath
forall a. MaybeT IO a -> MaybeT IO a -> MaybeT IO a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> MaybeT IO FilePath
cabalFileAndWorkDir) MaybeT IO FilePath
-> (FilePath -> (CradleTree a, FilePath))
-> MaybeT IO (CradleTree a, FilePath)
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> FilePath -> (CradleTree a, FilePath)
forall a. FilePath -> (CradleTree a, FilePath)
simpleCabalCradle)
MaybeT IO (CradleTree a, FilePath)
-> MaybeT IO (CradleTree a, FilePath)
-> MaybeT IO (CradleTree a, FilePath)
forall a. MaybeT IO a -> MaybeT IO a -> MaybeT IO a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (MaybeT IO FilePath
stackExecutable MaybeT IO FilePath -> MaybeT IO FilePath -> MaybeT IO FilePath
forall a b. MaybeT IO a -> MaybeT IO b -> MaybeT IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> FilePath -> MaybeT IO FilePath
stackConfigDir FilePath
start_dir MaybeT IO FilePath
-> (FilePath -> MaybeT IO (CradleTree a, FilePath))
-> MaybeT IO (CradleTree a, FilePath)
forall a b. MaybeT IO a -> (a -> MaybeT IO b) -> MaybeT IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= FilePath -> MaybeT IO (CradleTree a, FilePath)
forall a. FilePath -> MaybeT IO (CradleTree a, FilePath)
stackCradle)
MaybeT IO (CradleTree a, FilePath)
-> MaybeT IO (CradleTree a, FilePath)
-> MaybeT IO (CradleTree a, FilePath)
forall a. MaybeT IO a -> MaybeT IO a -> MaybeT IO a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (MaybeT IO FilePath
cabalExecutable MaybeT IO FilePath -> MaybeT IO FilePath -> MaybeT IO FilePath
forall a b. MaybeT IO a -> MaybeT IO b -> MaybeT IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> FilePath -> MaybeT IO FilePath
cabalFileDir FilePath
start_dir MaybeT IO FilePath
-> (FilePath -> (CradleTree a, FilePath))
-> MaybeT IO (CradleTree a, FilePath)
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> FilePath -> (CradleTree a, FilePath)
forall a. FilePath -> (CradleTree a, FilePath)
simpleCabalCradle)
where
maybeItsBios :: MaybeT IO (CradleTree a, FilePath)
maybeItsBios = (\FilePath
wdir -> (Callable -> Maybe Callable -> Maybe FilePath -> CradleTree a
forall a.
Callable -> Maybe Callable -> Maybe FilePath -> CradleTree a
Bios (FilePath -> Callable
Program (FilePath -> Callable) -> FilePath -> Callable
forall a b. (a -> b) -> a -> b
$ FilePath
wdir FilePath -> FilePath -> FilePath
</> FilePath
".hie-bios") Maybe Callable
forall a. Maybe a
Nothing Maybe FilePath
forall a. Maybe a
Nothing, FilePath
wdir)) (FilePath -> (CradleTree a, FilePath))
-> MaybeT IO FilePath -> MaybeT IO (CradleTree a, FilePath)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FilePath -> MaybeT IO FilePath
biosWorkDir FilePath
start_dir
cabalFileAndWorkDir :: MaybeT IO FilePath
cabalFileAndWorkDir = FilePath -> MaybeT IO FilePath
cabalFileDir FilePath
start_dir MaybeT IO FilePath
-> (FilePath -> MaybeT IO FilePath) -> MaybeT IO FilePath
forall a b. MaybeT IO a -> (a -> MaybeT IO b) -> MaybeT IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (\FilePath
dir -> FilePath -> MaybeT IO ()
cabalWorkDir FilePath
dir MaybeT IO () -> MaybeT IO FilePath -> MaybeT IO FilePath
forall a b. MaybeT IO a -> MaybeT IO b -> MaybeT IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> FilePath -> MaybeT IO FilePath
forall a. a -> MaybeT IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure FilePath
dir)
stackCradle :: FilePath -> MaybeT IO (CradleTree a, FilePath)
stackCradle :: forall a. FilePath -> MaybeT IO (CradleTree a, FilePath)
stackCradle FilePath
fp = do
[FilePath]
pkgs <- FilePath -> MaybeT IO [FilePath]
stackYamlPkgs FilePath
fp
[Package]
pkgsWithComps <- IO [Package] -> MaybeT IO [Package]
forall a. IO a -> MaybeT IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO [Package] -> MaybeT IO [Package])
-> IO [Package] -> MaybeT IO [Package]
forall a b. (a -> b) -> a -> b
$ [Maybe Package] -> [Package]
forall a. [Maybe a] -> [a]
catMaybes ([Maybe Package] -> [Package])
-> IO [Maybe Package] -> IO [Package]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (FilePath -> IO (Maybe Package))
-> [FilePath] -> IO [Maybe Package]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM (FilePath -> FilePath -> IO (Maybe Package)
nestedPkg FilePath
fp) [FilePath]
pkgs
let yaml :: FilePath
yaml = FilePath
fp FilePath -> FilePath -> FilePath
</> FilePath
"stack.yaml"
(CradleTree a, FilePath) -> MaybeT IO (CradleTree a, FilePath)
forall a. a -> MaybeT IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ((CradleTree a, FilePath) -> MaybeT IO (CradleTree a, FilePath))
-> (CradleTree a, FilePath) -> MaybeT IO (CradleTree a, FilePath)
forall a b. (a -> b) -> a -> b
$ (,FilePath
fp) (CradleTree a -> (CradleTree a, FilePath))
-> CradleTree a -> (CradleTree a, FilePath)
forall a b. (a -> b) -> a -> b
$ case [Package]
pkgsWithComps of
[] -> StackType -> CradleTree a
forall a. StackType -> CradleTree a
Stack (Maybe FilePath -> Maybe FilePath -> StackType
StackType Maybe FilePath
forall a. Maybe a
Nothing (FilePath -> Maybe FilePath
forall a. a -> Maybe a
Just FilePath
yaml))
[Package]
ps -> StackType -> [(FilePath, StackType)] -> CradleTree a
forall a. StackType -> [(FilePath, StackType)] -> CradleTree a
StackMulti StackType
forall a. Monoid a => a
mempty ([(FilePath, StackType)] -> CradleTree a)
-> [(FilePath, StackType)] -> CradleTree a
forall a b. (a -> b) -> a -> b
$ do
Package Name
n [Component]
cs <- [Package]
ps
Component
c <- [Component]
cs
let (FilePath
prefix, FilePath
comp) = Name -> Component -> (FilePath, FilePath)
Implicit.stackComponent Name
n Component
c
(FilePath, StackType) -> [(FilePath, StackType)]
forall a. a -> [a]
forall (f :: * -> *) a. Applicative f => a -> f a
pure (FilePath
prefix, Maybe FilePath -> Maybe FilePath -> StackType
StackType (FilePath -> Maybe FilePath
forall a. a -> Maybe a
Just FilePath
comp) (FilePath -> Maybe FilePath
forall a. a -> Maybe a
Just FilePath
yaml))
simpleCabalCradle :: FilePath -> (CradleTree a, FilePath)
simpleCabalCradle :: forall a. FilePath -> (CradleTree a, FilePath)
simpleCabalCradle FilePath
fp = (CabalType -> CradleTree a
forall a. CabalType -> CradleTree a
Cabal (CabalType -> CradleTree a) -> CabalType -> CradleTree a
forall a b. (a -> b) -> a -> b
$ Maybe FilePath -> Maybe FilePath -> CabalType
CabalType Maybe FilePath
forall a. Maybe a
Nothing Maybe FilePath
forall a. Maybe a
Nothing, FilePath
fp)
cabalExecutable :: MaybeT IO FilePath
cabalExecutable :: MaybeT IO FilePath
cabalExecutable = IO (Maybe FilePath) -> MaybeT IO FilePath
forall (m :: * -> *) a. m (Maybe a) -> MaybeT m a
MaybeT (IO (Maybe FilePath) -> MaybeT IO FilePath)
-> IO (Maybe FilePath) -> MaybeT IO FilePath
forall a b. (a -> b) -> a -> b
$ FilePath -> IO (Maybe FilePath)
findExecutable FilePath
"cabal"
stackExecutable :: MaybeT IO FilePath
stackExecutable :: MaybeT IO FilePath
stackExecutable = IO (Maybe FilePath) -> MaybeT IO FilePath
forall (m :: * -> *) a. m (Maybe a) -> MaybeT m a
MaybeT (IO (Maybe FilePath) -> MaybeT IO FilePath)
-> IO (Maybe FilePath) -> MaybeT IO FilePath
forall a b. (a -> b) -> a -> b
$ FilePath -> IO (Maybe FilePath)
findExecutable FilePath
"stack"
biosWorkDir :: FilePath -> MaybeT IO FilePath
biosWorkDir :: FilePath -> MaybeT IO FilePath
biosWorkDir = (FilePath -> Bool) -> FilePath -> MaybeT IO FilePath
findFileUpwards (FilePath
".hie-bios" ==)
cabalWorkDir :: FilePath -> MaybeT IO ()
cabalWorkDir :: FilePath -> MaybeT IO ()
cabalWorkDir FilePath
wdir = do
Bool
check <- IO Bool -> MaybeT IO Bool
forall a. IO a -> MaybeT IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> MaybeT IO Bool) -> IO Bool -> MaybeT IO Bool
forall a b. (a -> b) -> a -> b
$ FilePath -> IO Bool
doesDirectoryExist (FilePath
wdir FilePath -> FilePath -> FilePath
</> FilePath
"dist-newstyle")
Bool -> MaybeT IO () -> MaybeT IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
check (MaybeT IO () -> MaybeT IO ()) -> MaybeT IO () -> MaybeT IO ()
forall a b. (a -> b) -> a -> b
$ FilePath -> MaybeT IO ()
forall a. FilePath -> MaybeT IO a
forall (m :: * -> *) a. MonadFail m => FilePath -> m a
fail FilePath
"No dist-newstyle"
stackWorkDir :: FilePath -> MaybeT IO ()
stackWorkDir :: FilePath -> MaybeT IO ()
stackWorkDir FilePath
wdir = do
Bool
check <- IO Bool -> MaybeT IO Bool
forall a. IO a -> MaybeT IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> MaybeT IO Bool) -> IO Bool -> MaybeT IO Bool
forall a b. (a -> b) -> a -> b
$ FilePath -> IO Bool
doesDirectoryExist (FilePath
wdir FilePath -> FilePath -> FilePath
</> FilePath
".stack-work")
Bool -> MaybeT IO () -> MaybeT IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
check (MaybeT IO () -> MaybeT IO ()) -> MaybeT IO () -> MaybeT IO ()
forall a b. (a -> b) -> a -> b
$ FilePath -> MaybeT IO ()
forall a. FilePath -> MaybeT IO a
forall (m :: * -> *) a. MonadFail m => FilePath -> m a
fail FilePath
"No .stack-work"
cabalConfigDir :: FilePath -> MaybeT IO FilePath
cabalConfigDir :: FilePath -> MaybeT IO FilePath
cabalConfigDir = (FilePath -> Bool) -> FilePath -> MaybeT IO FilePath
findFileUpwards (\FilePath
fp -> FilePath
fp FilePath -> FilePath -> Bool
forall a. Eq a => a -> a -> Bool
== FilePath
"cabal.project" Bool -> Bool -> Bool
|| FilePath
fp FilePath -> FilePath -> Bool
forall a. Eq a => a -> a -> Bool
== FilePath
"cabal.project.local")
cabalFileDir :: FilePath -> MaybeT IO FilePath
cabalFileDir :: FilePath -> MaybeT IO FilePath
cabalFileDir = (FilePath -> Bool) -> FilePath -> MaybeT IO FilePath
findFileUpwards (\FilePath
fp -> FilePath -> FilePath
takeExtension FilePath
fp FilePath -> FilePath -> Bool
forall a. Eq a => a -> a -> Bool
== FilePath
".cabal")
stackConfigDir :: FilePath -> MaybeT IO FilePath
stackConfigDir :: FilePath -> MaybeT IO FilePath
stackConfigDir = (FilePath -> Bool) -> FilePath -> MaybeT IO FilePath
findFileUpwards FilePath -> Bool
forall {a}. (Eq a, IsString a) => a -> Bool
isStack
where
isStack :: a -> Bool
isStack a
name = a
name a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
"stack.yaml"
findFileUpwards :: (FilePath -> Bool) -> FilePath -> MaybeT IO FilePath
findFileUpwards :: (FilePath -> Bool) -> FilePath -> MaybeT IO FilePath
findFileUpwards FilePath -> Bool
p FilePath
dir = do
[FilePath]
cnts <-
IO [FilePath] -> MaybeT IO [FilePath]
forall a. IO a -> MaybeT IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO
(IO [FilePath] -> MaybeT IO [FilePath])
-> IO [FilePath] -> MaybeT IO [FilePath]
forall a b. (a -> b) -> a -> b
$ (IOError -> Maybe [FilePath])
-> ([FilePath] -> IO [FilePath]) -> IO [FilePath] -> IO [FilePath]
forall e b a.
Exception e =>
(e -> Maybe b) -> (b -> IO a) -> IO a -> IO a
handleJust
(\(IOError
e :: IOError) -> if IOError -> Bool
isPermissionError IOError
e then [FilePath] -> Maybe [FilePath]
forall a. a -> Maybe a
Just [] else Maybe [FilePath]
forall a. Maybe a
Nothing)
[FilePath] -> IO [FilePath]
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
((FilePath -> Bool) -> FilePath -> IO [FilePath]
findFile FilePath -> Bool
p FilePath
dir)
case [FilePath]
cnts of
[] | FilePath
dir' FilePath -> FilePath -> Bool
forall a. Eq a => a -> a -> Bool
== FilePath
dir -> FilePath -> MaybeT IO FilePath
forall a. FilePath -> MaybeT IO a
forall (m :: * -> *) a. MonadFail m => FilePath -> m a
fail FilePath
"No cabal files"
| Bool
otherwise -> (FilePath -> Bool) -> FilePath -> MaybeT IO FilePath
findFileUpwards FilePath -> Bool
p FilePath
dir'
FilePath
_ : [FilePath]
_ -> FilePath -> MaybeT IO FilePath
forall a. a -> MaybeT IO a
forall (m :: * -> *) a. Monad m => a -> m a
return FilePath
dir
where dir' :: FilePath
dir' = FilePath -> FilePath
takeDirectory FilePath
dir
findFile :: (FilePath -> Bool) -> FilePath -> IO [FilePath]
findFile :: (FilePath -> Bool) -> FilePath -> IO [FilePath]
findFile FilePath -> Bool
p FilePath
dir = do
Bool
b <- FilePath -> IO Bool
doesDirectoryExist FilePath
dir
if Bool
b then 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
doesPredFileExist else [FilePath] -> IO [FilePath]
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return []
where
getFiles :: IO [FilePath]
getFiles = (FilePath -> Bool) -> [FilePath] -> [FilePath]
forall a. (a -> Bool) -> [a] -> [a]
filter FilePath -> Bool
p ([FilePath] -> [FilePath]) -> IO [FilePath] -> IO [FilePath]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FilePath -> IO [FilePath]
getDirectoryContents FilePath
dir
doesPredFileExist :: FilePath -> IO Bool
doesPredFileExist 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