Extensible effects todaybot

London Haskell User Group, 24th February 2016

Ben Clifford
benc@cqx.ltd.uk

Overview

I'm going to talk about my experience porting a small bot to use extensible effects. I did this as an attempt to learn more about extensible effects with a simple, clearly defined project.

Effects

Extensible effects

r/LondonSocialClub todaybot

r/LondonSocialClub todaybot dates

application: bot main outline

Existing script-like implementation, https://github.com/benclifford/lsc-todaybot

main = do
  progress "todaybot"

  configuration <- readConfiguration   

  forever $ do
    skipExceptions $ mainLoop configuration
    sleep 13

mainLoop configuration = do

  bearerToken <- authenticate configuration
  posts <- getHotPosts bearerToken
  mapM_ (skipExceptions . (processPost bearerToken)) posts
  progress "Pass completed."

Porting to extensible-effects

IO Effects

Type signatures and errors

Main.hs:376:7:
    Could not deduce (r
                      ~ (Reader BearerToken
                         :> (Reader LocalTime
                             :> (Writer String
                                 :> (Sleep :> (Exc IOError :> (Lift IO :> 
Void)))))))
    from the context (Member (Exc IOError) r,
                      SetMember Lift (Lift IO) r)
      bound by the type signature for
                 handleEff :: (Member (Exc IOError) r,
                               SetMember Lift (Lift IO) r) =>
                              Lift IO (Eff r ()) -> Eff r ()
      at Main.hs:373:18-105
      ‘r’ is a rigid type variable bound by
          the type signature for
            handleEff :: (Member (Exc IOError) r,
                          SetMember Lift (Lift IO) r) =>
                         Lift IO (Eff r ()) -> Eff r ()
          at Main.hs:373:18
    Expected type: Eff r () -> Free (Union r) ()
      Actual type: Free
                     (Union
                        (Reader BearerToken
                         :> (Reader LocalTime
                             :> (Writer String
                                 :> (Sleep :> (Exc IOError :> (Lift IO :> Void)))))))
                     ()
                   -> Free
                        (Union
                           (Reader BearerToken
                            :> (Reader LocalTime
                                :> (Writer String
                                    :> (Sleep :> (Exc IOError :> (Lift IO :> Void)))))))
                        ()
    Relevant bindings include
      rest :: Eff r () (bound at Main.hs:375:7)
      k :: a -> Eff r () (bound at Main.hs:374:27)
      handleEff :: Lift IO (Eff r ()) -> Eff r ()
        (bound at Main.hs:374:5)
    In a stmt of a 'do' block: convertIOExceptions rest
    In the expression:
      do { rest <- send . inj $ Lift (transIO ioact) (transK k);
           convertIOExceptions rest }
    In an equation for ‘handleEff’:
        handleEff (Lift ioact k)
          = do { rest <- send . inj $ Lift (transIO ioact) (transK k);
                 convertIOExceptions rest }

Reader effect, for configuration

Easy effect to separate out is a configuration reader.

getConfiguration :: (Member (Reader Configuration) r) => Eff r Configuration
getConfiguration = ask

withConfiguration act = do
  c <- readConfiguration
  runReader act c

main = runLift todaybot

todaybot = do
    lift $ putStrLn "Starting todaybot"
    withConfiguration $ forever $ do
      ...
      lift $ putStrLn "inside withConfiguration"
      config <- getConfiguration
      ...
    ...

getConfiguration is ask, but with a stricter type.

Some code can request Reader Configuration effects, some cannot.

Reader, handler type

  getConfiguration :: (Member (Reader Configuration) r)
    => Eff r Configuration

getConfiguration requests Reader Configuration effects.

  withConfiguration :: SetMember Lift (Lift IO) r
    => Eff (Reader Configuration :> r) v -> Eff r v

withConfiguration handles Reader Configuration effects; and requests the same effects as the supplied effectful computation, minus Reader Configuration.

Supplied computation can do all the same effects (r) as outside withConfiguration without needing a change.

Compile error if effects aren't all handled - another handler, runLift, lower down to handle Lift IO.

Rule of thumb? :> when handling effects, Member or SetMember when producing effects.

Writer effect, for logging

Writer String effect. extensible-effects provides the effect type and several different handlers, but not one that does what we want - dump those Strings to stderr. 

progress :: (Member (Writer String) r) => String -> Eff r ()
progress s = tell s

main = runStack todaybot

todaybot = do
         progress "Starting todaybot"
         ...

runStack prog = liftIO
              $ handleLog 
              $ prog

But, what's inside?

Writer effect - what's inside?

[w == String for our logger]

data Writer w v = Writer !w v
    deriving (Typeable, Functor)

tell :: (Typeable w, Member (Writer w) r) => w -> Eff r ()
tell !w = send . inj $ Writer w ()

handleLog :: SetMember Lift (Lift IO) r) =>
  Eff (Writer String :> r) a -> Eff r a
handleLog =
           freeMap
           (return) -- <- pure value
           (\effect -> handleRelay effect handleLog write)
                                      --  ^other effect ^our writer effect
  where
    write (Writer msg restOfProgram) = do
      lift $ hPutStr stdout msg
      lift $ hFlush stdout
      handleLog restOfProgram

Three cases. Not required to loop, but we do. (see exceptions, later)

(A lot of this boilerplate is gone in the freer package)

Reader effect for the current time

Similar, but needs to pass a value to the rest of the program (monadic bind).

newtype Reader e v = Reader (e -> v)
    deriving (Typeable, Functor)

handleGetCurrentLocalTime :: (SetMember Lift (Lift IO) r) => Eff (Reader LocalTime :> r) a -> Eff r a
handleGetCurrentLocalTime = freeMap
           (return)
           (\e -> handleRelay e handleGetCurrentLocalTime readTime)
  where
    readTime (Reader rest) = do
      v <- lift $ do
        nowUTC <- getCurrentTime
        tz <- getCurrentTimeZone
        return $ utcToLocalTime tz nowUTC
      handleGetCurrentLocalTime (rest v)

--  readTime :: (SetMember Lift (Lift IO) r) => 
--    -- 
--    Reader LocalTime (Eff (Reader LocalTime :> r) a)
--     -> Eff r a  
--         ^ interpretation of effect

Base interpreter stack

main = runStack todaybot

runStack
  :: Eff
       (Reader LocalTime
        :> (Writer String
            :> (Sleep 
                :> (Lift IO  
                    :> Void)))))
       ()
     -> IO ()

runStack prog = void $ runLift
           $ handleSleep
           $ handleLog
           $ handleGetCurrentLocalTime
           $ prog

... other effects (eg Reader Configuration) handled deeper in the program - don't appear here

Base interpreter stack / split

main = runStack todaybot

runStack prog = void $ (alpha . beta) prog

alpha
  :: Eff (Sleep :> (Exc IOError :> (Lift IO :> Void))) ()
     -> IO (Either IOError ())
alpha a = runLift
        $ (runExc :: Eff (Exc IOError :> Lift IO :> Void) () -> Eff (Lift IO :> Void) (Either IOError ()))
        $ handleSleep a

beta
  :: (SetMember Lift (Lift IO) r,
      Member (Exc IOError) r)
  => Eff (Reader LocalTime :> (Writer String :> r)) a -> Eff r a

beta a = handleLog
       $ handleGetCurrentLocalTime
       $ a

Exc e: Exceptions

Exceptions behave quite differently compared to the raw IO version of todaybot.

The usual suspects... 

newtype Exc e v = Exc e
    deriving (Functor, Typeable)
-- v unused, because we don't continue after an exception

throwExc :: (Typeable e, Member (Exc e) r) => e -> Eff r a
throwExc e = send . inj $ Exc e

runExc :: Typeable e => Eff (Exc e :> r) a -> Eff r (Either e a)
runExc = freeMap
         (return . Right) -- change return type
         (\u -> handleRelay u runExc (\(Exc e) -> return (Left e)))

--     does not evaluate rest of program ^

Exc e: catch

catchExc catches exceptions, so they never reach the outer runExc handler... instead they are passed onto the supplied handle function.

catchExc :: (Typeable e, Member (Exc e) r)
         => Eff r a
         -> (e -> Eff r a)
         -> Eff r a
catchExc prog handle = loop prog
 where
  loop = freeMap
         return
         (\eff -> interpose eff loop (\(Exc e) -> handle e))

interpose intercepts effects, rather than handling them - so subprogram is run in a different interpreter than rest of program.

We don't loop on an Exc here either, but that causes catchExc to end, rather than the whole program.

... somethingFailing `catchExc` (\exception -> ...) ...

Exceptions: What does todaybot want?

In IO-based todaybot, anything that does IO can throw an exception, and we can catch it wherever.

Error handling policy is: per-post, if something fails, abandon that post; if something fails not belonging to a post, abandon this pass, and try again in 13 minutes time.

This behaviour is completely lost in the translation to effects presented so far...

Exceptions: where are the IO exceptions?

main = runStack todaybot

runStack p = runLift -- IO call happens in here, so IO
                     -- exceptions are thrown from here
                     -- where we can't catch them in prog.
           $ handleSleep
           $ handleLog
           $ handleGetCurrentLocalTime
           $ p

todaybot = ...
      (lift $ someFailingIO) `catchExc` ...
      -- this catch never fires  ^^^
      ...

Exceptions: catching IO exceptions

Technique taken from freer monads paper

convertIOExceptions :: (Member (Exc IOError) r, SetMember Lift (Lift IO) r) => Eff r () -> Eff r ()
convertIOExceptions = freeMap
           (return)
           (\eff -> interpose eff convertIOExceptions handleEff)
  where
    handleEff (Lift ioact k) = do
      rest <- send . inj $ Lift (tryIOError ioact) (transK k)
      convertIOExceptions rest

    transK rest ev = case ev of
      Right v -> k v
      Left ex -> throwExc ex

tryIOError :: IO a -> IO (Either IOError a) -- System.IO.Error

We convert the exceptions to Either IOError down at the IO handlers, and then back at the top (in transK), translate that Either into Exc.

But what about exceptions from other effects?

Awkwardly for a project of this small size, it looks like the same IOError -> Either -> Exc path has to be taken in every effect handler. (?)

Which means can't use same top level calls, because (eg) tell does not throw any Exc effects.

comparison with freer

The freer package is similar but newer than extensible-effects.

I ported todaybot in a few hours - code is on freer branch on github.

comparison with freer

handleLog :: (Member (Exc IOError) r, SetMember Lift (Lift IO) r)
          => Eff (Writer String :> r) a -> Eff r a
handleLog = freeMap (return)
           (\eff -> handleRelay eff handleLog write)
  where
    write :: (Member (Exc IOError) r, SetMember Lift (Lift IO) r)
          => (Writer String (Eff (Writer String :> r) a)) -> Eff r a
    write (Writer w v) = do
      lift $ do hPutStr stdout w
                hFlush stdout
      handleLog v

vs

handleLog :: (Member (Exc IOError) r, Member IOEffect r)
          => Eff (Writer String ': r) a -> Eff r a
handleLog = handleRelay return write
  where
    write :: (Member (Exc IOError) r, Member IOEffect r)
          => (Writer String v) -> Arr r v a -> Eff r a
    write (Writer w) k = do
      doIO $ do hPutStr stdout w
                hFlush stdout
      k ()

Switch?

So would I switch mainline todaybot to using extensible effects?

For todaybot: Main bit of ugliness is the exception handling; overkill for something this small.

For bigger project: yes, pretty interested.

See also...

The standard extensible-effects paper
Freer monads, more extensible effects paper
ocharles 24 Days of Hackage: Extensible effects
ro-che.info blog Problems with mtl - contains introduction mtl vs extensible effects
reddit thread from 2013 - debate including ekmett