Performing a MonadIO Action Inside

Question

In a reactive banana, I try to run reactimate :: Event (IO ()) -> Moment () with some Arduino actions in the hArduino package , an instance of MonadIO . There is no Arduino a -> IO a function in the package. How to perform Arduino actions in reactimate ?

Answer 1

How do you perform Arduino actions in reactimate ?

I could get them to execute indirectly by performing an IO action that has an observable side effect. Then inside withArduino I would observe this side effect and run the corresponding Arduino command.

Here is a sample code. First, let me get the import aside.

 {-# 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 don’t have arduino, I will have to prototype several 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 will pretend that the Arduino and Pin types are opaque.

We need a network of events to convert input events representing signals received from arduino into output events that describe what we want to send to arduino. To make things extremely simple, let me get data from one output and output the same data to another output.

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

Then connect our network of events to the outside world. When the output events occur, I simply write this value to the IORef, which I can watch 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 that reactimate and compile called only once, outside the main loop. These functions configure your network of events; you do not want to name them in each cycle.

Finally, we start 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 

Notice how we use liftIO to interact with the event network from within Arduino computing. We call fireInputPin to trigger an input event, the event network writeIORef an output response event, and the writeIORef we gave reactimate causes the value of the output event to be written to IORef. If the event network was more complex and the input event did not raise any output event, the contents of the IORef would remain unchanged. Regardless, we can observe this content and use it to determine which Arduino calculations should be performed. In this case, we simply send the output value to the predefined output.

Answer 2

I have no experience with Arduino or Harduino, so do the following with a pinch of salt.

Given that it is not recommended to reinitialize the board on each reactimate , I don’t think there is a clean option [*]. The main problem is that the reactimate implementation in the reactive banana does not know anything about the Arduino monad, and therefore all the additional effects that it adds had to be resolved by the time of reactimate in order to trigger the action (thus, IO ). The only way I can see is to run my own version of withArduino , which skips initialization. With a quick look at a source that looks doable if it is very dirty.

[*] Or, at least, a clean parameter that does not include a mutable state, as in the correct answers.

---

Given that Heinrich Apfelmus kindly added this answer, offering an interesting way out, I could not help but fulfill his suggestions. The loan also goes to helises, since the forests of his answer saved me quite a lot of time. In addition to the notes below the code block, see the Heinrich blog for an additional comment 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 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 -> ma -> IO a carry forklift act = do ref <- newEmptyMVar writeChan (requests forklift) $ do liftIO . putMVar ref =<< act takeMVar ref -- Mock-up lifted from gelisam 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:

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

• It's just a name, but in any case, the newForkLift argument, called unlift , perfectly reflects the discussion above.

• Communication is bidirectional. carry crafts MVar , which give us access to the values ​​returned by Arduino teams. This allows us to use events like eReadInputPin completely natural way.

• The layers are clearly separated. On the one hand, the main loop only triggers user interface events, such as 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 circuit via a forklift.

• Why did I put sempahore there? I will let you guess what will happen if you let him go ...