module Hix.Data.Monad where

import Control.Monad.Catch (MonadCatch, MonadMask, MonadThrow)
import Control.Monad.Trans.Class (lift)
import Control.Monad.Trans.Except (ExceptT)
import Control.Monad.Trans.Reader (ReaderT, asks)
import GHC.Records (HasField (getField))
import Path (Abs, Dir, Path)

import Hix.Data.Error (Error)
import Hix.Data.OutputFormat (OutputFormat)
import Hix.Data.OutputTarget (OutputTarget)

data LogLevel =
  LogError
  |
  LogWarn
  |
  LogInfo
  |
  LogVerbose
  |
  LogDebug
  deriving stock (LogLevel -> LogLevel -> Bool
(LogLevel -> LogLevel -> Bool)
-> (LogLevel -> LogLevel -> Bool) -> Eq LogLevel
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: LogLevel -> LogLevel -> Bool
== :: LogLevel -> LogLevel -> Bool
$c/= :: LogLevel -> LogLevel -> Bool
/= :: LogLevel -> LogLevel -> Bool
Eq, Int -> LogLevel -> ShowS
[LogLevel] -> ShowS
LogLevel -> String
(Int -> LogLevel -> ShowS)
-> (LogLevel -> String) -> ([LogLevel] -> ShowS) -> Show LogLevel
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> LogLevel -> ShowS
showsPrec :: Int -> LogLevel -> ShowS
$cshow :: LogLevel -> String
show :: LogLevel -> String
$cshowList :: [LogLevel] -> ShowS
showList :: [LogLevel] -> ShowS
Show, (forall x. LogLevel -> Rep LogLevel x)
-> (forall x. Rep LogLevel x -> LogLevel) -> Generic LogLevel
forall x. Rep LogLevel x -> LogLevel
forall x. LogLevel -> Rep LogLevel x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. LogLevel -> Rep LogLevel x
from :: forall x. LogLevel -> Rep LogLevel x
$cto :: forall x. Rep LogLevel x -> LogLevel
to :: forall x. Rep LogLevel x -> LogLevel
Generic)

data AppResources =
  AppResources {
    AppResources -> Path Abs Dir
cwd :: Path Abs Dir,
    AppResources -> Path Abs Dir
tmp :: Path Abs Dir,
    AppResources -> Bool
verbose :: Bool,
    AppResources -> Bool
debug :: Bool,
    AppResources -> Bool
quiet :: Bool,
    AppResources -> OutputFormat
output :: OutputFormat,
    AppResources -> OutputTarget
target :: OutputTarget,
    AppResources -> LogLevel -> Text -> M ()
logger :: LogLevel -> Text -> M ()
  }

newtype M a =
  M (ReaderT AppResources (ExceptT Error IO) a)
  deriving newtype ((forall a b. (a -> b) -> M a -> M b)
-> (forall a b. a -> M b -> M a) -> Functor M
forall a b. a -> M b -> M a
forall a b. (a -> b) -> M a -> M b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
$cfmap :: forall a b. (a -> b) -> M a -> M b
fmap :: forall a b. (a -> b) -> M a -> M b
$c<$ :: forall a b. a -> M b -> M a
<$ :: forall a b. a -> M b -> M a
Functor, Functor M
Functor M
-> (forall a. a -> M a)
-> (forall a b. M (a -> b) -> M a -> M b)
-> (forall a b c. (a -> b -> c) -> M a -> M b -> M c)
-> (forall a b. M a -> M b -> M b)
-> (forall a b. M a -> M b -> M a)
-> Applicative M
forall a. a -> M a
forall a b. M a -> M b -> M a
forall a b. M a -> M b -> M b
forall a b. M (a -> b) -> M a -> M b
forall a b c. (a -> b -> c) -> M a -> M b -> M c
forall (f :: * -> *).
Functor f
-> (forall a. a -> f a)
-> (forall a b. f (a -> b) -> f a -> f b)
-> (forall a b c. (a -> b -> c) -> f a -> f b -> f c)
-> (forall a b. f a -> f b -> f b)
-> (forall a b. f a -> f b -> f a)
-> Applicative f
$cpure :: forall a. a -> M a
pure :: forall a. a -> M a
$c<*> :: forall a b. M (a -> b) -> M a -> M b
<*> :: forall a b. M (a -> b) -> M a -> M b
$cliftA2 :: forall a b c. (a -> b -> c) -> M a -> M b -> M c
liftA2 :: forall a b c. (a -> b -> c) -> M a -> M b -> M c
$c*> :: forall a b. M a -> M b -> M b
*> :: forall a b. M a -> M b -> M b
$c<* :: forall a b. M a -> M b -> M a
<* :: forall a b. M a -> M b -> M a
Applicative, Applicative M
Applicative M
-> (forall a b. M a -> (a -> M b) -> M b)
-> (forall a b. M a -> M b -> M b)
-> (forall a. a -> M a)
-> Monad M
forall a. a -> M a
forall a b. M a -> M b -> M b
forall a b. M a -> (a -> M b) -> M b
forall (m :: * -> *).
Applicative m
-> (forall a b. m a -> (a -> m b) -> m b)
-> (forall a b. m a -> m b -> m b)
-> (forall a. a -> m a)
-> Monad m
$c>>= :: forall a b. M a -> (a -> M b) -> M b
>>= :: forall a b. M a -> (a -> M b) -> M b
$c>> :: forall a b. M a -> M b -> M b
>> :: forall a b. M a -> M b -> M b
$creturn :: forall a. a -> M a
return :: forall a. a -> M a
Monad, Monad M
Monad M -> (forall a. IO a -> M a) -> MonadIO M
forall a. IO a -> M a
forall (m :: * -> *).
Monad m -> (forall a. IO a -> m a) -> MonadIO m
$cliftIO :: forall a. IO a -> M a
liftIO :: forall a. IO a -> M a
MonadIO, Monad M
Monad M -> (forall e a. Exception e => e -> M a) -> MonadThrow M
forall e a. Exception e => e -> M a
forall (m :: * -> *).
Monad m -> (forall e a. Exception e => e -> m a) -> MonadThrow m
$cthrowM :: forall e a. Exception e => e -> M a
throwM :: forall e a. Exception e => e -> M a
MonadThrow, MonadThrow M
MonadThrow M
-> (forall e a. Exception e => M a -> (e -> M a) -> M a)
-> MonadCatch M
forall e a. Exception e => M a -> (e -> M a) -> M a
forall (m :: * -> *).
MonadThrow m
-> (forall e a. Exception e => m a -> (e -> m a) -> m a)
-> MonadCatch m
$ccatch :: forall e a. Exception e => M a -> (e -> M a) -> M a
catch :: forall e a. Exception e => M a -> (e -> M a) -> M a
MonadCatch, MonadCatch M
MonadCatch M
-> (forall b. ((forall a. M a -> M a) -> M b) -> M b)
-> (forall b. ((forall a. M a -> M a) -> M b) -> M b)
-> (forall a b c.
    M a -> (a -> ExitCase b -> M c) -> (a -> M b) -> M (b, c))
-> MonadMask M
forall b. ((forall a. M a -> M a) -> M b) -> M b
forall a b c.
M a -> (a -> ExitCase b -> M c) -> (a -> M b) -> M (b, c)
forall (m :: * -> *).
MonadCatch m
-> (forall b. ((forall a. m a -> m a) -> m b) -> m b)
-> (forall b. ((forall a. m a -> m a) -> m b) -> m b)
-> (forall a b c.
    m a -> (a -> ExitCase b -> m c) -> (a -> m b) -> m (b, c))
-> MonadMask m
$cmask :: forall b. ((forall a. M a -> M a) -> M b) -> M b
mask :: forall b. ((forall a. M a -> M a) -> M b) -> M b
$cuninterruptibleMask :: forall b. ((forall a. M a -> M a) -> M b) -> M b
uninterruptibleMask :: forall b. ((forall a. M a -> M a) -> M b) -> M b
$cgeneralBracket :: forall a b c.
M a -> (a -> ExitCase b -> M c) -> (a -> M b) -> M (b, c)
generalBracket :: forall a b c.
M a -> (a -> ExitCase b -> M c) -> (a -> M b) -> M (b, c)
MonadMask)

liftE :: ExceptT Error IO a -> M a
liftE :: forall a. ExceptT Error IO a -> M a
liftE = ReaderT AppResources (ExceptT Error IO) a -> M a
forall a. ReaderT AppResources (ExceptT Error IO) a -> M a
M (ReaderT AppResources (ExceptT Error IO) a -> M a)
-> (ExceptT Error IO a
    -> ReaderT AppResources (ExceptT Error IO) a)
-> ExceptT Error IO a
-> M a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ExceptT Error IO a -> ReaderT AppResources (ExceptT Error IO) a
forall (m :: * -> *) a. Monad m => m a -> ReaderT AppResources m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift

data AppResProxy = AppResProxy

instance HasField name AppResources a => HasField name AppResProxy (M a) where
  getField :: AppResProxy -> M a
getField AppResProxy
AppResProxy = ReaderT AppResources (ExceptT Error IO) a -> M a
forall a. ReaderT AppResources (ExceptT Error IO) a -> M a
M ((AppResources -> a) -> ReaderT AppResources (ExceptT Error IO) a
forall (m :: * -> *) r a. Monad m => (r -> a) -> ReaderT r m a
asks (forall (x :: k) r a. HasField x r a => r -> a
forall {k} (x :: k) r a. HasField x r a => r -> a
getField @name))

appRes :: AppResProxy
appRes :: AppResProxy
appRes = AppResProxy
AppResProxy