netwire-5.0.3/0000755000175000001440000000000013255605432013537 5ustar00neverusers00000000000000netwire-5.0.3/Control/0000755000175000001440000000000013255605432015157 5ustar00neverusers00000000000000netwire-5.0.3/Control/Wire/0000755000175000001440000000000013255605432016065 5ustar00neverusers00000000000000netwire-5.0.3/Control/Wire/Unsafe/0000755000175000001440000000000013255605432017306 5ustar00neverusers00000000000000netwire-5.0.3/Control/Wire/Unsafe/Event.hs0000644000175000001440000000362513255605432020731 0ustar00neverusers00000000000000-- | -- Module: Control.Wire.Unsafe.Event -- Copyright: (c) 2013 Ertugrul Soeylemez -- License: BSD3 -- Maintainer: Ertugrul Soeylemez module Control.Wire.Unsafe.Event ( -- * Events Event(..), -- * Helper functions event, merge, occurred, onEventM ) where import Control.DeepSeq import Control.Monad import Control.Wire.Core import Data.Semigroup import Data.Typeable -- | Denotes a stream of values, each together with time of occurrence. -- Since 'Event' is commonly used for functional reactive programming it -- does not define most of the usual instances to protect continuous -- time and discrete event occurrence semantics. data Event a = Event a | NoEvent deriving (Typeable) instance Functor Event where fmap f = event NoEvent (Event . f) instance (Semigroup a) => Monoid (Event a) where mempty = NoEvent mappend = (<>) instance (NFData a) => NFData (Event a) where rnf (Event x) = rnf x rnf NoEvent = () instance (Semigroup a) => Semigroup (Event a) where (<>) = merge (<>) -- | Fold the given event. event :: b -> (a -> b) -> Event a -> b event _ j (Event x) = j x event n _ NoEvent = n -- | Merge two events using the given function when both occur at the -- same time. merge :: (a -> a -> a) -> Event a -> Event a -> Event a merge _ NoEvent NoEvent = NoEvent merge _ (Event x) NoEvent = Event x merge _ NoEvent (Event y) = Event y merge f (Event x) (Event y) = Event (f x y) -- | Did the given event occur? occurred :: Event a -> Bool occurred = event False (const True) -- | Each time the given event occurs, perform the given action with the -- value the event carries. The resulting event carries the result of -- the action. -- -- * Depends: now. onEventM :: (Monad m) => (a -> m b) -> Wire s e m (Event a) (Event b) onEventM c = mkGen_ $ liftM Right . event (return NoEvent) (liftM Event . c) netwire-5.0.3/Control/Wire/Core.hs0000644000175000001440000003236413255605432017321 0ustar00neverusers00000000000000-- | -- Module: Control.Wire.Core -- Copyright: (c) 2013 Ertugrul Soeylemez -- License: BSD3 -- Maintainer: Ertugrul Soeylemez {-# LANGUAGE GADTs #-} {-# LANGUAGE RankNTypes #-} {-# LANGUAGE TupleSections #-} module Control.Wire.Core ( -- * Wires Wire(..), stepWire, -- * Constructing wires mkConst, mkEmpty, mkGen, mkGen_, mkGenN, mkId, mkPure, mkPure_, mkPureN, mkSF, mkSF_, mkSFN, -- * Data flow and dependencies delay, evalWith, force, forceNF, -- * Utilities (&&&!), (***!), lstrict, mapWire ) where import Control.Applicative import Control.Arrow import Control.Category import Control.DeepSeq hiding (force) import Control.Monad import Control.Monad.Fix import Control.Parallel.Strategies import Data.Monoid import Data.Profunctor import qualified Data.Semigroup as Sg import Data.String import Prelude hiding ((.), id) -- | A wire is a signal function. It maps a reactive value to another -- reactive value. data Wire s e m a b where WArr :: (Either e a -> Either e b) -> Wire s e m a b WConst :: Either e b -> Wire s e m a b WGen :: (s -> Either e a -> m (Either e b, Wire s e m a b)) -> Wire s e m a b WId :: Wire s e m a a WPure :: (s -> Either e a -> (Either e b, Wire s e m a b)) -> Wire s e m a b instance (Monad m, Monoid e) => Alternative (Wire s e m a) where empty = WConst (Left mempty) w1@(WConst (Right _)) <|> _ = w1 w1@WId <|> _ = w1 WConst (Left ex) <|> w2 = mapLeft (ex <>) w2 w1' <|> w2' = WGen $ \ds mx' -> liftM2 (\(mx1, w1) (mx2, w2) -> lstrict (choose mx1 mx2, w1 <|> w2)) (stepWire w1' ds mx') (stepWire w2' ds mx') where choose mx1@(Right _) _ = mx1 choose _ mx2@(Right _) = mx2 choose (Left ex1) (Left ex2) = Left (ex1 <> ex2) instance (Monad m) => Applicative (Wire s e m a) where pure = WConst . Right wf' <*> wx' = WGen $ \ds mx' -> liftM2 (\(mf, wf) (mx, wx) -> lstrict (mf <*> mx, wf <*> wx)) (stepWire wf' ds mx') (stepWire wx' ds mx') instance (Monad m) => Arrow (Wire s e m) where arr f = WArr (fmap f) first w' = WGen $ \ds mxy' -> liftM (\(mx, w) -> lstrict (liftA2 (,) mx (fmap snd mxy'), first w)) (stepWire w' ds (fmap fst mxy')) instance (Monad m, Monoid e) => ArrowChoice (Wire s e m) where left w' = WGen $ \ds mmx' -> liftM (fmap Left ***! left) . stepWire w' ds $ case mmx' of Right (Left x) -> Right x Right (Right _) -> Left mempty Left ex -> Left ex right w' = WGen $ \ds mmx' -> liftM (fmap Right ***! right) . stepWire w' ds $ case mmx' of Right (Right x) -> Right x Right (Left _) -> Left mempty Left ex -> Left ex wl' +++ wr' = WGen $ \ds mmx' -> case mmx' of Right (Left x) -> do liftM2 (\(mx, wl) (_, wr) -> lstrict (fmap Left mx, wl +++ wr)) (stepWire wl' ds (Right x)) (stepWire wr' ds (Left mempty)) Right (Right x) -> do liftM2 (\(_, wl) (mx, wr) -> lstrict (fmap Right mx, wl +++ wr)) (stepWire wl' ds (Left mempty)) (stepWire wr' ds (Right x)) Left ex -> liftM2 (\(_, wl) (_, wr) -> lstrict (Left ex, wl +++ wr)) (stepWire wl' ds (Left ex)) (stepWire wr' ds (Left ex)) wl' ||| wr' = WGen $ \ds mmx' -> case mmx' of Right (Left x) -> do liftM2 (\(mx, wl) (_, wr) -> lstrict (mx, wl ||| wr)) (stepWire wl' ds (Right x)) (stepWire wr' ds (Left mempty)) Right (Right x) -> do liftM2 (\(_, wl) (mx, wr) -> lstrict (mx, wl ||| wr)) (stepWire wl' ds (Left mempty)) (stepWire wr' ds (Right x)) Left ex -> liftM2 (\(_, wl) (_, wr) -> lstrict (Left ex, wl ||| wr)) (stepWire wl' ds (Left ex)) (stepWire wr' ds (Left ex)) instance (MonadFix m) => ArrowLoop (Wire s e m) where loop w' = WGen $ \ds mx' -> liftM (fmap fst ***! loop) . mfix $ \ ~(mx, _) -> let d | Right (_, d) <- mx = d | otherwise = error "Feedback broken by inhibition" in stepWire w' ds (fmap (, d) mx') instance (Monad m, Monoid e) => ArrowPlus (Wire s e m) where (<+>) = (<|>) instance (Monad m, Monoid e) => ArrowZero (Wire s e m) where zeroArrow = empty instance (Monad m) => Category (Wire s e m) where id = WId w2' . w1' = WGen $ \ds mx0 -> do (mx1, w1) <- stepWire w1' ds mx0 (mx2, w2) <- stepWire w2' ds mx1 mx2 `seq` return (mx2, w2 . w1) instance (Monad m, Monoid e) => Choice (Wire s e m) where left' = left right' = right instance (Monad m, Floating b) => Floating (Wire s e m a b) where (**) = liftA2 (**) acos = fmap acos acosh = fmap acosh asin = fmap asin asinh = fmap asinh atan = fmap atan atanh = fmap atanh cos = fmap cos cosh = fmap cosh exp = fmap exp log = fmap log logBase = liftA2 logBase pi = pure pi sin = fmap sin sinh = fmap sinh sqrt = fmap sqrt tan = fmap tan tanh = fmap tanh instance (Monad m, Fractional b) => Fractional (Wire s e m a b) where (/) = liftA2 (/) recip = fmap recip fromRational = pure . fromRational instance (Monad m) => Functor (Wire s e m a) where fmap f (WArr g) = WArr (fmap f . g) fmap f (WConst mx) = WConst (fmap f mx) fmap f (WGen g) = WGen (\ds -> liftM (fmap f ***! fmap f) . g ds) fmap f WId = WArr (fmap f) fmap f (WPure g) = WPure (\ds -> (fmap f ***! fmap f) . g ds) instance (Monad m, IsString b) => IsString (Wire s e m a b) where fromString = pure . fromString instance (Monad m, Monoid b) => Monoid (Wire s e m a b) where mempty = pure mempty mappend = liftA2 mappend instance (Monad m, Num b) => Num (Wire s e m a b) where (+) = liftA2 (+) (-) = liftA2 (-) (*) = liftA2 (*) abs = fmap abs negate = fmap negate signum = fmap signum fromInteger = pure . fromInteger instance (Monad m) => Profunctor (Wire s e m) where dimap f g (WArr h) = WArr (fmap g . h . fmap f) dimap _ g (WConst mx) = WConst (fmap g mx) dimap f g (WGen h) = WGen (\ds -> liftM (fmap g ***! dimap f g) . h ds . fmap f) dimap f g WId = WArr (fmap (g . f)) dimap f g (WPure h) = WPure (\ds -> (fmap g ***! dimap f g) . h ds . fmap f) lmap f (WArr g) = WArr (g . fmap f) lmap _ (WConst mx) = WConst mx lmap f (WGen g) = WGen (\ds -> liftM (fmap (lmap f)) . g ds . fmap f) lmap f WId = WArr (fmap f) lmap f (WPure g) = WPure (\ds -> fmap (lmap f) . g ds . fmap f) rmap = fmap instance (Monad m, Sg.Semigroup b) => Sg.Semigroup (Wire s e m a b) where (<>) = liftA2 (Sg.<>) instance (Monad m, Monoid e) => Strong (Wire s e m) where first' = first second' = second -- | Left-strict version of '&&&' for functions. (&&&!) :: (a -> b) -> (a -> c) -> (a -> (b, c)) (&&&!) f g x' = let (x, y) = (f x', g x') in x `seq` (x, y) -- | Left-strict version of '***' for functions. (***!) :: (a -> c) -> (b -> d) -> ((a, b) -> (c, d)) (***!) f g (x', y') = let (x, y) = (f x', g y') in x `seq` (x, y) -- | This wire delays its input signal by the smallest possible -- (semantically infinitesimal) amount of time. You can use it when you -- want to use feedback ('ArrowLoop'): If the user of the feedback -- depends on /now/, delay the value before feeding it back. The -- argument value is the replacement signal at the beginning. -- -- * Depends: before now. delay :: a -> Wire s e m a a delay x' = mkSFN $ \x -> (x', delay x) -- | Evaluate the input signal using the given 'Strategy' here. This -- wire evaluates only produced values. -- -- * Depends: now. evalWith :: Strategy a -> Wire s e m a a evalWith s = WArr $ \mx -> case mx of Right x -> (x `using` s) `seq` mx Left _ -> mx -- | Force the input signal to WHNF here. This wire forces both -- produced values and inhibition values. -- -- * Depends: now. force :: Wire s e m a a force = WArr $ \mx -> case mx of Right x -> x `seq` mx Left ex -> ex `seq` mx -- | Force the input signal to NF here. This wire forces only produced -- values. -- -- * Depends: now. forceNF :: (NFData a) => Wire s e m a a forceNF = WArr $ \mx -> case mx of Right x -> x `deepseq` mx Left _ -> mx -- | Left-strict tuple. lstrict :: (a, b) -> (a, b) lstrict (x, y) = x `seq` (x, y) -- | Apply the given function to the wire's inhibition value. mapLeft :: (Monad m) => (e -> e) -> Wire s e m a b -> Wire s e m a b mapLeft _ w1@WId = w1 mapLeft f' w = mapOutput f w where f (Left ex) = Left (f' ex) f (Right x) = Right x -- | Apply the given function to the wire's output. mapOutput :: (Monad m) => (Either e b' -> Either e b) -> Wire s e m a b' -> Wire s e m a b mapOutput f (WArr g) = WArr (f . g) mapOutput f (WConst mx) = WConst (f mx) mapOutput f (WGen g) = WGen (\ds -> liftM (f *** mapOutput f) . g ds) mapOutput f WId = WArr f mapOutput f (WPure g) = WPure (\ds -> (f *** mapOutput f) . g ds) -- | Apply the given monad morphism to the wire's underlying monad. mapWire :: (Monad m', Monad m) => (forall a. m' a -> m a) -> Wire s e m' a b -> Wire s e m a b mapWire _ (WArr g) = WArr g mapWire _ (WConst mx) = WConst mx mapWire f (WGen g) = WGen (\ds -> liftM (lstrict . second (mapWire f)) . f . g ds) mapWire _ WId = WId mapWire f (WPure g) = WPure (\ds -> lstrict . second (mapWire f) . g ds) -- | Construct a stateless wire from the given signal mapping function. mkConst :: Either e b -> Wire s e m a b mkConst = WConst -- | Construct the empty wire, which inhibits forever. mkEmpty :: (Monoid e) => Wire s e m a b mkEmpty = mkConst (Left mempty) -- | Construct a stateful wire from the given transition function. mkGen :: (Monad m, Monoid s) => (s -> a -> m (Either e b, Wire s e m a b)) -> Wire s e m a b mkGen f = loop mempty where loop s' = WGen $ \ds mx -> let s = s' <> ds in s `seq` case mx of Left ex -> return (Left ex, loop s) Right x' -> liftM lstrict (f s x') -- | Construct a stateless wire from the given transition function. mkGen_ :: (Monad m) => (a -> m (Either e b)) -> Wire s e m a b mkGen_ f = loop where loop = WGen $ \_ mx -> case mx of Left ex -> return (Left ex, loop) Right x -> liftM (lstrict . (, loop)) (f x) -- | Construct a stateful wire from the given transition function. mkGenN :: (Monad m) => (a -> m (Either e b, Wire s e m a b)) -> Wire s e m a b mkGenN f = loop where loop = WGen $ \_ mx -> case mx of Left ex -> return (Left ex, loop) Right x' -> liftM lstrict (f x') -- | Construct the identity wire. mkId :: Wire s e m a a mkId = WId -- | Construct a pure stateful wire from the given transition function. mkPure :: (Monoid s) => (s -> a -> (Either e b, Wire s e m a b)) -> Wire s e m a b mkPure f = loop mempty where loop s' = WPure $ \ds mx -> let s = s' <> ds in s `seq` case mx of Left ex -> (Left ex, loop s) Right x' -> lstrict (f s x') -- | Construct a pure stateless wire from the given transition function. mkPure_ :: (a -> Either e b) -> Wire s e m a b mkPure_ f = WArr $ (>>= f) -- | Construct a pure stateful wire from the given transition function. mkPureN :: (a -> (Either e b, Wire s e m a b)) -> Wire s e m a b mkPureN f = loop where loop = WPure $ \_ mx -> case mx of Left ex -> (Left ex, loop) Right x' -> lstrict (f x') -- | Construct a pure stateful wire from the given signal function. mkSF :: (Monoid s) => (s -> a -> (b, Wire s e m a b)) -> Wire s e m a b mkSF f = mkPure (\ds -> lstrict . first (Right) . f ds) -- | Construct a pure stateless wire from the given function. mkSF_ :: (a -> b) -> Wire s e m a b mkSF_ f = WArr (fmap f) -- | Construct a pure stateful wire from the given signal function. mkSFN :: (a -> (b, Wire s e m a b)) -> Wire s e m a b mkSFN f = mkPureN (lstrict . first (Right) . f) -- | Perform one step of the given wire. stepWire :: (Monad m) => Wire s e m a b -> s -> Either e a -> m (Either e b, Wire s e m a b) stepWire w@(WArr f) _ mx' = return (f mx', w) stepWire w@(WConst mx) _ mx' = return (mx' *> mx, w) stepWire (WGen f) ds mx' = f ds mx' stepWire w@WId _ mx' = return (mx', w) stepWire (WPure f) ds mx' = return (f ds mx') netwire-5.0.3/Control/Wire/Event.hs0000644000175000001440000001726713255605432017517 0ustar00neverusers00000000000000-- | -- Module: Control.Wire.Event -- Copyright: (c) 2013 Ertugrul Soeylemez -- License: BSD3 -- Maintainer: Ertugrul Soeylemez module Control.Wire.Event ( -- * Events Event, -- * Time-based at, never, now, periodic, periodicList, -- * Signal analysis became, noLonger, edge, -- * Modifiers (<&), (&>), dropE, dropWhileE, filterE, merge, mergeL, mergeR, notYet, once, takeE, takeWhileE, -- * Scans accumE, accum1E, iterateE, -- ** Special scans maximumE, minimumE, productE, sumE ) where import Control.Applicative import Control.Arrow import Control.Monad.Fix import Control.Wire.Core import Control.Wire.Session import Control.Wire.Unsafe.Event import Data.Fixed -- | Merge events with the leftmost event taking precedence. Equivalent -- to using the monoid interface with 'First'. Infixl 5. -- -- * Depends: now on both. -- -- * Inhibits: when any of the two wires inhibit. (<&) :: (Monad m) => Wire s e m a (Event b) -> Wire s e m a (Event b) -> Wire s e m a (Event b) (<&) = liftA2 (merge const) infixl 5 <& -- | Merge events with the rightmost event taking precedence. -- Equivalent to using the monoid interface with 'Last'. Infixl 5. -- -- * Depends: now on both. -- -- * Inhibits: when any of the two wires inhibit. (&>) :: (Monad m) => Wire s e m a (Event b) -> Wire s e m a (Event b) -> Wire s e m a (Event b) (&>) = liftA2 (merge (const id)) infixl 5 &> -- | Left scan for events. Each time an event occurs, apply the given -- function. -- -- * Depends: now. accumE :: (b -> a -> b) -- ^ Fold function -> b -- ^ Initial value. -> Wire s e m (Event a) (Event b) accumE f = loop where loop x' = mkSFN $ event (NoEvent, loop x') (\y -> let x = f x' y in (Event x, loop x)) -- | Left scan for events with no initial value. Each time an event -- occurs, apply the given function. The first event is produced -- unchanged. -- -- * Depends: now. accum1E :: (a -> a -> a) -- ^ Fold function -> Wire s e m (Event a) (Event a) accum1E f = initial where initial = mkSFN $ event (NoEvent, initial) (Event &&& accumE f) -- | At the given point in time. -- -- * Depends: now when occurring. at :: (HasTime t s) => t -- ^ Time of occurrence. -> Wire s e m a (Event a) at t' = mkSF $ \ds x -> let t = t' - dtime ds in if t <= 0 then (Event x, never) else (NoEvent, at t) -- | Occurs each time the predicate becomes true for the input signal, -- for example each time a given threshold is reached. -- -- * Depends: now. became :: (a -> Bool) -> Wire s e m a (Event a) became p = off where off = mkSFN $ \x -> if p x then (Event x, on) else (NoEvent, off) on = mkSFN $ \x -> (NoEvent, if p x then on else off) -- | Forget the first given number of occurrences. -- -- * Depends: now. dropE :: Int -> Wire s e m (Event a) (Event a) dropE n | n <= 0 = mkId dropE n = fix $ \again -> mkSFN $ \mev -> (NoEvent, if occurred mev then dropE (pred n) else again) -- | Forget all initial occurrences until the given predicate becomes -- false. -- -- * Depends: now. dropWhileE :: (a -> Bool) -> Wire s e m (Event a) (Event a) dropWhileE p = fix $ \again -> mkSFN $ \mev -> case mev of Event x | not (p x) -> (mev, mkId) _ -> (NoEvent, again) -- | Forget all occurrences for which the given predicate is false. -- -- * Depends: now. filterE :: (a -> Bool) -> Wire s e m (Event a) (Event a) filterE p = mkSF_ $ \mev -> case mev of Event x | p x -> mev _ -> NoEvent -- | On each occurrence, apply the function the event carries. -- -- * Depends: now. iterateE :: a -> Wire s e m (Event (a -> a)) (Event a) iterateE = accumE (\x f -> f x) -- | Maximum of all events. -- -- * Depends: now. maximumE :: (Ord a) => Wire s e m (Event a) (Event a) maximumE = accum1E max -- | Minimum of all events. -- -- * Depends: now. minimumE :: (Ord a) => Wire s e m (Event a) (Event a) minimumE = accum1E min -- | Left-biased event merge. mergeL :: Event a -> Event a -> Event a mergeL = merge const -- | Right-biased event merge. mergeR :: Event a -> Event a -> Event a mergeR = merge (const id) -- | Never occurs. never :: Wire s e m a (Event b) never = mkConst (Right NoEvent) -- | Occurs each time the predicate becomes false for the input signal, -- for example each time a given threshold is no longer exceeded. -- -- * Depends: now. noLonger :: (a -> Bool) -> Wire s e m a (Event a) noLonger p = off where off = mkSFN $ \x -> if p x then (NoEvent, off) else (Event x, on) on = mkSFN $ \x -> (NoEvent, if p x then off else on) -- | Events occur first when the predicate is false then when it is -- true, and then this pattern repeats. -- -- * Depends: now. edge :: (a -> Bool) -> Wire s e m a (Event a) edge p = off where off = mkSFN $ \x -> if p x then (Event x, on) else (NoEvent, off) on = mkSFN $ \x -> if p x then (NoEvent, on) else (Event x, off) -- | Forget the first occurrence. -- -- * Depends: now. notYet :: Wire s e m (Event a) (Event a) notYet = mkSFN $ event (NoEvent, notYet) (const (NoEvent, mkId)) -- | Occurs once immediately. -- -- * Depends: now when occurring. now :: Wire s e m a (Event a) now = mkSFN $ \x -> (Event x, never) -- | Forget all occurrences except the first. -- -- * Depends: now when occurring. once :: Wire s e m (Event a) (Event a) once = mkSFN $ \mev -> (mev, if occurred mev then never else once) -- | Periodic occurrence with the given time period. First occurrence -- is now. -- -- * Depends: now when occurring. periodic :: (HasTime t s) => t -> Wire s e m a (Event a) periodic int | int <= 0 = error "periodic: Non-positive interval" periodic int = mkSFN $ \x -> (Event x, loop int) where loop 0 = loop int loop t' = mkSF $ \ds x -> let t = t' - dtime ds in if t <= 0 then (Event x, loop (mod' t int)) else (NoEvent, loop t) -- | Periodic occurrence with the given time period. First occurrence -- is now. The event values are picked one by one from the given list. -- When the list is exhausted, the event does not occur again. periodicList :: (HasTime t s) => t -> [b] -> Wire s e m a (Event b) periodicList int _ | int <= 0 = error "periodic: Non-positive interval" periodicList _ [] = never periodicList int (x:xs) = mkSFN $ \_ -> (Event x, loop int xs) where loop _ [] = never loop 0 xs = loop int xs loop t' xs0@(x:xs) = mkSF $ \ds _ -> let t = t' - dtime ds in if t <= 0 then (Event x, loop (mod' t int) xs) else (NoEvent, loop t xs0) -- | Product of all events. -- -- * Depends: now. productE :: (Num a) => Wire s e m (Event a) (Event a) productE = accumE (*) 1 -- | Sum of all events. -- -- * Depends: now. sumE :: (Num a) => Wire s e m (Event a) (Event a) sumE = accumE (+) 0 -- | Forget all but the first given number of occurrences. -- -- * Depends: now. takeE :: Int -> Wire s e m (Event a) (Event a) takeE n | n <= 0 = never takeE n = fix $ \again -> mkSFN $ \mev -> (mev, if occurred mev then takeE (pred n) else again) -- | Forget all but the initial occurrences for which the given -- predicate is true. -- -- * Depends: now. takeWhileE :: (a -> Bool) -> Wire s e m (Event a) (Event a) takeWhileE p = fix $ \again -> mkSFN $ \mev -> case mev of Event x | not (p x) -> (NoEvent, never) _ -> (mev, again) netwire-5.0.3/Control/Wire/Interval.hs0000644000175000001440000001013313255605432020203 0ustar00neverusers00000000000000-- | -- Module: Control.Wire.Interval -- Copyright: (c) 2013 Ertugrul Soeylemez -- License: BSD3 -- Maintainer: Ertugrul Soeylemez module Control.Wire.Interval ( -- * Basic intervals inhibit, -- * Time intervals after, for, -- * Signal analysis unless, when, -- * Event-based intervals asSoonAs, between, hold, holdFor, until ) where import Control.Arrow import Control.Wire.Core import Control.Wire.Event import Control.Wire.Session import Control.Wire.Unsafe.Event import Data.Monoid import Prelude hiding (until) -- | After the given time period. -- -- * Depends: now after the given time period. -- -- * Inhibits: for the given time period. after :: (HasTime t s, Monoid e) => t -> Wire s e m a a after t' = mkPure $ \ds x -> let t = t' - dtime ds in if t <= 0 then (Right x, mkId) else (Left mempty, after t) -- | Alias for 'hold'. asSoonAs :: (Monoid e) => Wire s e m (Event a) a asSoonAs = hold -- | Start each time the left event occurs, stop each time the right -- event occurs. -- -- * Depends: now when active. -- -- * Inhibits: after the right event occurred, before the left event -- occurs. between :: (Monoid e) => Wire s e m (a, Event b, Event c) a between = mkPureN $ \(x, onEv, _) -> event (Left mempty, between) (const (Right x, active)) onEv where active = mkPureN $ \(x, _, offEv) -> event (Right x, active) (const (Left mempty, between)) offEv -- | For the given time period. -- -- * Depends: now for the given time period. -- -- * Inhibits: after the given time period. for :: (HasTime t s, Monoid e) => t -> Wire s e m a a for t' = mkPure $ \ds x -> let t = t' - dtime ds in if t <= 0 then (Left mempty, mkEmpty) else (Right x, for t) -- | Start when the event occurs for the first time reflecting its -- latest value. -- -- * Depends: now. -- -- * Inhibits: until the event occurs for the first time. hold :: (Monoid e) => Wire s e m (Event a) a hold = mkPureN $ event (Left mempty, hold) (Right &&& holdWith) where holdWith x = mkPureN $ event (Right x, holdWith x) (Right &&& holdWith) -- | Hold each event occurrence for the given time period. Inhibits -- when no event occurred for the given amount of time. New occurrences -- override old occurrences, even when they are still held. -- -- * Depends: now. -- -- * Inhibits: when no event occurred for the given amount of time. holdFor :: (HasTime t s, Monoid e) => t -> Wire s e m (Event a) a holdFor int | int <= 0 = error "holdFor: Non-positive interval." holdFor int = off where off = mkPure $ \_ -> event (Left mempty, off) (Right &&& on int) on t' x' = mkPure $ \ds -> let t = t' - dtime ds in event (if t <= 0 then (Left mempty, off) else (Right x', on t x')) (Right &&& on int) -- | Inhibit forever with the given value. -- -- * Inhibits: always. inhibit :: e -> Wire s e m a b inhibit = mkConst . Left -- | When the given predicate is false for the input signal. -- -- * Depends: now. -- -- * Inhibits: unless the predicate is false. unless :: (Monoid e) => (a -> Bool) -> Wire s e m a a unless p = mkPure_ $ \x -> if p x then Left mempty else Right x -- | Produce until the given event occurs. When it occurs, inhibit with -- its value forever. -- -- * Depends: now until event occurs. -- -- * Inhibits: forever after event occurs. until :: (Monoid e) => Wire s e m (a, Event b) a until = mkPureN . uncurry $ \x -> event (Right x, until) (const (Left mempty, mkEmpty)) -- | When the given predicate is true for the input signal. -- -- * Depends: now. -- -- * Inhibits: when the predicate is false. when :: (Monoid e) => (a -> Bool) -> Wire s e m a a when p = mkPure_ $ \x -> if p x then Right x else Left mempty netwire-5.0.3/Control/Wire/Run.hs0000644000175000001440000000322013255605432017162 0ustar00neverusers00000000000000-- | -- Module: Control.Wire.Run -- Copyright: (c) 2013 Ertugrul Soeylemez -- License: BSD3 -- Maintainer: Ertugrul Soeylemez {-# LANGUAGE RankNTypes #-} module Control.Wire.Run ( -- * Testing wires testWire, testWireM ) where import Control.Monad.IO.Class import Control.Wire.Core import Control.Wire.Session import Data.Functor.Identity import System.IO -- | This function runs the given wire using the given state delta -- generator. It constantly shows the output of the wire on one line on -- stdout. Press Ctrl-C to abort. testWire :: (MonadIO m, Show b, Show e) => Session m s -> (forall a. Wire s e Identity a b) -> m c testWire s0 w0 = loop s0 w0 where loop s' w' = do (ds, s) <- stepSession s' let Identity (mx, w) = stepWire w' ds (Right ()) liftIO $ do putChar '\r' putStr (either (\ex -> "I: " ++ show ex) show mx) putStr "\027[K" hFlush stdout loop s w -- | This function runs the given wire using the given state delta -- generator. It constantly shows the output of the wire on one line on -- stdout. Press Ctrl-C to abort. testWireM :: (Monad m', MonadIO m, Show b, Show e) => (forall a. m' a -> m a) -> Session m s -> (forall a. Wire s e m' a b) -> m c testWireM run s0 w0 = loop s0 w0 where loop s' w' = do (ds, s) <- stepSession s' (mx, w) <- run (stepWire w' ds (Right ())) liftIO $ do putChar '\r' putStr (either (\ex -> "I: " ++ show ex) show mx) putStr "\027[K" hFlush stdout loop s w netwire-5.0.3/Control/Wire/Session.hs0000644000175000001440000000620513255605432020047 0ustar00neverusers00000000000000-- | -- Module: Control.Wire.Session -- Copyright: (c) 2013 Ertugrul Soeylemez -- License: BSD3 -- Maintainer: Ertugrul Soeylemez {-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE DeriveFoldable #-} {-# LANGUAGE DeriveFunctor #-} {-# LANGUAGE DeriveTraversable #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE FunctionalDependencies #-} {-# LANGUAGE MultiParamTypeClasses #-} module Control.Wire.Session ( -- * State delta types HasTime(..), Session(..), -- ** Wires with time Timed(..), clockSession, clockSession_, countSession, countSession_ ) where import Control.Applicative import Control.Monad.IO.Class import Data.Data import Data.Foldable (Foldable) import Data.Semigroup import Data.Time.Clock import Data.Traversable (Traversable) -- | State delta types with time deltas. class (Monoid s, Real t) => HasTime t s | s -> t where -- | Extract the current time delta. dtime :: s -> t -- | State delta generators as required for wire sessions, most notably -- to generate time deltas. These are mini-wires with the sole purpose -- of generating these deltas. newtype Session m s = Session { stepSession :: m (s, Session m s) } deriving (Functor) instance (Applicative m) => Applicative (Session m) where pure x = let s = Session (pure (x, s)) in s Session ff <*> Session fx = Session $ liftA2 (\(f, sf) (x, sx) -> (f x, sf <*> sx)) ff fx -- | This state delta type denotes time deltas. This is necessary for -- most FRP applications. data Timed t s = Timed t s deriving (Data, Eq, Foldable, Functor, Ord, Read, Show, Traversable, Typeable) instance (Semigroup s, Monoid s, Real t) => HasTime t (Timed t s) where dtime (Timed dt _) = dt instance (Semigroup s, Num t) => Semigroup (Timed t s) where Timed dt1 ds1 <> Timed dt2 ds2 = let dt = dt1 + dt2 ds = ds1 <> ds2 in dt `seq` ds `seq` Timed dt ds instance (Semigroup s, Monoid s, Num t) => Monoid (Timed t s) where mempty = Timed 0 mempty mappend = (<>) -- | State delta generator for a real time clock. clockSession :: (MonadIO m) => Session m (s -> Timed NominalDiffTime s) clockSession = Session $ do t0 <- liftIO getCurrentTime return (Timed 0, loop t0) where loop t' = Session $ do t <- liftIO getCurrentTime let dt = diffUTCTime t t' dt `seq` return (Timed dt, loop t) -- | Non-extending version of 'clockSession'. clockSession_ :: (Applicative m, MonadIO m) => Session m (Timed NominalDiffTime ()) clockSession_ = clockSession <*> pure () -- | State delta generator for a simple counting clock. Denotes a fixed -- framerate. This is likely more useful than 'clockSession' for -- simulations and real-time games. countSession :: (Applicative m) => t -- ^ Increment size. -> Session m (s -> Timed t s) countSession dt = let loop = Session (pure (Timed dt, loop)) in loop -- | Non-extending version of 'countSession'. countSession_ :: (Applicative m) => t -> Session m (Timed t ()) countSession_ dt = countSession dt <*> pure () netwire-5.0.3/Control/Wire/Switch.hs0000644000175000001440000002037213255605432017666 0ustar00neverusers00000000000000-- | -- Module: Control.Wire.Switch -- Copyright: (c) 2013 Ertugrul Soeylemez -- License: BSD3 -- Maintainer: Ertugrul Soeylemez module Control.Wire.Switch ( -- * Simple switching (-->), (>--), -- * Context switching modes, -- * Event-based switching -- ** Intrinsic switch, dSwitch, -- ** Intrinsic continuable kSwitch, dkSwitch, -- ** Extrinsic rSwitch, drSwitch, alternate, -- ** Extrinsic continuable krSwitch, dkrSwitch ) where import Control.Applicative import Control.Arrow import Control.Monad import Control.Wire.Core import Control.Wire.Event import Control.Wire.Unsafe.Event import qualified Data.Map as M import Data.Monoid -- | Acts like the first wire until it inhibits, then switches to the -- second wire. Infixr 1. -- -- * Depends: like current wire. -- -- * Inhibits: after switching like the second wire. -- -- * Switch: now. (-->) :: (Monad m) => Wire s e m a b -> Wire s e m a b -> Wire s e m a b w1' --> w2' = WGen $ \ds mx' -> do (mx, w1) <- stepWire w1' ds mx' case mx of Left _ | Right _ <- mx' -> stepWire w2' ds mx' _ -> mx `seq` return (mx, w1 --> w2') infixr 1 --> -- | Acts like the first wire until the second starts producing, at which point -- it switches to the second wire. Infixr 1. -- -- * Depends: like current wire. -- -- * Inhibits: after switching like the second wire. -- -- * Switch: now. (>--) :: (Monad m) => Wire s e m a b -> Wire s e m a b -> Wire s e m a b w1' >-- w2' = WGen $ \ds mx' -> do (m2, w2) <- stepWire w2' ds mx' case m2 of Right _ -> m2 `seq` return (m2, w2) _ -> do (m1, w1) <- stepWire w1' ds mx' m1 `seq` return (m1, w1 >-- w2) infixr 1 >-- -- | Intrinsic continuable switch: Delayed version of 'kSwitch'. -- -- * Inhibits: like the first argument wire, like the new wire after -- switch. Inhibition of the second argument wire is ignored. -- -- * Switch: once, after now, restart state. dkSwitch :: (Monad m) => Wire s e m a b -> Wire s e m (a, b) (Event (Wire s e m a b -> Wire s e m a b)) -> Wire s e m a b dkSwitch w1' w2' = WGen $ \ds mx' -> do (mx, w1) <- stepWire w1' ds mx' (mev, w2) <- stepWire w2' ds (liftA2 (,) mx' mx) let w | Right (Event sw) <- mev = sw w1 | otherwise = dkSwitch w1 w2 return (mx, w) -- | Extrinsic switch: Delayed version of 'rSwitch'. -- -- * Inhibits: like the current wire. -- -- * Switch: recurrent, after now, restart state. drSwitch :: (Monad m) => Wire s e m a b -> Wire s e m (a, Event (Wire s e m a b)) b drSwitch w' = WGen $ \ds mx' -> let nw w | Right (_, Event w1) <- mx' = w1 | otherwise = w in liftM (second (drSwitch . nw)) (stepWire w' ds (fmap fst mx')) -- | Acts like the first wire until an event occurs then switches -- to the second wire. Behaves like this wire until the event occurs -- at which point a *new* instance of the first wire is switched to. -- -- * Depends: like current wire. -- -- * Inhibits: like the argument wires. -- -- * Switch: once, now, restart state. alternate :: (Monad m) => Wire s e m a b -> Wire s e m a b -> Wire s e m (a, Event x) b alternate w1 w2 = go w1 w2 w1 where go w1' w2' w' = WGen $ \ds mx' -> let (w1, w2, w) | Right (_, Event _) <- mx' = (w2', w1', w2') | otherwise = (w1', w2', w') in liftM (second (go w1 w2)) (stepWire w ds (fmap fst mx')) -- | Intrinsic switch: Delayed version of 'switch'. -- -- * Inhibits: like argument wire until switch, then like the new wire. -- -- * Switch: once, after now, restart state. dSwitch :: (Monad m) => Wire s e m a (b, Event (Wire s e m a b)) -> Wire s e m a b dSwitch w' = WGen $ \ds mx' -> do (mx, w) <- stepWire w' ds mx' let nw | Right (_, Event w1) <- mx = w1 | otherwise = dSwitch w return (fmap fst mx, nw) -- | Extrinsic continuable switch. Delayed version of 'krSwitch'. -- -- * Inhibits: like the current wire. -- -- * Switch: recurrent, after now, restart state. dkrSwitch :: (Monad m) => Wire s e m a b -> Wire s e m (a, Event (Wire s e m a b -> Wire s e m a b)) b dkrSwitch w' = WGen $ \ds mx' -> let nw w | Right (_, Event f) <- mx' = f w | otherwise = w in liftM (second (dkrSwitch . nw)) (stepWire w' ds (fmap fst mx')) -- | Intrinsic continuable switch: @kSwitch w1 w2@ starts with @w1@. -- Its signal is received by @w2@, which may choose to switch to a new -- wire. Passes the wire we are switching away from to the new wire, -- such that it may be reused in it. -- -- * Inhibits: like the first argument wire, like the new wire after -- switch. Inhibition of the second argument wire is ignored. -- -- * Switch: once, now, restart state. kSwitch :: (Monad m, Monoid s) => Wire s e m a b -> Wire s e m (a, b) (Event (Wire s e m a b -> Wire s e m a b)) -> Wire s e m a b kSwitch w1' w2' = WGen $ \ds mx' -> do (mx, w1) <- stepWire w1' ds mx' (mev, w2) <- stepWire w2' ds (liftA2 (,) mx' mx) case mev of Right (Event sw) -> stepWire (sw w1) mempty mx' _ -> return (mx, kSwitch w1 w2) -- | Extrinsic continuable switch. This switch works like 'rSwitch', -- except that it passes the wire we are switching away from to the new -- wire. -- -- * Inhibits: like the current wire. -- -- * Switch: recurrent, now, restart state. krSwitch :: (Monad m) => Wire s e m a b -> Wire s e m (a, Event (Wire s e m a b -> Wire s e m a b)) b krSwitch w'' = WGen $ \ds mx' -> let w' | Right (_, Event f) <- mx' = f w'' | otherwise = w'' in liftM (second krSwitch) (stepWire w' ds (fmap fst mx')) -- | Route the left input signal based on the current mode. The right -- input signal can be used to change the current mode. When switching -- away from a mode and then switching back to it, it will be resumed. -- Freezes time during inactivity. -- -- * Complexity: O(n * log n) space, O(log n) lookup time on switch wrt -- number of started, inactive modes. -- -- * Depends: like currently active wire (left), now (right). -- -- * Inhibits: when active wire inhibits. -- -- * Switch: now on mode change. modes :: (Monad m, Ord k) => k -- ^ Initial mode. -> (k -> Wire s e m a b) -- ^ Select wire for given mode. -> Wire s e m (a, Event k) b modes m0 select = loop M.empty m0 (select m0) where loop ms' m' w'' = WGen $ \ds mxev' -> case mxev' of Left _ -> do (mx, w) <- stepWire w'' ds (fmap fst mxev') return (mx, loop ms' m' w) Right (x', ev) -> do let (ms, m, w') = switch ms' m' w'' ev (mx, w) <- stepWire w' ds (Right x') return (mx, loop ms m w) switch ms' m' w' NoEvent = (ms', m', w') switch ms' m' w' (Event m) = let ms = M.insert m' w' ms' in case M.lookup m ms of Nothing -> (ms, m, select m) Just w -> (M.delete m ms, m, w) -- | Extrinsic switch: Start with the given wire. Each time the input -- event occurs, switch to the wire it carries. -- -- * Inhibits: like the current wire. -- -- * Switch: recurrent, now, restart state. rSwitch :: (Monad m) => Wire s e m a b -> Wire s e m (a, Event (Wire s e m a b)) b rSwitch w'' = WGen $ \ds mx' -> let w' | Right (_, Event w1) <- mx' = w1 | otherwise = w'' in liftM (second rSwitch) (stepWire w' ds (fmap fst mx')) -- | Intrinsic switch: Start with the given wire. As soon as its event -- occurs, switch to the wire in the event's value. -- -- * Inhibits: like argument wire until switch, then like the new wire. -- -- * Switch: once, now, restart state. switch :: (Monad m, Monoid s) => Wire s e m a (b, Event (Wire s e m a b)) -> Wire s e m a b switch w' = WGen $ \ds mx' -> do (mx, w) <- stepWire w' ds mx' case mx of Right (_, Event w1) -> stepWire w1 mempty mx' _ -> return (fmap fst mx, switch w) netwire-5.0.3/Control/Wire/Time.hs0000644000175000001440000000141513255605432017320 0ustar00neverusers00000000000000-- | -- Module: Control.Wire.Time -- Copyright: (c) 2013 Ertugrul Soeylemez -- License: BSD3 -- Maintainer: Ertugrul Soeylemez module Control.Wire.Time ( -- * Time wires time, timeF, timeFrom ) where import Control.Wire.Core import Control.Wire.Session -- | Local time starting from zero. time :: (HasTime t s) => Wire s e m a t time = timeFrom 0 -- | Local time starting from zero, converted to your favorite -- fractional type. timeF :: (Fractional b, HasTime t s, Monad m) => Wire s e m a b timeF = fmap realToFrac time -- | Local time starting from the given value. timeFrom :: (HasTime t s) => t -> Wire s e m a t timeFrom t' = mkSF $ \ds _ -> let t = t' + dtime ds in lstrict (t, timeFrom t) netwire-5.0.3/Control/Wire.hs0000644000175000001440000000221713255605432016423 0ustar00neverusers00000000000000-- | -- Module: Control.Wire -- Copyright: (c) 2013 Ertugrul Soeylemez -- License: BSD3 -- Maintainer: Ertugrul Soeylemez module Control.Wire ( -- * Reexports module Control.Wire.Core, module Control.Wire.Event, module Control.Wire.Interval, module Control.Wire.Run, module Control.Wire.Session, module Control.Wire.Switch, module Control.Wire.Time, -- * Convenient type aliases WireP, SimpleWire, -- * External module Control.Applicative, module Control.Arrow, module Control.Category, module Data.Semigroup, Identity(..), NominalDiffTime ) where import Control.Applicative import Control.Arrow import Control.Category import Control.Wire.Core import Control.Wire.Event import Control.Wire.Interval import Control.Wire.Run import Control.Wire.Session import Control.Wire.Switch import Control.Wire.Time import Data.Functor.Identity import Data.Semigroup import Data.Time.Clock -- | Pure wires. type WireP s e = Wire s e Identity -- | Simple wires with time. type SimpleWire = Wire (Timed NominalDiffTime ()) () Identity netwire-5.0.3/FRP/0000755000175000001440000000000013255605432014166 5ustar00neverusers00000000000000netwire-5.0.3/FRP/Netwire/0000755000175000001440000000000013255605432015603 5ustar00neverusers00000000000000netwire-5.0.3/FRP/Netwire/Utils/0000755000175000001440000000000013255605432016703 5ustar00neverusers00000000000000netwire-5.0.3/FRP/Netwire/Utils/Timeline.hs0000644000175000001440000001173413255605432021013 0ustar00neverusers00000000000000-- | -- Module: FRP.Netwire.Utils.Timeline -- Copyright: (c) 2013 Ertugrul Soeylemez -- License: BSD3 -- Maintainer: Ertugrul Soeylemez {-# LANGUAGE DeriveDataTypeable #-} module FRP.Netwire.Utils.Timeline ( -- * Time lines for statistics wires Timeline, -- * Constructing time lines insert, singleton, union, -- * Linear sampling linAvg, linCutL, linCutR, linLookup, -- * Staircase sampling scAvg, scCutL, scCutR, scLookup ) where import Control.Applicative import Data.Data import Data.Map.Strict (Map) import qualified Data.Map.Strict as M -- | A time line is a non-empty set of samples together with time -- information. newtype Timeline t a = Timeline { timeline :: Map t a } deriving (Data, Eq, Ord, Read, Show, Typeable) instance Functor (Timeline t) where fmap f (Timeline m) = Timeline (M.map f m) -- | Insert the given data point. insert :: (Ord t) => t -> a -> Timeline t a -> Timeline t a insert t x (Timeline m) = Timeline (M.insert t x m) -- | Linearly interpolate the points in the time line, integrate the -- given time interval of the graph, divide by the interval length. linAvg :: (Fractional a, Fractional t, Real t) => t -> t -> Timeline t a -> a linAvg t0 t1 | t0 > t1 = const (error "linAvg: Invalid interval") | t0 == t1 = linLookup t0 linAvg t0 t1 = avg 0 . M.assocs . timeline . linCutR t1 . linCutL t0 where avg a' ((t', y1) : xs@((t, y2) : _)) = let dt = realToFrac (t - t') a = a' + dt*(y1 + y2)/2 in a `seq` avg a xs avg a' _ = a' / realToFrac (t1 - t0) -- | Cut the timeline at the given point in time @t@, such that all -- samples up to but not including @t@ are forgotten. The most recent -- sample before @t@ is moved and interpolated accordingly. linCutL :: (Fractional a, Fractional t, Real t) => t -> Timeline t a -> Timeline t a linCutL t tl@(Timeline m) = Timeline $ case M.splitLookup t m of (_, Just x, mr) -> M.insert t x mr (_, _, mr) -> M.insert t (linLookup t tl) mr -- | Cut the timeline at the given point in time @t@, such that all -- samples later than @t@ are forgotten. The most recent sample after -- @t@ is moved and interpolated accordingly. linCutR :: (Fractional a, Fractional t, Real t) => t -> Timeline t a -> Timeline t a linCutR t tl@(Timeline m) = Timeline $ case M.splitLookup t m of (ml, Just x, _) -> M.insert t x ml (ml, _, _) -> M.insert t (linLookup t tl) ml -- | Look up with linear sampling. linLookup :: (Fractional a, Fractional t, Real t) => t -> Timeline t a -> a linLookup t (Timeline m) = case M.splitLookup t m of (_, Just x, _) -> x (ml, _, mr) -> case (fst <$> M.maxViewWithKey ml, fst <$> M.minViewWithKey mr) of (Just (t1, x1), Just (t2, x2)) -> let f = realToFrac ((t - t1) / (t2 - t1)) in x1*(1 - f) + x2*f (Just (_, x), _) -> x (_, Just (_, x)) -> x _ -> error "linLookup: BUG: querying empty Timeline" -- | Integrate the given time interval of the staircase, divide by the -- interval length. scAvg :: (Fractional a, Real t) => t -> t -> Timeline t a -> a scAvg t0 t1 | t0 > t1 = const (error "scAvg: Invalid interval") | t0 == t1 = scLookup t0 scAvg t0 t1 = avg 0 . M.assocs . timeline . scCutR t1 . scCutL t0 where avg a' ((t', y) : xs@((t, _) : _)) = let dt = realToFrac (t - t') a = a' + dt*y in a `seq` avg a xs avg a' _ = a' / realToFrac (t1 - t0) -- | Cut the timeline at the given point in time @t@, such that all -- samples up to but not including @t@ are forgotten. The most recent -- sample before @t@ is moved accordingly. scCutL :: (Ord t) => t -> Timeline t a -> Timeline t a scCutL t tl@(Timeline m) = Timeline $ case M.splitLookup t m of (_, Just x, mr) -> M.insert t x mr (_, _, mr) -> M.insert t (scLookup t tl) mr -- | Cut the timeline at the given point in time @t@, such that all -- samples later than @t@ are forgotten. The earliest sample after @t@ -- is moved accordingly. scCutR :: (Ord t) => t -> Timeline t a -> Timeline t a scCutR t tl@(Timeline m) = Timeline $ case M.splitLookup t m of (ml, Just x, _) -> M.insert t x ml (ml, _, _) -> M.insert t (scLookup t tl) ml -- | Look up on staircase. scLookup :: (Ord t) => t -> Timeline t a -> a scLookup t (Timeline m) = case (M.lookupLE t m, M.lookupGE t m) of (Just (_, x), _) -> x (_, Just (_, x)) -> x _ -> error "linLookup: BUG: querying empty Timeline" -- | Singleton timeline with the given point. singleton :: t -> a -> Timeline t a singleton t = Timeline . M.singleton t -- | Union of two time lines. Right-biased. union :: (Ord t) => Timeline t a -> Timeline t a -> Timeline t a union (Timeline m1) (Timeline m2) = Timeline (M.union m2 m1) netwire-5.0.3/FRP/Netwire/Analyze.hs0000644000175000001440000002046713255605432017553 0ustar00neverusers00000000000000-- | -- Module: FRP.Netwire.Analyze -- Copyright: (c) 2013 Ertugrul Soeylemez -- License: BSD3 -- Maintainer: Ertugrul Soeylemez module FRP.Netwire.Analyze ( -- * Linear graphs lAvg, lGraph, lGraphN, -- * Staircase graphs sAvg, sGraph, sGraphN, -- * Peaks highPeak, highPeakBy, lowPeak, lowPeakBy, -- * Debug avgFps, framerate ) where import Control.Wire import qualified Data.Foldable as F import qualified Data.Sequence as Seq import qualified FRP.Netwire.Utils.Timeline as Tl import Prelude hiding ((.), id) -- | Average framerate over the last given number of samples. One -- important thing to note is that the value of this wire will generally -- disagree with 'sAvg' composed with 'framerate'. This is expected, -- because this wire simply calculates the arithmetic mean, whereas -- 'sAvg' will actually integrate the framerate graph. -- -- Note: This wire is for debugging purposes only, because it exposes -- discrete time. Do not taint your application with discrete time. -- -- * Complexity: O(n) time and space wrt number of samples. avgFps :: (RealFloat b, HasTime t s) => Int -- ^ Number of samples. -> Wire s e m a b avgFps int | int < 1 = error "avgFps: Non-positive number of samples" avgFps int = loop Seq.empty where intf = fromIntegral int afps = (/ intf) . F.foldl' (+) 0 loop ss' = mkSF $ \ds _ -> let fps = recip . realToFrac . dtime $ ds ss = Seq.take int (fps Seq.<| ss') in if isInfinite fps then (afps ss', loop ss') else ss `seq` (afps ss, loop ss) -- | Current framerate. -- -- Note: This wire is for debugging purposes only, because it exposes -- discrete time. Do not taint your application with discrete time. -- -- * Inhibits: when the clock stopped ticking. framerate :: (Eq b, Fractional b, HasTime t s, Monoid e) => Wire s e m a b framerate = mkPure $ \ds _ -> let dt = realToFrac (dtime ds) in (if dt == 0 then Left mempty else Right (recip dt), framerate) -- | High peak. -- -- * Depends: now. highPeak :: (Ord a) => Wire s e m a a highPeak = highPeakBy compare -- | High peak with respect to the given comparison function. -- -- * Depends: now. highPeakBy :: (a -> a -> Ordering) -> Wire s e m a a highPeakBy = peakBy GT -- | Calculate the average of the signal over the given interval (from -- now). This is done by calculating the integral of the corresponding -- linearly interpolated graph and dividing it by the interval length. -- See 'Tl.linAvg' for details. -- -- Linear interpolation can be slow. If you don't need it, you can use -- the staircase variant 'sAvg'. -- -- Example: @lAvg 2@ -- -- * Complexity: O(s) space, O(s) time wrt number of samples in the -- interval. -- -- * Depends: now. lAvg :: (Fractional a, Fractional t, HasTime t s) => t -- ^ Interval size. -> Wire s e m a a lAvg int = mkSF $ \ds x -> let t = dtime ds in (x, loop t (Tl.singleton t x)) where loop t' tl' = mkSF $ \ds x -> let t = t' + dtime ds t0 = t - int tl = Tl.linCutL t0 (Tl.insert t x tl') a = Tl.linAvg t0 t tl in (a, loop t tl) -- | Produce a linearly interpolated graph for the given points in time, -- where the magnitudes of the points are distances from /now/. -- -- Linear interpolation can be slow. If you don't need it, you can use -- the faster staircase variant 'sGraph'. -- -- Example: @lGraph [0, 1, 2]@ will output the interpolated inputs at -- /now/, one second before now and two seconds before now. -- -- * Complexity: O(s) space, O(n * log s) time, where s = number of -- samples in the interval, n = number of requested data points. -- -- * Depends: now. lGraph :: (Fractional a, Fractional t, HasTime t s) => [t] -- ^ Data points to produce. -> Wire s e m a [a] lGraph qts = mkSF $ \ds x -> let t = dtime ds in (x <$ qts, loop t (Tl.singleton t x)) where earliest = maximum (map abs qts) loop t' tl' = mkSF $ \ds x -> let t = t' + dtime ds tl = Tl.linCutL (t - earliest) (Tl.insert t x tl') ps = map (\qt -> Tl.linLookup (t - abs qt) tl) qts in (ps, loop t tl) -- | Graph the given interval from now with the given number of evenly -- distributed points in time. Convenience interface to 'lGraph'. -- -- Linear interpolation can be slow. If you don't need it, you can use -- the faster staircase variant 'sGraphN'. -- -- * Complexity: O(s) space, O(n * log s) time, where s = number of -- samples in the interval, n = number of requested data points. -- -- * Depends: now. lGraphN :: (Fractional a, Fractional t, HasTime t s) => t -- ^ Interval to graph from now. -> Int -- ^ Number of data points to produce. -> Wire s e m a [a] lGraphN int n | int <= 0 = error "lGraphN: Non-positive interval" | n <= 0 = error "lGraphN: Non-positive number of data points" lGraphN int n = let n1 = n - 1 f qt = realToFrac int * fromIntegral qt / fromIntegral n1 in lGraph (map f [0..n1]) -- | Low peak. -- -- * Depends: now. lowPeak :: (Ord a) => Wire s e m a a lowPeak = lowPeakBy compare -- | Low peak with respect to the given comparison function. -- -- * Depends: now. lowPeakBy :: (a -> a -> Ordering) -> Wire s e m a a lowPeakBy = peakBy LT -- | Given peak with respect to the given comparison function. peakBy :: (Eq o) => o -- ^ This ordering means the first argument is larger. -> (a -> a -> o) -- ^ Compare two elements. -> Wire s e m a a peakBy o comp = mkSFN $ \x -> (x, loop x) where loop x' = mkSFN $ \x -> id &&& loop $ if comp x x' == o then x else x' -- | Calculate the average of the signal over the given interval (from -- now). This is done by calculating the integral of the corresponding -- staircase graph and dividing it by the interval length. See -- 'Tl.scAvg' for details. -- -- See also 'lAvg'. -- -- Example: @sAvg 2@ -- -- * Complexity: O(s) space, O(s) time wrt number of samples in the -- interval. -- -- * Depends: now. sAvg :: (Fractional a, Fractional t, HasTime t s) => t -- ^ Interval size. -> Wire s e m a a sAvg int = mkSF $ \ds x -> let t = dtime ds in (x, loop t (Tl.singleton t x)) where loop t' tl' = mkSF $ \ds x -> let t = t' + dtime ds t0 = t - int tl = Tl.scCutL t0 (Tl.insert t x tl') a = Tl.scAvg t0 t tl in (a, loop t tl) -- | Produce a staircase graph for the given points in time, where the -- magnitudes of the points are distances from /now/. -- -- See also 'lGraph'. -- -- Example: @sGraph [0, 1, 2]@ will output the inputs at /now/, one -- second before now and two seconds before now. -- -- * Complexity: O(s) space, O(n * log s) time, where s = number of -- samples in the interval, n = number of requested data points. -- -- * Depends: now. sGraph :: (Fractional t, HasTime t s) => [t] -- ^ Data points to produce. -> Wire s e m a [a] sGraph qts = mkSF $ \ds x -> let t = dtime ds in (x <$ qts, loop t (Tl.singleton t x)) where earliest = maximum (map abs qts) loop t' tl' = mkSF $ \ds x -> let t = t' + dtime ds tl = Tl.scCutL (t - earliest) (Tl.insert t x tl') ps = map (\qt -> Tl.scLookup (t - abs qt) tl) qts in (ps, loop t tl) -- | Graph the given interval from now with the given number of evenly -- distributed points in time. Convenience interface to 'sGraph'. -- -- See also 'lGraphN'. -- -- * Complexity: O(s) space, O(n * log s) time, where s = number of -- samples in the interval, n = number of requested data points. -- -- * Depends: now. sGraphN :: (Fractional t, HasTime t s) => t -- ^ Interval to graph from now. -> Int -- ^ Number of data points to produce. -> Wire s e m a [a] sGraphN int n | int <= 0 = error "sGraphN: Non-positive interval" | n <= 0 = error "sGraphN: Non-positive number of data points" sGraphN int n = let n1 = n - 1 f qt = realToFrac int * fromIntegral qt / fromIntegral n1 in sGraph (map f [0..n1]) netwire-5.0.3/FRP/Netwire/Move.hs0000644000175000001440000000402713255605432017050 0ustar00neverusers00000000000000-- | -- Module: FRP.Netwire.Move -- Copyright: (c) 2013 Ertugrul Soeylemez -- License: BSD3 -- Maintainer: Ertugrul Soeylemez module FRP.Netwire.Move ( -- * Calculus derivative, integral, integralWith ) where import Control.Wire -- | Time derivative of the input signal. -- -- * Depends: now. -- -- * Inhibits: at singularities. derivative :: (RealFloat a, HasTime t s, Monoid e) => Wire s e m a a derivative = mkPure $ \_ x -> (Left mempty, loop x) where loop x' = mkPure $ \ds x -> let dt = realToFrac (dtime ds) dx = (x - x') / dt mdx | isNaN dx = Right 0 | isInfinite dx = Left mempty | otherwise = Right dx in mdx `seq` (mdx, loop x) -- | Integrate the input signal over time. -- -- * Depends: before now. integral :: (Fractional a, HasTime t s) => a -- ^ Integration constant (aka start value). -> Wire s e m a a integral x' = mkPure $ \ds dx -> let dt = realToFrac (dtime ds) in x' `seq` (Right x', integral (x' + dt*dx)) -- | Integrate the left input signal over time, but apply the given -- correction function to it. This can be used to implement collision -- detection/reaction. -- -- The right signal of type @w@ is the /world value/. It is just passed -- to the correction function for reference and is not used otherwise. -- -- The correction function must be idempotent with respect to the world -- value: @f w (f w x) = f w x@. This is necessary and sufficient to -- protect time continuity. -- -- * Depends: before now. integralWith :: (Fractional a, HasTime t s) => (w -> a -> a) -- ^ Correction function. -> a -- ^ Integration constant (aka start value). -> Wire s e m (a, w) a integralWith correct = loop where loop x' = mkPure $ \ds (dx, w) -> let dt = realToFrac (dtime ds) x = correct w (x' + dt*dx) in x' `seq` (Right x', loop x) netwire-5.0.3/FRP/Netwire/Noise.hs0000644000175000001440000000517513255605432017224 0ustar00neverusers00000000000000-- | -- Module: FRP.Netwire.Noise -- Copyright: (c) 2013 Ertugrul Soeylemez -- License: BSD3 -- Maintainer: Ertugrul Soeylemez module FRP.Netwire.Noise ( -- * Noise generators noise, noiseR, wackelkontakt, -- * Convenience stdNoise, stdNoiseR, stdWackelkontakt ) where import Control.Wire import Prelude hiding ((.), id) import System.Random -- | Noise events with the given distance between events. Use 'hold' or -- 'holdFor' to generate a staircase. noise :: (HasTime t s, Random b, RandomGen g) => t -- ^ Time period. -> g -- ^ Random number generator. -> Wire s e m a (Event b) noise int | int <= 0 = error "noise: Non-positive interval" noise int = periodicList int . randoms -- | Noise events with the given distance between events. Noise will be -- in the given range. Use 'hold' or 'holdFor' to generate a staircase. noiseR :: (HasTime t s, Random b, RandomGen g) => t -- ^ Step duration. -> (b, b) -- ^ Noise range. -> g -- ^ Random number generator. -> Wire s e m a (Event b) noiseR int _ | int <= 0 = error "noiseR: Non-positive interval" noiseR int r = periodicList int . randomRs r -- | Convenience interface to 'noise' for 'StdGen'. stdNoise :: (HasTime t s, Random b) => t -- ^ Step duration. -> Int -- ^ 'StdGen' seed. -> Wire s e m a (Event b) stdNoise int = noise int . mkStdGen -- | Convenience interface to 'noiseR' for 'StdGen'. stdNoiseR :: (HasTime t s, Monad m, Random b) => t -- ^ Step duration. -> (b, b) -- ^ Noise range. -> Int -- ^ 'StdGen' seed. -> Wire s e m a (Event b) stdNoiseR int r = noiseR int r . mkStdGen -- | Convenience interface to 'wackelkontakt' for 'StdGen'. stdWackelkontakt :: (HasTime t s, Monad m, Monoid e) => t -- ^ Step duration. -> Double -- ^ Probability to produce. -> Int -- ^ 'StdGen' seed. -> Wire s e m a a stdWackelkontakt int p = wackelkontakt int p . mkStdGen -- | Randomly produce or inhibit with the given probability, each time -- for the given duration. -- -- The name /Wackelkontakt/ (German for /slack joint/) is a Netwire -- running gag. It makes sure that you revisit the documentation from -- time to time. =) -- -- * Depends: now. wackelkontakt :: (HasTime t s, Monad m, Monoid e, RandomGen g) => t -- ^ Duration. -> Double -- ^ Probability to produce. -> g -- ^ Random number generator. -> Wire s e m a a wackelkontakt int _ _ | int <= 0 = error "wackelkontakt: Non-positive duration" wackelkontakt int p g = fmap snd $ when (< p) . hold . noise int g &&& id netwire-5.0.3/FRP/Netwire.hs0000644000175000001440000000212513255605432016137 0ustar00neverusers00000000000000-- | -- Module: FRP.Netwire -- Copyright: (c) 2013 Ertugrul Soeylemez -- License: BSD3 -- Maintainer: Ertugrul Soeylemez module FRP.Netwire ( -- * Netwire reexports Wire, WireP, SimpleWire, delay, evalWith, force, forceNF, module Control.Wire.Event, module Control.Wire.Interval, module Control.Wire.Run, module Control.Wire.Session, module Control.Wire.Switch, module Control.Wire.Time, -- * Additional wires module FRP.Netwire.Analyze, module FRP.Netwire.Move, module FRP.Netwire.Noise, -- * External module Control.Applicative, module Control.Arrow, module Control.Category, module Data.Semigroup ) where import Control.Applicative import Control.Arrow import Control.Category import Control.Wire import Control.Wire.Event import Control.Wire.Interval import Control.Wire.Run import Control.Wire.Session import Control.Wire.Switch import Control.Wire.Time import Data.Semigroup import FRP.Netwire.Analyze import FRP.Netwire.Move import FRP.Netwire.Noise netwire-5.0.3/LICENSE0000644000175000001440000000300413255605432014541 0ustar00neverusers00000000000000Netwire license Copyright (c) 2014, Ertugrul Soeylemez All rights reserved. Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are met: * Redistributions of source code must retain the above copyright notice, this list of conditions and the following disclaimer. * Redistributions in binary form must reproduce the above copyright notice, this list of conditions and the following disclaimer in the documentation and/or other materials provided with the distribution. * Neither the name of the author nor the names of any contributors may be used to endorse or promote products derived from this software without specific prior written permission. THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. netwire-5.0.3/Setup.lhs0000644000175000001440000000013213255605432015343 0ustar00neverusers00000000000000> module Main where > > import Distribution.Simple > > main :: IO () > main = defaultMain netwire-5.0.3/netwire.cabal0000644000175000001440000000420413255605432016200 0ustar00neverusers00000000000000name: netwire version: 5.0.3 category: FRP synopsis: Functional reactive programming library maintainer: Ertugrul Söylemez author: Ertugrul Söylemez copyright: Copyright 2016 Ertugrul Söylemez homepage: https://github.com/esoeylemez/netwire bug-reports: https://github.com/esoeylemez/netwire/issues license: BSD3 license-file: LICENSE description: This library provides interfaces for and implements wire arrows useful both for functional reactive programming (FRP) and locally stateful programming (LSP). build-type: Simple cabal-version: >= 1.10 extra-source-files: CHANGELOG.md README.md source-repository head type: git location: https://github.com/esoeylemez/netwire.git -- flag Examples -- default: False -- description: Build the example programs -- manual: True library build-depends: base >= 4.5 && < 5, containers >= 0.5 && < 1, deepseq >= 1.3 && < 2, parallel >= 3.2 && < 4, profunctors >= 4.3 && < 6, random >= 1.1 && < 2, semigroups >= 0.15 && < 1, transformers >= 0.3 && < 1, time >= 1.4 && < 2 default-language: Haskell2010 if impl(ghc >= 7.10.1) ghc-options: -W -fdefer-typed-holes else ghc-options: -W exposed-modules: Control.Wire Control.Wire.Core Control.Wire.Event Control.Wire.Interval Control.Wire.Run Control.Wire.Session Control.Wire.Switch Control.Wire.Time Control.Wire.Unsafe.Event FRP.Netwire FRP.Netwire.Analyze FRP.Netwire.Move FRP.Netwire.Noise FRP.Netwire.Utils.Timeline -- executable netwire-test -- build-depends: -- base >= 4.5 && < 5, -- containers, -- netwire -- default-language: Haskell2010 -- default-extensions: -- Arrows -- OverloadedStrings -- RecursiveDo -- ghc-options: -threaded -- hs-source-dirs: test -- main-is: Test.hs -- if !flag(testprogram) -- buildable: False netwire-5.0.3/CHANGELOG.md0000644000175000001440000000056213255605432015353 0ustar00neverusers00000000000000# 5.0.3: Maintenance release * Fixed constraints for Semigroup-Monoid-Proposal * Fixed flags for older GHCs Contributors: * [Pavel Krajcevski](https://github.com/Mokosha) # 5.0.2: Maintenance release * Moved to Git and GitHub. * Relaxed profunctors dependency (finally). * Moved language extensions into the individual modules. * Minor style changes. netwire-5.0.3/README.md0000644000175000001440000004072413255605432015025 0ustar00neverusers00000000000000Netwire ======= Netwire is a functional reactive programming (FRP) library with signal inhibition. It implements three related concepts, *wires*, *intervals* and *events*, the most important of which is the *wire*. To work with wires we will need a few imports: ``` haskell import FRP.Netwire import Prelude hiding ((.), id) ``` The `FRP.Netwire` module exports the basic types and helper functions. It also has some convenience reexports you will pretty much always need when working with wires, including `Control.Category`. This is why we need the explicit `Prelude` import. In general wires are generalized automaton arrows, so you can express many design patterns using them. The `FRP.Netwire` module provides a proper FRP framework based on them, which strictly respects continuous time and discrete event semantics. When developing a framework based on Netwire, e.g. a GUI library or a game engine, you may want to import `Control.Wire` instead. Introduction ------------ The following type is central to the entire library: ``` haskell data Wire s e m a b ``` Don't worry about the large number of type arguments. They all have very simple meanings, which will be explained below. A value of this type is called a *wire* and represents a *reactive* value of type `b`, that is a value that may change over time. It may depend on a reactive value of type `a`. In a sense a wire is a function from a reactive value of type `a` to a reactive value of type `b`, so whenever you see something of type `Wire s e m a b` your mind should draw an arrow from `a` to `b`. In FRP terminology a reactive value is called a *behavior*. A constant reactive value can be constructed using `pure`: ``` haskell pure 15 ``` This wire is the reactive value 15. It does not depend on other reactive values and does not change over time. This suggests that there is an applicative interface to wires, which is indeed the case: ``` haskell liftA2 (+) (pure 15) (pure 17) ``` This reactive value is the sum of two reactive values, each of which is just a constant, 15 and 17 respectively. So this is the constant reactive value 32. Let's spell out its type: ``` haskell myWire :: (Monad m, Num b) => Wire s e m a b myWire = liftA2 (+) (pure 15) (pure 17) ``` This indicates that `m` is some kind of underlying monad. As an application developer you don't have to concern yourself much about it. Framework developers can use it to allow wires to access environment values through a reader monad or to produce something (like a GUI) through a writer monad. The wires we have seen so far are rather boring. Let's look at a more interesting one: ``` haskell time :: (HasTime t s) => Wire s e m a t ``` This wire represents the current local time, which starts at zero when execution begins. It does not make any assumptions about the time type other than that it is a numeric type with a `Real` instance. This is enforced implicitly by the `HasTime` constraint. The type of this wire gives some insight into the `s` parameter. Wires are generally pure and do not have access to the system clock or other run-time information. The timing information has to come from outside and is passed to the wire through a value of type `s`, called the *state delta*. We will learn more about this in the next section about executing wires. Since there is an applicative interface you can also apply `fmap` to a wire to apply a function to its value: ``` haskell fmap (2*) time ``` This reactive value is a clock that is twice as fast as the regular local time clock. If you use system time as your clock, then the time type `t` will most likely be `NominalDiffTime` from `Data.Time.Clock`. However, you will usually want to have time of type `Double` or some other floating point type. There is a predefined wire for this: ``` haskell timeF :: (Fractional b, HasTime t s, Monad m) => Wire s e m a b timeF = fmap realToFrac time ``` If you think of reactive values as graphs with the horizontal axis representing time, then the `time` wire is just a straight diagonal line and constant wires (constructed by `pure`) are just horizontal lines. You can use the applicative interface to perform arithmetic on them: ``` haskell liftA2 (\t c -> c - 2*t) time (pure 60) ``` This gives you a countdown clock that starts at 60 and runs twice as fast as the regular clock. So it after two seconds its value will be 56, decreasing by 2 each second. Testing wires ------------- Enough theory, we wanna see some performance now! Let's write a simple program to test a constant (`pure`) wire: ``` haskell import Control.Wire import Prelude hiding ((.), id) wire :: (Monad m) => Wire s () m a Integer wire = pure 15 main :: IO () main = testWire (pure ()) wire ``` This should just display the value 15. Abort the program by pressing Ctrl-C. The `testWire` function is a convenience to examine wires. It just executes the wire and continuously prints its value to stdout: ``` haskell testWire :: (MonadIO m, Show b, Show e) => Session m s -> (forall a. Wire s e Identity a b) -> m c ``` The type signatures in Netwire are known to be scary. =) But like most of the library the underlying meaning is actually very simple. Conceptually the wire is run continuously step by step, at each step increasing its local time slightly. This process is traditionally called *stepping*. As an FRP developer you assume a continuous time model, so you don't observe this stepping process from the point of view of your reactive application, but it can be useful to know that wire execution is actually a discrete process. The first argument of `testWire` needs some explanation. It is a recipe for state deltas. In the above example we have just used `pure ()`, meaning that we don't use anything stateful from the outside world, particularly we don't use a clock. From the type signature it is also clear that this sets `s = ()`. The second argument is the wire to run. The input type is quantified meaning that it needs to be polymorphic in its input type. In other words it means that the wire does not depend on any other reactive value. The underlying monad is `Identity` with the obvious meaning that this wire cannot have any monadic effects. The following application just displays the number of seconds passed since program start (with some subsecond precision): ``` haskell wire :: (HasTime t s) => Wire s () m a t wire = time main :: IO () main = testWire clockSession_ wire ``` Since this time the wire actually needs a clock we use `clockSession_` as the second argument: ``` haskell clockSession_ :: (Applicative m, MonadIO m) => Session m (Timed NominalDiffTime ()) ``` It will instantiate `s` to be `Timed NominalDiffTime ()`. This type indeed has a `HasTime` instance with `t` being `NominalDiffTime`. In simpler words it provides a clock to the wire. At first it may seem weird to use `NominalDiffTime` instead of something like `UTCTime`, but this is reasonable, because time is relative to the wire's start time. Also later in the section about switching we will see that a wire does not necessarily start when the program starts. Constructing wires ------------------ Now that we know how to test wires we can start constructing more complicated wires. First of all it is handy that there are many convenience instances, including `Num`. Instead of `pure 15` we can simply write `15`. Also instead of ``` haskell liftA2 (+) time (pure 17) ``` we can simply write: ``` haskell time + 17 ``` This clock starts at 17 instead of zero. Let's make it run twice as fast: ``` haskell 2*time + 17 ``` If you have trouble wrapping your head around such an expression it may help to read `a*b + c` mathematically as `a(t)*b(t) + c(t)` and read `time` as simply `t`. So far we have seen wires that ignore their input. The following wire uses its input: ``` haskell integral 5 ``` It literally integrates its input value with respect to time. Its argument is the integration constant, i.e. the start value. To supply an input simply compose it: ``` haskell integral 5 . 3 ``` Remember that `3` really means `pure 3`, a constant wire. The integral of the constant 3 is `3*t + c` and here `c = 5`. Here is another example: ``` haskell integral 5 . time ``` Since `time` denotes `t` the integral will be `t^2/2 + c`, again with `c = 5`. This may sound like a complicated, sophisticated wire, but it's really not. Surprisingly there is no crazy algebra or complicated numerical algorithm going on under the hood. Integrating over time requires one addition and one division each frame. So there is nothing wrong with using it extensively to animate a scene or to move objects in a game. Sometimes categorical composition and the applicative interface can be inconvenient, in which case you may choose to use the arrow interface. The above integration can be expressed the following way: ``` haskell proc _ -> do t <- time -< () integral 5 -< t ``` Since `time` ignores its input signal, we just give it a constant signal with value `()`. We name time's value `t` and pass it as the input signal to `integral`. Intervals --------- Wires may choose to produce a signal only for a limited amount of time. We refer to those wires as intervals. When a wire does not produce, then it *inhibits*. Example: ``` haskell for 3 ``` This wire acts like the identity wire in that it passes its input signal through unchanged: ``` haskell for 3 . "yes" ``` The signal of this wire will be "yes", but after three seconds it will stop to act like the identity wire and will inhibit forever. When you use `testWire` inhibition will be displayed as "I:" followed by a value, the *inhibition value*. This is what the `e` parameter to `Wire` is. It's called the *inhibition monoid*: ``` haskell for :: (HasTime t s, Monoid e) => t -> Wire s e m a a ``` As you can see the input and output types are the same and fully polymorphic, hinting at the identity-like behavior. All predefined intervals inhibit with the `mempty` value. When the wire inhibits, you don't get a signal of type `a`, but rather an inhibition value of type `e`. Netwire does not interpret this value in any way and in most cases you would simply use `e = ()`. Intervals give you a very elegant way to combine wires: ``` haskell for 3 . "yes" <|> "no" ``` This wire produces "yes" for three seconds. Then the wire to the left of `<|>` will stop producing, so `<|>` will use the wire to its right instead. You can read the operator as a left-biased "or". The signal of the wire `w1 <|> w2` will be the signal of the leftmost component wire that actually produced a signal. There are a number of predefined interval wires. The above signal can be written equivalently as: ``` haskell after 3 . "no" <|> "yes" ``` The left wire will inhibit for the first three seconds, so during that interval the right wire is chosen. After that, as suggested by its name, the `after` wire starts acting like the identity wire, so the left side takes precedence. Once the time period has passed the `after` wire will produce forever, leaving the "yes" wire never to be reached again. However, you can easily combine intervals: ``` haskell after 5 . for 6 . "Blip!" <|> "Look at me..." ``` The left wire will produce after five seconds from the beginning for six seconds from the beginning, so effectively it will produce for one second. When you animate this wire, you will see the string "Look at me..." for five seconds, then you will see "Blip!" for one second, then finally it will go back to "Look at me..." and display that one forever. Events ------ Events are things that happen at certain points in time. Examples include button presses, network packets or even just reaching a certain point in time. As such they can be thought of as lists of values together with their occurrence times. Events are actually first class signals of the `Event` type: ``` haskell data Event a ``` For example the predefined `never` event is the event that never occurs: ``` haskell never :: Wire s e m a (Event b) ``` As suggested by the type events contain a value. Netwire does not export the constructors of the `Event` type by default. If you are a framework developer you can import the `Control.Wire.Unsafe.Event` module to implement your own events. A game engine may include events for key presses or certain things happening in the scene. However, as an application developer you should view this type as being opaque. This is necessary in order to protect continuous time semantics. You cannot access event values directly. There are a number of ways to respond to an event. The primary way to do this in Netwire is to turn events into intervals. There are a number of predefined wires for that purpose, for example `asSoonAs`: ``` haskell asSoonAs :: (Monoid e) => Wire s e m (Event a) a ``` This wire takes an event signal as its input. Initially it inhibits, but as soon as the event occurs for the first time, it produces the event's last value forever. The `at` event will occur only once after the given time period has passed: ``` haskell at :: (HasTime t s) => t -> Wire s e m a (Event a) ``` Example: ``` haskell at 3 . "blubb" ``` This event will occur after three seconds, and the event's value will be "blubb". Using `asSoonAs` we can turn this into an interval: ``` haskell asSoonAs . at 3 . "blubb" ``` This wire will inhibit for three seconds and then start producing. It will produce the value "blubb" forever. That's the event's last value after three seconds, and it will never change, because the event does not occur ever again. Here is an example that may be more representative of that property: ``` haskell asSoonAs . at 3 . time ``` This wire inhibits for three seconds, then it produces the value 3 (or a value close to it) forever. Notice that this is not a clock. It does not produce the current time, but the `time` at the point in time when the event occurred. To combine multiple events there are a number of options. In principle you should think of event values to form a semigroup (of your choice), because events can occur simultaneously. However, in many cases the actual value of the event is not that interesting, so there is an easy way to get a left- or right-biased combination: ``` haskell (at 2 <& at 3) . time ``` This event occurs two times, namely once after two seconds and once after three seconds. In each case the event value will be the occurrence time. Here is an interesting case: ``` haskell at 2 . "blah" <& at 2 . "blubb" ``` These events will occur simultaneously. The value will be "blah", because `<&` means left-biased combination. There is also `&>` for right-biased combination. If event values actually form a semigroup, then you can just use monoidal composition: ``` haskell at 2 . "blah" <> at 2 . "blubb" ``` Again these events occur at the same time, but this time the event value will be "blahblubb". Note that you are using two Monoid instances and one Semigroup instance here. If the signals of two wires form a monoid, then wires themselves form a monoid: ``` haskell w1 <> w2 = liftA2 (<>) w1 w2 ``` There are many predefined event-wires and many combinators for manipulating events in the `Control.Wire.Event` module. A common events is the `now` event: ``` haskell now :: Wire s e m a (Event a) ``` This event occurs once at the beginning. Switching --------- We still lack a meaningful way to respond to events. This is where *switching* comes in, sometimes also called *dynamic switching*. The most important combinator for switching is `-->`: ``` haskell w1 --> w2 ``` The idea is really straightforward: This wire acts like `w1` as long as it produces. As soon as it stops producing it is discarded and `w2` takes its place. Example: ``` haskell for 3 . "yes" --> "no" ``` In this case the behavior will be the same as in the *intervals* section, but with two major differences: Firstly when the first interval ends, it is completely discarded and garbage-collected, never to be seen again. Secondly and more importantly the point in time of switching will be the beginning for the new wire. Example: ``` haskell for 3 . time --> time ``` This wire will show a clock counting to three seconds, then it will start over from zero. This is why we usually refer to time as *local time*. Recursion is fully supported. Here is a fun example: ``` haskell netwireIsCool = for 2 . "Once upon a time..." --> for 3 . "... games were completely imperative..." --> for 2 . "... but then..." --> for 10 . ("Netwire 5! " <> anim) --> netwireIsCool where anim = holdFor 0.5 . periodic 1 . "Hoo..." <|> "...ray!" ```