Skip to content

A record based API #2

@noughtmare

Description

@noughtmare

I've seen some people saying that a record based API would be more intuitive for them. I've done a little experiment and came up with this:

type Env' = Rec InternalHandler'

newtype InternalHandler' e = InternalHandler' { runHandler' :: forall es a. e :> es => e (Eff' es) a }

type role Eff' nominal representational
newtype Eff' (es :: [Effect]) (a :: Type) = Eff' { unEff' :: Env' es -> Ctl a }

instance Functor (Eff' es) -- ...
instance Applicative (Eff' es) -- ...
instance Monad (Eff' es) -- ...

class Handling' (esSend :: [Effect]) (es :: [Effect]) (r :: Type) | esSend -> es r where
  handlingDict' :: HandlingDict' es r
  handlingDict' = error
    "Sp.Eff: nonexistent handling context! Don't attempt to manually define an instance for the 'Handling' typeclass."

data HandlingDict' es r = Handling' (Env' es) !(Marker r)
type instance DictRep (Handling' _ es r) = HandlingDict' es r

type Handler' e es r =  esSend a. Handling' esSend es r => e :> esSend => e (Eff' esSend) a

toInternalHandler' ::  e es r. Marker r -> Rec InternalHandler' es -> Handler' e es r -> InternalHandler' e
toInternalHandler' mark es hdl = InternalHandler' x where
    x :: forall esSend a. e :> esSend => e (Eff' esSend) a
    x = reflectDict @(Handling' esSend es r) hdl (Handling' es mark)

handle' :: (InternalHandler' e -> Env' es' -> Env' es) -> Handler' e es' a -> Eff' es a -> Eff' es' a
handle' f = \hdl (Eff' m) -> Eff' \es -> prompt \mark -> m $! f (toInternalHandler' mark es hdl) es

send' :: e :> es => (e (Eff' es) a -> Eff' es a) -> Eff' es a
send' f = Eff' \es -> unEff' (f (runHandler' (Rec.index es))) es

interpose' :: (e :> es) => Handler' e es a -> Eff' es a -> Eff' es a
interpose' = handle' \ih es -> Rec.update ih es

This interface can then be used as follows:

data Reader r m a = Reader
  { ask_ :: m r
  , local_ :: (r -> r) -> m a -> m a
  }

ask :: Reader r :> es => Eff' es r
ask = send' ask_

local :: Reader r :> es => (r -> r) -> Eff' es a -> Eff' es a
local f m = send' \h -> local_ h f m

handleReader :: r -> Handler' (Reader r) es a
handleReader !r = Reader
  { ask_ = pure r
  , local_ = \f m -> interpose' (handleReader (f r)) m
  }

I haven't tested this, but it is mostly the same as the existing code, so I think it will work. One advantage is that it doesn't require users to use "scary" GADTs.

What do you think about this?

Metadata

Metadata

Assignees

No one assigned

    Labels

    No labels
    No labels

    Projects

    No projects

    Milestone

    No milestone

    Relationships

    None yet

    Development

    No branches or pull requests

    Issue actions