Search code examples
haskellmonadsfrpreaderwriter

What is the correct implementation of addToLeftPlayerPos


I'm trying to follow this paper on functional reactive programming but I'm stuck on the second example in section 4.2.

I got the first example with the reader transformer up and running:

module Main where

import FRP.BearRiver    
import Control.Monad.Trans.MSF.Reader

type Game = Ball
type Ball = Int

type GameEnv = ReaderT GameSettings

data GameSettings
    = GameSettings
      { leftPlayerPos  :: Int
      , rightPlayerPos :: Int
      }

ballToRight :: Monad m => MSF (GameEnv m) () Ball
ballToRight =
    count >>> arrM addToLeftPlayerPos
    where
      addToLeftPlayerPos =
          (\n -> (n +) <$> asks leftPlayerPos)

hitRight :: Monad m => MSF (GameEnv m) Ball Bool
hitRight = arrM (\i -> (i >=) <$> asks rightPlayerPos)

But with the next step I'm struggling. I can't figure out how to introduce a writer transformer correctly, as I don't get it even to compile:

module Main where

import FRP.BearRiver
import Control.Monad
import Control.Monad.Trans.MSF.Reader
import Control.Monad.Trans.MSF.Writer

type Game = Ball
type Ball = Int

type GameEnv m =
    WriterT [String] (ReaderT GameSettings m)

data GameSettings
    = GameSettings
      { leftPlayerPos  :: Int
      , rightPlayerPos :: Int
      }

ballToRight :: Monad m => MSF (GameEnv m) () Ball
ballToRight =
    count >>> arrM addLeftPlayerPos >>> arrM checkHitR
    where
      addLeftPlayerPos =
          (\n -> (n +) <$> asks leftPlayerPos)
      checkHitR n = do
          rp <- asks rightPlayerPos
when (rp > n) $ tell ["Ball is at " ++ (show n)]

Actually the line with the function call addLeftPlayerPos is the problematic one, as the function arrM addLeftPlayerPos isn't given in the paper and my version seems to lack the WriterT type signature as the type alias type GameEnv m ... suggests

What could be the correct implementation of the addLeftPlayerPos function?

Edit: The compiler error is:

 Expected type: MSF (GameEnv m) () Ball
    Actual type: MSF (ReaderT GameSettings m1) () () 
• In the expression: 
    count >>> arrM addToLeftPlayerPos >>> arrM checkHitR 

Solution

  • Some phrasing

    When you have a transformer stack you must "lift" your operations to run the inner-monad functions. for example:

    type MyMonad a = Transformer1 (Transformer2 IO) a
    

    The stack here is Transformer1 of Transformer2 of IO. The "outer" monad is Transformer1 which wraps Transformer2 with an inner-most (or base, bottom) monad of IO. In your case the stack is actuall a Writer of a Reader of some unknown monad m, all good.

    Now if we want to run f :: Transformer2 IO a from within a function g :: MyMonad we must lift f. Similarly, if we have getLine :: IO String and we wish to run that from within g :: Transformer1 (Transformer2 IO) a then we can lift (lift getLine).

    Lifting

    If you import Control.Monad.Trans.Class you can lift your ReaderT operations. For example lift (asks ...) instead of just asks ....

    This does help a lot. The error you commented probably is due to the use of asks in checkHitR.

    One More Type Error

    After doing our lifting we have the error:

    frosch.hs:23:5: error:
        • Couldn't match type ‘()’ with ‘Int’
          Expected type: MSF (GameEnv m) () Ball
            Actual type: MSF
                           (WriterT [[Char]] (ReaderT GameSettings m)) () ()
    

    This is because your checkHitR doesn't return the value rp (which I assume it should). Fixing that issue gives us our final code of:

    module Main where
    
    import FRP.BearRiver
    import Control.Monad.Trans.Class
    import Control.Monad
    import Control.Monad.Trans.MSF.Reader
    import Control.Monad.Trans.MSF.Writer
    
    type Game = Ball
    type Ball = Int
    
    type GameEnv m =
        WriterT [String] (ReaderT GameSettings m)
    
    data GameSettings
        = GameSettings
          { leftPlayerPos  :: Int
          , rightPlayerPos :: Int
          }
    
    ballToRight :: Monad m => MSF (GameEnv m) () Ball
    ballToRight =
        count >>> arrM addLeftPlayerPos >>> arrM checkHitR
        where
          addLeftPlayerPos =
              (\n -> (n +) <$> lift (asks leftPlayerPos))
          checkHitR n = do
              rp <- lift (asks rightPlayerPos)
              when (rp > n) $ tell ["Ball is at " ++ (show n)]
              pure rp