Haskell 在reactimate内部执行MonadIO操作

在reactivebanana中，我正在尝试运行

reactimate:：Event（IO（））->Moment（）

，在

MonadIO

的一个实例中执行

Arduino

的一些操作。软件包中似乎没有提供

Arduino a->IO a

功能。您将如何执行

reactimate

中的

Arduino

操作？

我对Arduino或hArduino没有任何经验，因此请采取以下措施

考虑到在每个

reactimate

上重新初始化电路板是不合理的，我认为没有干净的选项[*]。基本问题是，reactive banana中

reactimate

的实现对

Arduino

monad一无所知，因此它添加的所有额外效果必须在

reactimate

触发操作时得到解决（因此

IO

类型）。我能看到的唯一出路是使用Arduino推出您自己的

版本，它跳过了初始化。从快速浏览的结果来看，这看起来是可行的，尽管非常混乱

[*]或者至少是一个不涉及可变状态的干净选项，如在正确答案中


鉴于海因里希·阿普费尔莫斯提出了一个有趣的解决办法，善意地补充了这个答案，我忍不住实施了他的建议。格里森也功不可没，因为他的回答为我节省了不少时间。除了代码块下方的注释外，请参阅“叉车”的更多注释

{-#语言泛化newtypedering，ScopedTypeVariables}
导入控制.Monad（join，（do
putStrLn“读取错误，正在重试…”
unArduino$digitalRead p
withArduino:：Arduino（）->IO（）
withArduino（Arduino主体）=do
putStrLn“假装我们正在初始化arduino。”
身体

注:


叉车（此处，
ard
）在一个单独的线程中运行一个
Arduino
循环。
carry
允许我们发送
Arduino
命令，例如
readInputPin
和
copyPin
，通过
Chan（Arduino（））
在该线程中执行

它只是一个名称，但无论如何，调用
unlift
的
newforkfork
的参数很好地反映了上述讨论

通信是双向的。
carry
crafts
MVar
s允许我们访问
Arduino
命令返回的值。这允许我们以完全自然的方式使用事件，如
eReadInputPin

各层完全分开。一方面，主循环仅触发诸如
eLine
之类的UI事件，然后由事件网络处理。另一方面，
Arduino
代码仅通过叉车与事件网络和主循环通信

{-# 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

为什么我在里面放了一个？我会让你猜如果你把它摘下来会发生什么


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

我会通过执行具有明显副作用的IO操作来间接执行它们。然后，在使用Arduino的
内部，我会观察到这种副作用并运行相应的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

注意我们如何使用
liftIO
从Arduino计算内部与事件网络交互。我们调用
fireInputPin
来触发输入事件，事件网络会触发输出事件作为响应，我们给
reactimate
的
writeIORef
会导致输出事件的值为writ连接到IORef。如果事件网络更复杂，并且输入事件没有触发任何输出事件，IORef的内容将保持不变。无论如何，我们可以观察这些内容，并使用它来确定要运行哪个Arduino计算。在这种情况下，我们只需将输出值发送到一个预定引脚。
我想您可以使用
与Arduino:：Bool->FilePath->Arduino（）->IO（）
。谢谢@duplode的评论，
withArduino
是一个初始化所有组件的函数，我不想在程序的主循环中随时运行它。
MonadIO
只给你
IO a->MA
。你需要的是另一个方向。这是（部分）由
MonadBaseControl IO
提供，或者，如果您知道具体的monad，则提供类似
withArduino
的函数。感谢@TobiasBrandt提供您的答案，但是
withArduino
并不是我可以每毫秒执行一次的函数。请注意，Heinrich已经发布了一个适当的解决方案作为对我答案的注释。主要问题似乎是因为
withArduino
想要一次执行整个程序，而Ryoichiro想要一点一点地提供操作。看起来arduino库不支持这一点，Tobias是对的。在这些情况下，有一个小技巧通常是有帮助的：并发性。更具体地说，你可以用
编写一个事件循环ver
和
readMVar
并将此作为参数提供给
withArduino
。然后，被动香蕉端只需使用
putMVar
来传达它想要的动作
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