{-# 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: " 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
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 =
forall a. Sem ConcStack a -> IO a
runConc forall b c a. (b -> c) -> (a -> b) -> a -> c
.
forall e (r :: [(* -> *) -> * -> *]) a.
Member (Final IO) r =>
Sem (Error e : r) a -> Sem r (Either e a)
errorToIOFinal forall b c a. (b -> c) -> (a -> b) -> a -> c
.
forall (r :: [(* -> *) -> * -> *]).
Member (Final IO) r =>
InterpreterFor Critical r
interpretCritical forall b c a. (b -> c) -> (a -> b) -> a -> c
.
forall (r :: [(* -> *) -> * -> *]).
Members '[Critical, Race, Async, Embed IO] r =>
InterpreterFor Interrupt r
interpretInterrupt forall b c a. (b -> c) -> (a -> b) -> a -> c
.
forall (r :: [(* -> *) -> * -> *]).
Members '[Resource, Async, Race, Embed IO] r =>
Maybe Severity -> InterpreterFor Log r
interpretLogStderrLevelConc (forall a. a -> Maybe a
Just Severity
level) forall b c a. (b -> c) -> (a -> b) -> a -> c
.
forall (r :: [(* -> *) -> * -> *]).
Member (Embed IO) r =>
InterpreterFor ChronosTime r
interpretTimeChronos
runAppLevel ::
Severity ->
Sem AppStack a ->
IO a
runAppLevel :: forall a. Severity -> Sem AppStack a -> IO a
runAppLevel Severity
level =
forall (m :: * -> *) a b.
Applicative m =>
(a -> m b) -> Either a b -> m b
leftA forall a. Text -> IO a
exitError forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< 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 =
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 :: [(* -> *) -> * -> *]). err -> Sem r Text
exitErrorMessage = forall (f :: * -> *) a. Applicative f => a -> f a
pure forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 :: [(* -> *) -> * -> *]).
(ExitErrorMessage err, Members '[eff !! err, Error Text] r) =>
InterpreterFor eff r
resumeExit =
forall err (eff :: (* -> *) -> * -> *) (r :: [(* -> *) -> * -> *])
a.
Member (Resumable err eff) r =>
(err -> Sem r a) -> Sem (eff : r) a -> Sem r a
resuming @err (forall e (r :: [(* -> *) -> * -> *]) a.
Member (Error e) r =>
e -> Sem r a
throw forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< forall err (r :: [(* -> *) -> * -> *]).
ExitErrorMessage err =>
err -> Sem r Text
exitErrorMessage)
stopExit ::
∀ err r .
ExitErrorMessage err =>
Member (Error Text) r =>
InterpreterFor (Stop err) r
stopExit :: forall err (r :: [(* -> *) -> * -> *]).
(ExitErrorMessage err, Member (Error Text) r) =>
InterpreterFor (Stop err) r
stopExit =
forall (m :: * -> *) a b.
Applicative m =>
(a -> m b) -> Either a b -> m b
leftA (forall e (r :: [(* -> *) -> * -> *]) a.
Member (Error e) r =>
e -> Sem r a
throw forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< forall err (r :: [(* -> *) -> * -> *]).
ExitErrorMessage err =>
err -> Sem r Text
exitErrorMessage) forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< forall err (r :: [(* -> *) -> * -> *]) a.
Sem (Stop err : r) a -> Sem r (Either err a)
runStop