Консольная интерактивность в Netwire?

Question

Я тестирую с Netwire библиотека haskell и заставила его работать с простым time провод:

import Control.Wire
import Prelude hiding ((.), id)

import Control.Monad.IO.Class
import Data.Functor.Identity
import System.IO

wire :: (HasTime t s) => Wire s () m a t
wire = time

run :: (HasTime t s, MonadIO m, Show b, Show e) =>
       Session m s -> Wire s e m a b -> m ()
run session wire = do
  (dt, session') <- stepSession session
  (wt', wire') <- stepWire wire dt $ Right undefined
  case wt' of
    -- | Exit
    Left _ -> return ()
    Right x -> do
      liftIO $ do
        putChar '\r'
        putStr $ either (\ex -> show ex) show wt'
        hFlush stdout
        -- Interactivity here?
        gotInput <- hReady stdin
        if gotInput then
          return ()
          else return ()
      run session' wire'

main :: IO ()
-- main = testWire clockSession_ wire
main = run clockSession_ wire

Обратите внимание run в основном модифицируется из testWire, поэтому я не знаю, является ли это правильным способом формирования сети проводов. Часть кода происходит от http://todayincode.tumblr.com/post/96914679355/almost-a-netwire-5-tutorial но этот учебник не говорит о событиях.

Сейчас я пытаюсь добавить немного интерактивности в программу. В настоящее время выйдите из программы при нажатии любой клавиши. Я полагаю, что я должен сделать некоторое переключение событий. Тем не менее, я застрял здесь, потому что я не могу найти способ изменить wire' или поменяй поведение. Я пытался прочитать документ API и источник, но я не вижу, как на самом деле "запустить" событие или использовать его для переключения проводов.

Опять же, поскольку я еще не очень хорошо знаком с Haskell, возможно, я допустил здесь несколько глупых ошибок.

Обновление 1/2

Я получил свою цель, работая по следующему коду. Таймер останавливается при любом нажатии клавиши. Обновление 2 мне удалось выделить pollInput в другой IO Единственная функция, ууу!

import Control.Wire
import Prelude hiding ((.), id)

import Control.Monad.IO.Class
import Data.Functor.Identity
import System.IO

wire :: (HasTime t s) => Wire s () m a t
wire = time

run :: (HasTime t s, MonadIO m, Show b, Show e) =>
       Session m s -> Wire s e m a b -> m ()
run session wire = do
  -- Get input here
  input <- liftIO $ pollInput

  (dt, session') <- stepSession session
  (wt', wire') <- stepWire wire dt $ input
  case wt' of
    -- | Exit
    Left _ -> liftIO (putStrLn "") >> return ()
    Right x -> do
      liftIO $ do
        putChar '\r'
        putStr $ either (\ex -> show ex) show wt'
        hFlush stdout

      run session' wire'

pollInput :: IO (Either a b)
pollInput =  do
  gotInput <- hReady stdin
  if gotInput then
    return (Left undefined)
    else return (Right undefined)


setup :: IO ()
setup = do
  hSetBuffering stdin NoBuffering
  hSetBuffering stdout NoBuffering


main :: IO ()
main = do
  setup
  run clockSession_ wire

Однако это вызывает некоторые дополнительные вопросы. Во-первых, это хорошая практика? Во-вторых, какой тип pollInput? Я пытался набрать его вручную, но безуспешно. Автоматический тип удержания работает, хотя.

Это мое объяснение того, как работает этот код:

Сначала пользовательский ввод с консоли опрашивается, и после некоторой логики генерируется "вход" для проводного соединения (плохой выбор имени, но этот сгенерированный вход является проводным входом) и передается по сети. Здесь я просто передаю запрет (Left something), и вызовет выход из цикла. Конечно, при выходе программа создает новую строку, чтобы консоль выглядела лучше.

(Ну, я до сих пор не понимаю, как Event работает, правда)

Обновление 3/4

Прочитав ответ @Cirdec и много поиграв в мой редактор, я получаю эту однопоточную версию без IORef, также выход при нажатии 'x'Обновление 4: (но это ничего не выводит):

import Control.Wire
import Prelude hiding ((.),id)
import Control.Wire.Unsafe.Event
import System.IO
import Control.Monad.IO.Class

data InputEvent = KeyPressed Char 
                | NoKeyPressed
                deriving (Ord, Eq, Read, Show)
type OutputEvent = IO ()

--- Wires
example :: (HasTime t s, Monad m, Show t) =>
           Wire s () m (Event [InputEvent]) (Event [OutputEvent])
example = switch $
          (fmap ((:[]) . print) <$> periodic 1 . time
           &&&
           fmap (const mkEmpty) <$> filterE (any (== KeyPressed 'x'))
           )

readKeyboard :: IO (Either e (InputEvent))
readKeyboard = do
  hSetBuffering stdin NoBuffering
  gotInput <- hReady stdin
  if gotInput then do
    c <- getChar
    return $ Right $ KeyPressed c
    else return $ Right $ NoKeyPressed

output :: [OutputEvent] -> IO ()
output (x:xs) = id x >> output xs
output _ = return ()

run :: (HasTime t s, MonadIO m) =>
       Session m s -> Wire s e m (Event [InputEvent]) (Event [OutputEvent]) -> m e
run = go
  where
    go session wire = do
      -- | inputEvent :: Event InputEvent
      inputEvent <- liftIO $ readKeyboard
      (dt, session') <- stepSession session
      (wt', wire') <- stepWire wire dt (Event <$> (fmap (:[]) inputEvent))
      -- (wt', wire') <- stepWire wire dt (Right undefined)
      case wt' of
        Left a -> return a
        Right bEvent -> do
          case bEvent of
            Event b -> liftIO $ output b
            _ -> return ()
          go session' wire'

main = do
  run clockSession_ example

Я думаю, что это намного лучше, чем мой оригинал, но я все еще не до конца уверен, является ли это хорошей практикой или нет.

Answer 1

Во-первых, я бы указал на Kleisli Arrow в Netwire 5?, Я пришел с этим ответом после долгого времени попытки понять Монады и Стрелы. Я приведу минимальный пример использования Kleisli Wire в ближайшее время.

Эта программа просто повторяет то, что пользователь вводит, и завершает работу, когда нажимает q, Хотя это бесполезно, оно демонстрирует, вероятно, хорошую практику использования Netwire 5.

mkKleisli :: (Monad m, Monoid e) => (a -> m b) -> Wire s e m a b
mkKleisli f = mkGen_ $ \a -> liftM Right $ f a

Это конструктор Kleisli, написанный в ответе в сообщении. Таким образом, эта функция снимает любую функцию Клейсли a -> m b в Wire s e m a b, Это ядро ​​любого ввода / вывода, который мы делаем в этой программе.

Так как мы повторяем как пользовательские типы, hGetChar это, наверное, лучший выбор. Поэтому мы поднимаем это в провод.

inputWire :: Wire s () IO () Char
inputWire = mkKleisli $ \_ -> hGetChar stdin

Точно так же мы используем следующий провод для вывода символов на экране.

outputWire :: Wire s () IO Char ()
outputWire = mkKleisli $ putChar

Затем, чтобы определить, когда нам нужно выйти, создается чистый провод для вывода True когда q это вход (Обратите внимание, что mkSF_ можно использовать вместо arr).

quitWire :: (Monad m, Monoid e) => Wire s e m Char Bool
quitWire = arr $ quitNow
    where 
      quitNow c 
          | c == 'q' || c == 'Q' = True
          | otherwise = False

Чтобы на самом деле использовать информацию о выходе, нам нужно написать специальную (но очень простую) runWire функция, которая запускает провод типа Wire s e m () Bool, Когда провод блокируется или возвращает false, функция завершается.

runWire :: (Monad m) => Session m s -> Wire s e m () Bool -> m ()
runWire s w = do
  (ds, s') <- stepSession s
  (quitNow, w') <- stepWire w ds (Right ())
  case quitNow of
    Right False -> runWire s' w'
    _ -> return ()

Теперь давайте соединим провода.

mainWire = inputWire >>> (quitWire &&& outputWire) >>> arr (\(q,_) -> q)

Конечно, мы можем использовать синтаксис Arrow:

mainWire = proc _ -> do 
  c <- inputWire -< ()
  q <- quitWire -< c
  outputWire -< c
  returnA -< q

Не уверен, что proc Версия быстрее или нет, но в этом простом примере оба вполне читабельны.

Мы получаем информацию от inputWireнакорми его quitWire а также outputWire и получить кортеж (Bool, ()), Затем мы берем первый в качестве конечного результата.

Наконец, мы запускаем все в main!

main = do 
  hSetEcho stdin False 
  hSetBuffering stdin NoBuffering
  hSetBuffering stdout NoBuffering 
  runWire clockSession_ mainWire

Вот последний код, который я использовал:

{-# LANGUAGE Arrows #-}

module Main where

import Control.Wire
import Control.Monad
import Control.Arrow
import System.IO
import Prelude hiding ((.), id)

mkKleisli :: (Monad m, Monoid e) => (a -> m b) -> Wire s e m a b
mkKleisli f = mkGen_ $ \a -> liftM Right $ f a

inputWire :: Wire s () IO () Char
inputWire = mkKleisli $ \_ -> hGetChar stdin

outputWire :: Wire s () IO Char ()
outputWire = mkKleisli $ putChar

quitWire :: (Monad m, Monoid e) => Wire s e m Char Bool
quitWire = arr $ quitNow
    where 
      quitNow c 
          | c == 'q' || c == 'Q' = True
          | otherwise = False

runWire :: (Monad m) => Session m s -> Wire s e m () Bool -> m ()
runWire s w = do
  (ds, s') <- stepSession s
  (quitNow, w') <- stepWire w ds (Right ())
  case quitNow of
    Right False -> runWire s' w'
    _ -> return ()

mainWire = inputWire >>> (quitWire &&& outputWire) >>> arr (\(q,_) -> q)

main = do 
  hSetEcho stdin False 
  hSetBuffering stdin NoBuffering
  hSetBuffering stdout NoBuffering 
  runWire clockSession_ mainWire

Answer 2

Если вы не хотите блокировать на входе и выходе, не блокируйте на входе и выходе. Чтобы продемонстрировать, как подключить сеть к событиям, мы сделаем небольшую структуру для запуска проводов. Мы избежим блокирования перехода, выполняя все IO в отдельных темах.

Из сетевой документации нам разрешено деконструировать Event Если мы разрабатываем рамки.

Netwire не экспортирует конструкторы Event введите по умолчанию. Если вы разработчик фреймворка, вы можете импортировать Control.Wire.Unsafe.Event Модуль для реализации ваших собственных событий.

Это позволяет нам видеть, что Event просто

data Event a = NoEvent | Event a

Мы сделаем очень простую структуру, которая использует одно действие в m для ввода и один для вывода. Это запускает действие m (Either e a) читать действие или запретить. Это либо запускает действие b -> m () вывести или остановить, когда провод блокирует.

import Control.Wire
import Prelude hiding ((.), id)

import Control.Wire.Unsafe.Event

run :: (HasTime t s, Monad m) =>
       m (Either e a) -> (b -> m ()) ->
       Session m s -> Wire s e m (Event a) (Event b) -> m e
run read write = go
    where
        go session wire = do
            (dt, session') <- stepSession session
            a <- read
            (wt', wire') <- stepWire wire dt (Event <$> a)
            case wt' of
                Left e -> return e
                Right bEvent -> do
                    case bEvent of
                        Event b -> write b
                        _       -> return ()
                    go session' wire'

Мы будем использовать это для запуска примера программы, которая выводит время каждую секунду и останавливается (блокирует), когда 'x' клавиша нажата.

example :: (HasTime t s, Monad m, Show t) =>
           Wire s () m (Event [InputEvent]) (Event [OutputEvent])
example = switch $
            (fmap ((:[]) . print) <$> periodic 1 . time)
            &&&
            (fmap (const mkEmpty) <$> filterE (any (== KeyPressed 'x')))

Входные и выходные события переносят несколько событий в случае, если на одном шаге времени происходит более одного события. Входные события - это просто нажатие символьных клавиш. Выходные события IO действия.

data InputEvent = KeyPressed Char 
  deriving (Ord, Eq, Read, Show)
type OutputEvent = IO ()

Наш неблокирующий ввод / вывод будет выполнять три потока: входной поток, выходной поток и проводной поток. Они будут общаться друг с другом, атомно модифицируя IORef s. Это излишне для примера программы (мы могли бы просто использовать hReady при чтении) и недостаточно для производственной программы (потоки ввода-вывода будут вращаться в ожидании символов и вывода). На практике опрос для событий и планирование выходных данных, как правило, будет обеспечиваться какой-либо другой структурой ввода-вывода (OpenGL, набор инструментов графического интерфейса, игровой движок и т. Д.).

import Data.IORef

type IOQueue a = IORef [a]

newIOQueue :: IO (IOQueue a)
newIOQueue = newIORef []

readIOQueue :: IOQueue a -> IO [a]
readIOQueue = flip atomicModifyIORef (\xs -> ([], reverse xs))

appendIOQueue :: IOQueue a -> [a] -> IO ()
appendIOQueue que new = atomicModifyIORef que (\xs -> (reverse new ++ xs, ()))

Главный поток устанавливает очереди, порождает потоки ввода-вывода, запускает соединение и сигнализирует потоки ввода-вывода, когда программа остановлена.

import Control.Concurrent.MVar
import Control.Concurrent.Async

import Control.Monad.IO.Class

runKeyboard :: (HasTime t s, MonadIO m) =>
               Session m s -> Wire s e m (Event [InputEvent]) (Event [OutputEvent]) -> m e
runKeyboard session wire = do
    stopped <- liftIO newEmptyMVar 
    let continue = isEmptyMVar stopped
    inputEvents  <- liftIO newIOQueue
    outputEvents <- liftIO newIOQueue
    inputThread  <- liftIO $ async (readKeyboard continue (appendIOQueue inputEvents .    (:[])))
    outputThread <- liftIO $ async (runEvents    continue (sequence_ <$> readIOQueue outputEvents))
    let read  = liftIO $ Right <$> readIOQueue   inputEvents 
    let write = liftIO .           appendIOQueue outputEvents
    e <- run read write session wire
    liftIO $ putMVar stopped ()
    liftIO $ wait inputThread
    liftIO $ wait outputThread
    return e

Поток ввода ждет клавиш, вращающихся, когда ввод не готов. Отправляет KeyPressed события в очередь.

import System.IO

readKeyboard :: IO Bool -> (InputEvent -> IO ()) -> IO ()
readKeyboard continue send = do
    hSetBuffering stdin NoBuffering
    while continue $ do
        ifM (hReady stdin) $ do
            a <- getChar
            send (KeyPressed a)

ifM :: Monad m => m Bool -> m a -> m ()
ifM check act = do
    continue <- check
    if continue then act >> return () else return ()

while :: Monad m => m Bool -> m a -> m ()
while continue act = go
    where
        go = ifM continue loop
        loop = act >> go

Выходной поток выполняет действия, которые он отправляет, пока ему предписано продолжить (и еще раз после того, как ему будет дан сигнал об остановке, чтобы убедиться, что все выходные данные выполнены).

runEvents :: IO Bool -> (IO (IO ())) -> IO ()
runEvents continue fetch = (while continue $ fetch >>= id) >> fetch >>= id

Мы можем запустить пример программы с runKeyboard,

main = runKeyboard clockSession_ example