module Hix.Path where

import Control.Monad.Trans.Reader (ask)
import Path (Abs, Dir, Path, parent, toFilePath)
import System.FilePattern.Directory (getDirectoryFiles)
import System.IO.Error (tryIOError)

import qualified Hix.Monad
import Hix.Monad (Env (Env), M)

findFlake :: Path Abs Dir -> IO (Maybe (Path Abs Dir))
findFlake :: Path Abs Dir -> IO (Maybe (Path Abs Dir))
findFlake Path Abs Dir
cur =
  IO [FilePattern] -> IO (Either IOError [FilePattern])
forall a. IO a -> IO (Either IOError a)
tryIOError (FilePattern -> [FilePattern] -> IO [FilePattern]
getDirectoryFiles (Path Abs Dir -> FilePattern
forall b t. Path b t -> FilePattern
toFilePath Path Abs Dir
cur) [FilePattern
Item [FilePattern]
"flake.nix"]) IO (Either IOError [FilePattern])
-> (Either IOError [FilePattern] -> IO (Maybe (Path Abs Dir)))
-> IO (Maybe (Path Abs Dir))
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (IOError -> IO (Maybe (Path Abs Dir)))
-> ([FilePattern] -> IO (Maybe (Path Abs Dir)))
-> Either IOError [FilePattern]
-> IO (Maybe (Path Abs Dir))
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (IO (Maybe (Path Abs Dir)) -> IOError -> IO (Maybe (Path Abs Dir))
forall a b. a -> b -> a
const (Maybe (Path Abs Dir) -> IO (Maybe (Path Abs Dir))
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe (Path Abs Dir)
forall a. Maybe a
Nothing)) \case
    [Item [FilePattern]
_] -> Maybe (Path Abs Dir) -> IO (Maybe (Path Abs Dir))
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Path Abs Dir -> Maybe (Path Abs Dir)
forall a. a -> Maybe a
Just Path Abs Dir
cur)
    [FilePattern]
_ | Path Abs Dir -> Path Abs Dir
forall b t. Path b t -> Path b Dir
parent Path Abs Dir
cur Path Abs Dir -> Path Abs Dir -> Bool
forall a. Eq a => a -> a -> Bool
== Path Abs Dir
cur -> Maybe (Path Abs Dir) -> IO (Maybe (Path Abs Dir))
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe (Path Abs Dir)
forall a. Maybe a
Nothing
    [FilePattern]
_ | Bool
otherwise -> Path Abs Dir -> IO (Maybe (Path Abs Dir))
findFlake (Path Abs Dir -> Path Abs Dir
forall b t. Path b t -> Path b Dir
parent Path Abs Dir
cur)

inferRoot :: M (Path Abs Dir)
inferRoot :: M (Path Abs Dir)
inferRoot = do
  Env {Path Abs Dir
cwd :: Path Abs Dir
$sel:cwd:Env :: Env -> Path Abs Dir
cwd} <- ReaderT Env (ExceptT Error IO) Env
forall (m :: * -> *) r. Monad m => ReaderT r m r
ask
  Path Abs Dir -> Maybe (Path Abs Dir) -> Path Abs Dir
forall a. a -> Maybe a -> a
fromMaybe Path Abs Dir
cwd (Maybe (Path Abs Dir) -> Path Abs Dir)
-> ReaderT Env (ExceptT Error IO) (Maybe (Path Abs Dir))
-> M (Path Abs Dir)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO (Maybe (Path Abs Dir))
-> ReaderT Env (ExceptT Error IO) (Maybe (Path Abs Dir))
forall a. IO a -> ReaderT Env (ExceptT Error IO) a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (Path Abs Dir -> IO (Maybe (Path Abs Dir))
findFlake Path Abs Dir
cwd)

rootDir :: Maybe (Path Abs Dir) -> M (Path Abs Dir)
rootDir :: Maybe (Path Abs Dir) -> M (Path Abs Dir)
rootDir =
  M (Path Abs Dir)
-> (Path Abs Dir -> M (Path Abs Dir))
-> Maybe (Path Abs Dir)
-> M (Path Abs Dir)
forall b a. b -> (a -> b) -> Maybe a -> b
maybe M (Path Abs Dir)
inferRoot Path Abs Dir -> M (Path Abs Dir)
forall a. a -> ReaderT Env (ExceptT Error IO) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure