{-# LANGUAGE ScopedTypeVariables #-}

-- Code is derived from https://github.com/mpickering/hie-bios/blob/master/src/HIE/Bios/Cradle.hs
-- git commit: 6460ab40709fe5cc6209b2094d32f80d46c889fd
-- Derived code subject to hie-bios's BSD 3-Clause "New" or "Revised" License
-- Hie-bios's license is distributed with the hie-bios dependency
-- Initial differences can be found at https://github.com/mpickering/hie-bios/pull/178

module Hie.Implicit.Cradle
  ( loadImplicitHieCradle,
  )
where

import Control.Applicative ((<|>))
import Control.Exception (handleJust)
import Control.Monad
import Control.Monad.IO.Class
import Control.Monad.Trans.Maybe
import Data.Maybe
import Data.Void
import HIE.Bios.Config hiding (cabalComponent, stackComponent)
import HIE.Bios.Cradle
import HIE.Bios.Types hiding (ActionName (..))
import Hie.Cabal.Parser
import Hie.Locate
import Hie.Yaml
import System.Directory hiding (findFile)
import System.FilePath
import System.IO.Error (isPermissionError)

-- | Given root\/foo\/bar.hs, load an implicit cradle
loadImplicitHieCradle :: FilePath -> IO (Cradle a)
loadImplicitHieCradle :: FilePath -> IO (Cradle a)
loadImplicitHieCradle FilePath
wfile = do
  let wdir :: FilePath
wdir = 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)
  Cradle a -> IO (Cradle 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
$ case Maybe (CradleConfig Void, FilePath)
cfg of
    Just (CradleConfig Void, FilePath)
bc -> (Void -> Cradle a) -> (CradleConfig Void, FilePath) -> Cradle a
forall b a.
(b -> Cradle a) -> (CradleConfig b, FilePath) -> Cradle a
getCradle Void -> Cradle a
forall a. Void -> a
absurd (CradleConfig Void, FilePath)
bc
    Maybe (CradleConfig Void, FilePath)
Nothing -> FilePath -> Cradle a
forall a. FilePath -> Cradle a
defaultCradle FilePath
wdir

implicitConfig :: FilePath -> MaybeT IO (CradleConfig a, FilePath)
implicitConfig :: FilePath -> MaybeT IO (CradleConfig a, FilePath)
implicitConfig FilePath
fp = do
  (CradleType a
crdType, FilePath
wdir) <- FilePath -> MaybeT IO (CradleType a, FilePath)
forall a. FilePath -> MaybeT IO (CradleType a, FilePath)
implicitConfig' FilePath
fp
  (CradleConfig a, FilePath) -> MaybeT IO (CradleConfig a, FilePath)
forall (m :: * -> *) a. Monad m => a -> m a
return ([FilePath] -> CradleType a -> CradleConfig a
forall a. [FilePath] -> CradleType a -> CradleConfig a
CradleConfig [] CradleType a
crdType, FilePath
wdir)

implicitConfig' :: FilePath -> MaybeT IO (CradleType a, FilePath)
implicitConfig' :: FilePath -> MaybeT IO (CradleType a, FilePath)
implicitConfig' FilePath
fp =
  ( \FilePath
wdir ->
      (Callable -> Maybe Callable -> Maybe FilePath -> CradleType a
forall a.
Callable -> Maybe Callable -> Maybe FilePath -> CradleType 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 -> (CradleType a, FilePath))
-> MaybeT IO FilePath -> MaybeT IO (CradleType a, FilePath)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FilePath -> MaybeT IO FilePath
biosWorkDir FilePath
fp
    --   <|> (Obelisk,) <$> obeliskWorkDir fp
    --   <|> (Bazel,) <$> rulesHaskellWorkDir fp
    MaybeT IO (CradleType a, FilePath)
-> MaybeT IO (CradleType a, FilePath)
-> MaybeT IO (CradleType a, FilePath)
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 (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> FilePath -> MaybeT IO FilePath
cabalProjectDir FilePath
fp MaybeT IO FilePath -> MaybeT IO FilePath -> MaybeT IO FilePath
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> FilePath -> MaybeT IO FilePath
cabalDistDir FilePath
fp MaybeT IO FilePath
-> (FilePath -> MaybeT IO (CradleType a, FilePath))
-> MaybeT IO (CradleType a, FilePath)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= FilePath -> MaybeT IO (CradleType a, FilePath)
forall a. FilePath -> MaybeT IO (CradleType a, FilePath)
cabal)
    MaybeT IO (CradleType a, FilePath)
-> MaybeT IO (CradleType a, FilePath)
-> MaybeT IO (CradleType a, FilePath)
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 (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> FilePath -> MaybeT IO FilePath
stackYamlDir FilePath
fp MaybeT IO FilePath -> MaybeT IO FilePath -> MaybeT IO FilePath
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> FilePath -> MaybeT IO FilePath
stackWorkDir FilePath
fp MaybeT IO FilePath
-> (FilePath -> MaybeT IO (CradleType a, FilePath))
-> MaybeT IO (CradleType a, FilePath)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= FilePath -> MaybeT IO (CradleType a, FilePath)
forall a. FilePath -> MaybeT IO (CradleType a, FilePath)
stack)
    MaybeT IO (CradleType a, FilePath)
-> MaybeT IO (CradleType a, FilePath)
-> MaybeT IO (CradleType a, FilePath)
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 (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> (FilePath -> MaybeT IO FilePath
cabalProjectDir FilePath
fp MaybeT IO FilePath -> MaybeT IO FilePath -> MaybeT IO FilePath
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> FilePath -> MaybeT IO FilePath
cabalDistDir FilePath
fp) MaybeT IO FilePath
-> (FilePath -> MaybeT IO (CradleType a, FilePath))
-> MaybeT IO (CradleType a, FilePath)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= FilePath -> MaybeT IO (CradleType a, FilePath)
forall a. FilePath -> MaybeT IO (CradleType a, FilePath)
cabal)
    MaybeT IO (CradleType a, FilePath)
-> MaybeT IO (CradleType a, FilePath)
-> MaybeT IO (CradleType a, FilePath)
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 (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> FilePath -> MaybeT IO FilePath
stackYamlDir FilePath
fp MaybeT IO FilePath
-> (FilePath -> MaybeT IO (CradleType a, FilePath))
-> MaybeT IO (CradleType a, FilePath)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= FilePath -> MaybeT IO (CradleType a, FilePath)
forall a. FilePath -> MaybeT IO (CradleType a, FilePath)
stack)
    MaybeT IO (CradleType a, FilePath)
-> MaybeT IO (CradleType a, FilePath)
-> MaybeT IO (CradleType a, FilePath)
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 (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> FilePath -> MaybeT IO FilePath
cabalFile FilePath
fp MaybeT IO FilePath
-> (FilePath -> MaybeT IO (CradleType a, FilePath))
-> MaybeT IO (CradleType a, FilePath)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= FilePath -> MaybeT IO (CradleType a, FilePath)
forall a. FilePath -> MaybeT IO (CradleType a, FilePath)
cabal)
  where
    readPkgs :: (Name -> Component -> b)
-> (FilePath -> m [FilePath]) -> FilePath -> m [b]
readPkgs Name -> Component -> b
f FilePath -> m [FilePath]
gp FilePath
p = do
      [FilePath]
cfs <- FilePath -> m [FilePath]
gp FilePath
p
      [Package]
pkgs <- IO [Package] -> m [Package]
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO [Package] -> m [Package]) -> IO [Package] -> m [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)
mapM (FilePath -> FilePath -> IO (Maybe Package)
nestedPkg FilePath
p) [FilePath]
cfs
      [b] -> m [b]
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([b] -> m [b]) -> [b] -> m [b]
forall a b. (a -> b) -> a -> b
$ (Package -> [b]) -> [Package] -> [b]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap ((Name -> Component -> b) -> Package -> [b]
forall b. (Name -> Component -> b) -> Package -> [b]
components Name -> Component -> b
f) [Package]
pkgs
    build :: ([b] -> a)
-> (Name -> Component -> b)
-> (FilePath -> m [FilePath])
-> FilePath
-> m (a, FilePath)
build [b] -> a
cn Name -> Component -> b
cc FilePath -> m [FilePath]
gp FilePath
p = do
      a
c <- [b] -> a
cn ([b] -> a) -> m [b] -> m a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Name -> Component -> b)
-> (FilePath -> m [FilePath]) -> FilePath -> m [b]
forall (m :: * -> *) b.
MonadIO m =>
(Name -> Component -> b)
-> (FilePath -> m [FilePath]) -> FilePath -> m [b]
readPkgs Name -> Component -> b
cc FilePath -> m [FilePath]
gp FilePath
p
      (a, FilePath) -> m (a, FilePath)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (a
c, FilePath
p)
    cabal :: FilePath -> MaybeT IO (CradleType a, FilePath)
    cabal :: FilePath -> MaybeT IO (CradleType a, FilePath)
cabal = ([(FilePath, CabalType)] -> CradleType a)
-> (Name -> Component -> (FilePath, CabalType))
-> (FilePath -> MaybeT IO [FilePath])
-> FilePath
-> MaybeT IO (CradleType a, FilePath)
forall (m :: * -> *) b a.
MonadIO m =>
([b] -> a)
-> (Name -> Component -> b)
-> (FilePath -> m [FilePath])
-> FilePath
-> m (a, FilePath)
build (CabalType -> [(FilePath, CabalType)] -> CradleType a
forall a. CabalType -> [(FilePath, CabalType)] -> CradleType a
CabalMulti CabalType
forall a. Monoid a => a
mempty) Name -> Component -> (FilePath, CabalType)
cabalComponent' FilePath -> MaybeT IO [FilePath]
cabalPkgs
    stack :: FilePath -> MaybeT IO (CradleType a, FilePath)
    stack :: FilePath -> MaybeT IO (CradleType a, FilePath)
stack = ([(FilePath, StackType)] -> CradleType a)
-> (Name -> Component -> (FilePath, StackType))
-> (FilePath -> MaybeT IO [FilePath])
-> FilePath
-> MaybeT IO (CradleType a, FilePath)
forall (m :: * -> *) b a.
MonadIO m =>
([b] -> a)
-> (Name -> Component -> b)
-> (FilePath -> m [FilePath])
-> FilePath
-> m (a, FilePath)
build (StackType -> [(FilePath, StackType)] -> CradleType a
forall a. StackType -> [(FilePath, StackType)] -> CradleType a
StackMulti StackType
forall a. Monoid a => a
mempty) Name -> Component -> (FilePath, StackType)
stackComponent' FilePath -> MaybeT IO [FilePath]
stackYamlPkgs
    components :: (Name -> Component -> b) -> Package -> [b]
components Name -> Component -> b
f (Package Name
n [Component]
cs) = (Component -> b) -> [Component] -> [b]
forall a b. (a -> b) -> [a] -> [b]
map (Name -> Component -> b
f Name
n) [Component]
cs

    cabalComponent' :: Name -> Component -> (FilePath, CabalType)
cabalComponent' Name
n Component
c = Maybe FilePath -> CabalType
CabalType (Maybe FilePath -> CabalType)
-> (FilePath -> Maybe FilePath) -> FilePath -> CabalType
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> Maybe FilePath
forall a. a -> Maybe a
Just (FilePath -> CabalType)
-> (FilePath, FilePath) -> (FilePath, CabalType)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Name -> Component -> (FilePath, FilePath)
cabalComponent Name
n Component
c
    stackComponent' :: Name -> Component -> (FilePath, StackType)
stackComponent' Name
n Component
c = (Maybe FilePath -> Maybe FilePath -> StackType)
-> Maybe FilePath -> Maybe FilePath -> StackType
forall a b c. (a -> b -> c) -> b -> a -> c
flip Maybe FilePath -> Maybe FilePath -> StackType
StackType Maybe FilePath
forall a. Maybe a
Nothing (Maybe FilePath -> StackType)
-> (FilePath -> Maybe FilePath) -> FilePath -> StackType
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> Maybe FilePath
forall a. a -> Maybe a
Just (FilePath -> StackType)
-> (FilePath, FilePath) -> (FilePath, StackType)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Name -> Component -> (FilePath, FilePath)
stackComponent Name
n Component
c

------------------------------------------------------------------------

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"

cabalDistDir :: FilePath -> MaybeT IO FilePath
cabalDistDir :: FilePath -> MaybeT IO FilePath
cabalDistDir = (FilePath -> Bool) -> FilePath -> MaybeT IO FilePath
findSubdirUpwards FilePath -> Bool
isCabal
  where
    -- TODO do old style dist builds work?
    isCabal :: FilePath -> Bool
isCabal FilePath
name = FilePath
name FilePath -> FilePath -> Bool
forall a. Eq a => a -> a -> Bool
== FilePath
"dist-newstyle" Bool -> Bool -> Bool
|| FilePath
name FilePath -> FilePath -> Bool
forall a. Eq a => a -> a -> Bool
== FilePath
"dist"

cabalProjectDir :: FilePath -> MaybeT IO FilePath
cabalProjectDir :: FilePath -> MaybeT IO FilePath
cabalProjectDir = (FilePath -> Bool) -> FilePath -> MaybeT IO FilePath
findFileUpwards FilePath -> Bool
isCabal
  where
    isCabal :: FilePath -> Bool
isCabal FilePath
"cabal.project" = Bool
True
    isCabal FilePath
"cabal.project.local" = Bool
True
    isCabal FilePath
_ = Bool
False

cabalFile :: FilePath -> MaybeT IO FilePath
cabalFile :: FilePath -> MaybeT IO FilePath
cabalFile = (FilePath -> Bool) -> FilePath -> MaybeT IO FilePath
findFileUpwards FilePath -> Bool
isCabal
  where
    isCabal :: FilePath -> Bool
isCabal = (FilePath
".cabal" FilePath -> FilePath -> Bool
forall a. Eq a => a -> a -> Bool
==) (FilePath -> Bool) -> (FilePath -> FilePath) -> FilePath -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> FilePath
takeExtension

------------------------------------------------------------------------
-- Stack Cradle
-- Works for by invoking `stack repl` with a wrapper script

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"

stackWorkDir :: FilePath -> MaybeT IO FilePath
stackWorkDir :: FilePath -> MaybeT IO FilePath
stackWorkDir = (FilePath -> Bool) -> FilePath -> MaybeT IO FilePath
findSubdirUpwards FilePath -> Bool
isStack
  where
    isStack :: FilePath -> Bool
isStack FilePath
name = FilePath
name FilePath -> FilePath -> Bool
forall a. Eq a => a -> a -> Bool
== FilePath
".stack-work"

stackYamlDir :: FilePath -> MaybeT IO FilePath
stackYamlDir :: FilePath -> MaybeT IO FilePath
stackYamlDir = (FilePath -> Bool) -> FilePath -> MaybeT IO FilePath
findFileUpwards FilePath -> Bool
isStack
  where
    isStack :: FilePath -> Bool
isStack FilePath
name = FilePath
name FilePath -> FilePath -> Bool
forall a. Eq a => a -> a -> Bool
== FilePath
"stack.yaml"

-- | Searches upwards for the first directory containing a subdirectory
-- to match the predicate.
findSubdirUpwards :: (FilePath -> Bool) -> FilePath -> MaybeT IO FilePath
findSubdirUpwards :: (FilePath -> Bool) -> FilePath -> MaybeT IO FilePath
findSubdirUpwards FilePath -> Bool
p FilePath
dir = (FilePath -> IO Bool) -> FilePath -> MaybeT IO FilePath
findContentUpwards FilePath -> IO Bool
p' FilePath
dir
  where
    p' :: FilePath -> IO Bool
p' FilePath
subdir = do
      Bool
exists <- FilePath -> IO Bool
doesDirectoryExist (FilePath -> IO Bool) -> FilePath -> IO Bool
forall a b. (a -> b) -> a -> b
$ FilePath
dir FilePath -> FilePath -> FilePath
</> FilePath
subdir
      Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool -> IO Bool) -> Bool -> IO Bool
forall a b. (a -> b) -> a -> b
$ (FilePath -> Bool
p FilePath
subdir) Bool -> Bool -> Bool
&& Bool
exists

-- | Searches upwards for the first directory containing a file to match
-- the predicate.
findFileUpwards :: (FilePath -> Bool) -> FilePath -> MaybeT IO FilePath
findFileUpwards :: (FilePath -> Bool) -> FilePath -> MaybeT IO FilePath
findFileUpwards FilePath -> Bool
p FilePath
dir = (FilePath -> IO Bool) -> FilePath -> MaybeT IO FilePath
findContentUpwards FilePath -> IO Bool
p' FilePath
dir
  where
    p' :: FilePath -> IO Bool
p' FilePath
file = do
      Bool
exists <- FilePath -> IO Bool
doesFileExist (FilePath -> IO Bool) -> FilePath -> IO Bool
forall a b. (a -> b) -> a -> b
$ FilePath
dir FilePath -> FilePath -> FilePath
</> FilePath
file
      Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool -> IO Bool) -> Bool -> IO Bool
forall a b. (a -> b) -> a -> b
$ (FilePath -> Bool
p FilePath
file) Bool -> Bool -> Bool
&& Bool
exists

findContentUpwards :: (FilePath -> IO Bool) -> FilePath -> MaybeT IO FilePath
findContentUpwards :: (FilePath -> IO Bool) -> FilePath -> MaybeT IO FilePath
findContentUpwards FilePath -> IO Bool
p FilePath
dir = do
  [FilePath]
cnts <-
    IO [FilePath] -> MaybeT IO [FilePath]
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
        -- Catch permission errors
        (\(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 (f :: * -> *) a. Applicative f => a -> f a
pure
        ((FilePath -> IO Bool) -> FilePath -> IO [FilePath]
findContent FilePath -> IO 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 (m :: * -> *) a. MonadFail m => FilePath -> m a
fail FilePath
"No cabal files"
      | Bool
otherwise -> (FilePath -> IO Bool) -> FilePath -> MaybeT IO FilePath
findContentUpwards FilePath -> IO Bool
p FilePath
dir'
    FilePath
_ : [FilePath]
_ -> FilePath -> MaybeT IO FilePath
forall (m :: * -> *) a. Monad m => a -> m a
return FilePath
dir
  where
    dir' :: FilePath
dir' = FilePath -> FilePath
takeDirectory FilePath
dir

-- | Sees if any file in the directory matches the predicate
findContent :: (FilePath -> IO Bool) -> FilePath -> IO [FilePath]
findContent :: (FilePath -> IO Bool) -> FilePath -> IO [FilePath]
findContent FilePath -> IO Bool
p FilePath
dir = do
  Bool
b <- FilePath -> IO Bool
doesDirectoryExist FilePath
dir
  if Bool
b then IO [FilePath]
getFiles else [FilePath] -> IO [FilePath]
forall (f :: * -> *) a. Applicative f => a -> f a
pure []
  where
    getFiles :: IO [FilePath]
getFiles = FilePath -> IO [FilePath]
getDirectoryContents FilePath
dir IO [FilePath] -> ([FilePath] -> IO [FilePath]) -> IO [FilePath]
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
p

biosWorkDir :: FilePath -> MaybeT IO FilePath
biosWorkDir :: FilePath -> MaybeT IO FilePath
biosWorkDir = (FilePath -> Bool) -> FilePath -> MaybeT IO FilePath
findFileUpwards (FilePath
".hie-bios" FilePath -> FilePath -> Bool
forall a. Eq a => a -> a -> Bool
==)