the `catch` function should intercept errors that were thrown by interpreters too

[srghma]

this works correctly

module FeatureTests.Main where

import Protolude
import Run (Run)
import Run as Run
import Run.Reader as Run
import Run.Except as Run
import Data.Symbol (SProxy(..))

data MyActionF a
  = MyAction__Do a

derive instance functorMyActionF ∷ Functor MyActionF

_my_action = SProxy ∷ SProxy "my_action"

type MY_ACTION = Run.FProxy MyActionF

type MyActionEffect r = ( my_action ∷ MY_ACTION | r )

liftMyAction ∷ ∀ r. MyActionF Unit → Run (MyActionEffect r) Unit
liftMyAction = Run.lift _my_action

myAction__Do ∷ ∀ r. Run (MyActionEffect r) Unit
myAction__Do = liftMyAction $ MyAction__Do unit

data MyError
  = MyError
  -- | | MyOtherError

handleMyAction :: forall r. MyActionF ~> Run (except ∷ Run.EXCEPT MyError | r)
handleMyAction = case _ of
  MyAction__Do next -> do
    -- | liftEffect $ Console.log str
    _ <- Run.throw MyError
    pure next

runMyAction
  :: forall r
   . Run (except ∷ Run.EXCEPT MyError, my_action :: MY_ACTION | r)
  ~> Run (except ∷ Run.EXCEPT MyError | r)
runMyAction = Run.interpret (Run.on _my_action handleMyAction Run.send)

main :: Effect Unit
main = do
  let
    body :: forall r . Run (except ∷ Run.EXCEPT MyError, my_action :: MY_ACTION | r) Unit
    body = do
      insideBodyRes <-
        Run.catch
        (\catchedError -> traceM { catchedError }
        )
        (Run.throw MyError)
      traceM { insideBodyRes }

    interpretX :: Run (except ∷ Run.EXCEPT MyError, my_action :: MY_ACTION) Unit -> Either MyError Unit
    interpretX x =
      -- | Run.runBaseAff'
      Run.extract
      $ Run.runExcept
      $ runMyAction
      x

  let bodyRes = interpretX body

  traceM { bodyRes }

  pure unit

and outputs

{ catchedError: MyError {} }
{ insideBodyRes: {} }
{ bodyRes: Right { value0: {} } }

---

this works correctly too and is analog of runError from https://hackage.haskell.org/package/freer-0.2.4.1/docs/src/Control-Monad-Freer-Exception.html

module FeatureTests.Main where

import Protolude
import Run (Run)
import Run as Run
import Run.Reader as Run
import Run.Except as Run
import Data.Symbol (SProxy(..))

data MyActionF a
  = MyAction__Do a

derive instance functorMyActionF ∷ Functor MyActionF

_my_action = SProxy ∷ SProxy "my_action"

type MY_ACTION = Run.FProxy MyActionF

type MyActionEffect r = ( my_action ∷ MY_ACTION | r )

liftMyAction ∷ ∀ r. MyActionF Unit → Run (MyActionEffect r) Unit
liftMyAction = Run.lift _my_action

myAction__Do ∷ ∀ r. Run (MyActionEffect r) Unit
myAction__Do = liftMyAction $ MyAction__Do unit

data MyError
  = MyError
  -- | | MyOtherError

handleMyAction :: forall r. MyActionF ~> Run (except ∷ Run.EXCEPT MyError | r)
handleMyAction = case _ of
  MyAction__Do next -> do
    -- | liftEffect $ Console.log str
    _ <- Run.throw MyError
    pure next

runMyAction
  :: forall r
   . Run (except ∷ Run.EXCEPT MyError, my_action :: MY_ACTION | r)
  ~> Run (except ∷ Run.EXCEPT MyError | r)
runMyAction = Run.interpret (Run.on _my_action handleMyAction Run.send)

main :: Effect Unit
main = do
  let
    body :: forall r . Run (except ∷ Run.EXCEPT MyError, my_action :: MY_ACTION | r) Unit
    body = do
      insideBodyRes <- Run.runExcept myAction__Do
      traceM { insideBodyRes }

    interpretX :: Run (except ∷ Run.EXCEPT MyError, my_action :: MY_ACTION) Unit -> Either MyError Unit
    interpretX x =
      -- | Run.runBaseAff'
      Run.extract
      $ Run.runExcept
      $ runMyAction
      x

  let bodyRes = interpretX body

  traceM { bodyRes }

  pure unit

the output is

{ bodyRes: Left { value0: MyError {} } }

---

but this

main :: Effect Unit
main = do
  let
    body :: forall r . Run (except ∷ Run.EXCEPT MyError, my_action :: MY_ACTION | r) Unit
    body = do
      insideBodyRes <-
        Run.catch
        (\catchedError -> traceM { catchedError }
        )
        myAction__Do
      traceM { insideBodyRes }

    interpretX :: Run (except ∷ Run.EXCEPT MyError, my_action :: MY_ACTION) Unit -> Either MyError Unit
    interpretX x =
      -- | Run.runBaseAff'
      Run.extract
      $ Run.runExcept
      $ runMyAction
      x

  let bodyRes = interpretX body

  traceM { bodyRes }

  pure unit

should output

{ catchedError: MyError {} }
{ insideBodyRes: {} }
{ bodyRes: Right { value0: {} } }

like in 1st example

but instead outputs

{ bodyRes: Left { value0: MyError {} } }

like in the second example

---

it would be better if catch was the implementation of catchError from https://hackage.haskell.org/package/freer-0.2.4.1/docs/src/Control-Monad-Freer-Exception.html instead of being an alias of runExcept from this lib

[natefaubion]

Do you have a suggestion for an implementation that is different from how it currently exists?

[srghma]

Im new to this but i guess the interpose function should be implemented

-- | Intercept the request and possibly reply to it, but leave it
-- unhandled
interpose :: Member t r =>
             (a -> Eff r w) -> (forall v. t v -> Arr r v w -> Eff r w) ->
             Eff r a -> Eff r w
interpose ret h = loop
 where
   loop (Val x)  = ret x
   loop (E u q)  = case prj u of
     Just x -> h x k
     _      -> E u (tsingleton k)
    where k = qComp q loop

since I cannot find anything similar to interpose in purescript-run, only analog of handleRelay which is run...

-- | Given a request, either handle it or relay it.
handleRelay :: (a -> Eff r w) ->
               (forall v. t v -> Arr r v w -> Eff r w) ->
               Eff (t ': r) a -> Eff r w
handleRelay ret h = loop
 where
  loop (Val x)  = ret x
  loop (E u' q)  = case decomp u' of
    Right x -> h x k
    Left  u -> E u (tsingleton k)
   where k = qComp q loop

[natefaubion]

I don't really know what any of that means. Can you make a suggestion in terms of how the library is currently written, and not in terms of a different library?

[srghma]

my mistake

I misread

-- | A catcher for Exceptions. Handlers are allowed to rethrow
-- exceptions.
catchError :: Member (Exc e) r =>
        Eff r a -> (e -> Eff r a) -> Eff r a
catchError m handle = interpose return (\(Exc e) _k -> handle e) m

handlers - now other interpreters

[srghma]

managed this to work using CATCH from purescript-moonlight

module Test.Catch where

import Debug.Trace
import Prelude
import Test.Assert

import Control.Monad.Rec.Class (tailRecM, Step(..))
import Data.Array as Array
import Data.Either (Either(..))
import Data.Foldable (for_, oneOfMap)
import Data.Functor.Variant (FProxy(..))
import Data.Maybe (Maybe(..))
import Data.Monoid.Additive (Additive(..))
import Data.Symbol (SProxy(..))
import Data.Tuple (Tuple(..))
import Effect (Effect)
import Effect.Console (logShow, log)
import Run (Run)
import Run as Run
import Run.Except (EXCEPT)
import Run.Except as Run.Except
import Run.Writer (WRITER)
import Run.Writer as Run.Writer

data MyActionF a
  = MyAction__Do a

derive instance functorMyActionF ∷ Functor MyActionF

_my_action :: SProxy "my_action"
_my_action = SProxy

type MY_ACTION = FProxy MyActionF

type MyActionEffect r = ( my_action ∷ MY_ACTION | r )

liftMyAction ∷ ∀ r. MyActionF Unit → Run (MyActionEffect r) Unit
liftMyAction = Run.lift _my_action

myAction__Do ∷ ∀ r. Run (MyActionEffect r) Unit
myAction__Do = liftMyAction $ MyAction__Do unit

data MyError
  = MyError

derive instance eqMyError :: Eq MyError

instance showMyError :: Show MyError where
  show MyError = "MyError"

handleMyAction :: forall r. MyActionF ~> Run (except ∷ EXCEPT MyError | r)
handleMyAction = case _ of
  MyAction__Do next -> do
    -- | liftEffect $ Console.log str
    _ <- Run.Except.throw MyError
    pure next

runMyAction
  :: forall r
   . Run (except ∷ EXCEPT MyError, my_action :: MY_ACTION | r)
  ~> Run (except ∷ EXCEPT MyError | r)
runMyAction = Run.interpret (Run.on _my_action handleMyAction Run.send)

------------------

data Catch e a = Catch (Maybe e → a)
derive instance functorCatch ∷ Functor (Catch e)
_catch = SProxy ∷ SProxy "catch"
type CATCH e = FProxy (Catch e)
type WithCatch r e  = Run (catch ∷ CATCH e|r)

catch ∷ ∀ e a r. (e → WithCatch r e a) → WithCatch r e a → WithCatch r e a
catch handler attempt = do
  mbErr ← Run.lift _catch $ Catch identity
  case mbErr of
    Just e → handler e
    Nothing → attempt

reverseCatch ∷ ∀ a e r. e → WithCatch (except ∷ EXCEPT e|r) e a → WithCatch (except ∷ EXCEPT e|r) e Unit
reverseCatch defErr attempt = do
  mbErr ← Run.lift _catch $ Catch identity
  case mbErr of
    Just e → pure unit
    Nothing → Run.Except.throw defErr

runCatch
  ∷ ∀ r e a
  . Run (except ∷ EXCEPT e, catch ∷ CATCH e|r) a
  → Run r (Either e a)
runCatch = loop (pure <<< Left)
  where
  split =
    Run.on _catch Right
    $ Run.on Run.Except._except
        (Left <<< Right)
        (Left <<< Left)
  loop hndl r = case Run.peel r of
    Right a →
      pure $ Right a
    Left f → case split f of
      Right (Catch cont) →
        loop (\e → loop hndl $ cont $ Just e) $ cont Nothing
      Left (Right (Run.Except.Except err)) →
        hndl err
      Left (Left others) →
        loop hndl =<< Run.send others

------------------

main :: Effect Unit
main = do
  let
    body :: forall r . Run (writer :: WRITER (Array String), catch ∷ CATCH MyError, except ∷ EXCEPT MyError, my_action :: MY_ACTION | r) Unit
    body = do
      Run.Writer.tell [ "before" ]
      (_ :: Unit) <-
        catch
        (\(_ :: MyError) -> Run.Writer.tell [ "MyError is catched" ])
        myAction__Do
      Run.Writer.tell [ "after" ]

    interpretBody
      :: Run (writer :: WRITER (Array String), catch ∷ CATCH MyError, except ∷ EXCEPT MyError, my_action :: MY_ACTION) Unit
      -> Tuple (Array String) (Either MyError Unit)
    interpretBody x =
      Run.extract
      $ Run.Writer.runWriter
      $ runCatch
      $ runMyAction
      x

  let bodyRes = interpretBody body

  traceM bodyRes

  assertEqual { actual: bodyRes, expected: Tuple ["before","MyError is catched","after"] (Right unit) }