Выполнить действие MonadIO внутри реактивации

Как бы вы выполнили действия Arduino в reactimate?

Я бы заставил их выполняться косвенно, выполняя действие ввода-вывода, которое имеет наблюдаемый побочный эффект. Затем внутри 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

Так как у меня нет ардуино, то мне придется смастерить несколько методов из ардуино.

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

Обратите внимание, что reactimate и compile вызываются только один раз вне основного цикла. Эти функции настраивают вашу сеть событий, вы не хотите вызывать их в каждом цикле.

Наконец, мы запускаем основной цикл.

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, который мы передали reactimate, заставляет значение выходного события записываться в IORef. Если бы сеть событий была более сложной и входное событие не запускало выходное событие, содержимое IORef оставалось бы неизменным. Несмотря на это, мы можем наблюдать за этим содержимым и использовать его, чтобы определить, какое вычисление Arduino запустить. В этом случае мы просто отправляем выходное значение на заранее определенный вывод.

У меня нет опыта работы с Arduino или hArduino, поэтому отнеситесь к тому, что будет дальше, с долей скептицизма.

Учитывая, что нецелесообразно повторно инициализировать плату на каждом reactimate, я не думаю, что есть чистый вариант [*]. Основная проблема заключается в том, что реализация reactimate в reactive-banana ничего не знает о монаде Arduino, и поэтому все дополнительные эффекты, которые она добавляет, должны быть разрешены к тому времени, когда reactimate запускает действие (таким образом, тип IO). Единственный выход, который я вижу, это запустить собственную версию withArduino, которая пропускает инициализацию. Из беглого взгляда на источник, это выглядит осуществимо, хотя и очень грязно.

[*] Или, по крайней мере, чистый вариант, не связанный с изменяемым состоянием, как в правильных ответах.

Учитывая, что Генрих Апфельмус любезно дополнил этот ответ, предложив интересный выход, я не мог не реализовать его предложение. Кредит также принадлежит gelisam, так как его ответ сэкономил мне немало времени. Помимо примечаний под блоком кода, дополнительные сведения см. в блоге Генриха. комментарий к «погрузчику».

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

Заметки:

• Вилочный погрузчик (здесь ard) выполняет цикл Arduino в отдельном потоке. carry позволяет нам отправлять Arduino команд, таких как readInputPin и copyPin, для выполнения в этом потоке через файл Chan (Arduino ()).

• Это просто имя, но в любом случае аргумент в пользу того, что newForkLift называется unlift, прекрасно отражает приведенное выше обсуждение.

• Связь двусторонняя. carry создает MVar, которые дают нам доступ к значениям, возвращаемым командами Arduino. Это позволяет нам использовать такие события, как eReadInputPin, совершенно естественным образом.

• Слои четко разделены. С одной стороны, основной цикл запускает только события пользовательского интерфейса, такие как eLine, которые затем обрабатываются сетью событий. С другой стороны, код Arduino взаимодействует только с сетью событий и основным циклом через вилочный погрузчик.

• Почему я поместил семпахору в там? Я дам вам угадать, что произойдет, если вы снимете его...