{-# 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.IO (stderr)

-- | The default stack for a Prelate app.
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)

-- | Run the default 'AppStack' with the specified log level and return a potential error as 'Left'.
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

-- | Run the default 'AppStack' with the specified log level and print an potential error to stderr.
runAppLevel ::
  Severity ->
  Sem AppStack () ->
  IO ()
runAppLevel :: Severity -> Sem AppStack () -> IO ()
runAppLevel Severity
level =
  forall (m :: * -> *) a b.
Applicative m =>
(a -> m b) -> Either a b -> m b
leftA Text -> IO ()
printError 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

-- | Run the default 'AppStack' and print an potential error to stderr.
runApp :: Sem AppStack () -> IO ()
runApp :: Sem AppStack () -> IO ()
runApp =
  Severity -> Sem AppStack () -> IO ()
runAppLevel Severity
Info

-- | Render an error for printing it as an exit message.
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

-- | Convert an effect to 'Resumable' and throw a potential error as 'Text', exiting the program if used with 'runApp'.
--
-- Uses 'ExitErrorMessage' to render the error.
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