{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE FunctionalDependencies #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE UndecidableInstances #-}
{-# LANGUAGE CPP #-}
module Cli.Extras.Types where
import Control.Concurrent.MVar (MVar)
import Control.Monad.Catch (MonadCatch, MonadMask, MonadThrow)
import Control.Monad.Log (LoggingT(..), MonadLog, Severity (..), WithSeverity (..), logMessage)
import Control.Monad.Reader (MonadIO, ReaderT (..), MonadReader (..), ask, mapReaderT)
import Control.Monad.Writer (WriterT)
import Control.Monad.State (StateT)
import Control.Monad.Except (ExceptT, MonadError (..))
import Control.Monad.IO.Class (liftIO)
import Control.Monad.Trans (MonadTrans, lift)
import Data.IORef (IORef)
import Data.Text (Text)
import System.Exit (ExitCode (..), exitWith)
import Cli.Extras.TerminalString (TerminalString)
import Cli.Extras.Theme (CliTheme)
#if !(MIN_VERSION_base(4, 13, 0))
import Control.Monad.Fail (MonadFail)
#endif
data Output
= Output_Log (WithSeverity Text)
| Output_LogRaw (WithSeverity Text)
| Output_Write [TerminalString]
| Output_Overwrite [TerminalString]
| Output_ClearLine
deriving (Output -> Output -> Bool
(Output -> Output -> Bool)
-> (Output -> Output -> Bool) -> Eq Output
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Output -> Output -> Bool
$c/= :: Output -> Output -> Bool
== :: Output -> Output -> Bool
$c== :: Output -> Output -> Bool
Eq, Int -> Output -> ShowS
[Output] -> ShowS
Output -> String
(Int -> Output -> ShowS)
-> (Output -> String) -> ([Output] -> ShowS) -> Show Output
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Output] -> ShowS
$cshowList :: [Output] -> ShowS
show :: Output -> String
$cshow :: Output -> String
showsPrec :: Int -> Output -> ShowS
$cshowsPrec :: Int -> Output -> ShowS
Show, Eq Output
Eq Output =>
(Output -> Output -> Ordering)
-> (Output -> Output -> Bool)
-> (Output -> Output -> Bool)
-> (Output -> Output -> Bool)
-> (Output -> Output -> Bool)
-> (Output -> Output -> Output)
-> (Output -> Output -> Output)
-> Ord Output
Output -> Output -> Bool
Output -> Output -> Ordering
Output -> Output -> Output
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Output -> Output -> Output
$cmin :: Output -> Output -> Output
max :: Output -> Output -> Output
$cmax :: Output -> Output -> Output
>= :: Output -> Output -> Bool
$c>= :: Output -> Output -> Bool
> :: Output -> Output -> Bool
$c> :: Output -> Output -> Bool
<= :: Output -> Output -> Bool
$c<= :: Output -> Output -> Bool
< :: Output -> Output -> Bool
$c< :: Output -> Output -> Bool
compare :: Output -> Output -> Ordering
$ccompare :: Output -> Output -> Ordering
$cp1Ord :: Eq Output
Ord)
type CliLog m = MonadLog Output m
type CliThrow e m = MonadError e m
putLog :: CliLog m => Severity -> Text -> m ()
putLog :: Severity -> Text -> m ()
putLog sev :: Severity
sev = Output -> m ()
forall message (m :: * -> *). MonadLog message m => message -> m ()
logMessage (Output -> m ()) -> (Text -> Output) -> Text -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WithSeverity Text -> Output
Output_Log (WithSeverity Text -> Output)
-> (Text -> WithSeverity Text) -> Text -> Output
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Severity -> Text -> WithSeverity Text
forall a. Severity -> a -> WithSeverity a
WithSeverity Severity
sev
newtype DieT e m a = DieT { DieT e m a -> ReaderT (e -> (Text, ExitCode)) (LoggingT Output m) a
unDieT :: ReaderT (e -> (Text, ExitCode)) (LoggingT Output m) a }
deriving
( a -> DieT e m b -> DieT e m a
(a -> b) -> DieT e m a -> DieT e m b
(forall a b. (a -> b) -> DieT e m a -> DieT e m b)
-> (forall a b. a -> DieT e m b -> DieT e m a)
-> Functor (DieT e m)
forall a b. a -> DieT e m b -> DieT e m a
forall a b. (a -> b) -> DieT e m a -> DieT e m b
forall e (m :: * -> *) a b.
Functor m =>
a -> DieT e m b -> DieT e m a
forall e (m :: * -> *) a b.
Functor m =>
(a -> b) -> DieT e m a -> DieT e m b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a -> DieT e m b -> DieT e m a
$c<$ :: forall e (m :: * -> *) a b.
Functor m =>
a -> DieT e m b -> DieT e m a
fmap :: (a -> b) -> DieT e m a -> DieT e m b
$cfmap :: forall e (m :: * -> *) a b.
Functor m =>
(a -> b) -> DieT e m a -> DieT e m b
Functor, Functor (DieT e m)
a -> DieT e m a
Functor (DieT e m) =>
(forall a. a -> DieT e m a)
-> (forall a b. DieT e m (a -> b) -> DieT e m a -> DieT e m b)
-> (forall a b c.
(a -> b -> c) -> DieT e m a -> DieT e m b -> DieT e m c)
-> (forall a b. DieT e m a -> DieT e m b -> DieT e m b)
-> (forall a b. DieT e m a -> DieT e m b -> DieT e m a)
-> Applicative (DieT e m)
DieT e m a -> DieT e m b -> DieT e m b
DieT e m a -> DieT e m b -> DieT e m a
DieT e m (a -> b) -> DieT e m a -> DieT e m b
(a -> b -> c) -> DieT e m a -> DieT e m b -> DieT e m c
forall a. a -> DieT e m a
forall a b. DieT e m a -> DieT e m b -> DieT e m a
forall a b. DieT e m a -> DieT e m b -> DieT e m b
forall a b. DieT e m (a -> b) -> DieT e m a -> DieT e m b
forall a b c.
(a -> b -> c) -> DieT e m a -> DieT e m b -> DieT e m c
forall e (m :: * -> *). Applicative m => Functor (DieT e m)
forall e (m :: * -> *) a. Applicative m => a -> DieT e m a
forall e (m :: * -> *) a b.
Applicative m =>
DieT e m a -> DieT e m b -> DieT e m a
forall e (m :: * -> *) a b.
Applicative m =>
DieT e m a -> DieT e m b -> DieT e m b
forall e (m :: * -> *) a b.
Applicative m =>
DieT e m (a -> b) -> DieT e m a -> DieT e m b
forall e (m :: * -> *) a b c.
Applicative m =>
(a -> b -> c) -> DieT e m a -> DieT e m b -> DieT e 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
<* :: DieT e m a -> DieT e m b -> DieT e m a
$c<* :: forall e (m :: * -> *) a b.
Applicative m =>
DieT e m a -> DieT e m b -> DieT e m a
*> :: DieT e m a -> DieT e m b -> DieT e m b
$c*> :: forall e (m :: * -> *) a b.
Applicative m =>
DieT e m a -> DieT e m b -> DieT e m b
liftA2 :: (a -> b -> c) -> DieT e m a -> DieT e m b -> DieT e m c
$cliftA2 :: forall e (m :: * -> *) a b c.
Applicative m =>
(a -> b -> c) -> DieT e m a -> DieT e m b -> DieT e m c
<*> :: DieT e m (a -> b) -> DieT e m a -> DieT e m b
$c<*> :: forall e (m :: * -> *) a b.
Applicative m =>
DieT e m (a -> b) -> DieT e m a -> DieT e m b
pure :: a -> DieT e m a
$cpure :: forall e (m :: * -> *) a. Applicative m => a -> DieT e m a
$cp1Applicative :: forall e (m :: * -> *). Applicative m => Functor (DieT e m)
Applicative, Applicative (DieT e m)
a -> DieT e m a
Applicative (DieT e m) =>
(forall a b. DieT e m a -> (a -> DieT e m b) -> DieT e m b)
-> (forall a b. DieT e m a -> DieT e m b -> DieT e m b)
-> (forall a. a -> DieT e m a)
-> Monad (DieT e m)
DieT e m a -> (a -> DieT e m b) -> DieT e m b
DieT e m a -> DieT e m b -> DieT e m b
forall a. a -> DieT e m a
forall a b. DieT e m a -> DieT e m b -> DieT e m b
forall a b. DieT e m a -> (a -> DieT e m b) -> DieT e m b
forall e (m :: * -> *). Monad m => Applicative (DieT e m)
forall e (m :: * -> *) a. Monad m => a -> DieT e m a
forall e (m :: * -> *) a b.
Monad m =>
DieT e m a -> DieT e m b -> DieT e m b
forall e (m :: * -> *) a b.
Monad m =>
DieT e m a -> (a -> DieT e m b) -> DieT e 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
return :: a -> DieT e m a
$creturn :: forall e (m :: * -> *) a. Monad m => a -> DieT e m a
>> :: DieT e m a -> DieT e m b -> DieT e m b
$c>> :: forall e (m :: * -> *) a b.
Monad m =>
DieT e m a -> DieT e m b -> DieT e m b
>>= :: DieT e m a -> (a -> DieT e m b) -> DieT e m b
$c>>= :: forall e (m :: * -> *) a b.
Monad m =>
DieT e m a -> (a -> DieT e m b) -> DieT e m b
$cp1Monad :: forall e (m :: * -> *). Monad m => Applicative (DieT e m)
Monad, Monad (DieT e m)
Monad (DieT e m) =>
(forall a. IO a -> DieT e m a) -> MonadIO (DieT e m)
IO a -> DieT e m a
forall a. IO a -> DieT e m a
forall e (m :: * -> *). MonadIO m => Monad (DieT e m)
forall e (m :: * -> *) a. MonadIO m => IO a -> DieT e m a
forall (m :: * -> *).
Monad m =>
(forall a. IO a -> m a) -> MonadIO m
liftIO :: IO a -> DieT e m a
$cliftIO :: forall e (m :: * -> *) a. MonadIO m => IO a -> DieT e m a
$cp1MonadIO :: forall e (m :: * -> *). MonadIO m => Monad (DieT e m)
MonadIO, Monad (DieT e m)
Monad (DieT e m) =>
(forall a. String -> DieT e m a) -> MonadFail (DieT e m)
String -> DieT e m a
forall a. String -> DieT e m a
forall e (m :: * -> *). MonadFail m => Monad (DieT e m)
forall e (m :: * -> *) a. MonadFail m => String -> DieT e m a
forall (m :: * -> *).
Monad m =>
(forall a. String -> m a) -> MonadFail m
fail :: String -> DieT e m a
$cfail :: forall e (m :: * -> *) a. MonadFail m => String -> DieT e m a
$cp1MonadFail :: forall e (m :: * -> *). MonadFail m => Monad (DieT e m)
MonadFail
, Monad (DieT e m)
e -> DieT e m a
Monad (DieT e m) =>
(forall e a. Exception e => e -> DieT e m a)
-> MonadThrow (DieT e m)
forall e a. Exception e => e -> DieT e m a
forall e (m :: * -> *). MonadThrow m => Monad (DieT e m)
forall e (m :: * -> *) e a.
(MonadThrow m, Exception e) =>
e -> DieT e m a
forall (m :: * -> *).
Monad m =>
(forall e a. Exception e => e -> m a) -> MonadThrow m
throwM :: e -> DieT e m a
$cthrowM :: forall e (m :: * -> *) e a.
(MonadThrow m, Exception e) =>
e -> DieT e m a
$cp1MonadThrow :: forall e (m :: * -> *). MonadThrow m => Monad (DieT e m)
MonadThrow, MonadThrow (DieT e m)
MonadThrow (DieT e m) =>
(forall e a.
Exception e =>
DieT e m a -> (e -> DieT e m a) -> DieT e m a)
-> MonadCatch (DieT e m)
DieT e m a -> (e -> DieT e m a) -> DieT e m a
forall e a.
Exception e =>
DieT e m a -> (e -> DieT e m a) -> DieT e m a
forall e (m :: * -> *). MonadCatch m => MonadThrow (DieT e m)
forall e (m :: * -> *) e a.
(MonadCatch m, Exception e) =>
DieT e m a -> (e -> DieT e m a) -> DieT e m a
forall (m :: * -> *).
MonadThrow m =>
(forall e a. Exception e => m a -> (e -> m a) -> m a)
-> MonadCatch m
catch :: DieT e m a -> (e -> DieT e m a) -> DieT e m a
$ccatch :: forall e (m :: * -> *) e a.
(MonadCatch m, Exception e) =>
DieT e m a -> (e -> DieT e m a) -> DieT e m a
$cp1MonadCatch :: forall e (m :: * -> *). MonadCatch m => MonadThrow (DieT e m)
MonadCatch, MonadCatch (DieT e m)
MonadCatch (DieT e m) =>
(forall b.
((forall a. DieT e m a -> DieT e m a) -> DieT e m b) -> DieT e m b)
-> (forall b.
((forall a. DieT e m a -> DieT e m a) -> DieT e m b) -> DieT e m b)
-> (forall a b c.
DieT e m a
-> (a -> ExitCase b -> DieT e m c)
-> (a -> DieT e m b)
-> DieT e m (b, c))
-> MonadMask (DieT e m)
DieT e m a
-> (a -> ExitCase b -> DieT e m c)
-> (a -> DieT e m b)
-> DieT e m (b, c)
((forall a. DieT e m a -> DieT e m a) -> DieT e m b) -> DieT e m b
((forall a. DieT e m a -> DieT e m a) -> DieT e m b) -> DieT e m b
forall b.
((forall a. DieT e m a -> DieT e m a) -> DieT e m b) -> DieT e m b
forall a b c.
DieT e m a
-> (a -> ExitCase b -> DieT e m c)
-> (a -> DieT e m b)
-> DieT e m (b, c)
forall e (m :: * -> *). MonadMask m => MonadCatch (DieT e m)
forall e (m :: * -> *) b.
MonadMask m =>
((forall a. DieT e m a -> DieT e m a) -> DieT e m b) -> DieT e m b
forall e (m :: * -> *) a b c.
MonadMask m =>
DieT e m a
-> (a -> ExitCase b -> DieT e m c)
-> (a -> DieT e m b)
-> DieT e 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
generalBracket :: DieT e m a
-> (a -> ExitCase b -> DieT e m c)
-> (a -> DieT e m b)
-> DieT e m (b, c)
$cgeneralBracket :: forall e (m :: * -> *) a b c.
MonadMask m =>
DieT e m a
-> (a -> ExitCase b -> DieT e m c)
-> (a -> DieT e m b)
-> DieT e m (b, c)
uninterruptibleMask :: ((forall a. DieT e m a -> DieT e m a) -> DieT e m b) -> DieT e m b
$cuninterruptibleMask :: forall e (m :: * -> *) b.
MonadMask m =>
((forall a. DieT e m a -> DieT e m a) -> DieT e m b) -> DieT e m b
mask :: ((forall a. DieT e m a -> DieT e m a) -> DieT e m b) -> DieT e m b
$cmask :: forall e (m :: * -> *) b.
MonadMask m =>
((forall a. DieT e m a -> DieT e m a) -> DieT e m b) -> DieT e m b
$cp1MonadMask :: forall e (m :: * -> *). MonadMask m => MonadCatch (DieT e m)
MonadMask
, MonadLog Output
)
instance MonadTrans (DieT e) where
lift :: m a -> DieT e m a
lift = ReaderT (e -> (Text, ExitCode)) (LoggingT Output m) a -> DieT e m a
forall e (m :: * -> *) a.
ReaderT (e -> (Text, ExitCode)) (LoggingT Output m) a -> DieT e m a
DieT (ReaderT (e -> (Text, ExitCode)) (LoggingT Output m) a
-> DieT e m a)
-> (m a -> ReaderT (e -> (Text, ExitCode)) (LoggingT Output m) a)
-> m a
-> DieT e m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LoggingT Output m a
-> ReaderT (e -> (Text, ExitCode)) (LoggingT Output m) a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (LoggingT Output m a
-> ReaderT (e -> (Text, ExitCode)) (LoggingT Output m) a)
-> (m a -> LoggingT Output m a)
-> m a
-> ReaderT (e -> (Text, ExitCode)) (LoggingT Output m) a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. m a -> LoggingT Output m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift
instance MonadReader r m => MonadReader r (DieT e m) where
ask :: DieT e m r
ask = ReaderT (e -> (Text, ExitCode)) (LoggingT Output m) r -> DieT e m r
forall e (m :: * -> *) a.
ReaderT (e -> (Text, ExitCode)) (LoggingT Output m) a -> DieT e m a
DieT (ReaderT (e -> (Text, ExitCode)) (LoggingT Output m) r
-> DieT e m r)
-> ReaderT (e -> (Text, ExitCode)) (LoggingT Output m) r
-> DieT e m r
forall a b. (a -> b) -> a -> b
$ LoggingT Output m r
-> ReaderT (e -> (Text, ExitCode)) (LoggingT Output m) r
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (LoggingT Output m r
-> ReaderT (e -> (Text, ExitCode)) (LoggingT Output m) r)
-> LoggingT Output m r
-> ReaderT (e -> (Text, ExitCode)) (LoggingT Output m) r
forall a b. (a -> b) -> a -> b
$ LoggingT Output m r
forall r (m :: * -> *). MonadReader r m => m r
ask
local :: (r -> r) -> DieT e m a -> DieT e m a
local = (\f :: ReaderT (e -> (Text, ExitCode)) (LoggingT Output m) a
-> ReaderT (e -> (Text, ExitCode)) (LoggingT Output m) a
f (DieT a :: ReaderT (e -> (Text, ExitCode)) (LoggingT Output m) a
a) -> ReaderT (e -> (Text, ExitCode)) (LoggingT Output m) a -> DieT e m a
forall e (m :: * -> *) a.
ReaderT (e -> (Text, ExitCode)) (LoggingT Output m) a -> DieT e m a
DieT (ReaderT (e -> (Text, ExitCode)) (LoggingT Output m) a
-> DieT e m a)
-> ReaderT (e -> (Text, ExitCode)) (LoggingT Output m) a
-> DieT e m a
forall a b. (a -> b) -> a -> b
$ ReaderT (e -> (Text, ExitCode)) (LoggingT Output m) a
-> ReaderT (e -> (Text, ExitCode)) (LoggingT Output m) a
f ReaderT (e -> (Text, ExitCode)) (LoggingT Output m) a
a) ((ReaderT (e -> (Text, ExitCode)) (LoggingT Output m) a
-> ReaderT (e -> (Text, ExitCode)) (LoggingT Output m) a)
-> DieT e m a -> DieT e m a)
-> ((r -> r)
-> ReaderT (e -> (Text, ExitCode)) (LoggingT Output m) a
-> ReaderT (e -> (Text, ExitCode)) (LoggingT Output m) a)
-> (r -> r)
-> DieT e m a
-> DieT e m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (LoggingT Output m a -> LoggingT Output m a)
-> ReaderT (e -> (Text, ExitCode)) (LoggingT Output m) a
-> ReaderT (e -> (Text, ExitCode)) (LoggingT Output m) a
forall (m :: * -> *) a (n :: * -> *) b r.
(m a -> n b) -> ReaderT r m a -> ReaderT r n b
mapReaderT ((LoggingT Output m a -> LoggingT Output m a)
-> ReaderT (e -> (Text, ExitCode)) (LoggingT Output m) a
-> ReaderT (e -> (Text, ExitCode)) (LoggingT Output m) a)
-> ((r -> r) -> LoggingT Output m a -> LoggingT Output m a)
-> (r -> r)
-> ReaderT (e -> (Text, ExitCode)) (LoggingT Output m) a
-> ReaderT (e -> (Text, ExitCode)) (LoggingT Output m) a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (r -> r) -> LoggingT Output m a -> LoggingT Output m a
forall r (m :: * -> *) a. MonadReader r m => (r -> r) -> m a -> m a
local
reader :: (r -> a) -> DieT e m a
reader = ReaderT (e -> (Text, ExitCode)) (LoggingT Output m) a -> DieT e m a
forall e (m :: * -> *) a.
ReaderT (e -> (Text, ExitCode)) (LoggingT Output m) a -> DieT e m a
DieT (ReaderT (e -> (Text, ExitCode)) (LoggingT Output m) a
-> DieT e m a)
-> ((r -> a)
-> ReaderT (e -> (Text, ExitCode)) (LoggingT Output m) a)
-> (r -> a)
-> DieT e m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LoggingT Output m a
-> ReaderT (e -> (Text, ExitCode)) (LoggingT Output m) a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (LoggingT Output m a
-> ReaderT (e -> (Text, ExitCode)) (LoggingT Output m) a)
-> ((r -> a) -> LoggingT Output m a)
-> (r -> a)
-> ReaderT (e -> (Text, ExitCode)) (LoggingT Output m) a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. m a -> LoggingT Output m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m a -> LoggingT Output m a)
-> ((r -> a) -> m a) -> (r -> a) -> LoggingT Output m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (r -> a) -> m a
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
reader
instance MonadIO m => MonadError e (DieT e m) where
throwError :: e -> DieT e m a
throwError e :: e
e = do
e -> (Text, ExitCode)
handler <- ReaderT
(e -> (Text, ExitCode)) (LoggingT Output m) (e -> (Text, ExitCode))
-> DieT e m (e -> (Text, ExitCode))
forall e (m :: * -> *) a.
ReaderT (e -> (Text, ExitCode)) (LoggingT Output m) a -> DieT e m a
DieT ReaderT
(e -> (Text, ExitCode)) (LoggingT Output m) (e -> (Text, ExitCode))
forall r (m :: * -> *). MonadReader r m => m r
ask
let (output :: Text
output, exitCode :: ExitCode
exitCode) = e -> (Text, ExitCode)
handler e
e
Severity -> Text -> DieT e m ()
forall (m :: * -> *). CliLog m => Severity -> Text -> m ()
putLog Severity
Alert Text
output
IO a -> DieT e m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO a -> DieT e m a) -> IO a -> DieT e m a
forall a b. (a -> b) -> a -> b
$ ExitCode -> IO a
forall a. ExitCode -> IO a
exitWith (ExitCode -> IO a) -> ExitCode -> IO a
forall a b. (a -> b) -> a -> b
$ ExitCode
exitCode
catchError :: DieT e m a -> (e -> DieT e m a) -> DieT e m a
catchError m :: DieT e m a
m _ = DieT e m a
m
data CliConfig e = CliConfig
{
CliConfig e -> IORef Severity
_cliConfig_logLevel :: IORef Severity
,
CliConfig e -> Bool
_cliConfig_noColor :: Bool
,
CliConfig e -> Bool
_cliConfig_noSpinner :: Bool
,
CliConfig e -> MVar Bool
_cliConfig_lock :: MVar Bool
,
CliConfig e -> IORef Bool
_cliConfig_tipDisplayed :: IORef Bool
,
CliConfig e -> IORef ([Bool], [TerminalString])
_cliConfig_spinnerStack :: IORef ([Bool], [TerminalString])
,
CliConfig e -> e -> (Text, ExitCode)
_cliConfig_errorLogExitCode :: e -> (Text, ExitCode)
,
CliConfig e -> CliTheme
_cliConfig_theme :: CliTheme
}
class Monad m => HasCliConfig e m | m -> e where
getCliConfig :: m (CliConfig e)
instance HasCliConfig e m => HasCliConfig e (ReaderT r m) where
getCliConfig :: ReaderT r m (CliConfig e)
getCliConfig = m (CliConfig e) -> ReaderT r m (CliConfig e)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift m (CliConfig e)
forall e (m :: * -> *). HasCliConfig e m => m (CliConfig e)
getCliConfig
instance (Monoid w, HasCliConfig e m) => HasCliConfig e (WriterT w m) where
getCliConfig :: WriterT w m (CliConfig e)
getCliConfig = m (CliConfig e) -> WriterT w m (CliConfig e)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift m (CliConfig e)
forall e (m :: * -> *). HasCliConfig e m => m (CliConfig e)
getCliConfig
instance HasCliConfig e m => HasCliConfig e (StateT s m) where
getCliConfig :: StateT s m (CliConfig e)
getCliConfig = m (CliConfig e) -> StateT s m (CliConfig e)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift m (CliConfig e)
forall e (m :: * -> *). HasCliConfig e m => m (CliConfig e)
getCliConfig
instance HasCliConfig e m => HasCliConfig e (ExceptT e m) where
getCliConfig :: ExceptT e m (CliConfig e)
getCliConfig = m (CliConfig e) -> ExceptT e m (CliConfig e)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift m (CliConfig e)
forall e (m :: * -> *). HasCliConfig e m => m (CliConfig e)
getCliConfig
newtype CliT e m a = CliT
{ CliT e m a -> ReaderT (CliConfig e) (DieT e m) a
unCliT :: ReaderT (CliConfig e) (DieT e m) a
}
deriving
( a -> CliT e m b -> CliT e m a
(a -> b) -> CliT e m a -> CliT e m b
(forall a b. (a -> b) -> CliT e m a -> CliT e m b)
-> (forall a b. a -> CliT e m b -> CliT e m a)
-> Functor (CliT e m)
forall a b. a -> CliT e m b -> CliT e m a
forall a b. (a -> b) -> CliT e m a -> CliT e m b
forall e (m :: * -> *) a b.
Functor m =>
a -> CliT e m b -> CliT e m a
forall e (m :: * -> *) a b.
Functor m =>
(a -> b) -> CliT e m a -> CliT e m b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a -> CliT e m b -> CliT e m a
$c<$ :: forall e (m :: * -> *) a b.
Functor m =>
a -> CliT e m b -> CliT e m a
fmap :: (a -> b) -> CliT e m a -> CliT e m b
$cfmap :: forall e (m :: * -> *) a b.
Functor m =>
(a -> b) -> CliT e m a -> CliT e m b
Functor, Functor (CliT e m)
a -> CliT e m a
Functor (CliT e m) =>
(forall a. a -> CliT e m a)
-> (forall a b. CliT e m (a -> b) -> CliT e m a -> CliT e m b)
-> (forall a b c.
(a -> b -> c) -> CliT e m a -> CliT e m b -> CliT e m c)
-> (forall a b. CliT e m a -> CliT e m b -> CliT e m b)
-> (forall a b. CliT e m a -> CliT e m b -> CliT e m a)
-> Applicative (CliT e m)
CliT e m a -> CliT e m b -> CliT e m b
CliT e m a -> CliT e m b -> CliT e m a
CliT e m (a -> b) -> CliT e m a -> CliT e m b
(a -> b -> c) -> CliT e m a -> CliT e m b -> CliT e m c
forall a. a -> CliT e m a
forall a b. CliT e m a -> CliT e m b -> CliT e m a
forall a b. CliT e m a -> CliT e m b -> CliT e m b
forall a b. CliT e m (a -> b) -> CliT e m a -> CliT e m b
forall a b c.
(a -> b -> c) -> CliT e m a -> CliT e m b -> CliT e m c
forall e (m :: * -> *). Applicative m => Functor (CliT e m)
forall e (m :: * -> *) a. Applicative m => a -> CliT e m a
forall e (m :: * -> *) a b.
Applicative m =>
CliT e m a -> CliT e m b -> CliT e m a
forall e (m :: * -> *) a b.
Applicative m =>
CliT e m a -> CliT e m b -> CliT e m b
forall e (m :: * -> *) a b.
Applicative m =>
CliT e m (a -> b) -> CliT e m a -> CliT e m b
forall e (m :: * -> *) a b c.
Applicative m =>
(a -> b -> c) -> CliT e m a -> CliT e m b -> CliT e 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
<* :: CliT e m a -> CliT e m b -> CliT e m a
$c<* :: forall e (m :: * -> *) a b.
Applicative m =>
CliT e m a -> CliT e m b -> CliT e m a
*> :: CliT e m a -> CliT e m b -> CliT e m b
$c*> :: forall e (m :: * -> *) a b.
Applicative m =>
CliT e m a -> CliT e m b -> CliT e m b
liftA2 :: (a -> b -> c) -> CliT e m a -> CliT e m b -> CliT e m c
$cliftA2 :: forall e (m :: * -> *) a b c.
Applicative m =>
(a -> b -> c) -> CliT e m a -> CliT e m b -> CliT e m c
<*> :: CliT e m (a -> b) -> CliT e m a -> CliT e m b
$c<*> :: forall e (m :: * -> *) a b.
Applicative m =>
CliT e m (a -> b) -> CliT e m a -> CliT e m b
pure :: a -> CliT e m a
$cpure :: forall e (m :: * -> *) a. Applicative m => a -> CliT e m a
$cp1Applicative :: forall e (m :: * -> *). Applicative m => Functor (CliT e m)
Applicative, Applicative (CliT e m)
a -> CliT e m a
Applicative (CliT e m) =>
(forall a b. CliT e m a -> (a -> CliT e m b) -> CliT e m b)
-> (forall a b. CliT e m a -> CliT e m b -> CliT e m b)
-> (forall a. a -> CliT e m a)
-> Monad (CliT e m)
CliT e m a -> (a -> CliT e m b) -> CliT e m b
CliT e m a -> CliT e m b -> CliT e m b
forall a. a -> CliT e m a
forall a b. CliT e m a -> CliT e m b -> CliT e m b
forall a b. CliT e m a -> (a -> CliT e m b) -> CliT e m b
forall e (m :: * -> *). Monad m => Applicative (CliT e m)
forall e (m :: * -> *) a. Monad m => a -> CliT e m a
forall e (m :: * -> *) a b.
Monad m =>
CliT e m a -> CliT e m b -> CliT e m b
forall e (m :: * -> *) a b.
Monad m =>
CliT e m a -> (a -> CliT e m b) -> CliT e 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
return :: a -> CliT e m a
$creturn :: forall e (m :: * -> *) a. Monad m => a -> CliT e m a
>> :: CliT e m a -> CliT e m b -> CliT e m b
$c>> :: forall e (m :: * -> *) a b.
Monad m =>
CliT e m a -> CliT e m b -> CliT e m b
>>= :: CliT e m a -> (a -> CliT e m b) -> CliT e m b
$c>>= :: forall e (m :: * -> *) a b.
Monad m =>
CliT e m a -> (a -> CliT e m b) -> CliT e m b
$cp1Monad :: forall e (m :: * -> *). Monad m => Applicative (CliT e m)
Monad, Monad (CliT e m)
Monad (CliT e m) =>
(forall a. IO a -> CliT e m a) -> MonadIO (CliT e m)
IO a -> CliT e m a
forall a. IO a -> CliT e m a
forall e (m :: * -> *). MonadIO m => Monad (CliT e m)
forall e (m :: * -> *) a. MonadIO m => IO a -> CliT e m a
forall (m :: * -> *).
Monad m =>
(forall a. IO a -> m a) -> MonadIO m
liftIO :: IO a -> CliT e m a
$cliftIO :: forall e (m :: * -> *) a. MonadIO m => IO a -> CliT e m a
$cp1MonadIO :: forall e (m :: * -> *). MonadIO m => Monad (CliT e m)
MonadIO, Monad (CliT e m)
Monad (CliT e m) =>
(forall a. String -> CliT e m a) -> MonadFail (CliT e m)
String -> CliT e m a
forall a. String -> CliT e m a
forall e (m :: * -> *). MonadFail m => Monad (CliT e m)
forall e (m :: * -> *) a. MonadFail m => String -> CliT e m a
forall (m :: * -> *).
Monad m =>
(forall a. String -> m a) -> MonadFail m
fail :: String -> CliT e m a
$cfail :: forall e (m :: * -> *) a. MonadFail m => String -> CliT e m a
$cp1MonadFail :: forall e (m :: * -> *). MonadFail m => Monad (CliT e m)
MonadFail
, Monad (CliT e m)
e -> CliT e m a
Monad (CliT e m) =>
(forall e a. Exception e => e -> CliT e m a)
-> MonadThrow (CliT e m)
forall e a. Exception e => e -> CliT e m a
forall e (m :: * -> *). MonadThrow m => Monad (CliT e m)
forall e (m :: * -> *) e a.
(MonadThrow m, Exception e) =>
e -> CliT e m a
forall (m :: * -> *).
Monad m =>
(forall e a. Exception e => e -> m a) -> MonadThrow m
throwM :: e -> CliT e m a
$cthrowM :: forall e (m :: * -> *) e a.
(MonadThrow m, Exception e) =>
e -> CliT e m a
$cp1MonadThrow :: forall e (m :: * -> *). MonadThrow m => Monad (CliT e m)
MonadThrow, MonadThrow (CliT e m)
MonadThrow (CliT e m) =>
(forall e a.
Exception e =>
CliT e m a -> (e -> CliT e m a) -> CliT e m a)
-> MonadCatch (CliT e m)
CliT e m a -> (e -> CliT e m a) -> CliT e m a
forall e a.
Exception e =>
CliT e m a -> (e -> CliT e m a) -> CliT e m a
forall e (m :: * -> *). MonadCatch m => MonadThrow (CliT e m)
forall e (m :: * -> *) e a.
(MonadCatch m, Exception e) =>
CliT e m a -> (e -> CliT e m a) -> CliT e m a
forall (m :: * -> *).
MonadThrow m =>
(forall e a. Exception e => m a -> (e -> m a) -> m a)
-> MonadCatch m
catch :: CliT e m a -> (e -> CliT e m a) -> CliT e m a
$ccatch :: forall e (m :: * -> *) e a.
(MonadCatch m, Exception e) =>
CliT e m a -> (e -> CliT e m a) -> CliT e m a
$cp1MonadCatch :: forall e (m :: * -> *). MonadCatch m => MonadThrow (CliT e m)
MonadCatch, MonadCatch (CliT e m)
MonadCatch (CliT e m) =>
(forall b.
((forall a. CliT e m a -> CliT e m a) -> CliT e m b) -> CliT e m b)
-> (forall b.
((forall a. CliT e m a -> CliT e m a) -> CliT e m b) -> CliT e m b)
-> (forall a b c.
CliT e m a
-> (a -> ExitCase b -> CliT e m c)
-> (a -> CliT e m b)
-> CliT e m (b, c))
-> MonadMask (CliT e m)
CliT e m a
-> (a -> ExitCase b -> CliT e m c)
-> (a -> CliT e m b)
-> CliT e m (b, c)
((forall a. CliT e m a -> CliT e m a) -> CliT e m b) -> CliT e m b
((forall a. CliT e m a -> CliT e m a) -> CliT e m b) -> CliT e m b
forall b.
((forall a. CliT e m a -> CliT e m a) -> CliT e m b) -> CliT e m b
forall a b c.
CliT e m a
-> (a -> ExitCase b -> CliT e m c)
-> (a -> CliT e m b)
-> CliT e m (b, c)
forall e (m :: * -> *). MonadMask m => MonadCatch (CliT e m)
forall e (m :: * -> *) b.
MonadMask m =>
((forall a. CliT e m a -> CliT e m a) -> CliT e m b) -> CliT e m b
forall e (m :: * -> *) a b c.
MonadMask m =>
CliT e m a
-> (a -> ExitCase b -> CliT e m c)
-> (a -> CliT e m b)
-> CliT e 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
generalBracket :: CliT e m a
-> (a -> ExitCase b -> CliT e m c)
-> (a -> CliT e m b)
-> CliT e m (b, c)
$cgeneralBracket :: forall e (m :: * -> *) a b c.
MonadMask m =>
CliT e m a
-> (a -> ExitCase b -> CliT e m c)
-> (a -> CliT e m b)
-> CliT e m (b, c)
uninterruptibleMask :: ((forall a. CliT e m a -> CliT e m a) -> CliT e m b) -> CliT e m b
$cuninterruptibleMask :: forall e (m :: * -> *) b.
MonadMask m =>
((forall a. CliT e m a -> CliT e m a) -> CliT e m b) -> CliT e m b
mask :: ((forall a. CliT e m a -> CliT e m a) -> CliT e m b) -> CliT e m b
$cmask :: forall e (m :: * -> *) b.
MonadMask m =>
((forall a. CliT e m a -> CliT e m a) -> CliT e m b) -> CliT e m b
$cp1MonadMask :: forall e (m :: * -> *). MonadMask m => MonadCatch (CliT e m)
MonadMask
, MonadLog Output
, MonadError e
, MonadReader (CliConfig e)
)
instance MonadTrans (CliT e) where
lift :: m a -> CliT e m a
lift = ReaderT (CliConfig e) (DieT e m) a -> CliT e m a
forall e (m :: * -> *) a.
ReaderT (CliConfig e) (DieT e m) a -> CliT e m a
CliT (ReaderT (CliConfig e) (DieT e m) a -> CliT e m a)
-> (m a -> ReaderT (CliConfig e) (DieT e m) a) -> m a -> CliT e m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DieT e m a -> ReaderT (CliConfig e) (DieT e m) a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (DieT e m a -> ReaderT (CliConfig e) (DieT e m) a)
-> (m a -> DieT e m a) -> m a -> ReaderT (CliConfig e) (DieT e m) a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. m a -> DieT e m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift
instance Monad m => HasCliConfig e (CliT e m)where
getCliConfig :: CliT e m (CliConfig e)
getCliConfig = CliT e m (CliConfig e)
forall r (m :: * -> *). MonadReader r m => m r
ask