{-# language NoImplicitPrelude #-}
{-# options_haddock prune #-}
module Prelate.App (
runApp,
runAppLevel,
runAppLevelE,
AppStack,
resumeExit,
stopExit,
ExitErrorMessage (exitErrorMessage),
) where
import Conc (ConcStack, Critical, interpretCritical, interpretInterrupt)
import qualified Data.Text.IO as Text
import Incipit
import Log (Severity (Info), interpretLogStderrLevelConc)
import Polysemy.Chronos (ChronosTime, interpretTimeChronos)
import System.Exit (exitFailure)
import System.IO (stderr)
type AppStack =
[
ChronosTime,
Log,
Interrupt,
Critical,
Error Text
] ++ ConcStack
printError :: Text -> IO ()
printError :: Text -> IO ()
printError Text
msg =
Handle -> Text -> IO ()
Text.hPutStrLn Handle
stderr (Text
"Error: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
msg)
exitError :: Text -> IO a
exitError :: forall a. Text -> IO a
exitError Text
msg = do
Text -> IO ()
printError Text
msg
IO a
forall a. IO a
exitFailure
runAppLevelE ::
Severity ->
Sem AppStack a ->
IO (Either Text a)
runAppLevelE :: forall a. Severity -> Sem AppStack a -> IO (Either Text a)
runAppLevelE Severity
level =
Sem ConcStack (Either Text a) -> IO (Either Text a)
forall a. Sem ConcStack a -> IO a
runConc (Sem ConcStack (Either Text a) -> IO (Either Text a))
-> (Sem
(ChronosTime : Log : Interrupt : Critical : Error Text : ConcStack)
a
-> Sem ConcStack (Either Text a))
-> Sem
(ChronosTime : Log : Interrupt : Critical : Error Text : ConcStack)
a
-> IO (Either Text a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
Sem (Error Text : ConcStack) a -> Sem ConcStack (Either Text a)
forall e (r :: EffectRow) a.
Member (Final IO) r =>
Sem (Error e : r) a -> Sem r (Either e a)
errorToIOFinal (Sem (Error Text : ConcStack) a -> Sem ConcStack (Either Text a))
-> (Sem
(ChronosTime : Log : Interrupt : Critical : Error Text : ConcStack)
a
-> Sem (Error Text : ConcStack) a)
-> Sem
(ChronosTime : Log : Interrupt : Critical : Error Text : ConcStack)
a
-> Sem ConcStack (Either Text a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
Sem (Critical : Error Text : ConcStack) a
-> Sem (Error Text : ConcStack) a
forall (r :: EffectRow).
Member (Final IO) r =>
InterpreterFor Critical r
InterpreterFor Critical (Error Text : ConcStack)
interpretCritical (Sem (Critical : Error Text : ConcStack) a
-> Sem (Error Text : ConcStack) a)
-> (Sem
(ChronosTime : Log : Interrupt : Critical : Error Text : ConcStack)
a
-> Sem (Critical : Error Text : ConcStack) a)
-> Sem
(ChronosTime : Log : Interrupt : Critical : Error Text : ConcStack)
a
-> Sem (Error Text : ConcStack) a
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
Sem (Interrupt : Critical : Error Text : ConcStack) a
-> Sem (Critical : Error Text : ConcStack) a
forall (r :: EffectRow).
Members '[Critical, Race, Async, Embed IO] r =>
InterpreterFor Interrupt r
InterpreterFor Interrupt (Critical : Error Text : ConcStack)
interpretInterrupt (Sem (Interrupt : Critical : Error Text : ConcStack) a
-> Sem (Critical : Error Text : ConcStack) a)
-> (Sem
(ChronosTime : Log : Interrupt : Critical : Error Text : ConcStack)
a
-> Sem (Interrupt : Critical : Error Text : ConcStack) a)
-> Sem
(ChronosTime : Log : Interrupt : Critical : Error Text : ConcStack)
a
-> Sem (Critical : Error Text : ConcStack) a
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
Maybe Severity
-> InterpreterFor
Log (Interrupt : Critical : Error Text : ConcStack)
forall (r :: EffectRow).
Members '[Resource, Async, Race, Embed IO] r =>
Maybe Severity -> InterpreterFor Log r
interpretLogStderrLevelConc (Severity -> Maybe Severity
forall a. a -> Maybe a
Just Severity
level) (Sem (Log : Interrupt : Critical : Error Text : ConcStack) a
-> Sem (Interrupt : Critical : Error Text : ConcStack) a)
-> (Sem
(ChronosTime : Log : Interrupt : Critical : Error Text : ConcStack)
a
-> Sem (Log : Interrupt : Critical : Error Text : ConcStack) a)
-> Sem
(ChronosTime : Log : Interrupt : Critical : Error Text : ConcStack)
a
-> Sem (Interrupt : Critical : Error Text : ConcStack) a
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
Sem
(ChronosTime : Log : Interrupt : Critical : Error Text : ConcStack)
a
-> Sem (Log : Interrupt : Critical : Error Text : ConcStack) a
forall (r :: EffectRow).
Member (Embed IO) r =>
InterpreterFor ChronosTime r
InterpreterFor
ChronosTime (Log : Interrupt : Critical : Error Text : ConcStack)
interpretTimeChronos
runAppLevel ::
Severity ->
Sem AppStack a ->
IO a
runAppLevel :: forall a. Severity -> Sem AppStack a -> IO a
runAppLevel Severity
level =
(Text -> IO a) -> Either Text a -> IO a
forall (m :: * -> *) a b.
Applicative m =>
(a -> m b) -> Either a b -> m b
leftA Text -> IO a
forall a. Text -> IO a
exitError (Either Text a -> IO a)
-> (Sem
(ChronosTime : Log : Interrupt : Critical : Error Text : ConcStack)
a
-> IO (Either Text a))
-> Sem
(ChronosTime : Log : Interrupt : Critical : Error Text : ConcStack)
a
-> IO a
forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< Severity -> Sem AppStack a -> IO (Either Text a)
forall a. Severity -> Sem AppStack a -> IO (Either Text a)
runAppLevelE Severity
level
runApp :: Sem AppStack a -> IO a
runApp :: forall a. Sem AppStack a -> IO a
runApp =
Severity -> Sem AppStack a -> IO a
forall a. Severity -> Sem AppStack a -> IO a
runAppLevel Severity
Info
class ExitErrorMessage err where
exitErrorMessage :: err -> Sem r Text
instance {-# overlappable #-} Show err => ExitErrorMessage err where
exitErrorMessage :: forall (r :: EffectRow). err -> Sem r Text
exitErrorMessage = Text -> Sem r Text
forall a. a -> Sem r a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Text -> Sem r Text) -> (err -> Text) -> err -> Sem r Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. err -> Text
forall b a. (Show a, IsString b) => a -> b
show
resumeExit ::
∀ err eff r .
ExitErrorMessage err =>
Members [eff !! err, Error Text] r =>
InterpreterFor eff r
resumeExit :: forall err (eff :: (* -> *) -> * -> *) (r :: EffectRow).
(ExitErrorMessage err, Members '[eff !! err, Error Text] r) =>
InterpreterFor eff r
resumeExit =
forall err (eff :: (* -> *) -> * -> *) (r :: EffectRow) a.
Member (Resumable err eff) r =>
(err -> Sem r a) -> Sem (eff : r) a -> Sem r a
resuming @err (Text -> Sem r a
forall e (r :: EffectRow) a. Member (Error e) r => e -> Sem r a
throw (Text -> Sem r a) -> (err -> Sem r Text) -> err -> Sem r a
forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< err -> Sem r Text
forall (r :: EffectRow). err -> Sem r Text
forall err (r :: EffectRow).
ExitErrorMessage err =>
err -> Sem r Text
exitErrorMessage)
stopExit ::
∀ err r .
ExitErrorMessage err =>
Member (Error Text) r =>
InterpreterFor (Stop err) r
stopExit :: forall err (r :: EffectRow).
(ExitErrorMessage err, Member (Error Text) r) =>
InterpreterFor (Stop err) r
stopExit =
(err -> Sem r a) -> Either err a -> Sem r a
forall (m :: * -> *) a b.
Applicative m =>
(a -> m b) -> Either a b -> m b
leftA (Text -> Sem r a
forall e (r :: EffectRow) a. Member (Error e) r => e -> Sem r a
throw (Text -> Sem r a) -> (err -> Sem r Text) -> err -> Sem r a
forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< err -> Sem r Text
forall (r :: EffectRow). err -> Sem r Text
forall err (r :: EffectRow).
ExitErrorMessage err =>
err -> Sem r Text
exitErrorMessage) (Either err a -> Sem r a)
-> (Sem (Stop err : r) a -> Sem r (Either err a))
-> Sem (Stop err : r) a
-> Sem r a
forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< Sem (Stop err : r) a -> Sem r (Either err a)
forall err (r :: EffectRow) a.
Sem (Stop err : r) a -> Sem r (Either err a)
runStop