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)