{-# 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
/= :: 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

-- | 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 :: 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

-- TODO generalize to bigger error types
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

  -- Cannot catch
  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
  { -- | We are capable of changing the log level at runtime
    CliConfig e -> IORef Severity
_cliConfig_logLevel :: IORef Severity
  , -- | Disallow coloured output
    CliConfig e -> Bool
_cliConfig_noColor :: Bool
  , -- | Disallow spinners
    CliConfig e -> Bool
_cliConfig_noSpinner :: Bool
  , -- | Whether the last message was an Overwrite output
    CliConfig e -> MVar Bool
_cliConfig_lock :: MVar Bool
  , -- | Whether the user tip (to make verbose) was already displayed
    CliConfig e -> IORef Bool
_cliConfig_tipDisplayed :: IORef Bool
  , -- | Stack of logs from nested spinners
    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.
    CliConfig e -> e -> (Text, ExitCode)
_cliConfig_errorLogExitCode :: e -> (Text, ExitCode)
  , -- | Theme strings for spinners
    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 -- CliLog
    , MonadError e -- CliThrow
    , MonadReader (CliConfig e) -- HasCliConfig
    )

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