module Hix.Monad where import Control.Monad.Trans.Class (lift) import Control.Monad.Trans.Except (ExceptT, runExceptT, throwE) import Control.Monad.Trans.Reader (ReaderT (runReaderT)) import Path (Abs, Dir, Path) import Hix.Data.Error (Error (BootstrapError, EnvError, GhciError, NewError), tryIO) data Env = Env { Env -> Path Abs Dir cwd :: Path Abs Dir } deriving stock (Env -> Env -> Bool (Env -> Env -> Bool) -> (Env -> Env -> Bool) -> Eq Env forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a $c== :: Env -> Env -> Bool == :: Env -> Env -> Bool $c/= :: Env -> Env -> Bool /= :: Env -> Env -> Bool Eq, Int -> Env -> ShowS [Env] -> ShowS Env -> String (Int -> Env -> ShowS) -> (Env -> String) -> ([Env] -> ShowS) -> Show Env forall a. (Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a $cshowsPrec :: Int -> Env -> ShowS showsPrec :: Int -> Env -> ShowS $cshow :: Env -> String show :: Env -> String $cshowList :: [Env] -> ShowS showList :: [Env] -> ShowS Show, (forall x. Env -> Rep Env x) -> (forall x. Rep Env x -> Env) -> Generic Env forall x. Rep Env x -> Env forall x. Env -> Rep Env x forall a. (forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a $cfrom :: forall x. Env -> Rep Env x from :: forall x. Env -> Rep Env x $cto :: forall x. Rep Env x -> Env to :: forall x. Rep Env x -> Env Generic) type M a = ReaderT Env (ExceptT Error IO) a throwM :: Error -> M a throwM :: forall a. Error -> M a throwM = ExceptT Error IO a -> ReaderT Env (ExceptT Error IO) a forall (m :: * -> *) a. Monad m => m a -> ReaderT Env m a forall (t :: (* -> *) -> * -> *) (m :: * -> *) a. (MonadTrans t, Monad m) => m a -> t m a lift (ExceptT Error IO a -> ReaderT Env (ExceptT Error IO) a) -> (Error -> ExceptT Error IO a) -> Error -> ReaderT Env (ExceptT Error IO) a forall b c a. (b -> c) -> (a -> b) -> a -> c . Error -> ExceptT Error IO a forall (m :: * -> *) e a. Monad m => e -> ExceptT e m a throwE noteEnv :: Text -> Maybe a -> M a noteEnv :: forall a. Text -> Maybe a -> M a noteEnv Text err = M a -> (a -> M a) -> Maybe a -> M a forall b a. b -> (a -> b) -> Maybe a -> b maybe (Error -> M a forall a. Error -> M a throwM (Text -> Error EnvError Text err)) a -> M a forall a. a -> ReaderT Env (ExceptT Error IO) a forall (f :: * -> *) a. Applicative f => a -> f a pure noteGhci :: Text -> Maybe a -> M a noteGhci :: forall a. Text -> Maybe a -> M a noteGhci Text err = M a -> (a -> M a) -> Maybe a -> M a forall b a. b -> (a -> b) -> Maybe a -> b maybe (Error -> M a forall a. Error -> M a throwM (Text -> Error GhciError Text err)) a -> M a forall a. a -> ReaderT Env (ExceptT Error IO) a forall (f :: * -> *) a. Applicative f => a -> f a pure noteNew :: Text -> Maybe a -> M a noteNew :: forall a. Text -> Maybe a -> M a noteNew Text err = M a -> (a -> M a) -> Maybe a -> M a forall b a. b -> (a -> b) -> Maybe a -> b maybe (Error -> M a forall a. Error -> M a throwM (Text -> Error NewError Text err)) a -> M a forall a. a -> ReaderT Env (ExceptT Error IO) a forall (f :: * -> *) a. Applicative f => a -> f a pure noteBootstrap :: Text -> Maybe a -> M a noteBootstrap :: forall a. Text -> Maybe a -> M a noteBootstrap Text err = M a -> (a -> M a) -> Maybe a -> M a forall b a. b -> (a -> b) -> Maybe a -> b maybe (Error -> M a forall a. Error -> M a throwM (Text -> Error BootstrapError Text err)) a -> M a forall a. a -> ReaderT Env (ExceptT Error IO) a forall (f :: * -> *) a. Applicative f => a -> f a pure runM :: Path Abs Dir -> M a -> IO (Either Error a) runM :: forall a. Path Abs Dir -> M a -> IO (Either Error a) runM Path Abs Dir root M a ma = ExceptT Error IO a -> IO (Either Error a) forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a) runExceptT (M a -> Env -> ExceptT Error IO a forall r (m :: * -> *) a. ReaderT r m a -> r -> m a runReaderT M a ma (Path Abs Dir -> Env Env Path Abs Dir root)) tryIOM :: IO a -> M a tryIOM :: forall a. IO a -> M a tryIOM IO a ma = ExceptT Error IO a -> ReaderT Env (ExceptT Error IO) a forall (m :: * -> *) a. Monad m => m a -> ReaderT Env m a forall (t :: (* -> *) -> * -> *) (m :: * -> *) a. (MonadTrans t, Monad m) => m a -> t m a lift (IO a -> ExceptT Error IO a forall a. IO a -> ExceptT Error IO a tryIO IO a ma)