How do I implement dynamic withCurrentDir effect

[theGhostJW]

Hello,
I am getting started with effectful but having an issue getting head around the types for the following Dynamic higher order effect.

I am trying to implement a dynamic version of something very similar to Effectful.FileSystem but based on Path.IO as opposed to System.Directory.

I am having trouble working out what the data constructor and handler for WithCurrentDir should look like ???.
Any help greatly appreciated.
thanks
John

import Path ( Path, Abs, Dir, File )
import qualified Path.IO as PIO
import Prelude
import qualified Prelude as P

import BasePrelude (IOException)
import Control.Monad.Catch (catch)
import Effectful as EF (
  Dispatch (Dynamic),
  DispatchOf,
  Eff,
  Effect,
  IOE,
  liftIO,
  type (:>),
 )
import Effectful.Dispatch.Dynamic
import Effectful.Dispatch.Static (unsafeLiftMapIO)
import Effectful.Error.Static as E
import Effectful.TH (makeEffect)
import qualified DSL.FileSystem.Raw as PO

data FileSystem :: Effect where
  CreateDir :: Path b Dir -> FileSystem m ()
 -- ??? what should the type of _b be?
  WithCurrentDir :: Path Abs Dir -> _b -> FileSystem m a

makeEffect ''FileSystem

type instance DispatchOf FileSystem = Dynamic

newtype FSException = FSException IOException
  deriving (Show)

instance Exception FSException

adaptException :: (HasCallStack, IOE :> es, E.Error FSException :> es) => IO b -> Eff es b
adaptException m = EF.liftIO m `catch` \(e :: IOException) -> throwError . FSException $ e

runFileSystem :: forall es a. (HasCallStack, IOE :> es, E.Error FSException :> es) => Eff (FileSystem : es) a -> Eff es a
runFileSystem =
  let
    er :: IO b -> Eff es b
    er = adaptException
   in
    interpret $ \_ -> \case
      CreateDir d -> er $ PO.createDir d
      WithCurrentDir p action -> 
            -- ???  what goes here including adapting errors?
             unsafeLiftMapIO (PIO.withCurrentDir p) action  -- this doesn't compile

{-
Static effect as implemented in Effectful.FileSystem
-- | Lifted 'withCurrentDir'.
withCurrentDir :: (FileSystem :> es) => Path b Dir -> Eff es a -> Eff es a
withCurrentDir path = unsafeLiftMapIO (R.withCurrentDir path)
-}

[arybczak]

Did you have a look at https://hackage.haskell.org/package/effectful-core-2.2.2.2/docs/Effectful-Dispatch-Dynamic.html#g:3? It should have answers to both questions in the attached code.

[theGhostJW]

Thank you @arybczak
Now that I look again I see you have provided a clear example. Based on your example I think my code should look like the below.

The only thing I am still a little unsure about is the exception handling.

This is what I think is going on:
runFileSystemHOE ignores exceptions (and is wrong) and runFileSystemHOE' catches IOExceptions and wraps them in a custom type consistent with the type signature of runFileSystemHOE'.

If I was to run this effect with runFileSystemHOE then any exception would not be handled and the application would terminate with that exception. In runFileSystemHOE' was used then the exception would be wrapped and the users handler for E.Error FSException would pick it up when the application was run.

rethrow differs from adaptException in the earlier example because the catching is being done in the context of the Eff monad where as in adaptException the catching is being done in IO.

Is my implementation / understanding correct?

thanks
John

data FileSystem :: Effect where
  WithCurrentDir :: Path Abs Dir -> m a -> FileSystem m a

makeEffect ''FileSystem

type instance DispatchOf FileSystem = Dynamic

newtype FSException = FSException IOException
  deriving (Show)

instance Exception FSException

runFileSystemHOE :: 
forall es a. (HasCallStack, IOE :> es, E.Error FSException :> es) => Eff (FileSystem : es) a -> Eff es a
runFileSystemHOE =
  interpret $ \env ->
    \case
      WithCurrentDir p action ->
        localSeqUnliftIO env (\unlift -> R.withCurrentDir p (unlift action))

runFileSystemHOE' ::
 forall es a. (HasCallStack, IOE :> es, E.Error FSException :> es) => Eff (FileSystem : es) a -> Eff es a
runFileSystemHOE' =
  interpret $ \env ->
    \case
      WithCurrentDir p action ->
        rethrow $
          localSeqUnliftIO
            env
            ( \unlift ->
                R.withCurrentDir p (unlift action)
            )
 where
  -- catch from Control.Monad.Catch (catch) in the exceptions package
  rethrow m = m `catch` \(e :: IOException) -> throwError . FSException $ e

[arybczak]

AFAICS runFileSystemHOE' looks good.

I don't think your adaptException type checks :) So can't say anything about it. Oh right, sorry, it does type check. Yeah, it's the same thing as \m -> rethrow (liftIO m), so it'll do the same thing as rethrow pretty much.

But to guess your intention, rethrow is exactly adaptException, but with correct types and it'll catch potential IO exceptions and convert them into errors of the Error effect.

[theGhostJW]

Thanks @arybczak !