{-# 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)  -- Regular logging message (with colors and newlines)
  | Output_LogRaw (WithSeverity Text)  -- Like `Output_Log` but without the implicit newline added.
  | Output_Write [TerminalString]  -- Render and write a TerminalString using putstrLn
  | Output_Overwrite [TerminalString]  -- Overwrite the current line (i.e. \r followed by `putStr`)
  | Output_ClearLine  -- Clear the line
  deriving (Output -> Output -> Bool
(Output -> Output -> Bool)
-> (Output -> Output -> Bool) -> Eq Output
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Output -> Output -> Bool
== :: Output -> Output -> Bool
$c/= :: Output -> Output -> Bool
/= :: 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
$cshowsPrec :: Int -> Output -> ShowS
showsPrec :: Int -> Output -> ShowS
$cshow :: Output -> String
show :: Output -> String
$cshowList :: [Output] -> ShowS
showList :: [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
$ccompare :: Output -> Output -> Ordering
compare :: Output -> Output -> Ordering
$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
>= :: Output -> Output -> Bool
$cmax :: Output -> Output -> Output
max :: Output -> Output -> Output
$cmin :: Output -> Output -> Output
min :: Output -> Output -> Output
Ord)

type CliLog m = MonadLog Output m

type CliThrow e m = MonadError e m

-- | Log a message to the console.
--
-- The message is guaranteed to be logged uninterrupted, even if there
-- are ongoing spinners.
putLog :: CliLog m => Severity -> Text -> m ()
putLog :: forall (m :: * -> *). CliLog m => Severity -> Text -> m ()
putLog 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 { forall e (m :: * -> *) a.
DieT e m a -> ReaderT (e -> (Text, ExitCode)) (LoggingT Output m) a
unDieT :: ReaderT (e -> (Text, ExitCode)) (LoggingT Output m) a }
  deriving
    ( (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
$cfmap :: forall e (m :: * -> *) a b.
Functor m =>
(a -> b) -> DieT e m a -> DieT e m b
fmap :: forall a b. (a -> b) -> DieT e m a -> DieT e m b
$c<$ :: forall e (m :: * -> *) a b.
Functor m =>
a -> DieT e m b -> DieT e m a
<$ :: forall a b. a -> DieT e m b -> DieT e m a
Functor, Functor (DieT e m)
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)
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
$cpure :: forall e (m :: * -> *) a. Applicative m => a -> DieT e m a
pure :: forall a. a -> DieT e m a
$c<*> :: forall e (m :: * -> *) a b.
Applicative m =>
DieT e m (a -> b) -> DieT e m a -> DieT e m b
<*> :: forall a b. DieT e m (a -> b) -> DieT e m a -> DieT e m b
$cliftA2 :: forall e (m :: * -> *) a b c.
Applicative m =>
(a -> b -> c) -> DieT e m a -> DieT e m b -> DieT e m c
liftA2 :: forall a b c.
(a -> b -> c) -> DieT e m a -> DieT e m b -> DieT e m c
$c*> :: forall e (m :: * -> *) a b.
Applicative m =>
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 b
$c<* :: forall e (m :: * -> *) a b.
Applicative m =>
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 a
Applicative, Applicative (DieT e m)
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)
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
$c>>= :: forall e (m :: * -> *) a b.
Monad m =>
DieT e m a -> (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
$c>> :: forall e (m :: * -> *) a b.
Monad m =>
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 b
$creturn :: forall e (m :: * -> *) a. Monad m => a -> DieT e m a
return :: forall a. a -> DieT e m a
Monad, Monad (DieT e m)
Monad (DieT e m) =>
(forall a. IO a -> DieT e m a) -> MonadIO (DieT e m)
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
$cliftIO :: forall e (m :: * -> *) a. MonadIO m => IO a -> DieT e m a
liftIO :: forall a. IO a -> DieT e m a
MonadIO, Monad (DieT e m)
Monad (DieT e m) =>
(forall a. String -> DieT e m a) -> MonadFail (DieT e m)
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
$cfail :: forall e (m :: * -> *) a. MonadFail m => String -> DieT e m a
fail :: forall a. String -> DieT e m a
MonadFail
    , Monad (DieT e m)
Monad (DieT e m) =>
(forall e a. (HasCallStack, Exception e) => e -> DieT e m a)
-> MonadThrow (DieT e m)
forall e a. (HasCallStack, Exception e) => e -> DieT e m a
forall e (m :: * -> *). MonadThrow m => Monad (DieT e m)
forall e (m :: * -> *) e a.
(MonadThrow m, HasCallStack, Exception e) =>
e -> DieT e m a
forall (m :: * -> *).
Monad m =>
(forall e a. (HasCallStack, Exception e) => e -> m a)
-> MonadThrow m
$cthrowM :: forall e (m :: * -> *) e a.
(MonadThrow m, HasCallStack, Exception e) =>
e -> DieT e m a
throwM :: forall e a. (HasCallStack, Exception e) => e -> DieT e m a
MonadThrow, MonadThrow (DieT e m)
MonadThrow (DieT e m) =>
(forall e a.
 (HasCallStack, Exception e) =>
 DieT e m a -> (e -> DieT e m a) -> DieT e m a)
-> MonadCatch (DieT e m)
forall e a.
(HasCallStack, 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, HasCallStack, Exception e) =>
DieT e m a -> (e -> DieT e m a) -> DieT e m a
forall (m :: * -> *).
MonadThrow m =>
(forall e a.
 (HasCallStack, Exception e) =>
 m a -> (e -> m a) -> m a)
-> MonadCatch m
$ccatch :: forall e (m :: * -> *) e a.
(MonadCatch m, HasCallStack, Exception e) =>
DieT e m a -> (e -> DieT e m a) -> DieT e m a
catch :: forall e a.
(HasCallStack, Exception e) =>
DieT e m a -> (e -> DieT e m a) -> DieT e m a
MonadCatch, MonadCatch (DieT e m)
MonadCatch (DieT e m) =>
(forall b.
 HasCallStack =>
 ((forall a. DieT e m a -> DieT e m a) -> DieT e m b) -> DieT e m b)
-> (forall b.
    HasCallStack =>
    ((forall a. DieT e m a -> DieT e m a) -> DieT e m b) -> DieT e m b)
-> (forall a b c.
    HasCallStack =>
    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)
forall b.
HasCallStack =>
((forall a. DieT e m a -> DieT e m a) -> DieT e m b) -> DieT e m b
forall a b c.
HasCallStack =>
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, HasCallStack) =>
((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, HasCallStack) =>
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. HasCallStack => ((forall a. m a -> m a) -> m b) -> m b)
-> (forall b.
    HasCallStack =>
    ((forall a. m a -> m a) -> m b) -> m b)
-> (forall a b c.
    HasCallStack =>
    m a -> (a -> ExitCase b -> m c) -> (a -> m b) -> m (b, c))
-> MonadMask m
$cmask :: forall e (m :: * -> *) b.
(MonadMask m, HasCallStack) =>
((forall a. DieT e m a -> DieT e m a) -> DieT e m b) -> DieT e m b
mask :: forall b.
HasCallStack =>
((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, HasCallStack) =>
((forall a. DieT e m a -> DieT e m a) -> DieT e m b) -> DieT e m b
uninterruptibleMask :: forall b.
HasCallStack =>
((forall a. DieT e m a -> DieT e m a) -> DieT e m b) -> DieT e m b
$cgeneralBracket :: forall e (m :: * -> *) a b c.
(MonadMask m, HasCallStack) =>
DieT e m a
-> (a -> ExitCase b -> DieT e m c)
-> (a -> DieT e m b)
-> DieT e m (b, c)
generalBracket :: forall a b c.
HasCallStack =>
DieT e m a
-> (a -> ExitCase b -> DieT e m c)
-> (a -> DieT e m b)
-> DieT e m (b, c)
MonadMask
    , MonadLog Output
    )

instance MonadTrans (DieT e) where
  lift :: forall (m :: * -> *) a. Monad m => 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 (m :: * -> *) a.
Monad m =>
m a -> ReaderT (e -> (Text, ExitCode)) 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 (m :: * -> *) a. Monad m => 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 (m :: * -> *) a.
Monad m =>
m a -> ReaderT (e -> (Text, ExitCode)) m a
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 :: forall a. (r -> r) -> DieT e m a -> DieT e m a
local = (\ReaderT (e -> (Text, ExitCode)) (LoggingT Output m) a
-> ReaderT (e -> (Text, ExitCode)) (LoggingT Output m) a
f (DieT 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 a. (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 :: forall a. (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 (m :: * -> *) a.
Monad m =>
m a -> ReaderT (e -> (Text, ExitCode)) 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 (m :: * -> *) a. Monad m => 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 a. (r -> a) -> m a
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
reader

-- TODO generalize to bigger error types
instance MonadIO m => MonadError e (DieT e m) where
  throwError :: forall a. e -> DieT e m a
throwError e
e = do
    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, exitCode) = handler e
    putLog Alert output
    liftIO $ exitWith $ exitCode

  -- Cannot catch
  catchError :: forall a. DieT e m a -> (e -> DieT e m a) -> DieT e m a
catchError DieT e m a
m e -> DieT e m a
_ = DieT e m a
m

--------------------------------------------------------------------------------

data CliConfig e = CliConfig
  { -- | We are capable of changing the log level at runtime
    forall e. CliConfig e -> IORef Severity
_cliConfig_logLevel :: IORef Severity
  , -- | Disallow coloured output
    forall e. CliConfig e -> Bool
_cliConfig_noColor :: Bool
  , -- | Disallow spinners
    forall e. CliConfig e -> Bool
_cliConfig_noSpinner :: Bool
  , -- | Whether the last message was an Overwrite output
    forall e. CliConfig e -> MVar Bool
_cliConfig_lock :: MVar Bool
  , -- | Whether the user tip (to make verbose) was already displayed
    forall e. CliConfig e -> IORef Bool
_cliConfig_tipDisplayed :: IORef Bool
  , -- | Stack of logs from nested spinners
    forall e. CliConfig e -> IORef ([Bool], [TerminalString])
_cliConfig_spinnerStack :: IORef ([Bool], [TerminalString])
  , -- | Handler for failures. Determines, given an error, what message
    -- should be printed, and what the exit status should be.
    forall e. CliConfig e -> e -> (Text, ExitCode)
_cliConfig_errorLogExitCode :: e -> (Text, ExitCode)
  , -- | Theme strings for spinners
    forall e. 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 (m :: * -> *) a. Monad m => m a -> ReaderT r m a
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 (m :: * -> *) a. Monad m => m a -> WriterT w m a
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 (m :: * -> *) a. Monad m => m a -> StateT s m a
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 (m :: * -> *) a. Monad m => m a -> ExceptT e m a
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
  { forall e (m :: * -> *) a.
CliT e m a -> ReaderT (CliConfig e) (DieT e m) a
unCliT :: ReaderT (CliConfig e) (DieT e m) a
  }
  deriving
    ( (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
$cfmap :: forall e (m :: * -> *) a b.
Functor m =>
(a -> b) -> CliT e m a -> CliT e m b
fmap :: forall a b. (a -> b) -> CliT e m a -> CliT e m b
$c<$ :: forall e (m :: * -> *) a b.
Functor m =>
a -> CliT e m b -> CliT e m a
<$ :: forall a b. a -> CliT e m b -> CliT e m a
Functor, Functor (CliT e m)
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)
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
$cpure :: forall e (m :: * -> *) a. Applicative m => a -> CliT e m a
pure :: forall a. a -> CliT e m a
$c<*> :: forall e (m :: * -> *) a b.
Applicative m =>
CliT e m (a -> b) -> CliT e m a -> CliT e m b
<*> :: forall a b. CliT e m (a -> b) -> CliT e m a -> CliT e m b
$cliftA2 :: forall e (m :: * -> *) a b c.
Applicative m =>
(a -> b -> c) -> CliT e m a -> CliT e m b -> CliT e m c
liftA2 :: forall a b c.
(a -> b -> c) -> CliT e m a -> CliT e m b -> CliT e m c
$c*> :: forall e (m :: * -> *) a b.
Applicative m =>
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 b
$c<* :: forall e (m :: * -> *) a b.
Applicative m =>
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 a
Applicative, Applicative (CliT e m)
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)
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
$c>>= :: forall e (m :: * -> *) a b.
Monad m =>
CliT e m a -> (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
$c>> :: forall e (m :: * -> *) a b.
Monad m =>
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 b
$creturn :: forall e (m :: * -> *) a. Monad m => a -> CliT e m a
return :: forall a. a -> CliT e m a
Monad, Monad (CliT e m)
Monad (CliT e m) =>
(forall a. IO a -> CliT e m a) -> MonadIO (CliT e m)
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
$cliftIO :: forall e (m :: * -> *) a. MonadIO m => IO a -> CliT e m a
liftIO :: forall a. IO a -> CliT e m a
MonadIO, Monad (CliT e m)
Monad (CliT e m) =>
(forall a. String -> CliT e m a) -> MonadFail (CliT e m)
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
$cfail :: forall e (m :: * -> *) a. MonadFail m => String -> CliT e m a
fail :: forall a. String -> CliT e m a
MonadFail
    , Monad (CliT e m)
Monad (CliT e m) =>
(forall e a. (HasCallStack, Exception e) => e -> CliT e m a)
-> MonadThrow (CliT e m)
forall e a. (HasCallStack, Exception e) => e -> CliT e m a
forall e (m :: * -> *). MonadThrow m => Monad (CliT e m)
forall e (m :: * -> *) e a.
(MonadThrow m, HasCallStack, Exception e) =>
e -> CliT e m a
forall (m :: * -> *).
Monad m =>
(forall e a. (HasCallStack, Exception e) => e -> m a)
-> MonadThrow m
$cthrowM :: forall e (m :: * -> *) e a.
(MonadThrow m, HasCallStack, Exception e) =>
e -> CliT e m a
throwM :: forall e a. (HasCallStack, Exception e) => e -> CliT e m a
MonadThrow, MonadThrow (CliT e m)
MonadThrow (CliT e m) =>
(forall e a.
 (HasCallStack, Exception e) =>
 CliT e m a -> (e -> CliT e m a) -> CliT e m a)
-> MonadCatch (CliT e m)
forall e a.
(HasCallStack, 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, HasCallStack, Exception e) =>
CliT e m a -> (e -> CliT e m a) -> CliT e m a
forall (m :: * -> *).
MonadThrow m =>
(forall e a.
 (HasCallStack, Exception e) =>
 m a -> (e -> m a) -> m a)
-> MonadCatch m
$ccatch :: forall e (m :: * -> *) e a.
(MonadCatch m, HasCallStack, Exception e) =>
CliT e m a -> (e -> CliT e m a) -> CliT e m a
catch :: forall e a.
(HasCallStack, Exception e) =>
CliT e m a -> (e -> CliT e m a) -> CliT e m a
MonadCatch, MonadCatch (CliT e m)
MonadCatch (CliT e m) =>
(forall b.
 HasCallStack =>
 ((forall a. CliT e m a -> CliT e m a) -> CliT e m b) -> CliT e m b)
-> (forall b.
    HasCallStack =>
    ((forall a. CliT e m a -> CliT e m a) -> CliT e m b) -> CliT e m b)
-> (forall a b c.
    HasCallStack =>
    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)
forall b.
HasCallStack =>
((forall a. CliT e m a -> CliT e m a) -> CliT e m b) -> CliT e m b
forall a b c.
HasCallStack =>
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, HasCallStack) =>
((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, HasCallStack) =>
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. HasCallStack => ((forall a. m a -> m a) -> m b) -> m b)
-> (forall b.
    HasCallStack =>
    ((forall a. m a -> m a) -> m b) -> m b)
-> (forall a b c.
    HasCallStack =>
    m a -> (a -> ExitCase b -> m c) -> (a -> m b) -> m (b, c))
-> MonadMask m
$cmask :: forall e (m :: * -> *) b.
(MonadMask m, HasCallStack) =>
((forall a. CliT e m a -> CliT e m a) -> CliT e m b) -> CliT e m b
mask :: forall b.
HasCallStack =>
((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, HasCallStack) =>
((forall a. CliT e m a -> CliT e m a) -> CliT e m b) -> CliT e m b
uninterruptibleMask :: forall b.
HasCallStack =>
((forall a. CliT e m a -> CliT e m a) -> CliT e m b) -> CliT e m b
$cgeneralBracket :: forall e (m :: * -> *) a b c.
(MonadMask m, HasCallStack) =>
CliT e m a
-> (a -> ExitCase b -> CliT e m c)
-> (a -> CliT e m b)
-> CliT e m (b, c)
generalBracket :: forall a b c.
HasCallStack =>
CliT e m a
-> (a -> ExitCase b -> CliT e m c)
-> (a -> CliT e m b)
-> CliT e m (b, c)
MonadMask
    , MonadLog Output -- CliLog
    , MonadError e -- CliThrow
    , MonadReader (CliConfig e) -- HasCliConfig
    )

instance MonadTrans (CliT e) where
  lift :: forall (m :: * -> *) a. Monad m => 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 (m :: * -> *) a. Monad m => m a -> ReaderT (CliConfig 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 (m :: * -> *) a. Monad m => 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