Execute MonadIO action inside of reactimate

Question

In reactive-banana, I am trying to run reactimate :: Event (IO ()) -> Moment () with some actions of Arduino in hArduino package, an instance of MonadIO. There seems no function of Arduino a -> IO a provided in the package. How would you execute Arduino actions in reactimate?

Lethargy

I think you can use withArduino :: Bool -> FilePath -> Arduino () -> IO (). – Society

Thank you @Society for your comment, withArduino is a function that initializes all their components, which I'd not like to run every moment in the main loop of the program. – Lethargy

MonadIO only gives you IO a -> m a. What you need is the other direction. This is (partly) given by MonadBaseControl IO or, if you know the specific monad, a function like withArduino. – Habitant

Thank you @TobiasBrandt for your answer, but withArduino is not such a function that I can execute every millisecond. – Lethargy

Note that Heinrich has posted a proper solution as a comment to my answer. – Society

Answer 1

How would you execute Arduino actions in reactimate?

I would cause them to be executed indirectly, by executing an IO action which has an observable side-effect. Then, inside withArduino, I would observe this side-effect and run the corresponding Arduino command.

Here's some example code. First, let's get the imports out of the way.

{-# LANGUAGE GeneralizedNewtypeDeriving, ScopedTypeVariables #-}

import Control.Monad.IO.Class
import Data.IORef
import Data.Word
import Reactive.Banana
import Reactive.Banana.Frameworks
import Text.Printf

Since I do not have an arduino, I'll have to mock up a few methods from hArduino.

newtype Arduino a = Arduino (IO a)
  deriving (Functor, Applicative, Monad, MonadIO)

newtype Pin = Pin Word8

pin :: Word8 -> Pin
pin = Pin

digitalWrite :: Pin -> Bool -> Arduino ()
digitalWrite (Pin n) v = Arduino $ do
    printf "Pretend pin %d on the arduino just got turned %s.\n"
           n (if v then "on" else "off")

digitalRead :: Pin -> Arduino Bool
digitalRead (Pin n) = Arduino $ do
    printf "We need to pretend we read a value from pin %d.\n" n
    putStrLn "Should we return True or False?"
    readLn

withArduino :: Arduino () -> IO ()
withArduino (Arduino body) = do
    putStrLn "Pretend we're initializing the arduino."
    body

In the rest of the code, I'll pretend that the Arduino and Pin types are opaque.

We'll need an event network to transform input events representing signals received from the arduino into output events describing what we want to send to the arduino. To keep things extremely simple, let's receive data from one pin and output the exact same data on another pin.

eventNetwork :: forall t. Event t Bool -> Event t Bool
eventNetwork = id

Next, let's connect our event network to the external world. When output events occur, I simply write the value into an IORef, which I'll be able to observe later.

main :: IO ()
main = do
    (inputPinAddHandler, fireInputPin) <- newAddHandler
    outputRef <- newIORef False

    let networkDescription :: forall t. Frameworks t => Moment t ()
        networkDescription = do
            -- input
            inputPinE <- fromAddHandler inputPinAddHandler

            -- output
            let outputPinE = eventNetwork inputPinE

            reactimate $ writeIORef outputRef <$> outputPinE
    network <- compile networkDescription
    actuate network

    withArduino $ do
      let inputPin  = pin 1
      let outputPin = pin 2

      -- initialize pins here...

      -- main loop
      loop inputPin outputPin fireInputPin outputRef

Note how reactimate and compile are only called once, outside the main loop. Those functions setup your event network, you do not want to call them on every loop.

Finally, we run the main loop.

loop :: Pin
     -> Pin
     -> (Bool -> IO ())
     -> IORef Bool
     -> Arduino ()
loop inputPin outputPin fireInputPin outputRef = do
    -- read the input from the arduino
    inputValue <- digitalRead inputPin

    -- send the input to the event network
    liftIO $ fireInputPin inputValue

    -- read the output from the event network
    outputValue <- liftIO $ readIORef outputRef

    -- send the output to the arduino
    digitalWrite outputPin outputValue

    loop inputPin outputPin fireInputPin outputRef

Note how we use liftIO to interact with the event network from inside an Arduino computation. We call fireInputPin to trigger an input event, the event network causes an output event to be triggered in response, and the writeIORef we gave to reactimate causes the output event's value to be written to the IORef. If the event network was more complicated and the input event did not trigger any output event, the contents of the IORef would remain unchanged. Regardless, we can observe that contents, and use it to determine which Arduino computation to run. In this case, we simply send the output value to a predetermined pin.

Piecemeal

I feel a bit wrong using IORef but it seems to be the only solution in this case. Thank you @gelisam! – Lethargy

Answer 2

I have no experience with Arduino or hArduino, so take what follows with a pinch of salt.

Given that it is unreasonable to reinitialise the board on every reactimate, I don't think there is a clean option [*]. The fundamental issue is that the implementation of reactimate in reactive-banana doesn't know anything about the Arduino monad, and so all extra effects it adds must have been resolved by the time reactimate fires the action (thus the IO type). The only way out I can see is rolling your own version of withArduino that skips the initialisation. From a quick glance at the source, that looks feasible, if very messy.

[*] Or at least a clean option not involving mutable state, as in the proper answers.

---

Given that Heinrich Apfelmus kindly augmented this answer by proposing an interesting way out, I couldn't help but implement his suggestion. Credit also goes to gelisam, as the scaffolding of his answer saved me quite a bit of time. Beyond the notes below the code block, see Heinrich's blog for extra commentary on the "forklift".

{-# LANGUAGE GeneralizedNewtypeDeriving, ScopedTypeVariables #-}

import Control.Monad (join, (<=<), forever)
import Control.Concurrent
import Data.Word
import Text.Printf
import Text.Read (readMaybe)
import Reactive.Banana
import Reactive.Banana.Frameworks

main :: IO ()
main = do
    let inputPin  = pin 1
        outputPin = pin 2

        readInputPin = digitalRead inputPin
        copyPin = digitalWrite outputPin =<< readInputPin

    ard <- newForkLift withArduino

    (lineAddHandler, fireLine) <- newAddHandler

    let networkDescription :: forall t. Frameworks t => Moment t ()
        networkDescription = do
            eLine <- fromAddHandler lineAddHandler

            let eCopyPin = copyPin <$ filterE ("c" ==) eLine
                eReadInputPin = readInputPin <$ filterE ("i" ==) eLine

            reactimate $ (printf "Input pin is on? %s\n" . show <=< carry ard)
                <$> eReadInputPin
            reactimate $ carry ard
                <$> eCopyPin

    actuate =<< compile networkDescription

    initialised <- newQSem 0
    carry ard $ liftIO (signalQSem initialised)
    waitQSem initialised

    forever $ do
        putStrLn "Enter c to copy, i to read input pin."
        fireLine =<< getLine

-- Heinrich's forklift.

data ForkLift m = ForkLift { requests :: Chan (m ()) }

newForkLift :: MonadIO m
            => (m () -> IO ()) -> IO (ForkLift m)
newForkLift unlift = do
    channel <- newChan
    let loop = forever . join . liftIO $ readChan channel
    forkIO $ unlift loop
    return $ ForkLift channel

carry :: MonadIO m => ForkLift m -> m a -> IO a
carry forklift act = do
    ref <- newEmptyMVar
    writeChan (requests forklift) $ do
        liftIO . putMVar ref =<< act
    takeMVar ref

-- Mock-up lifted from gelisam's answer.
-- Please pretend that Arduino is abstract.

newtype Arduino a = Arduino { unArduino :: IO a }
  deriving (Functor, Applicative, Monad, MonadIO)

newtype Pin = Pin Word8

pin :: Word8 -> Pin
pin = Pin

digitalWrite :: Pin -> Bool -> Arduino ()
digitalWrite (Pin n) v = Arduino $ do
    printf "Pretend pin %d on the arduino just got turned %s.\n"
           n (if v then "on" else "off")

digitalRead :: Pin -> Arduino Bool
digitalRead p@(Pin n) = Arduino $ do
    printf "We need to pretend we read a value from pin %d.\n" n
    putStrLn "Should we return True or False?"
    line <- getLine
    case readMaybe line of
        Just v -> return v
        Nothing -> do
            putStrLn "Bad read, retrying..."
            unArduino $ digitalRead p

withArduino :: Arduino () -> IO ()
withArduino (Arduino body) = do
    putStrLn "Pretend we're initializing the arduino."
    body

Notes:

• The forklift (here, ard) runs an Arduino loop in a separate thread. carry allows us to send Arduino commands such as readInputPin and copyPin to be executed in this thread via a Chan (Arduino ()).

• It is just a name, but in any case the argument to newForkLift being called unlift nicely mirrors the discussion above.

• The communication is bidirectional. carry crafts MVars that give us access to values returned by the Arduino commands. That allows us to use events like eReadInputPin in an entirely natural way.

• The layers are cleanly separated. On the one hand, the main loop only fires UI events like eLine, which are then processed by the event network. On the other hand, the Arduino code only communicates with the event network and the main loop through the forklift.

• Why did I put a sempahore in there? I will let you guess what happens if you take it off...

Society

The main problem seems to be that withArduino wants to execute the whole program at once, while Ryoichiro wants to feed operations bit by bit. It seems that the arduino library doesn't support that, – Habitant

Tobias is right. In these situations, there is a little trick that often helps, though: Concurrency. More specifically, you can write an event loop with forever and readMVar and supply this as argument to withArduino. Then, the reactive-banana side simply uses putMVar to communicate an action that it wants performed. (A concurrent channel may be more appropriate than an MVar, but the idea remains the same.) I like to call this the "forklift pattern". – Zoller

Thanks @Heinrich! I am going to try that pattern as well. (Not with a real Arduino board, unfortunately...) – Society

@HeinrichApfelmus One detail: are there any guarantees about the order of actions sent in this way in the case of reactimates for simultaneous events? (I guess the answer is "no", and that unifying simultaneous events beforehand is necessary to have peace of mind.) – Society

I chose another answer in the end, but thank you @duplode, TobiasBrandt and HeinrichApfelmus for working on my question! – Lethargy

@Society The guarantee is that reactimate are executed in "declaration order", i.e. a reactimate that comes before another reactimate in the Moment monad will also have its IO action executed first. It's a bit tricky to specify "declaration order" precisely when you have to consider executeE as well, but I hope you get what I mean. :-) – Zoller

@HeinrichApfelmus I get it, thanks. In fact, something now tells me I may have asked you this exact question two years ago :) In any case, I added an implementation of your solution to my answer, hopefully not doing anything silly in the process... – Society