Execute MonadIO action inside of reactimate

时间:2015-07-29 00:12:03

标签: haskell frp reactive-banana

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

2 个答案:

答案 0 :(得分:4)

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 self.smallThing.title = self.personTextField.text;, 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 reactimate monad, and so all extra effects it adds must have been resolved by the time Arduino fires the action (thus the reactimate type). The only way out I can see is rolling your own version of IO 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".

withArduino

Notes:

  • The forklift (here, {-# 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 ) runs an ard loop in a separate thread. Arduino allows us to send carry commands such as Arduino and readInputPin to be executed in this thread via a copyPin.

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

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

  • The layers are cleanly separated. On the one hand, the main loop only fires UI events like eReadInputPin, which are then processed by the event network. On the other hand, the eLine 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...

答案 1 :(得分:2)

  

您如何在reactimate中执行Arduino操作?

我会通过执行具有可观察副作用的IO操作来间接执行它们。然后,在withArduino内,我会观察到这个副作用并运行相应的Arduino命令。

这是一些示例代码。首先,让我们完成进口。

{-# LANGUAGE GeneralizedNewtypeDeriving, ScopedTypeVariables #-}

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

由于我没有arduino,我将不得不从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

在其余的代码中,我假装Arduino和Pin类型是不透明的。

我们需要一个事件网络来将表示从arduino接收的信号的输入事件转换为描述我们想要发送给arduino的输出事件。为了使事情变得非常简单,让我们从一个引脚接收数据,并在另一个引脚上输出完全相同的数据。

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

接下来,让我们将我们的活动网络连接到外部世界。当输出事件发生时,我只是将值写入IORef,稍后我将能够观察到。

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

请注意reactimatecompile仅在主循环之外调用一次。这些函数设置了您的事件网络,您不希望在每个循环中调用它们。

最后,我们运行主循环。

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

请注意我们如何使用liftIO从Arduino计算中与事件网络进行交互。我们调用fireInputPin来触发输入事件,事件网络导致响应触发输出事件,我们给writeIORef的{​​{1}}导致输出事件的值被写入IORef。如果事件网络更复杂并且输入事件未触发任何输出事件,则IORef的内容将保持不变。无论如何,我们可以观察内容,并使用它来确定运行哪个Arduino计算。在这种情况下,我们只需将输出值发送到预定的引脚。