Netwire camera example

Camera.hs

{-# LANGUAGE FlexibleContexts, ScopedTypeVariables, TupleSections #-}

module Test where

import Control.Arrow
import qualified Control.Monad as M ( unless )
import Control.Wire
import Control.Wire.Unsafe.Event
import Data.Foldable ( foldMap, for_ )
import Data.Function ( fix )
import Data.Monoid
import Data.Profunctor
import Prelude hiding ( (.), id )

data Input
  = W
  | S
  | Reset
  | Quit
    deriving (Eq,Read,Show)

hasKey :: Input -> Event [Input] -> Bool
hasKey _ NoEvent = False
hasKey k (Event evs) = k `elem` evs

pollEvents :: IO (Event Input)
pollEvents = fmap treat getLine
  where
    treat l
        | null treat' = NoEvent
        | otherwise = Event (head treat')
      where
        treat' = concatMap (map fst . reads) $ words l

camera :: (Monad m,Monoid s,HasTime Float s) => Wire s () m (Event Input) Float
camera = lmap (,0) idle
  where
    idle = switch $ (,) <$> lmap snd id <*> wards
    wards = (arr $ \(i,_) -> fmap ward i)
    ward i = case i of
      W -> idle . (notYet *** id + time * 0.1)
      S -> idle . (notYet *** id - time * 0.1)
      Reset -> idle . (notYet *** pure 0)
      _ -> inhibit ()

test :: IO ()
test = loop_ camera 0
  where
    loop_ camera t = do
      ev <- pollEvents
      putStrLn $ "time: " ++ show t
      let Identity (x,n) = stepWire camera (Timed t ()) (Right ev)
      for_ x $ \y -> print y >> loop_ n (t+1)