{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE UndecidableInstances #-}
module Cli.Extras.Types where
import Control.Concurrent.MVar (MVar)
import Control.Monad.Catch (MonadCatch, MonadMask, MonadThrow)
import Control.Monad.Fail (MonadFail)
import Control.Monad.Log (LoggingT(..), MonadLog, Severity (..), WithSeverity (..))
import Control.Monad.Reader (MonadIO, ReaderT (..), MonadReader (..), ask)
import Control.Monad.Writer (WriterT)
import Control.Monad.State (StateT)
import Control.Monad.Except (ExceptT, MonadError (..))
import Control.Monad.Trans (MonadTrans, lift)
import Data.IORef (IORef)
import Data.Text (Text)
import Cli.Extras.TerminalString (TerminalString)
import Cli.Extras.Theme (CliTheme)
import Cli.Extras.SubExcept
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
data CliConfig = CliConfig
{
CliConfig -> IORef Severity
_cliConfig_logLevel :: IORef Severity
,
CliConfig -> Bool
_cliConfig_noColor :: Bool
,
CliConfig -> Bool
_cliConfig_noSpinner :: Bool
,
CliConfig -> MVar Bool
_cliConfig_lock :: MVar Bool
,
CliConfig -> IORef Bool
_cliConfig_tipDisplayed :: IORef Bool
,
CliConfig -> IORef ([Bool], [TerminalString])
_cliConfig_spinnerStack :: IORef ([Bool], [TerminalString])
,
CliConfig -> CliTheme
_cliConfig_theme :: CliTheme
}
class Monad m => HasCliConfig m where
getCliConfig :: m CliConfig
instance HasCliConfig m => HasCliConfig (ReaderT r m) where
getCliConfig :: ReaderT r m CliConfig
getCliConfig = m CliConfig -> ReaderT r m CliConfig
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift m CliConfig
forall (m :: * -> *). HasCliConfig m => m CliConfig
getCliConfig
instance (Monoid w, HasCliConfig m) => HasCliConfig (WriterT w m) where
getCliConfig :: WriterT w m CliConfig
getCliConfig = m CliConfig -> WriterT w m CliConfig
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift m CliConfig
forall (m :: * -> *). HasCliConfig m => m CliConfig
getCliConfig
instance HasCliConfig m => HasCliConfig (StateT s m) where
getCliConfig :: StateT s m CliConfig
getCliConfig = m CliConfig -> StateT s m CliConfig
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift m CliConfig
forall (m :: * -> *). HasCliConfig m => m CliConfig
getCliConfig
instance HasCliConfig m => HasCliConfig (ExceptT e m) where
getCliConfig :: ExceptT e m CliConfig
getCliConfig = m CliConfig -> ExceptT e m CliConfig
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift m CliConfig
forall (m :: * -> *). HasCliConfig m => m CliConfig
getCliConfig
instance HasCliConfig m => HasCliConfig (SubExceptT e eSub m) where
getCliConfig :: SubExceptT e eSub m CliConfig
getCliConfig = m CliConfig -> SubExceptT e eSub m CliConfig
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift m CliConfig
forall (m :: * -> *). HasCliConfig m => m CliConfig
getCliConfig
newtype CliT e m a = CliT
{ CliT e m a -> ReaderT CliConfig (LoggingT Output (ExceptT e m)) a
unCliT :: ReaderT CliConfig (LoggingT Output (ExceptT 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 :: * -> *). Monad m => Functor (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 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 -> b) -> CliT e m a -> CliT e m b
forall e (m :: * -> *) a b c.
Monad 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.
Monad 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.
Monad 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.
Monad 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.
Monad 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. Monad m => a -> CliT e m a
$cp1Applicative :: forall e (m :: * -> *). Monad 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
)
instance MonadTrans (CliT e) where
lift :: m a -> CliT e m a
lift = ReaderT CliConfig (LoggingT Output (ExceptT e m)) a -> CliT e m a
forall e (m :: * -> *) a.
ReaderT CliConfig (LoggingT Output (ExceptT e m)) a -> CliT e m a
CliT (ReaderT CliConfig (LoggingT Output (ExceptT e m)) a -> CliT e m a)
-> (m a -> ReaderT CliConfig (LoggingT Output (ExceptT e m)) a)
-> m a
-> CliT e m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LoggingT Output (ExceptT e m) a
-> ReaderT CliConfig (LoggingT Output (ExceptT e m)) a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (LoggingT Output (ExceptT e m) a
-> ReaderT CliConfig (LoggingT Output (ExceptT e m)) a)
-> (m a -> LoggingT Output (ExceptT e m) a)
-> m a
-> ReaderT CliConfig (LoggingT Output (ExceptT e m)) a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ExceptT e m a -> LoggingT Output (ExceptT e m) a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (ExceptT e m a -> LoggingT Output (ExceptT e m) a)
-> (m a -> ExceptT e m a) -> m a -> LoggingT Output (ExceptT e m) a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. m a -> ExceptT e m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift
instance Monad m => HasCliConfig (CliT e m)where
getCliConfig :: CliT e m CliConfig
getCliConfig = ReaderT CliConfig (LoggingT Output (ExceptT e m)) CliConfig
-> CliT e m CliConfig
forall e (m :: * -> *) a.
ReaderT CliConfig (LoggingT Output (ExceptT e m)) a -> CliT e m a
CliT ReaderT CliConfig (LoggingT Output (ExceptT e m)) CliConfig
forall r (m :: * -> *). MonadReader r m => m r
ask