module Ribosome.App.Error where

import Rainbow (Chunk, chunk, faint, fore, hPutChunksLn, red)
import System.IO (Handle)


newtype RainbowError =
  RainbowError { RainbowError -> NonEmpty (NonEmpty Chunk)
unRainbowError :: NonEmpty (NonEmpty Chunk) }
  deriving newtype (NonEmpty RainbowError -> RainbowError
RainbowError -> RainbowError -> RainbowError
(RainbowError -> RainbowError -> RainbowError)
-> (NonEmpty RainbowError -> RainbowError)
-> (forall b. Integral b => b -> RainbowError -> RainbowError)
-> Semigroup RainbowError
forall b. Integral b => b -> RainbowError -> RainbowError
forall a.
(a -> a -> a)
-> (NonEmpty a -> a)
-> (forall b. Integral b => b -> a -> a)
-> Semigroup a
stimes :: forall b. Integral b => b -> RainbowError -> RainbowError
$cstimes :: forall b. Integral b => b -> RainbowError -> RainbowError
sconcat :: NonEmpty RainbowError -> RainbowError
$csconcat :: NonEmpty RainbowError -> RainbowError
<> :: RainbowError -> RainbowError -> RainbowError
$c<> :: RainbowError -> RainbowError -> RainbowError
Semigroup)

instance IsString RainbowError where
  fromString :: String -> RainbowError
fromString =
    NonEmpty (NonEmpty Chunk) -> RainbowError
RainbowError (NonEmpty (NonEmpty Chunk) -> RainbowError)
-> (String -> NonEmpty (NonEmpty Chunk)) -> String -> RainbowError
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NonEmpty Chunk -> NonEmpty (NonEmpty Chunk)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (NonEmpty Chunk -> NonEmpty (NonEmpty Chunk))
-> (String -> NonEmpty Chunk)
-> String
-> NonEmpty (NonEmpty Chunk)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Chunk -> NonEmpty Chunk
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Chunk -> NonEmpty Chunk)
-> (String -> Chunk) -> String -> NonEmpty Chunk
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Chunk
forall a. IsString a => String -> a
fromString

appError :: [Chunk] -> RainbowError
appError :: [Chunk] -> RainbowError
appError [Chunk]
msg =
  NonEmpty (NonEmpty Chunk) -> RainbowError
RainbowError [Chunk
"⚠️ " Chunk -> [Chunk] -> NonEmpty Chunk
forall a. a -> [a] -> NonEmpty a
:| (Radiant -> Chunk -> Chunk
fore Radiant
red Chunk
"Error ")  Chunk -> [Chunk] -> [Chunk]
forall a. a -> [a] -> [a]
: [Chunk]
msg]

ioError :: [Chunk] -> Text -> RainbowError
ioError :: [Chunk] -> Text -> RainbowError
ioError [Chunk]
msg Text
err =
  [Chunk] -> RainbowError
appError [Chunk]
msg RainbowError -> RainbowError -> RainbowError
forall a. Semigroup a => a -> a -> a
<> NonEmpty (NonEmpty Chunk) -> RainbowError
RainbowError [[Item (NonEmpty Chunk)
"🗨️ ", Radiant -> Chunk -> Chunk
fore Radiant
red (Chunk -> Chunk
faint (Text -> Chunk
chunk Text
err))]]

outputError ::
  Members [Stop RainbowError, Embed IO] r =>
  IO a ->
  Sem r a
outputError :: forall (r :: EffectRow) a.
Members '[Stop RainbowError, Embed IO] r =>
IO a -> Sem r a
outputError =
  (Text -> RainbowError) -> IO a -> Sem r a
forall e (r :: EffectRow) a.
Members '[Stop e, Embed IO] r =>
(Text -> e) -> IO a -> Sem r a
stopTryIOError Text -> RainbowError
err
  where
    err :: Text -> RainbowError
err =
      [Chunk] -> Text -> RainbowError
ioError [Item [Chunk]
"Printing message failed"]

runRainbowErrorAnd ::
  Members [Embed IO, Final IO] r =>
  Handle ->
  Sem r () ->
  Sem (Stop RainbowError : r) () ->
  Sem r ()
runRainbowErrorAnd :: forall (r :: EffectRow).
Members '[Embed IO, Final IO] r =>
Handle -> Sem r () -> Sem (Stop RainbowError : r) () -> Sem r ()
runRainbowErrorAnd Handle
handle Sem r ()
after Sem (Stop RainbowError : r) ()
action = do
  (RainbowError -> Sem r ())
-> (() -> Sem r ()) -> Either RainbowError () -> Sem r ()
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either RainbowError -> Sem r ()
onError () -> Sem r ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either RainbowError () -> Sem r ())
-> Sem r (Either RainbowError ()) -> Sem r ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Sem (Stop RainbowError : r) () -> Sem r (Either RainbowError ())
forall e (r :: EffectRow) a.
(Exception (StopExc e), Member (Final IO) r) =>
Sem (Stop e : r) a -> Sem r (Either e a)
stopToIOFinal Sem (Stop RainbowError : r) ()
action
  where
    onError :: RainbowError -> Sem r ()
onError (RainbowError NonEmpty (NonEmpty Chunk)
cs) = do
      IO () -> Sem r ()
forall (r :: EffectRow). Member (Embed IO) r => IO () -> Sem r ()
tryIOError_ ((NonEmpty Chunk -> IO ()) -> NonEmpty (NonEmpty Chunk) -> IO ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_ (Handle -> [Chunk] -> IO ()
hPutChunksLn Handle
handle ([Chunk] -> IO ())
-> (NonEmpty Chunk -> [Chunk]) -> NonEmpty Chunk -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NonEmpty Chunk -> [Chunk]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList) NonEmpty (NonEmpty Chunk)
cs)
      Sem r ()
after

runRainbowError ::
  Members [Embed IO, Final IO] r =>
  Handle ->
  Sem (Stop RainbowError : r) () ->
  Sem r ()
runRainbowError :: forall (r :: EffectRow).
Members '[Embed IO, Final IO] r =>
Handle -> Sem (Stop RainbowError : r) () -> Sem r ()
runRainbowError Handle
handle =
  Handle -> Sem r () -> Sem (Stop RainbowError : r) () -> Sem r ()
forall (r :: EffectRow).
Members '[Embed IO, Final IO] r =>
Handle -> Sem r () -> Sem (Stop RainbowError : r) () -> Sem r ()
runRainbowErrorAnd Handle
handle Sem r ()
forall (f :: * -> *). Applicative f => f ()
unit