{-# options_haddock not-home #-}

module Ribosome.Test.Error where

import Polysemy.Test (TestError (TestError))

import Ribosome.Host.Data.Report (Reportable, mapReport, reportMessages)
import Ribosome.Host.Data.RpcHandler (Handler)

-- |Resume an effect and convert its error from @'Stop' err@ to @'Error' 'TestError'@.
resumeTestError ::
  ∀ eff err r .
  Show err =>
  Members [eff !! err, Error TestError] r =>
  InterpreterFor eff r
resumeTestError :: forall (eff :: (* -> *) -> * -> *) err (r :: EffectRow).
(Show err, Members '[eff !! err, Error TestError] r) =>
InterpreterFor eff r
resumeTestError =
  (err -> TestError) -> Sem (eff : r) a -> Sem r a
forall err (eff :: (* -> *) -> * -> *) err' (r :: EffectRow) a.
Members '[Resumable err eff, Error err'] r =>
(err -> err') -> Sem (eff : r) a -> Sem r a
resumeHoistError (Text -> TestError
TestError (Text -> TestError) -> (err -> Text) -> err -> TestError
forall b c a. (b -> c) -> (a -> b) -> a -> c
. err -> Text
forall b a. (Show a, IsString b) => a -> b
show)

-- |Run a 'Handler', converting the @'Stop' 'Report'@ at its head to @'Error' 'TestError'@.
testHandler ::
  Member (Error TestError) r =>
  Handler r a ->
  Sem r a
testHandler :: forall (r :: EffectRow) a.
Member (Error TestError) r =>
Handler r a -> Sem r a
testHandler =
  (Report -> TestError) -> Sem (Stop Report : r) a -> Sem r a
forall err' (r :: EffectRow) err a.
Member (Error err') r =>
(err -> err') -> Sem (Stop err : r) a -> Sem r a
stopToErrorWith (Text -> TestError
TestError (Text -> TestError) -> (Report -> Text) -> Report -> TestError
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Report -> Text
reportMessages)

-- |Run a 'Handler' in a new thread and return an action that waits for the thread to terminate when sequenced.
-- Converts the @'Stop' 'Report'@ at its head to @'Error' 'TestError'@ when it is awaited.
testHandlerAsync ::
  Members [Error TestError, Async] r =>
  Handler r a ->
  Sem r (Sem r a)
testHandlerAsync :: forall (r :: EffectRow) a.
Members '[Error TestError, Async] r =>
Handler r a -> Sem r (Sem r a)
testHandlerAsync Handler r a
h = do
  Async (Maybe (Either Report a))
thread <- Sem r (Either Report a) -> Sem r (Async (Maybe (Either Report a)))
forall (r :: EffectRow) a.
Member Async r =>
Sem r a -> Sem r (Async (Maybe a))
async do
    Handler r a -> Sem r (Either Report a)
forall e (r :: EffectRow) a.
Sem (Stop e : r) a -> Sem r (Either e a)
runStop Handler r a
h
  pure do
    Handler r a -> Sem r a
forall (r :: EffectRow) a.
Member (Error TestError) r =>
Handler r a -> Sem r a
testHandler (Handler r a -> Sem r a)
-> (Either Report a -> Handler r a) -> Either Report a -> Sem r a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Either Report a -> Handler r a
forall err (r :: EffectRow) a.
Member (Stop err) r =>
Either err a -> Sem r a
stopEither (Either Report a -> Sem r a) -> Sem r (Either Report a) -> Sem r a
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< TestError -> Maybe (Either Report a) -> Sem r (Either Report a)
forall e (r :: EffectRow) a.
Member (Error e) r =>
e -> Maybe a -> Sem r a
note (Text -> TestError
TestError Text
"async handler didn't produce result") (Maybe (Either Report a) -> Sem r (Either Report a))
-> Sem r (Maybe (Either Report a)) -> Sem r (Either Report a)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Async (Maybe (Either Report a)) -> Sem r (Maybe (Either Report a))
forall (r :: EffectRow) a. Member Async r => Async a -> Sem r a
await Async (Maybe (Either Report a))
thread

-- |Interpret @'Stop' err@ to @'Error' 'TestError'@ by using @err@'s instance of 'Reportable'.
testError ::
  ∀ err r a .
  Reportable err =>
  Member (Error TestError) r =>
  Sem (Stop err : r) a ->
  Sem r a
testError :: forall err (r :: EffectRow) a.
(Reportable err, Member (Error TestError) r) =>
Sem (Stop err : r) a -> Sem r a
testError =
  Handler r a -> Sem r a
forall (r :: EffectRow) a.
Member (Error TestError) r =>
Handler r a -> Sem r a
testHandler (Handler r a -> Sem r a)
-> (Sem (Stop err : r) a -> Handler r a)
-> Sem (Stop err : r) a
-> Sem r a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Sem (Stop err : Stop Report : r) a -> Handler r a
forall e (r :: EffectRow) a.
(Reportable e, Member (Stop Report) r) =>
Sem (Stop e : r) a -> Sem r a
mapReport (Sem (Stop err : Stop Report : r) a -> Handler r a)
-> (Sem (Stop err : r) a -> Sem (Stop err : Stop Report : r) a)
-> Sem (Stop err : r) a
-> Handler r a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Sem (Stop err : r) a -> Sem (Stop err : Stop Report : r) a
forall (e2 :: (* -> *) -> * -> *) (e1 :: (* -> *) -> * -> *)
       (r :: EffectRow) a.
Sem (e1 : r) a -> Sem (e1 : e2 : r) a
raiseUnder