问题
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
?
回答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.
回答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 anArduino
loop in a separate thread.carry
allows us to sendArduino
commands such asreadInputPin
andcopyPin
to be executed in this thread via aChan (Arduino ())
.It is just a name, but in any case the argument to
newForkLift
being calledunlift
nicely mirrors the discussion above.The communication is bidirectional.
carry
craftsMVar
s that give us access to values returned by theArduino
commands. That allows us to use events likeeReadInputPin
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, theArduino
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...
来源:https://stackoverflow.com/questions/31689204/execute-monadio-action-inside-of-reactimate