{-# 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)

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

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

-- | Run the default 'AppStack' with the specified log level and print a potential error to stderr, exiting with failure
-- code.
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

-- | Run the default 'AppStack' and print an potential error to stderr, exiting with failure code.
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

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

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