packages feed

netwire 4.0.7 → 5.0.0

raw patch · 43 files changed

+2756/−3380 lines, 43 filesdep +netwiredep +paralleldep +transformersdep −bifunctorsdep −lifted-basedep −monad-controldep ~basedep ~containersdep ~semigroupssetup-changednew-component:exe:netwire-test

Dependencies added: netwire, parallel, transformers

Dependencies removed: bifunctors, lifted-base, monad-control, mtl, profunctors, tagged, vector-space

Dependency ranges changed: base, containers, semigroups

Files

Control/Wire.hs view
@@ -1,351 +1,53 @@ -- | -- Module:     Control.Wire--- Copyright:  (c) 2012 Ertugrul Soeylemez+-- Copyright:  (c) 2013 Ertugrul Soeylemez -- License:    BSD3 -- Maintainer: Ertugrul Soeylemez <es@ertes.de>------ Netwire is a library for functional reactive programming, that is for--- time-varying values.  It allows you to express various reactive--- systems elegantly and concisely by using an embedded domain-specific--- language.  Examples of such systems include------ * games,------ * network applications with time-varying components,------ * simulations,------ * stateful web applications,------ * widget-based user interfaces.------ This library is based on an extension of the automaton arrow.  The--- usage is explained in the following tutorial.  module Control.Wire-    ( -- * Quickstart tutorial-      -- $quickstart_intro--      -- ** Running wires-      -- $quickstart_running--      -- ** Constructing wires-      -- $quickstart_constructing--      -- ** Signal inhibition and events-      -- $quickstart_inhibition--      -- ** Custom wires-      -- $quickstart_custom--      -- * Netwire reexports-      module Control.Wire.Classes,-      module Control.Wire.Prefab,+    ( -- * Reexports+      module Control.Wire.Core,+      module Control.Wire.Event,+      module Control.Wire.Interval,+      module Control.Wire.Run,       module Control.Wire.Session,-      module Control.Wire.Trans,-      module Control.Wire.Types,-      module Control.Wire.Wire,+      module Control.Wire.Switch,+      module Control.Wire.Time, -      -- * Other reexports+      -- * Convenient type aliases+      WireP,+      SimpleWire,++      -- * External       module Control.Applicative,       module Control.Arrow,       module Control.Category,-      module Data.Proxy,-      module System.Random,-      Profunctor(..),-      Exception(..),-      SomeException(..)+      module Data.Semigroup,+      Identity(..),+      NominalDiffTime     )     where  import Control.Applicative import Control.Arrow import Control.Category-import Control.Exception (Exception(..), SomeException(..))-import Control.Wire.Classes-import Control.Wire.Prefab+import Control.Wire.Core+import Control.Wire.Event+import Control.Wire.Interval+import Control.Wire.Run import Control.Wire.Session-import Control.Wire.Trans-import Control.Wire.Types-import Control.Wire.Wire hiding (constant, identity, never)-import Data.Profunctor-import Data.Proxy (Proxy(..))-import System.Random---{- $quickstart_intro--This section is a quickstart tutorial for the experienced, impatient-Haskell programmer.--The main concept used in Netwire is a family of /wire categories/:--> data Wire e m a b--A value of type @Wire e m a b@ represents a function that takes as-arguments--* a time delta of type 'Time' (which is just 'Double') that will be-  explained below,--* an input value of type @a@.--From these inputs it--* either produces an output value of type @b@ or /inhibits/ with a value-  of type @e@,--* produces a new wire of type @Wire e m a b@.--So you can think of 'Wire' as:--> newtype Wire e m a b =->     Wire {->       stepWire :: Time -> a -> m (Either e b, Wire e m a b)->     }--To summarize a wire of type @Wire e m a b@ takes a value of type @a@ and-supposedly produces a value of type @b@.  It can be invoked multiple-times, where each invocation is called an /instant/ and the wire can-behave differently at every instant.  Additionally it can choose not to-produce anything, but instead inhibit with an /inhibition exception/ of-type @e@.  This is Netwire's notion of a time-varying value.  -}---{- $quickstart_running--To actually invoke a wire you can use the 'stepWire' function-(simplified type):--> stepWire ::->     (Monad m) =>->     Wire e m a b ->->     Time ->->     a ->->     m (Either e b, Wire e m a b)--The idea is simple:  You have an application loop that invokes a given-wire with a time delta, which is just the number of seconds passed since-the last instant and an application-specific input value.  It then does-something with the output value (or inhibition value) and restarts the-loop with the new wire produced by the current wire.  Such an-application loop based on @stepWire@ could look like this:--> loop w' = do->     dt <- timeDeltaToLastInstant->     (mx, w) <- stepWire w' dt ()->     case mx of->       Left ex -> printf "Inhibited: %s\n" (show ex)->       Right x -> printf "Produced: %s\n" (show x)->     loop w--Usually the time deltas are based on actual clock time.  To simplify-invocation for this common case there is a set of convenience functions-like 'stepSession' for stepping that calculate the time deltas for you:--> stepSession ::->     (Monad m) =>->     Wire e m a b ->->     Session m ->->     a ->->     m (Either e b, Wire e m a b, Session m)--To construct the initial session value you can use 'clockSession' or one-of the other predefined intial session values:--> clockSession :: (MonadIO m) => Session m--This simplifies the application loop, because you don't have to-calculate the time deltas yourself:--> loop w' session' = do->     (mx, w, session) <- stepSession w' session' ()->     case mx of->       Left ex -> printf "Inhibited: %s\n" (show ex)->       Right x -> printf "Produced: %s\n" (show x)->     loop w session--For the common case where the wire's underlying monad is 'Identity', but-the application monad is something else, there are convenience functions-like 'stepWireP', 'stepSessionP' and other @*P@ variants.--We haven't covered constructing wires yet.  This is explained in the-next section.  But we now have everything necessary to write our first-small application:--> module Main where->-> import Control.Monad.Identity (Identity)-> import Control.Wire-> import Prelude hiding ((.), id)-> import Text.Printf->-> testApp :: Wire () Identity a Time-> testApp = timeFrom 10->-> main :: IO ()-> main = loop testApp clockSession->     where->     loop w' session' = do->         (mx, w, session) <- stepSessionP w' session' ()->         case mx of->           Left ex -> putStrLn ("Inhibited: " ++ show ex)->           Right x -> putStrLn ("Produced: " ++ show x)->         loop w session--When you run this program, it will continuously display a number of-seconds starting with 10.  That's the @timeFrom 10@ wire.  Notice that-the "Prelude" module is imported with hidden 'Prelude..' and-'Prelude.id'.  Don't worry, the "Control.Wire" module reexports the-"Control.Category" module, which includes generalized version of both.--}---{- $quickstart_constructing--A number of convenience types are defined in the "Control.Wire.Types"-module, in particular the 'WireP' type:--> type WireP = Wire LastException Identity--Wires can be composed categorically, applicatively or by using wire-combinators.  To feed the output of one wire @w1@ into another wire @w2@-you just use categorical composition:--> w2 . w1--For example the 'noise' wire generates random noise based on the given-random number generator.  If its output type is 'Double', it generates-noise 0 <= x t < 1.  The 'avg' wire calculates the average value of its-input over the last given number of samples:--> let myNoise = noise (mkStdGen 0) :: WireP a Double->     myAvg   = avg 1000-> in myAvg . myNoise--That wire should produce values near 0.5, the average noise value over-the last 1000 samples of random noise between 0 and 1.  There is a bit-of cruft here to tell the type system that noise's output type is-'Double'.  To make this easier you can simply use 'outAs' or 'inAs':--> avg 1000 . outAs pDouble (noise (mkStdGen 0))--The 'Wire' type gives rise to a family of applicative functors.  Using-applicative style you can apply a function to the output of a wire or-zip together the outputs of two wires (the "Control.Applicative" module-is reexported by this module):--> timeString = fmap (printf "%8.2f") time->-> noisyTime = liftA2 (+) time (noise (mkStdGen 0))--Constant wires can be produced using 'pure'.  The following wire starts-at 0 and increases with a constant speed of 3:--> integral_ 0 . pure 3--There are lots of convenience instances for wires.  For example there-are instances for 'Num', 'Fractional' and 'Data.String.IsString', so you-can actually just use regular arithmetical operators and numeric-literals.  If you have enabled the @OverloadedStrings@ extension you can-also write string literals:--> let n = noise (mkStdGen 0)-> in time + 3*n->-> integral_ 0 . 3--There is a large library of predefined wires below the-"Control.Wire.Prefab" tree.--}+import Control.Wire.Switch+import Control.Wire.Time+import Data.Functor.Identity+import Data.Semigroup+import Data.Time.Clock  -{- $quickstart_inhibition--As noted a few times wires can choose not to produce a value.  In those-cases the wire /inhibits/ the signal.  This is where the @e@ type comes-into play.  That type is called the /inhibition monoid/.--Signal inhibition is what makes Netwire different.  The 'Wire' type is-an 'Alternative' functor, where the 'empty' wire always inhibits and-wires can be combined with the following semantics:--> w1 <|> w2--If @w1@ inhibits, then the combination @w1 \<|\> w2@ acts like @w2@.  In-other words, the combination chooses the first wire that produces.  If-both inhibit, then the combination inhibits.--Events are modelled around this.  An event wire is usually a wire that-acts like the identity wire, but it may inhibit depending on whether an-event has occurred or not.  One simple event wire is the 'for' wire:--> for 3--This wire acts like the identity wire for three seconds and then stops-producing forever.  You can use it to construct a wire that produces-"yes" for three seconds and then switches to "no":--> "yes" . for 3 <|> "no"--Another useful event wire is the 'wackelkontakt' wire (a Netwire running-gag; it's the German word for slack joint):--> wackelkontakt 0.9--This wire acts like the identity wire most of the time (90%), but-occasionally inhibits (10%).  Using it you can produce a broken clock,-which occasionally refuses to display the current time:--> brokenClock =->     printf "%8.2f" <$> wackelkontakt 0.9 . time <|>->     "sorry, slack joint"--The 'periodically' wire produces once every given number of seconds.-The following wire produces once every two seconds:--> periodically 2--There are various combinators for event wires in the-"Control.Wire.Trans.Event" module, most notably 'hold' and 'holdFor'.-Given an inhibiting wire the @hold@ combinator holds the last produced-value, so it turns instantaneous events into continuous ones:--> secondClock = printf "%8.2f" <$> hold (periodically 1 . time)--This one displays the time in seconds and is only updated every second.-The 'holdFor' combinator allows you to limit the time the last output is-held for:--> jumpyClock =->     printf "%8.2f" <$> holdFor 0.5 (periodically 1 . time) <|>->     "wait 500ms for the next second"+-- | Pure wires. -You find a library of predefined event wires in the-"Control.Wire.Prefab.Event" module.--}+type WireP s e = Wire s e Identity  -{- $quickstart_custom--From time to time you will want to write your own wire on a lower level.-In this case there are a number of options.  The simplest option is-'mkPure':--> mkPure ::->     (Time -> a -> (Either e b, Wire e m a b)) ->->     Wire e m a b--The type quite literally tells what this function does.  It takes a-function and turns it into a wire quite straightforwardly.  Another-option is to use 'mkState', which is equivalent to @mkPure@, but allows-you to express the wire as a local state transformer:--> mkState ::->     s ->->     (Time -> (a, s) -> (Either e b, s)) ->->     Wire e m a b+-- | Simple wires with time. -The first argument is a starting state, the second is the state-transformation function.--}+type SimpleWire = Wire (Timed NominalDiffTime ()) () Identity
− Control/Wire/Classes.hs 
@@ -1,46 +0,0 @@--- |--- Module:     Control.Wire.Classes--- Copyright:  (c) 2012 Ertugrul Soeylemez--- License:    BSD3--- Maintainer: Ertugrul Soeylemez <es@ertes.de>------ Various type classes.--module Control.Wire.Classes-    ( -- * Effects-      MonadRandom(..),--      -- * Utility classes-      Injectable(..)-    )-    where--import Data.Monoid-import System.Random----- | Class for injectable values.  See--- 'Control.Wire.Prefab.Event.inject'.--class Injectable e f where-    toSignal :: f a -> Either e a--instance (Monoid e) => Injectable e Maybe where-    toSignal = maybe (Left mempty) Right--instance Injectable e (Either e) where-    toSignal = id----- | Monads with a random number generator.--class (Monad m) => MonadRandom m where-    -- | Get a random number.-    getRandom :: (Random a) => m a--    -- | Get a random number in the given range.-    getRandomR :: (Random a) => (a, a) -> m a--instance MonadRandom IO where-    getRandom  = randomIO-    getRandomR = randomRIO
+ Control/Wire/Core.hs view
@@ -0,0 +1,421 @@+-- |+-- Module:     Control.Wire.Core+-- Copyright:  (c) 2013 Ertugrul Soeylemez+-- License:    BSD3+-- Maintainer: Ertugrul Soeylemez <es@ertes.de>++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 qualified Data.Semigroup as Sg+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.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' <|> 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, 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, Sg.Semigroup b) => Sg.Semigroup (Wire s e m a b) where+    (<>) = liftA2 (Sg.<>)+++-- | 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 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')
+ Control/Wire/Event.hs view
@@ -0,0 +1,338 @@+-- |+-- Module:     Control.Wire.Event+-- Copyright:  (c) 2013 Ertugrul Soeylemez+-- License:    BSD3+-- Maintainer: Ertugrul Soeylemez <es@ertes.de>++module Control.Wire.Event+    ( -- * Events+      Event,++      -- * Time-based+      at,+      never,+      now,+      periodic,+      periodicList,++      -- * Signal analysis+      became,+      noLonger,++      -- * 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)+++-- | 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)
+ Control/Wire/Interval.hs view
@@ -0,0 +1,184 @@+-- |+-- Module:     Control.Wire.Interval+-- Copyright:  (c) 2013 Ertugrul Soeylemez+-- License:    BSD3+-- Maintainer: Ertugrul Soeylemez <es@ertes.de>++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
− Control/Wire/Prefab.hs 
@@ -1,35 +0,0 @@--- |--- Module:     Control.Wire.Prefab--- Copyright:  (c) 2012 Ertugrul Soeylemez--- License:    BSD3--- Maintainer: Ertugrul Soeylemez <es@ertes.de>------ Proxy module for the prefab wires.--module Control.Wire.Prefab-    ( -- * Reexports-      module Control.Wire.Prefab.Accum,-      module Control.Wire.Prefab.Analyze,-      module Control.Wire.Prefab.Effect,-      module Control.Wire.Prefab.Event,-      module Control.Wire.Prefab.List,-      module Control.Wire.Prefab.Move,-      module Control.Wire.Prefab.Noise,-      module Control.Wire.Prefab.Queue,-      module Control.Wire.Prefab.Sample,-      module Control.Wire.Prefab.Simple,-      module Control.Wire.Prefab.Time-    )-    where--import Control.Wire.Prefab.Accum-import Control.Wire.Prefab.Analyze-import Control.Wire.Prefab.Effect-import Control.Wire.Prefab.Event-import Control.Wire.Prefab.List-import Control.Wire.Prefab.Move-import Control.Wire.Prefab.Noise-import Control.Wire.Prefab.Queue-import Control.Wire.Prefab.Sample-import Control.Wire.Prefab.Simple-import Control.Wire.Prefab.Time
− Control/Wire/Prefab/Accum.hs 
@@ -1,132 +0,0 @@--- |--- Module:     Control.Wire.Prefab.Accum--- Copyright:  (c) 2012 Ertugrul Soeylemez--- License:    BSD3--- Maintainer: Ertugrul Soeylemez <es@ertes.de>------ Accumulation wires.  These are left-scan equivalents of several--- sorts.--module Control.Wire.Prefab.Accum-    ( -- * General-      -- ** Accumulation-      accum,-      accumT,-      accum1,-      accumT1,-      -- ** Function iteration-      iterateW,-      iterateWT,-      -- ** Generic unfolding-      unfold,-      unfoldT,--       -- * Special-      countFrom,-      enumFromW,-      mconcatW-    )-    where--import Control.Wire.Wire-import Data.AdditiveGroup-import Data.Monoid-import Prelude hiding (enumFrom, iterate)----- | The most general accumulator.  This wire corresponds to a left--- scan.------ * Depends: previous instant.--accum :: (b -> a -> b) -> b -> Wire e m a b-accum f = accumT (const f)----- | Non-delaying variant of 'accum'.------ * Depends: current instant.--accum1 :: (b -> a -> b) -> b -> Wire e m a b-accum1 f = accumT1 (const f)----- | Like 'accum', but the accumulation function also receives the--- current time delta.------ * Depends: previous instant.--accumT :: (Time -> b -> a -> b) -> b -> Wire e m a b-accumT f x' =-    mkPure $ \dt x ->-        x' `seq` (Right x', accumT f (f dt x' x))----- | Non-delaying variant of 'accumT'.------ * Depends: current instant.--accumT1 :: (Time -> b -> a -> b) -> b -> Wire e m a b-accumT1 f x' =-    mkPure $ \dt x ->-        let y = f dt x' x in-        x' `seq` (Right y, accumT1 f y)----- | Counts from the given vector adding the current input for the next--- instant.------ * Depends: previous instant.--countFrom :: (AdditiveGroup b) => b -> Wire e m b b-countFrom = accum (^+^)----- | Enumerates from the given element.--enumFromW :: (Enum b) => b -> Wire e m a b-enumFromW = accum (\x _ -> succ x)----- | Apply the input function continously.  Corresponds to 'iterate' for--- lists.--iterateW :: (b -> b) -> b -> Wire e m a b-iterateW f = accum (\x _ -> f x)----- | Like 'iterate', but the accumulation function also receives the--- current time delta.--iterateWT :: (Time -> b -> b) -> b -> Wire e m a b-iterateWT f = accumT (\dt x _ -> f dt x)----- | Running 'Monoid' sum.------ * Depends: previous instant.--mconcatW :: (Monoid b) => Wire e m b b-mconcatW = accum mappend mempty----- | Corresponds to 'unfoldr' for lists.------ * Depends: current instant, if the unfolding function is strict in--- its second argument.--unfold :: (s -> a -> (b, s)) -> s -> Wire e m a b-unfold = unfoldT . const----- | Like 'unfold', but the accumulation function also receives the--- current time delta.------ * Depends: current instant, if the given function is strict in its--- third argument.--unfoldT :: (Time -> s -> a -> (b, s)) -> s -> Wire e m a b-unfoldT f s' =-    mkPure $ \dt x' ->-        let (x, s) = f dt s' x' in-        s' `seq` (Right x, unfoldT f s)
− Control/Wire/Prefab/Analyze.hs 
@@ -1,243 +0,0 @@--- |--- Module:     Control.Wire.Prefab.Analyze--- Copyright:  (c) 2012 Ertugrul Soeylemez--- License:    BSD3--- Maintainer: Ertugrul Soeylemez <es@ertes.de>------ Signal analysis wires.--module Control.Wire.Prefab.Analyze-    ( -- * Statistics-      -- ** Average-      avg,-      avgInt,-      avgAll,-      avgFps,-      avgFpsInt,-      -- ** Peak-      highPeak,-      lowPeak,-      peakBy,--      -- * Monitoring-      collect,-      firstSeen,-      lastSeen-    )-    where--import qualified Data.Map as M-import qualified Data.Sequence as Seq-import Control.Category-import Control.Wire.Prefab.Time-import Control.Wire.Wire-import Data.Map (Map)-import Data.Monoid-import Data.Sequence (Seq, ViewL(..), (|>), viewl)-import Data.VectorSpace-import Prelude hiding ((.), id)----- | Calculate the average of the signal over the given number of last--- samples.  If you need an average over all samples ever produced,--- consider using 'avgAll' instead.------ * Complexity: O(n) space wrt number of samples.------ * Depends: current instant.--avg ::-    forall a m e v.-    (Fractional a, VectorSpace v, Scalar v ~ a)-    => Int-    -> Wire e m v v-avg n | n <= 0 = error "avg: The number of samples must be positive"-avg n =-    mkPure $ \_ x ->-        (Right x, avg' (Seq.replicate n (x ^/ d)) x)--    where-    avg' :: Seq v -> v -> Wire e m v v-    avg' samples'' a' =-        mkPure $ \_ x ->-            let xa              = x ^/ d-                xa' :< samples' = viewl samples''-                samples         = samples' |> xa-                a               = a' ^-^ xa' ^+^ xa-            in a `seq` (Right a, avg' samples a)--    d :: Scalar v-    d = realToFrac n----- | Calculate the average of the input signal over all samples.  This--- is usually not what you want.  In most cases the 'avg' wire is--- preferable.------ * Depends: current instant.--avgAll ::-    forall a m e v.-    (Fractional a, VectorSpace v, Scalar v ~ a)-    => Wire e m v v-avgAll = mkPure $ \_ x -> (Right x, avgAll' 1 x)-    where-    avgAll' :: a -> v -> Wire e m v v-    avgAll' n' a' =-        mkPure $ \_ x ->-            let n = n' + 1-                a = a' ^+^ (x ^-^ a') ^/ n-            in a' `seq` (Right a, avgAll' n a)----- | Calculate the average number of instants per second for the last--- given number of instants.  In a continuous game or simulation this--- corresponds to the average number of frames per second, hence the--- name.------ * Complexity:  O(n) space wrt number of samples.------ * Depends: time.--avgFps :: (Monad m) => Int -> Wire e m a Double-avgFps n = recip (avg n) . dtime----- | Like 'avgFps', but sample in discrete intervals only.  This can--- greatly enhance the performance, when you have an inefficient clock--- source.------ * Complexity:  O(n) space wrt number of samples.------ * Depends: time.--avgFpsInt ::-    (Monad m)-    => Int  -- ^ Sampling interval.-    -> Int  -- ^ Number of samples.-    -> Wire e m a Double-avgFpsInt int n = recip (avgInt int n) . dtime----- | Same as 'avg', but with a sampling interval.  This can be used to--- increase the performance, if the input is complicated.------ * Complexity: O(n) space wrt number of samples.------ * Depends: current instant.--avgInt ::-    forall a m e v.-    (Fractional a, VectorSpace v, Scalar v ~ a)-    => Int  -- ^ Sampling interval.-    -> Int  -- ^ Number of samples.-    -> Wire e m v v-avgInt _ n | n <= 0 = error "avg: The number of samples must be positive"-avgInt int n =-    mkPure $ \_ x ->-        (Right x, avg' 0 (Seq.replicate n (x ^/ d)) x)--    where-    avg' :: Int -> Seq v -> v -> Wire e m v v-    avg' si samples'' a' | si < int = mkPure $ \_ _ -> (Right a', avg' (si + 1) samples'' a')-    avg' _ samples'' a' =-        mkPure $ \_ x ->-            let xa              = x ^/ d-                xa' :< samples' = viewl samples''-                samples         = samples' |> xa-                a               = a' ^-^ xa' ^+^ xa-            in a `seq` (Right a, avg' 0 samples a)--    d :: Scalar v-    d = realToFrac n----- | Collect all distinct inputs ever received together with a count.--- Elements not appearing in the map have not been observed yet.------ * Complexity: O(n) space.------ * Depends: current instant.--collect :: forall b m e. (Ord b) => Wire e m b (Map b Int)-collect = collect' M.empty-    where-    collect' :: Map b Int -> Wire e m b (Map b Int)-    collect' m' =-        mkPure $ \_ x ->-            let m = M.insertWith (+) x 1 m' in-            m `seq` (Right m, collect' m)----- | Outputs the first local time the input was seen.------ * Complexity: O(n) space, O(log n) time wrt number of samples so far.------ * Depends: current instant, time.--firstSeen :: forall a m e. (Ord a) => Wire e m a Time-firstSeen = seen' 0 M.empty-    where-    seen' :: Time -> Map a Time -> Wire e m a Time-    seen' t' m' =-        mkPure $ \dt x ->-            let t = t' + dt in-            t `seq`-            case M.lookup x m' of-              Just xt -> (Right xt, seen' t m')-              Nothing ->-                  let m = M.insert x t m' in-                  m `seq` (Right t, seen' t m)----- | High peak.------ * Depends: current instant.--highPeak :: (Ord b) => Wire e m b b-highPeak = peakBy compare----- | Outputs the local time the input was previously seen.------ * Complexity: O(n) space, O(log n) time wrt number of samples so far.------ * Depends: current instant, time.------ * Inhibits: if this is the first time the input is seen.--lastSeen :: forall a m e. (Monoid e, Ord a) => Wire e m a Time-lastSeen = seen' 0 M.empty-    where-    seen' :: Time -> Map a Time -> Wire e m a Time-    seen' t' m' =-        mkPure $ \dt x ->-            let t = t' + dt-                m = M.insert x t m' in-            t `seq` m `seq`-            case M.lookup x m' of-              Just xt -> (Right xt, seen' t m)-              Nothing -> (Left mempty, seen' t m)----- | Low peak.------ * Depends: current instant.--lowPeak :: (Ord b) => Wire e m b b-lowPeak = peakBy (flip compare)----- | Output the peak with respect to the given comparison function.------ * Depends: current instant.--peakBy :: forall b m e. (b -> b -> Ordering) -> Wire e m b b-peakBy f = mkPure $ \_ x -> (Right x, peak' x)-    where-    peak' :: b -> Wire e m b b-    peak' x' =-        mkPure $ \_ x ->-            case f x' x of-              GT -> (Right x', peak' x')-              _  -> (Right x, peak' x)
− Control/Wire/Prefab/Effect.hs 
@@ -1,117 +0,0 @@--- |--- Module:     Control.Wire.Prefab.Effect--- Copyright:  (c) 2012 Ertugrul Soeylemez--- License:    BSD3--- Maintainer: Ertugrul Soeylemez <es@ertes.de>------ Effectful wires.--module Control.Wire.Prefab.Effect-    ( -- * Monadic effects-      -- ** Simple-      perform,-      -- ** Exception-aware-      execute,-      execute_,-      executeWith,-      executeWith_,--      -- * Branching-      branch,-      quit,-      quitWith-    )-    where--import qualified Data.Bifunctor as Bi-import Control.Exception.Lifted-import Control.Monad-import Control.Monad.Trans.Control-import Control.Wire.Types-import Control.Wire.Wire-import Data.List-import Data.Monoid----- | Branch according to the unterlying 'MonadPlus' instance.  Note that--- this wire branches at every instant.------ * Depends: current instant.--branch :: (MonadPlus m) => Wire e m [a] a-branch = mkFixM $ \_ -> liftM Right . foldl' mplus mzero . map return----- | Variant of 'executeWith' for the 'LastException' inhibition monoid.------ * Depends: current instant.------ * Inhibits: when the action throws an exception.--execute ::-    (MonadBaseControl IO m)-    => Wire LastException m (m a) a-execute = executeWith (Last . Just)----- | Variant of 'executeWith_' for the 'LastException' inhibition monoid.------ * Depends: current instant, if the given function is strict.------ * Inhibits: when the action throws an exception.--execute_ ::-    (MonadBaseControl IO m)-    => (a -> m b)-    -> Wire LastException m a b-execute_ = executeWith_ (Last . Just)----- | Perform the input monadic action at every instant.------ * Depends: current instant.------ * Inhibits: when the action throws an exception.--executeWith ::-    (MonadBaseControl IO m)-    => (SomeException -> e)  -- ^ Turns an exception into an inhibition value.-    -> Wire e m (m a) a-executeWith fromEx = mkFixM $ \_ c -> liftM (Bi.first fromEx) (try c)----- | Perform the given monadic action at every instant.------ * Depends: current instant, if the given function is strict.------ * Inhibits: when the action throws an exception.--executeWith_ ::-    (MonadBaseControl IO m)-    => (SomeException -> e)  -- ^ Turns an exception into an inhibition value.-    -> (a -> m b)            -- ^ Action to perform.-    -> Wire e m a b-executeWith_ fromEx c = mkFixM $ \_ -> liftM (Bi.first fromEx) . try . c----- | Perform the input monadic action in a wire.------ * Depends: current instant.--perform :: (Monad m) => Wire e m (m b) b-perform = mkFixM . const $ liftM Right----- | Quits the current branch using 'mzero'.--quit :: (MonadPlus m) => Wire e m a b-quit = mkFixM $ \_ _ -> mzero----- | Acts like identity in the first instant, then quits the current--- branch using 'mzero'.------ * Depends: first instant.--quitWith :: (MonadPlus m) => Wire e m a a-quitWith = mkPure $ \_ x -> (Right x, quit)
− Control/Wire/Prefab/Event.hs 
@@ -1,307 +0,0 @@--- |--- Module:     Control.Wire.Prefab.Event--- Copyright:  (c) 2012 Ertugrul Soeylemez--- License:    BSD3--- Maintainer: Ertugrul Soeylemez <es@ertes.de>------ Event wires.--module Control.Wire.Prefab.Event-    ( -- * Instants-      afterI,-      eventsI,-      forI,-      notYet,-      once,-      periodicallyI,--      -- * Signal analysis-      changed,-      inject,-      -- ** Predicate-based-      asSoonAs,-      edge,-      forbid,-      require,-      unless,-      until,-      when,-      while,--      -- * Time-      after,-      events,-      for,-      periodically,--      -- * Utilities-      inhibit-    )-    where--import Control.Category-import Control.Wire.Classes-import Control.Wire.Types-import Control.Wire.Wire-import Data.Monoid-import Prelude hiding ((.), id, until)----- | Produce after the given amount of time.------ * Depends: current instant when producing, time.------ * Inhibits: until the given amount of time has passed.--after :: (Monoid e) => Time -> Event e m a-after t-    | t <= 0     = identity-    | otherwise = mkPure $ \dt _ -> (Left mempty, after (t - dt))----- | Produce after the given number of instants.------ * Depends: current instant when producing.------ * Inhibits: until the given number of instants has passed.--afterI :: (Monoid e) => Int -> Event e m a-afterI t-    | t <= 0     = identity-    | otherwise = mkPure $ \_ _ -> (Left mempty, afterI (t - 1))----- | Inhibit until the given predicate holds for the input signal.  Then--- produce forever.------ * Depends: current instant, if the predicate is strict.  Once true,--- on current instant forever.------ * Inhibits: until the predicate becomes true.--asSoonAs :: (Monoid e) => (a -> Bool) -> Event e m a-asSoonAs p =-    mkPure $ \_ x ->-        if p x-          then (Right x, identity)-          else (Left mempty, asSoonAs p)----- | Produce when the signal has changed and at the first instant.------ * Depends: current instant.------ * Inhibits: after the first instant when the input has changed.--changed :: (Eq a, Monoid e) => Event e m a-changed = mkPure $ \_ x0 -> (Right x0, changed' x0)-    where-    changed' x' =-        mkPure $ \_ x ->-            (if x' == x then Left mempty else Right x,-             changed' x)----- | Produces once whenever the given predicate switches from 'False' to--- 'True'.------ * Depends: current instant.------ * Inhibits: when the predicate has not just switched from 'False' to--- 'True'.--edge :: (Monoid e) => (a -> Bool) -> Event e m a-edge p = off-    where-    off = mkPure $ \_ x -> if p x then (Right x, on) else (Left mempty, off)-    on  = mkPure $ \_ x -> (Left mempty, if p x then on else off)----- | Produce once periodically.  The production periods are given by the--- argument list.  When it's @[1,2,3]@ it produces after one second,--- then after two more seconds and finally after three more seconds.--- When the list is exhausted, it never produces again.------ * Depends: current instant when producing, time.------ * Inhibits: between the given intervals.--events :: (Monoid e) => [Time] -> Event e m a-events [] = never-events (t':ts) =-    mkPure $ \dt x ->-        let t = t' - dt in-        if t <= 0-          then (Right x, events (mapHead (+ t) ts))-          else (Left mempty, events (t:ts))--    where-    mapHead :: (a -> a) -> [a] -> [a]-    mapHead _ []     = []-    mapHead f (x:xs) = f x : xs----- | Variant of 'periodically' in number of instants instead of amount--- of time.------ * Depends: current instant when producing.------ * Inhibits: between the given intervals.--eventsI :: (Monoid e) => [Int] -> Event e m a-eventsI [] = never-eventsI (0:ts) = mkPure $ \_ x -> (Right x, eventsI ts)-eventsI (t:ts) = mkPure $ \_ _ -> (Left mempty, eventsI (t - 1 : ts))----- | Produce for the given amount of time.------ * Depends: current instant when producing, time.------ * Inhibits: after the given amount of time has passed.--for :: (Monoid e) => Time -> Event e m a-for t-    | t <= 0     = never-    | otherwise = mkPure $ \dt x -> (Right x, for (t - dt))----- | Same as 'unless'.--forbid :: (Monoid e) => (a -> Bool) -> Event e m a-forbid = unless----- | Produce for the given number of instants.------ * Depends: current instant when producing.------ * Inhibits: after the given number of instants has passed.--forI :: (Monoid e) => Int -> Event e m a-forI t-    | t <= 0     = never-    | otherwise = mkPure $ \_ x -> (Right x, forI (t - 1))----- | Inhibit with the given value.  You may want to use a combination of--- 'Control.Applicative.empty' and 'Control.Wire.Trans.Event.<!>'--- instead.------ * Inhibits: always.--inhibit :: e -> Wire e m a b-inhibit ex = mkFix (\_ _ -> Left ex)----- | Inject the input signal.  Please keep in mind that in application--- code it is almost always wrong to use this wire.  It should only be--- used to interact with other frameworks/abstractions, and even then--- it's probably just a last resort.------ When you want to write your own wires, consider using 'mkPure' or the--- various variants of it.------ * Depends: current instant.------ * Inhibits: depending on input signal (see 'Injectable').--inject :: (Injectable e f) => Wire e m (f b) b-inject = mkFix (const toSignal)----- | Inhibit once.------ * Depends: current instant after the first instant.------ * Inhibits: in the first instant.--notYet :: (Monoid e) => Event e m a-notYet = mkPure $ \_ _ -> (Left mempty, identity)----- | Produce once.------ * Depends: current instant in the first instant.------ * Inhibits: after the first instant.--once :: (Monoid e) => Event e m a-once = mkPure $ \_ x -> (Right x, never)----- | Produce once periodically with the given time interval.------ * Depends: current instant when producing, time.------ * Inhibits: between the intervals.--periodically :: (Monoid e) => Time -> Event e m a-periodically = events . repeat----- | Produce once periodically with the given number of instants as the--- interval.------ * Depends: current instant when producing.------ * Inhibits: between the intervals.--periodicallyI :: (Monoid e) => Int -> Event e m a-periodicallyI = eventsI . repeat----- | Same as 'when'.--require :: (Monoid e) => (a -> Bool) -> Event e m a-require = when----- | Produce when the given predicate on the input signal does not hold.------ * Depends: current instant if the predicate is strict.------ * Inhibits: When the predicate is true.--unless :: (Monoid e) => (a -> Bool) -> Event e m a-unless p =-    mkFix $ \_ x ->-        if p x then Left mempty else Right x----- | Produce until the given predicate on the input signal holds, then--- inhibit forever.------ * Depends: current instant, if the predicate is strict.------ * Inhibits: forever as soon as the predicate becomes true.--until :: (Monoid e) => (a -> Bool) -> Event e m a-until p = while (not . p)----- | Produce when the given predicate on the input signal holds.------ * Depends: current instant if the predicate is strict.------ * Inhibits: When the predicate is false.--when :: (Monoid e) => (a -> Bool) -> Event e m a-when p =-    mkFix $ \_ x ->-        if p x then Right x else Left mempty----- | Produce while the given predicate on the input signal holds, then--- inhibit forever.------ * Depends: current instant, if the predicate is strict.------ * Inhibits: forever as soon as the predicate becomes false.--while :: (Monoid e) => (a -> Bool) -> Event e m a-while p =-    mkPure $ \_ x ->-        if p x-          then (Right x, while p)-          else (Left mempty, never)
− Control/Wire/Prefab/List.hs 
@@ -1,36 +0,0 @@--- |--- Module:     Control.Wire.Prefab.List--- Copyright:  (c) 2012 Ertugrul Soeylemez--- License:    BSD3--- Maintainer: Ertugrul Soeylemez <es@ertes.de>------ Wires from lists.--module Control.Wire.Prefab.List-    ( -- * Wires from lists-      cycleW,-      list-    )-    where--import Control.Applicative-import Control.Monad.Fix-import Control.Wire.Wire-import Data.Monoid----- | Produce the values in the given list cycling forever.------ * Inhibits: when the argument list is empty.--cycleW :: (Monad m, Monoid e) => [b] -> Wire e m a b-cycleW [] = empty-cycleW xs = fix (\again -> foldr cons again xs)----- | Produce the values in the given list and then inhibit forever.------ * Inhibits: when the list is exhausted.--list :: (Monad m, Monoid e) => [b] -> Wire e m a b-list = foldr cons empty
− Control/Wire/Prefab/Move.hs 
@@ -1,247 +0,0 @@--- |--- Module:     Control.Wire.Prefab.Move--- Copyright:  (c) 2012 Ertugrul Soeylemez--- License:    BSD3--- Maintainer: Ertugrul Soeylemez <es@ertes.de>------ This module provides the wires for various kinds of moving objects.--- In particular this includes various calculus wires like integrals and--- differentials.--module Control.Wire.Prefab.Move-    ( -- * Calculus-      -- ** Integrals-      integral,-      integral_,-      integralLim,-      integralLim_,-      integral1,-      integral1_,-      integralLim1,-      integralLim1_,-      -- ** Differentials-      derivative,-      derivative_,--      -- * Simulations/games-      object,-      object_,-      ObjectState(..),-      ObjectDiff(..)-    )-    where--import Control.Applicative-import Control.Arrow-import Control.Category-import Control.Wire.Prefab.Accum-import Control.Wire.Prefab.Time-import Control.Wire.Wire-import Data.Data-import Data.VectorSpace-import Prelude hiding ((.), id)----- | Object state.  This includes the position and velocity.--data ObjectState a =-    ObjectState {-      objPosition :: a,  -- ^ Position.-      objVelocity :: a   -- ^ Velocity.-    }-    deriving (Data, Eq, Ord, Read, Show, Typeable)----- | Differential for objects.--data ObjectDiff a-    -- | Accelerate (units per second).-    = Accelerate a--    -- | Teleport to the given position instantly (velocity will be-    -- unchanged).-    | Position a--    -- | Specify velocity (units per second).-    | Velocity a-    deriving (Data, Eq, Ord, Read, Show, Typeable)----- | Derivative.  Receives @x@ and @dt@ and calculates the change rate--- @dx/dt@.  Note that @dt@ despite its name does not have to be time.------ The exception handler function is called when @dt@ is zero.  That--- function's result is the wire's output for those instants.  If you--- don't want to handle exceptional cases specially, just pass @(^/)@ as--- the handler function.------ * Depends: current instant.--derivative ::-    (Eq dt, Fractional dt, VectorSpace b, Scalar b ~ dt)-    => (b -> dt -> b)  -- ^ Handle exceptional change rates (receives dx and dt).-    -> b               -- ^ Initial position.-    -> Wire e m (b, dt) b-derivative catch x0 =-    mkPure $ \_ (x1, dt) ->-        let dx = x1 ^-^ x0-            d | dt == 0    = catch dx dt-              | otherwise = dx ^/ dt-        in (Right d, derivative catch x1)----- | Same as 'derivative', but with respect to time.------ * Depends: current instant.--derivative_ ::-    (Monad m, VectorSpace b, Scalar b ~ Time)-    => (b -> Time -> b)  -- ^ Handle exceptional cases.-    -> b                 -- ^ Initial position.-    -> Wire e m b b-derivative_ catch x0 = derivative catch x0 . (id &&& dtime)----- | Integral wire.  Produces position from velocity in the sense of the--- given vector space.------ * Depends: previous instant.--integral ::-    (VectorSpace b)-    => b-    -> Wire e m (b, Scalar b) b-integral = accum (\x (dx, dt) -> x ^+^ dt *^ dx)----- | Non-delaying variant of 'integral'.------ * Depends: current instant.--integral1 ::-    (VectorSpace b)-    => b-    -> Wire e m (b, Scalar b) b-integral1 = accum1 (\x (dx, dt) -> x ^+^ dt *^ dx)----- | Same as 'integral', but with respect to time.------ * Depends: previous instant.--integral_ ::-    (VectorSpace b, Scalar b ~ Time)-    => b-    -> Wire e m b b-integral_ = accumT (\dt x dx -> x ^+^ dt *^ dx)----- | Non-delaying variant of 'integral_'.------ * Depends: current instant.--integral1_ ::-    (Monad m, VectorSpace b, Scalar b ~ Time)-    => b-    -> Wire e m b b-integral1_ = accumT1 (\dt x dx -> x ^+^ dt *^ dx)----- | Variant of 'integral', where you can specify a post-update--- function, which receives the previous position as well as the current--- (in that order).  This is useful for limiting the output (think of--- robot arms that can't be moved freely).------ * Depends: current instant if the post-update function is strict in--- its first argument, previous instant if not.--integralLim ::-    (VectorSpace b)-    => (w -> b -> b -> b)  -- ^ Post-update function.-    -> b                   -- ^ Initial value.-    -> Wire e m ((b, w), Scalar b) b-integralLim uf = accum (\x ((dx, w), dt) -> uf w x (x ^+^ dt *^ dx))----- | Non-delaying variant of 'integralLim'.------ * Depends: current instant.--integralLim1 ::-    (VectorSpace b)-    => (w -> b -> b -> b)  -- ^ Post-update function.-    -> b                   -- ^ Initial value.-    -> Wire e m ((b, w), Scalar b) b-integralLim1 uf = accum1 (\x ((dx, w), dt) -> uf w x (x ^+^ dt *^ dx))----- | Same as 'integralLim', but with respect to time.------ * Depends: previous instant.--integralLim_ ::-    (VectorSpace b, Scalar b ~ Time)-    => (w -> b -> b -> b)-    -> b-    -> Wire e m (b, w) b-integralLim_ uf = accumT (\dt x (dx, w) -> uf w x (x ^+^ dt *^ dx))----- | Non-delaying variant of 'integralLim_'.------ * Depends: current instant.--integralLim1_ ::-    (VectorSpace b, Scalar b ~ Time)-    => (w -> b -> b -> b)-    -> b-    -> Wire e m (b, w) b-integralLim1_ uf = accumT1 (\dt x (dx, w) -> uf w x (x ^+^ dt *^ dx))----- | Objects are generalized integrals.  They are controlled through--- velocity and/or acceleration and can be collision-checked as well as--- instantly teleported.------ The post-move update function receives the world state and the--- current object state.  It is applied just before the wire produces--- its output.  You can use it to perform collision-checks or to limit--- the velocity.------ Note that teleportation doesn't change the velocity.------ * Depends: current instant.--object ::-    forall b m dt e w.-    (VectorSpace b, Scalar b ~ dt)-    => (w -> ObjectState b -> ObjectState b)  -- ^ Post-move update function.-    -> ObjectState b                          -- ^ Initial state.-    -> Wire e m (ObjectDiff b, w, dt) (ObjectState b)-object uf = loop-    where-    applyDiff :: dt -> ObjectDiff b -> ObjectState b -> ObjectState b-    applyDiff dt (Accelerate dv) (ObjectState x' v') = ObjectState x v-        where-        v = v' ^+^ dt *^ dv-        x = x' ^+^ dt *^ v-    applyDiff _  (Position x) (ObjectState _ v)  = ObjectState x v-    applyDiff dt (Velocity v) (ObjectState x' _) = ObjectState (x' ^+^ dt *^ v) v--    loop :: ObjectState b -> Wire e m (ObjectDiff b, w, dt) (ObjectState b)-    loop os' =-        mkPure $ \_ (dos, w, dt) ->-            let os = uf w . applyDiff dt dos $ os'-            in (Right os, loop os)----- | Same as 'object', but with respect to time.------ * Depends: current instant.--object_ ::-    (Monad m, VectorSpace b, Scalar b ~ Time)-    => (w -> ObjectState b -> ObjectState b)  -- ^ Post-move update function.-    -> ObjectState b                          -- ^ Initial state.-    -> Wire e m (ObjectDiff b, w) (ObjectState b)-object_ uf x0 = object uf x0 . liftA2 (\(dx, w) dt -> (dx, w, dt)) id dtime
− Control/Wire/Prefab/Noise.hs 
@@ -1,96 +0,0 @@--- |--- Module:     Control.Wire.Prefab.Noise--- Copyright:  (c) 2012 Ertugrul Soeylemez--- License:    BSD3--- Maintainer: Ertugrul Soeylemez <es@ertes.de>------ Various noise generators.--module Control.Wire.Prefab.Noise-    ( -- * Pure random noise-      noise,-      noiseR,-      wackelkontakt,--      -- * Effectful random noise-      noiseM,-      noiseRM,-      wackelkontaktM-    )-    where--import Control.Monad-import Control.Wire.Classes-import Control.Wire.Prefab.Accum-import Control.Wire.Types-import Control.Wire.Wire-import Data.Monoid-import System.Random----- | Pure noise generator.--noise ::-    (Random b, RandomGen g)-    => g  -- ^ Initial random number generator.-    -> Wire e m a b-noise = unfold (\g' _ -> random g')----- | Noise generator.--noiseM ::-    (MonadRandom m, Random b)-    => Wire e m a b-noiseM =-    mkFixM $ \_ _ -> liftM (Right $!) getRandom----- | Ranged noise generator.------ * Depends: current instant.--noiseRM ::-    (MonadRandom m, Random b)-    => Wire e m (b, b) b-noiseRM = mkFixM $ \_ -> liftM (Right $!) . getRandomR----- | Pure ranged noise generator.------ * Depends: current instant.--noiseR ::-    (Random b, RandomGen g)-    => g  -- ^ Initial random number generator.-    -> Wire e m (b, b) b-noiseR = unfold (\g' r -> randomR r g')----- | Event:  Occurs randomly with the given probability.------ * Inhibits: @wackelkontaktM p@ inhibits with probability @1 - p@.--wackelkontakt ::-    (Monoid e, RandomGen g)-    => Double  -- ^ Occurrence probability.-    -> g  -- ^ Initial random number generator.-    -> Event e m a-wackelkontakt p g' =-    mkPure $ \_ x ->-        let (e, g) = random g' in-        (if (e < p) then Right x else Left mempty, wackelkontakt p g)----- | Event:  Occurs randomly with the given probability.------ * Inhibits: @wackelkontaktM p@ inhibits with probability @1 - p@.--wackelkontaktM ::-    (MonadRandom m, Monoid e)-    => Double  -- ^ Occurrence probability.-    -> Event e m a-wackelkontaktM p =-    mkFixM $ \_ x -> do-        e <- getRandom-        return (if (e < p) then Right x else Left mempty)
− Control/Wire/Prefab/Queue.hs 
@@ -1,88 +0,0 @@--- |--- Module:     Control.Wire.Prefab.Queue--- Copyright:  (c) 2012 Ertugrul Soeylemez--- License:    BSD3--- Maintainer: Ertugrul Soeylemez <es@ertes.de>------ Wires acting as queues.--module Control.Wire.Prefab.Queue-    ( -- * Queues-      bag,-      fifo,-      lifo-    )-    where--import qualified Data.Set as S-import qualified Data.Sequence as Seq-import Control.Wire.Wire-import Data.Monoid-import Data.Set (Set)-import Data.Sequence (ViewL(..), (><), viewl)----- | Incoming values are placed in a set, which is discharged element by--- element.  Lower values are served first.  Duplicate values are served--- once.------ Note: Incorrect usage can lead to congestion.------ * Complexity: O(n) space wrt bag size.------ * Depends: current instant.------ * Inhibits: when the bag is empty.--bag :: (Monoid e, Ord b) => Wire e m (Set b) b-bag = bag' S.empty-    where-    bag' s' =-        mkPure $ \_ xs ->-            case S.minView (S.union s' xs) of-              Nothing     -> (Left mempty, bag' S.empty)-              Just (x, s) -> (Right x, bag' s)----- | First in, first out.  The input list is placed on the right end of--- a queue at every instant, giving earlier elements a higher priority.--- The queue is discharged item by item from the left.------ Note: Incorrect usage can lead to congestion.------ * Complexity: O(n) space wrt queue size.------ * Depends: current instant.------ * Inhibits: when the queue is currently empty.--fifo :: (Monoid e) => Wire e m [b] b-fifo = fifo' Seq.empty-    where-    fifo' queue' =-        mkPure $ \_ xs ->-            case viewl (queue' >< Seq.fromList xs) of-              EmptyL     -> (Left mempty, fifo' Seq.empty)-              x :< queue -> (Right x, fifo' queue)----- | Last in, first out.  The input list is placed on a stack at every--- instant, giving earlier elements a higher priority.  The stack is--- discharged item by item from the top.------ Note: Incorrect usage can lead to congestion.------ * Complexity: O(n) space wrt stack size.------ * Depends: current instant.------ * Inhibits: when the stack is currently empty.--lifo :: (Monoid e) => Wire e m [b] b-lifo = lifo' Seq.empty-    where-    lifo' queue' =-        mkPure $ \_ xs ->-            case viewl (Seq.fromList xs >< queue') of-              EmptyL     -> (Left mempty, lifo' Seq.empty)-              x :< queue -> (Right x, lifo' queue)
− Control/Wire/Prefab/Sample.hs 
@@ -1,85 +0,0 @@--- |--- Module:     Control.Wire.Prefab.Sample--- Copyright:  (c) 2012 Ertugrul Soeylemez--- License:    BSD3--- Maintainer: Ertugrul Soeylemez <es@ertes.de>------ Signal sampling wires.--module Control.Wire.Prefab.Sample-    ( -- * Sampling-      --history,-      keep,-      sample,-      window,-      windowList-    )-    where--import qualified Data.Foldable as F-import qualified Data.Sequence as Seq-import Control.Wire.Wire-import Data.Sequence (Seq, (|>))----- | Produce the most recent inputs in the given time window.  The left--- input signal is the sample, the right input signal is the time--- window.------ * Complexity: O(n), where n the number of samples in the time window.------ * Depends: current instant.----history :: (Reactive cat) => Wire e cat (a, Time) (Seq (a, Time))---history = undefined----- | Keep the input signal of the first instant forever.------ Depends: first instant.--keep :: Wire e m a a-keep = mkPure (\_ x -> (Right x, constant x))----- | Sample the left signal at discrete intervals given by the right--- signal.------ * Depends: instant of the last sample.--sample :: Wire e m (a, Time) a-sample = mkPure $ \dt (x, _) -> (Right x, sample' dt x)-    where-    sample' t0' x' =-        mkPure $ \dt (x, t1) ->-            let t0 = t0' + dt in-            if t0 >= t1-              then (Right x, sample' (t0 - t1) x)-              else (Right x', sample' t0 x')----- | Produce up to the given number of most recent inputs.------ * Complexity: O(n), where n is the given argument.------ * Depends: current instant.--window :: Int -> Wire e m a (Seq a)-window = collect' Seq.empty-    where-    collect' s' 0 = window' s'-    collect' s' n =-        mkPure $ \_ x ->-            let s = s' |> x in-            s `seq` (Right s, collect' s (n - 1))--    window' s' =-        mkPure $ \_ x ->-            let s = Seq.drop 1 (s' |> x) in-            s `seq` (Right s, window' s)----- | Same as @fmap toList . window@.--windowList :: (Monad m) => Int -> Wire e m a [a]-windowList = fmap F.toList . window
− Control/Wire/Prefab/Simple.hs 
@@ -1,67 +0,0 @@--- |--- Module:     Control.Wire.Prefab.Simple--- Copyright:  (c) 2012 Ertugrul Soeylemez--- License:    BSD3--- Maintainer: Ertugrul Soeylemez <es@ertes.de>------ Basic wires.--module Control.Wire.Prefab.Simple-    ( -- * Basic signal manipulation-      append,-      delay,-      prepend,--      -- * Forcing evaluation-      force,-      forceNF-    )-    where--import Control.Arrow-import Control.Category-import Control.DeepSeq (NFData, ($!!))-import Control.Wire.Wire-import Prelude hiding ((.), id)----- | Convenience function to add another signal.------ * Depends: current instant.--append :: (Monad m) => Wire e m a b -> Wire e m a (a, b)-append = (id &&&)----- | One-instant delay.------ * Depends: previous instant.--delay :: a -> Wire e m a a-delay x' = mkPure (\_ x -> x' `seq` (Right x', delay x))----- | Acts like the identity wire, but forces evaluation of the signal to--- WHNF.------ * Depends: current instant.--force :: Wire e m a a-force = mkFix (\_ -> (Right $!))----- | Acts like the identity wire, but forces evaluation of the signal to--- NF.------ * Depends: current instant.--forceNF :: (NFData a) => Wire e m a a-forceNF = mkFix (\_ -> (Right $!!))----- | Convenience function to add another signal.------ * Depends: current instant.--prepend :: (Monad m) => Wire e m a b -> Wire e m a (b, a)-prepend = (&&& id)
− Control/Wire/Prefab/Time.hs 
@@ -1,45 +0,0 @@--- |--- Module:     Control.Wire.Prefab.Time--- Copyright:  (c) 2012 Ertugrul Soeylemez--- License:    BSD3--- Maintainer: Ertugrul Soeylemez <es@ertes.de>------ Time wires.--module Control.Wire.Prefab.Time-    ( -- * Time-      dtime,-      time,-      timeFrom-    )-    where--import Control.Wire.Wire----- | Outputs the time delta to the last instant.------ * Depends: time.--dtime :: Wire e m a Time-dtime = mkFix (\dt _ -> Right dt)----- | Outputs the current local time passed since the first instant.------ * Depends: time.--time :: Wire e m a Time-time = timeFrom 0----- | Outputs the current local time passed since the first instant with--- the given offset.------ * Depends: time.--timeFrom :: Time -> Wire e m a Time-timeFrom t' =-    mkPure $ \dt _ ->-        let t = t' + dt in-        t `seq` (Right t, timeFrom t)
+ Control/Wire/Run.hs view
@@ -0,0 +1,63 @@+-- |+-- Module:     Control.Wire.Run+-- Copyright:  (c) 2013 Ertugrul Soeylemez+-- License:    BSD3+-- Maintainer: Ertugrul Soeylemez <es@ertes.de>++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
Control/Wire/Session.hs view
@@ -1,239 +1,111 @@ -- | -- Module:     Control.Wire.Session--- Copyright:  (c) 2012 Ertugrul Soeylemez+-- Copyright:  (c) 2013 Ertugrul Soeylemez -- License:    BSD3 -- Maintainer: Ertugrul Soeylemez <es@ertes.de>------ Wire sessions.  module Control.Wire.Session-    ( -- * Performing instants-      stepSession,-      stepSession_,-      stepSessionP,-      stepSessionP_,--      -- * Testing wires-      testWire,-      testWireP,-      -- ** Helper functions-      testPrint,--      -- * Sessions+    ( -- * State delta types+      HasTime(..),       Session(..),-      -- ** Generic sessions-      genSession,-      -- ** Specific session types++      -- ** Wires with time+      Timed(..),       clockSession,-      counterSession,-      frozenSession+      clockSession_,+      countSession,+      countSession_     )     where -import Control.Concurrent-import Control.Exception-import Control.Monad-import Control.Monad.Identity-import Control.Monad.Trans-import Control.Wire.Types-import Control.Wire.Wire+import Control.Applicative+import Control.Monad.IO.Class+import Data.Data+import Data.Foldable (Foldable) import Data.Monoid import Data.Time.Clock-import System.IO----- | A session value contains time-related information.--newtype Session m =-    Session {-      sessionUpdate :: m (Time, Session m)-    }----- | Construct a session using real time.  This session type uses--- 'getCurrentTime'.  If you have a faster time source, you may want to--- use 'genSession' instead and construct your own clock.--clockSession :: (MonadIO m) => Session m-clockSession =-    Session $ do-        t0 <- liftIO getCurrentTime-        return (0, loop t0)--    where-    loop t' =-        Session $ do-            t <- liftIO getCurrentTime-            let dt = realToFrac (diffUTCTime t t')-            return (dt, loop t)----- | Construct a simple counter session.  The time delta is the given--- argument at every instant.--counterSession ::-    (Monad m)-    => Time  -- ^ Time delta for every instant.-    -> Session m-counterSession dt =-    let s = Session (return (dt, s)) in s+import Data.Traversable (Traversable)  --- | Construct a frozen session.  Same as @'counterSession' 0@.+-- | State delta types with time deltas. -frozenSession :: (Monad m) => Session m-frozenSession = counterSession 0+class (Monoid s, Real t) => HasTime t s | s -> t where+    -- | Extract the current time delta.+    dtime :: s -> t  --- | Construct a generic session from the given initial session value--- and the update function.  You can use this function to implement your--- own clock.------ If you just want to use real time, you may want to use--- 'clockSession'.--genSession ::-    (Monad m)-    => a-    -> (a -> m (Time, a))-    -> Session m-genSession s' f =-    Session $ do-        (t, s) <- f s'-        return (t, genSession s f)+-- | 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) --- | Perform an instant of the given wire as part of a wire session.------ This is a convenience function.  You can also construct time deltas--- yourself entirely circumventing 'Session'.  This can be useful, if--- there is really no need for an effectful monad.+instance (Applicative m) => Applicative (Session m) where+    pure x = let s = Session (pure (x, s)) in s -stepSession ::-    (MonadIO m)-    => Wire e m a b  -- ^ Wire to step.-    -> Session m     -- ^ Current session state.-    -> a             -- ^ Input value.-    -> m (Either e b, Wire e m a b, Session m)-stepSession w' (Session update) x' = do-    (dt, s) <- update-    (mx, w) <- stepWire w' dt x'-    mx `seq` return (mx, w, s)+    Session ff <*> Session fx =+        Session $ liftA2 (\(f, sf) (x, sx) -> (f x, sf <*> sx)) ff fx  --- | Like 'stepSession', but throws an exception instead of returning an--- 'Either' value.--stepSession_ ::-    (MonadIO m)-    => WireM m a b  -- ^ Wire to step.-    -> Session m    -- ^ Current session state.-    -> a            -- ^ Input value.-    -> m (b, WireM m a b, Session m)-stepSession_ w' s' x' = do-    (mx, w, s) <- stepSession w' s' x'--    let throwM   = liftIO . throwIO-        emptyErr = toException (userError "empty inhibition signal")-    x <- either (throwM . maybe emptyErr id . getLast) return mx+-- | This state delta type denotes time deltas.  This is necessary for+-- most FRP applications. -    return (x, w, s)+data Timed t s = Timed t s+    deriving (Data, Eq, Foldable, Functor,+              Ord, Read, Show, Traversable, Typeable) +instance (Monoid s, Real t) => HasTime t (Timed t s) where+    dtime (Timed dt _) = dt --- | Like 'stepSession', but for pure wires.+instance (Monoid s, Num t) => Monoid (Timed t s) where+    mempty = Timed 0 mempty -stepSessionP ::-    (Monad m)-    => Wire e Identity a b  -- ^ Wire to step.-    -> Session m            -- ^ Current session state.-    -> a                    -- ^ Input value.-    -> m (Either e b, Wire e Identity a b, Session m)-stepSessionP w' (Session update) !x' = do-    (dt, s) <- update-    let (mx, w) = stepWireP w' dt x'-    mx `seq` return (mx, w, s)+    mappend (Timed dt1 ds1) (Timed dt2 ds2) =+        let dt = dt1 + dt2+            ds = ds1 <> ds2+        in dt `seq` ds `seq` Timed dt ds  --- | Like 'stepSessionP', but throws an exception instead of returning an--- 'Either' value.--stepSessionP_ ::-    (MonadIO m)-    => WireP a b  -- ^ Wire to step.-    -> Session m  -- ^ Current session state.-    -> a          -- ^ Input value.-    -> m (b, WireP a b, Session m)-stepSessionP_ w' s' !x' = do-    (mx, w, s) <- stepSessionP w' s' x'+-- | State delta generator for a real time clock. -    let throwM   = liftIO . throwIO-        emptyErr = toException (userError "empty inhibition signal")-    x <- either (throwM . maybe emptyErr id . getLast) return mx+clockSession :: (MonadIO m) => Session m (s -> Timed NominalDiffTime s)+clockSession =+    Session $ do+        t0 <- liftIO getCurrentTime+        return (Timed 0, loop t0) -    return (x, w, s)+    where+    loop t' =+        Session $ do+            t <- liftIO getCurrentTime+            let dt = diffUTCTime t t'+            dt `seq` return (Timed dt, loop t)  --- | @testPrint n int mx@ prints a formatted version of @mx@ to stderr,--- if @n@ is zero.  It returns @mod (succ n) int@.  Requires @n >= 0@ to--- work properly.------ This function is used to implement the /printing interval/ used in--- 'testWire' and 'testWireM'.+-- | Non-extending version of 'clockSession'. -testPrint :: (Show e) => Int -> Int -> Either e String -> IO Int-testPrint n' int mx = do-    let n = let nn = n' + 1 in-            if nn >= int then 0 else nn-    when (n' == 0) $ do-        hPutStr stderr "\r\027[K"-        hPutStr stderr (either (("(I) " ++) . show) id mx)-        hFlush stderr-    n `seq` return n+clockSession_ :: (Applicative m, MonadIO m) => Session m (Timed NominalDiffTime ())+clockSession_ = clockSession <*> pure ()  --- | Runs the given wire continuously and prints its result to stderr.--- Runs forever until an exception is raised.------ The /printing interval/ sets the instants/printing ratio.  The higher--- this value, the less often the output is printed.  Examples:  1000--- means to print at every 1000-th instant, 1 means to print at every--- instant.+-- | 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. -testWire ::-    forall a b e m. (MonadIO m, Show e)-    => Int                -- ^ Printing interval.-    -> Int                -- ^ 'threadDelay' between instants.-    -> m a                -- ^ Input generator.-    -> Session m          -- ^ Initial session value.-    -> Wire e m a String  -- ^ Wire to test.-    -> m b-testWire int delay getInput = loop 0-    where-    loop :: Int -> Session m -> Wire e m a String -> m b-    loop n' s' w' = do-        x' <- getInput-        (mx, w, s) <- stepSession w' s' x'-        n <- mx `seq` liftIO (testPrint n' int mx)-        when (delay > 0) (liftIO (threadDelay delay))-        loop n s w+countSession ::+    (Applicative m)+    => t  -- ^ Increment size.+    -> Session m (s -> Timed t s)+countSession dt =+    let loop = Session (pure (Timed dt, loop))+    in loop  --- | Like 'testWire', but for pure wires.+-- | Non-extending version of 'countSession'. -testWireP ::-    forall a b e m. (MonadIO m, Show e)-    => Int                       -- ^ Printing interval.-    -> Int                       -- ^ 'threadDelay' between instants.-    -> m a                       -- ^ Input generator.-    -> Session m                 -- ^ Initial session value.-    -> Wire e Identity a String  -- ^ Wire to test.-    -> m b-testWireP int delay getInput = loop 0-    where-    loop :: Int -> Session m -> Wire e Identity a String -> m b-    loop n' s' w' = do-        x' <- getInput-        (mx, w, s) <- stepSessionP w' s' x'-        n <- mx `seq` liftIO (testPrint n' int mx)-        when (delay > 0) (liftIO (threadDelay delay))-        loop n s w+countSession_ :: (Applicative m, MonadIO m) => t -> Session m (Timed t ())+countSession_ dt = countSession dt <*> pure ()
+ Control/Wire/Switch.hs view
@@ -0,0 +1,250 @@+-- |+-- Module:     Control.Wire.Switch+-- Copyright:  (c) 2013 Ertugrul Soeylemez+-- License:    BSD3+-- Maintainer: Ertugrul Soeylemez <es@ertes.de>++module Control.Wire.Switch+    ( -- * Simple switching+      (-->),++      -- * Context switching+      modes,++      -- * Event-based switching+      -- ** Intrinsic+      switch,+      dSwitch,+      -- ** Intrinsic continuable+      kSwitch,+      dkSwitch,+      -- ** Extrinsic+      rSwitch,+      drSwitch,+      -- ** Extrinsic continuable+      krSwitch,+      dkrSwitch+    )+    where++import qualified Data.Map as M+import Control.Applicative+import Control.Arrow+import Control.Monad+import Control.Wire.Core+import Control.Wire.Event+import Control.Wire.Unsafe.Event+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 -->+++-- | 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'))+++-- | 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)
+ Control/Wire/Time.hs view
@@ -0,0 +1,38 @@+-- |+-- Module:     Control.Wire.Time+-- Copyright:  (c) 2013 Ertugrul Soeylemez+-- License:    BSD3+-- Maintainer: Ertugrul Soeylemez <es@ertes.de>++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 t `seq` (t, timeFrom t)
− Control/Wire/TimedMap.hs 
@@ -1,118 +0,0 @@--- |--- Module:     Control.Wire.TimedMap--- Copyright:  (c) 2012 Ertugrul Soeylemez--- License:    BSD3--- Maintainer: Ertugrul Soeylemez <es@ertes.de>------ Timed maps for efficient cleanups in the context wires.--module Control.Wire.TimedMap-    ( -- * Timed maps-      TimedMap,-      -- * Queries-      findWithDefault,-      lookup,-      -- * Construction-      empty,-      -- * Insertion-      insert,-      -- * Deletion-      cleanup,-      cut,-      delete-    )-    where--import qualified Data.Map as M-import qualified Data.Set as S-import Control.Monad-import Data.Data-import Data.Map (Map)-import Data.Set (Set)-import Prelude hiding (lookup)----- | A timed map is a map with an additional index based on time.--data TimedMap t k a =-    TimedMap !(Map k (a, t)) !(Map t (Set k))-    deriving (Data, Show, Typeable)----- | Remove all elements older than the given time.--cleanup :: (Ord k, Ord t) => t -> TimedMap t k a -> TimedMap t k a-cleanup t0 (TimedMap mk' mt') = TimedMap mk mt-    where-    (older', middle, mt) = M.splitLookup t0 mt'-    older =-        M.fromDistinctAscList .-        map (, ()) .-        S.toList .-        M.foldl' S.union S.empty .-        maybe id (M.insert t0) middle $ older'-    mk = mk' M.\\ older----- | Remove all but the given number of latest elements.--cut :: (Ord k, Ord t) => Int -> TimedMap t k a -> TimedMap t k a-cut n !tm@(TimedMap mk mt)-    | M.size mk > n =-        let k = S.findMin . snd . M.findMin $ mt in-        cut n (delete k tm)-    | otherwise = tm----- | Deletes the given key from the timed map.--delete :: (Ord k, Ord t) => k -> TimedMap t k a -> TimedMap t k a-delete k (TimedMap mk' mt') = TimedMap mk mt-    where-    mk = M.delete k mk'-    mt = case M.lookup k mk' of-           Nothing     -> mt'-           Just (_, t') ->-               let alter Nothing = Nothing-                   alter (Just s') = do-                       let s = S.delete k s'-                       guard (not (S.null s))-                       return s-               in M.alter alter t' mt'----- | Like 'lookup', but with a default value, if the key is not in the--- map.--findWithDefault :: (Ord k) => (a, t) -> k -> TimedMap t k a -> (a, t)-findWithDefault def k = maybe def id . lookup k----- | Empty timed map.--empty :: TimedMap t k a-empty = TimedMap M.empty M.empty----- | Insert into the timed map.--insert :: (Ord k, Ord t) => t -> k -> a -> TimedMap t k a -> TimedMap t k a-insert t k x (TimedMap mk' mt') = TimedMap mk mt-    where-    mk = M.insert k (x, t) mk'-    mt = case M.lookup k mk' of-           Nothing      -> M.insertWith S.union t (S.singleton k) mt'-           Just (_, t') ->-               let alter Nothing = Nothing-                   alter (Just s') = do-                       let s = S.delete k s'-                       guard (not (S.null s))-                       return s-               in M.insertWith S.union t (S.singleton k) .-                  M.alter alter t' $ mt'----- | Look up the given key in the timed map.--lookup :: (Ord k) => k -> TimedMap t k a -> Maybe (a, t)-lookup k (TimedMap mk _) = M.lookup k mk
− Control/Wire/Trans.hs 
@@ -1,25 +0,0 @@--- |--- Module:     Control.Wire.Trans--- Copyright:  (c) 2012 Ertugrul Soeylemez--- License:    BSD3--- Maintainer: Ertugrul Soeylemez <es@ertes.de>------ Proxy module to all wire combinator modules.--module Control.Wire.Trans-    ( -- * Reexports-      module Control.Wire.Trans.Combine,-      module Control.Wire.Trans.Embed,-      module Control.Wire.Trans.Event,-      module Control.Wire.Trans.Simple,-      module Control.Wire.Trans.Switch,-      module Control.Wire.Trans.Time-    )-    where--import Control.Wire.Trans.Combine-import Control.Wire.Trans.Embed-import Control.Wire.Trans.Event-import Control.Wire.Trans.Simple-import Control.Wire.Trans.Switch-import Control.Wire.Trans.Time
− Control/Wire/Trans/Combine.hs 
@@ -1,110 +0,0 @@--- |--- Module:     Control.Wire.Trans.Combine--- Copyright:  (c) 2012 Ertugrul Soeylemez--- License:    BSD3--- Maintainer: Ertugrul Soeylemez <es@ertes.de>------ Wire combinators to manage sets of wires.--module Control.Wire.Trans.Combine-    ( -- * Multiplexing-      context,-      contextLatest,-      contextLimit,--      -- * Multicast-      multicast-    )-    where--import qualified Control.Wire.TimedMap as Tm-import qualified Data.Map as M-import qualified Data.Traversable as T-import Control.Wire.TimedMap (TimedMap)-import Control.Wire.Wire-import Data.Map (Map)----- | The argument function turns the input signal into a context.  For--- each context the given base wire evolves individually.------ Note: Incorrect usage can lead to a memory leak.  Consider using--- 'contextLimit' instead.------ * Complexity:  O(n) space, O(log n) time wrt to number of stored--- contexts.------ * Depends: current instant.------ * Inhibits: when the context wire inhibits.--context ::-    forall a b m e k. (Monad m, Ord k)-    => (a -> k)      -- ^ Function to turn the signal into a context.-    -> Wire e m a b  -- ^ Base wire.-    -> Wire e m a b-context key w0 = context' M.empty 0-    where-    context' :: Map k (Wire e m a b, Time) -> Time -> Wire e m a b-    context' !ctxs t' =-        mkGen $ \dt' x' -> do-            let ctx      = key x'-                (w', t0) = M.findWithDefault (w0, t') ctx ctxs-                t        = t' + dt'-                dt       = t - t0-            (mx, w) <- dt `seq` stepWire w' dt x'-            return (mx, context' (M.insert ctx (w, t) ctxs) t)----- | Same as 'context', but keeps only the latest given number of--- contexts.--contextLatest ::-    (Monad m, Ord k)-    => (a -> k)      -- ^ Signal to context.-    -> Int           -- ^ Maximum number of latest wires.-    -> Wire e m a b  -- ^ Base wire.-    -> Wire e m a b-contextLatest key maxWires = contextLimit key (\_ _ -> Tm.cut maxWires)----- | Same as 'context', but applies the given cleanup function to the--- context map at every instant.  This can be used to drop older wires.--contextLimit ::-    forall a b m e k. (Monad m, Ord k)-    => (a -> k)      -- ^ Function to turn the signal into a context.-    -> (forall w. Int -> Time -> TimedMap Time k w -> TimedMap Time k w)-            -- ^ Cleanup function.  Receives the current instant number,-            -- the current local time and the current map.-    -> Wire e m a b  -- ^ Base wire.-    -> Wire e m a b-contextLimit key uf w0 = context' 0 Tm.empty 0-    where-    context' :: Int -> TimedMap Time k (Wire e m a b) -> Time -> Wire e m a b-    context' !n !ctxs t' =-        mkGen $ \dt' x' -> do-            let ctx      = key x'-                (w', t0) = Tm.findWithDefault (w0, t') ctx ctxs-                t        = t' + dt'-                dt       = t - t0-            (mx, w) <- dt `seq` stepWire w' dt x'-            return (mx, context' (n + 1) (uf n t (Tm.insert t ctx w ctxs)) t)----- | Broadcast the input signal to all of the given wires collecting--- their results.  Each of the given subwires is evolved individually.------ * Depends: like the most dependent subwire.------ * Inhibits: when any of the subwires inhibits.--multicast ::-    (Monad m, T.Traversable f)-    => f (Wire e m a b)-    -> Wire e m a (f b)-multicast ws' =-    mkGen $ \dt x' -> do-        res <- T.mapM (\w -> stepWire w dt x') ws'-        let resx = T.sequence . fmap (\(mx, w) -> fmap (, w) mx) $ res-        return (fmap (fmap fst) resx, multicast (fmap snd res))
− Control/Wire/Trans/Embed.hs 
@@ -1,47 +0,0 @@--- |--- Module:     Control.Wire.Trans.Embed--- Copyright:  (c) 2012 Ertugrul Soeylemez--- License:    BSD3--- Maintainer: Ertugrul Soeylemez <es@ertes.de>------ Combinators for embedding wires.--module Control.Wire.Trans.Embed-    ( -- * Embedding wires-      embed-    )-    where--import Control.Wire.Wire----- | Performs the argument wire with the input time delta.  It is--- stepped often enough to catch up with the main wire.  The individual--- results are combined as given by the fold (second and third--- argument).------ * Complexity: O(n) time wrt stepping the subwire, where n is the---   number of times the subwire is stepped.------ * Depends: like argument wire, if stepped.------ * Inhibits: When the fold results in a 'Left'.--embed ::-    (Monad m)-    => (a -> Time)                -- ^ Time delta for the subwire.-    -> (Either e c -> Either e b -> Either e c)  -- ^ Folding function.-    -> Either e c                      -- ^ Fold base value.-    -> Wire e m a b               -- ^ Subwire to step.-    -> Wire e m a c-embed delta fold z = embed' 0-    where-    embed' rdt w0 =-        mkGen $ \dt x' ->-            let idt = delta x'-                loop odt r w'-                    | odt >= idt = do-                        (mx, w) <- stepWire w' idt x'-                        loop (odt - idt) (fold r mx) w-                    | otherwise = return (r, embed' odt w')-            in loop (rdt + dt) z w0
− Control/Wire/Trans/Event.hs 
@@ -1,211 +0,0 @@--- |--- Module:     Control.Wire.Trans.Event--- Copyright:  (c) 2012 Ertugrul Soeylemez--- License:    BSD3--- Maintainer: Ertugrul Soeylemez <es@ertes.de>------ Event-related wire combinators.--module Control.Wire.Trans.Event-    ( -- * Combinators-      eitherE,-      (<||>),--      -- * Holding events-      hold,-      hold_,-      holdFor,-      holdForI,--      -- * Inhibition-      (<!>),-      event,-      exhibit,-      gotEvent,-      notE-    )-    where--import Control.Arrow-import Control.Category-import Control.Wire.Types-import Control.Wire.Wire-import Data.Monoid hiding ((<>))-import Data.Semigroup-import Prelude hiding ((.), id)----- | Try both wires combining their results with the given functions.------ * Like argument wires.------ * Inhibits: when both wires inhibit.--eitherE ::-    (Monad m, Monoid e)-    => (b1 -> b)        -- ^ Only left.-    -> (b2 -> b)        -- ^ Only right.-    -> (b1 -> b2 -> b)  -- ^ Both.-    -> Wire e m a b1   -- ^ First wire.-    -> Wire e m a b2   -- ^ Second wire.-    -> Wire e m a b-eitherE left right both = eitherE'-    where-    eitherE' w1' w2' =-        mkGen $ \dt x' -> do-            (mx1, w1) <- stepWire w1' dt x'-            (mx2, w2) <- stepWire w2' dt x'-            let res =-                    case (mx1, mx2) of-                      (Left ex1, Left ex2) -> Left (mappend ex1 ex2)-                      (Right x1, Right x2) -> Right (both x1 x2)-                      (Right x1, _)        -> Right (left x1)-                      (_, Right x2)        -> Right (right x2)-            return (res, eitherE' w1 w2)----- | Semigroup version of 'eitherE'.--(<||>) ::-    (Monad m, Monoid e, Semigroup b)-    => Wire e m a b-    -> Wire e m a b-    -> Wire e m a b-(<||>) = eitherE id id (<>)----- | If the argument wire inhibits, inhibit with the given exception--- instead.------ * Depends: like argument wire.------ * Inhibits: like argument wire.--(<!>) :: (Monad m) => Wire e m a b -> e -> Wire e m a b-w <!> ex = mapOutput (either (Left . const ex) Right) w----- | Prevent a wire from inhibiting.  Instead produce a signal wrapped--- in 'Maybe'.------ Note:  You probably shouldn't use this function.------ * Depends: like argument wire.--event :: (Monad m) => Wire e m a b -> Wire e m a (Maybe b)-event = mapOutput (Right . either (const Nothing) Just)----- | Prevent a wire from inhibiting.  Instead produce the inhibition--- value.------ Note:  You probably shouldn't use this function.------ * Depends: like argument wire.--exhibit :: (Monad m) => Wire e m a b -> Wire e m a (Either e b)-exhibit = mapOutput Right----- | Prevent a wire from inhibiting.  Instead produce 'False', if the--- wire inhibited.------ Note:  You probably shouldn't use this function.------ * Depends: like argument wire.--gotEvent :: (Monad m) => Wire e m a b -> Wire e m a Bool-gotEvent = mapOutput (Right . either (const False) (const True))----- | Hold the latest event.  Produces the last produced value starting--- with the given one.------ * Depends: like argument wire.--hold :: (Monad m) => b -> Wire e m a b -> Wire e m a b-hold x0 w' =-    mkGen $ \dt x' -> do-        (mx, w) <- stepWire w' dt x'-        case mx of-          Left _  -> return (Right x0, hold x0 w)-          Right x -> return (Right x, hold x w)----- | Hold the event.  Once the argument wire produces the produced value--- is held until the argument wire produces again.------ * Depends: like argument wire.------ * Inhibits: until the argument wire produces for the first time.--hold_ :: (Monad m) => Wire e m a b -> Wire e m a b-hold_ w' =-    mkGen $ \dt x' -> do-        (mx, w) <- stepWire w' dt x'-        return (mx, either (const hold_) hold mx w)----- | Hold the event for the given amount of time.  When the argument--- wire produces, the produced value is kept for the given amount of--- time.  If the wire produces again while another value is kept, the--- new value takes precedence.------ * Depends: like argument wire.------ * Inhibits: as described.--holdFor :: (Monad m) => Time -> Wire e m a b -> Wire e m a b-holdFor t0 w = hold' . exhibit w-    where-    hold' =-        mkPure $ \_ mx ->-            case mx of-              Left _  -> (mx, hold')-              Right x -> (mx, hold'' t0 x)--    hold'' t' x' =-        mkPure $ \dt mx ->-            let t = t' - dt in-            case mx of-              Left _-                  | t > 0     -> (Right x', hold'' t x')-                  | otherwise -> (mx, hold')-              Right x -> (mx, hold'' t0 x)----- | Hold the event for the given number of instances.  When the--- argument wire produces, the produced value is kept for the given--- number of instances.  If the wire produces again while another value--- is kept, the new value takes precedence.------ * Depends: like argument wire.------ * Inhibits: as described.--holdForI :: (Monad m) => Int -> Wire e m a b -> Wire e m a b-holdForI t0 w = hold' . exhibit w-    where-    hold' = mkPure $ \_ -> id &&& either (const hold') (hold'' t0)--    hold'' t x'-        | t <= 0 = hold'-        | otherwise =-            mkPure $ \_ mx ->-                case mx of-                  Left _  -> (Right x', hold'' (t - 1) x')-                  Right x -> (mx, hold'' t0 x)----- | Act like the identity wire, if the argument wire inhibits.--- Inhibit, if the argument wire produces.------ * Depends: like argument wire.------ * Inhibits: when argument wire produces.--notE :: (Monad m, Monoid e) => Event e m a -> Event e m a-notE w' =-    mkGen $ \dt x' -> do-        (mx, w) <- stepWire w' dt x'-        return (either (const $ Right x') (const $ Left mempty) mx, notE w)
− Control/Wire/Trans/Simple.hs 
@@ -1,49 +0,0 @@--- |--- Module:     Control.Wire.Trans.Simple--- Copyright:  (c) 2012 Ertugrul Soeylemez--- License:    BSD3--- Maintainer: Ertugrul Soeylemez <es@ertes.de>------ Basic wire combinators.--module Control.Wire.Trans.Simple-    ( -- * Predicate-based-      ifW-    )-    where--import Control.Arrow-import Control.Monad-import Control.Wire.Wire-import Data.Monoid-import Prelude hiding ((.), id)----- | The wire @ifW p x y@ acts like @x@, when the predicate @p@ is true,--- otherwise @y@.------ * Complexity: like the predicate and the chosen wire.------ * Depends: like the predicate and the chosen wire.------ * Inhibits: when the predicate or the chosen wire inhibits.--ifW ::-    (Monad m, Monoid e)-    => Wire e m a Bool  -- ^ Predicate.-    -> Wire e m a b     -- ^ If true.-    -> Wire e m a b     -- ^ If false.-    -> Wire e m a b-ifW = ifW' 0 0-    where-    ifW' !tx !ty wp' wx' wy' =-        mkGen $ \dt x' -> do-            (mb, wp) <- stepWire wp' dt x'-            case mb of-              Left ex -> return (Left ex, ifW' (tx + dt) (ty + dt) wp wx' wy')-              Right b ->-                  if b-                    then liftM (second (\wx -> ifW' 0 (ty + dt) wp wx wy')) $-                         stepWire wx' (tx + dt) x'-                    else liftM (second (ifW' (tx + dt) 0 wp wx')) $-                         stepWire wy' (ty + dt) x'
− Control/Wire/Trans/Switch.hs 
@@ -1,101 +0,0 @@--- |--- Module:     Control.Wire.Trans.Switch--- Copyright:  (c) 2012 Ertugrul Soeylemez--- License:    BSD3--- Maintainer: Ertugrul Soeylemez <es@ertes.de>------ Switching combinators.  Notice that these combinators restart time--- when switching.--module Control.Wire.Trans.Switch-    ( -- * Simple switching-      andThen,-      switch,-      switchBy,-      (-->)-    )-    where--import Control.Arrow-import Control.Monad-import Control.Wire.Wire----- | Infix variant of 'andThen'.------ This operator is right-associative with precedence 1.--(-->) :: (Monad m) => Wire e m a b -> Wire e m a b -> Wire e m a b-(-->) = andThen--infixr 1 -->----- | Behaves like the first wire until it inhibits.  Switches to the--- second wire as soon as the first one inhibits.------ The @`andThen`@ operator is right-associative with precedence 1.------ * Depends: like currently active wire.------ * Inhibits: when switched to second wire and that one inhibits.------ * Time: switching restarts time.--andThen ::-    (Monad m)-    => Wire e m a b  -- ^ Wire to start with.-    -> Wire e m a b  -- ^ Wire to switch into.-    -> Wire e m a b-andThen w1' w2' =-    mkGen $ \dt x' -> do-        (mx, w1) <- stepWire w1' dt x'-        case mx of-          Left _  -> stepWire w2' dt x'-          Right _ -> return (mx, andThen w1 w2')--infixr 1 `andThen`----- | If the first argument wire produces a wire, switch to it--- immediately.  If not, evolve the current wire.  The second argument--- wire is the initial wire.------ * Depends: like event wire and the currently active wire.------ * Inhibits: when the currently active wire inhibits.------ * Time: switching restarts time.--switch ::-    (Monad m)-    => Wire e m a (Wire e m a b)  -- ^ Produces a wire to switch into.-    -> Wire e m a b               -- ^ Initial wire.-    -> Wire e m a b-switch wnew' w0 =-    mkGen $ \dt x' -> do-        (w', wnew) <- liftM (first (either (const w0) id)) (stepWire wnew' dt x')-        (mx, w) <- stepWire w' dt x'-        return (mx, switch wnew w)----- | Whenever the given wire inhibits, a new wire is constructed using--- the given function.------ * Depends: like currently active wire.------ * Time: switching restarts time.--switchBy ::-    (Monad m)-    => (e' -> Wire e' m a b)  -- ^ Wire selection function.-    -> Wire e' m a b          -- ^ Initial wire.-    -> Wire e m a b-switchBy new w0 =-    mkGen $ \dt x' ->-        let select w' = do-                (mx, w) <- stepWire w' dt x'-                case mx of-                  Left ex -> select (new ex)-                  Right x -> return (Right x, switchBy new w)-        in select w0
− Control/Wire/Trans/Time.hs 
@@ -1,31 +0,0 @@--- |--- Module:     Control.Wire.Trans.Time--- Copyright:  (c) 2012 Ertugrul Soeylemez--- License:    BSD3--- Maintainer: Ertugrul Soeylemez <es@ertes.de>------ Time-related wire combinators.--module Control.Wire.Trans.Time-    ( -- * Local time-      mapTime-    )-    where--import Control.Arrow-import Control.Monad-import Control.Wire.Wire----- | Maps the given function over the time deltas for the given wire.------ * Complexity: like argument wire.------ * Depends: like argument wire.------ * Inhibits: like argument wire.--mapTime :: (Monad m) => (Time -> Time) -> Wire e m a b -> Wire e m a b-mapTime f w' =-    mkGen $ \dt ->-        liftM (second (mapTime f)) . stepWire w' (f dt)
− Control/Wire/Types.hs 
@@ -1,161 +0,0 @@--- |--- Module:     Control.Wire.Types--- Copyright:  (c) 2012 Ertugrul Soeylemez--- License:    BSD3--- Maintainer: Ertugrul Soeylemez <es@ertes.de>------ Types used in Netwire.  Most notably this module implements the--- instances for the various reactive classes.--module Control.Wire.Types-    ( -- * Convenient type aliases-      LastException,-      -- ** Events-      Event,-      EventM,-      EventP,-      -- ** Wires-      WireM,-      WireP,--      -- * Type-related utilities-      as,-      inAs,-      inLike,-      like,-      outAs,-      outLike,-      -- ** Predefined proxies-      pDouble,-      pFloat,-      pInt,-      pInteger,-      pString-    )-    where--import Control.Category-import Control.Exception (SomeException)-import Control.Monad-import Control.Monad.Identity-import Control.Wire.Wire-import Data.Monoid-import Data.Proxy-import Prelude hiding ((.), id)----- | Event wires are wires that act like identity wires, but may inhibit--- depending on whether a certain event has occurred.--type Event e m a = Wire e m a a----- | 'WireP' equivalent of 'Event'.--type EventP a = WireP a a----- | 'WireM' equivalent of 'Event'.--type EventM m a = WireM m a a----- | Monoid for the last occurred exception.--type LastException = Last SomeException----- | Monadic wires using 'LastException' as the inhibition monoid.--type WireM = Wire LastException----- | Pure wires using 'LastException' as the inhibition monoid.--type WireP = WireM Identity----- | Type-restricted identity wire.  This is useful to specify the type--- of a signal.------ * Depends: current instant.--as :: (Monad m) => Proxy a -> Wire e m a a-as _ = id----- | Utility to specify the input type of a wire.  The argument is--- ignored.  For types with defaulting you might prefer 'inLike'.------ > inAs (Proxy :: Proxy Double) highPeak--inAs :: Proxy a -> w a b -> w a b-inAs = const id----- | Utility to specify the input type of a wire.  The first argument is--- ignored.  This is useful to make use of defaulting or when writing a--- dummy value is actually shorter.------ > inLike (0 :: Double) highPeak--inLike :: a -> w a b -> w a b-inLike = const id----- | Type-restricted identity wire.  This is useful to specify the type--- of a signal.  The argument is ignored.------ * Depends: current instant.--like :: (Monad m) => a -> Wire e m a a-like = const id----- | Utility to specify the output type of a wire.  The argument is--- ignored.  For types with defaulting you might prefer 'outLike'.------ > outAs (Proxy :: Proxy Double) noiseM--outAs :: Proxy b -> w a b -> w a b-outAs = const id----- | Utility to specify the output type of a wire.  The first argument--- is ignored.  This is useful to make use of defaulting or when writing--- a dummy value is actually shorter.------ > outLike (0 :: Double) noiseM--outLike :: b -> w a b -> w a b-outLike = const id----- | 'Double' proxy for use with 'inAs' or 'outAs'.--pDouble :: Proxy Double-pDouble = Proxy----- | 'Float' proxy for use with 'inAs' or 'outAs'.--pFloat :: Proxy Float-pFloat = Proxy----- | 'Int' proxy for use with 'inAs' or 'outAs'.--pInt :: Proxy Int-pInt = Proxy----- | 'Integer' proxy for use with 'inAs' or 'outAs'.--pInteger :: Proxy Integer-pInteger = Proxy----- | 'String' proxy for use with 'inAs' or 'outAs'.--pString :: Proxy String-pString = Proxy
+ Control/Wire/Unsafe/Event.hs view
@@ -0,0 +1,78 @@+-- |+-- Module:     Control.Wire.Unsafe.Event+-- Copyright:  (c) 2013 Ertugrul Soeylemez+-- License:    BSD3+-- Maintainer: Ertugrul Soeylemez <es@ertes.de>++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)
− Control/Wire/Wire.hs 
@@ -1,376 +0,0 @@--- |--- Module:     Control.Wire.Wire--- Copyright:  (c) 2012 Ertugrul Soeylemez--- License:    BSD3--- Maintainer: Ertugrul Soeylemez <es@ertes.de>------ This is the core module implementing the 'Wire' type.--module Control.Wire.Wire-    ( -- * Wires-      Wire(..),-      Time,-      -- ** Constructing wires-      mkFix,-      mkFixM,-      mkGen,-      mkPure,-      mkState,-      mkStateM,-      -- ** Simple predefined wires-      constant,-      identity,-      never,-      -- ** Simple predefined combinators-      cons,-      fixW,-      mapOutput,--      -- * Stepping-      stepWire,-      stepWireP-    )-    where--import qualified Data.Bifunctor as Bi-import Control.Applicative-import Control.Arrow-import Control.Category-import Control.Monad-import Control.Monad.Fix-import Control.Monad.Identity-import Data.AdditiveGroup-import Data.AffineSpace-import Data.Cross-import Data.Monoid-import Data.Profunctor-import Data.String-import Data.VectorSpace-import Prelude hiding ((.), id)----- | Time.--type Time = Double----- | A wire is a signal function from an input value of type @a@ that--- either /produces/ an output value of type @b@ or /inhibits/ with a--- value of type @e@.  The underlying monad is @m@.--data Wire e m a b-    = WGen (Time -> a -> m (Either e b, Wire e m a b))-    | WPure (Time -> a -> (Either e b, Wire e m a b))--instance (AdditiveGroup b, Monad m) => AdditiveGroup (Wire e m a b) where-    zeroV = pure zeroV-    (^+^) = liftA2 (^+^)-    negateV = fmap negateV--instance (AdditiveGroup (Diff b), AffineSpace b, Monad m) => AffineSpace (Wire e m a b) where-    type Diff (Wire e m a b) = Wire e m a (Diff b)-    (.-.) = liftA2 (.-.)-    (.+^) = liftA2 (.+^)--instance (Monad m, Monoid e) => Alternative (Wire e m a) where-    empty = mkFix (const . const $ Left mempty)--    (<|>) = loop 0-        where-        loop !t2 (WPure f1) w2'@(WPure f2) =-            mkPure $ \dt x' ->-                let (mx1, w1) = f1 dt x' in-                case mx1 of-                  Left ex1 ->-                      let (mx2, w2) = f2 (t2 + dt) x' in-                      (Bi.first (mappend ex1) mx2, loop 0 w1 w2)-                  Right _ -> (mx1, loop (t2 + dt) w1 w2')--        loop !t2 w1' w2' =-            mkGen $ \dt x' -> do-                (mx1, w1) <- stepWire w1' dt x'-                case mx1 of-                  Left ex1 -> do-                      (mx2, w2) <- stepWire w2' (t2 + dt) x'-                      return (Bi.first (mappend ex1) mx2, loop 0 w1 w2)-                  Right _ -> return (mx1, loop (t2 + dt) w1 w2')--instance (Monad m) => Applicative (Wire e m a) where-    pure = constant--    (<*>) = loop 0-        where-        loop !tx (WPure ff) wx'@(WPure fx) =-            mkPure $ \dt x' ->-                let (mf, wf) = ff dt x' in-                case mf of-                  Right f ->-                      let (mx, wx) = fx (tx + dt) x' in-                      (fmap f mx, loop 0 wf wx)-                  Left ex -> (Left ex, loop (tx + dt) wf wx')--        loop !tx wf' wx' =-            mkGen $ \dt x' -> do-                (mf, wf) <- stepWire wf' dt x'-                case mf of-                  Right f -> do-                      (mx, wx) <- stepWire wx' (tx + dt) x'-                      return (fmap f mx, loop 0 wf wx)-                  Left ex -> return (Left ex, loop (tx + dt) wf wx')--instance (Monad m) => Arrow (Wire e m) where-    arr f     = mkFix (const $ Right . f)-    first w   = liftA2 (,) (lmap fst w) (arr snd)-    second w  = liftA2 (,) (arr fst) (lmap snd w)-    (&&&)     = liftA2 (,)-    w1 *** w2 = liftA2 (,) (lmap fst w1) (lmap snd w2)--instance (Monad m) => ArrowChoice (Wire e m) where-    (|||) = loop 0 0-        where-        loop !tl !tr wl' wr' =-            mkGen $ \dt ->-                either (\x' -> do-                            (mx, wl) <- stepWire wl' (tl + dt) x'-                            return (mx, loop 0 (tr + dt) wl wr'))-                       (\x' -> do-                            (mx, wr) <- stepWire wr' (tr + dt) x'-                            return (mx, loop (tl + dt) 0 wl' wr))--    w1 +++ w2 = fmap Left w1 ||| fmap Right w2--    left = loop 0-        where-        loop !tl wl' =-            mkGen $ \dt ->-                either (liftM (fmap Left *** loop 0) . stepWire wl' (tl + dt))-                       (\x -> return (Right (Right x), loop (tl + dt) wl'))--    right = loop 0-        where-        loop !tr wr' =-            mkGen $ \dt ->-                either (\x -> return (Right (Left x), loop (tr + dt) wr'))-                       (liftM (fmap Right *** loop 0) . stepWire wr' (tr + dt))--instance (MonadFix m) => ArrowLoop (Wire e m) where-    loop w' =-        mkGen $ \dt x' ->-            liftM (fmap fst *** loop) .-            mfix $ \ ~(mx, _) ->-                let feedbackErr = error "Feedback loop broken by inhibition" in-                stepWire w' dt (x', either (const feedbackErr) snd mx)--instance (Monad m, Monoid e) => ArrowPlus (Wire e m) where-    (<+>) = (<|>)--instance (Monad m, Monoid e) => ArrowZero (Wire e m) where-    zeroArrow = empty--instance (Monad m) => Category (Wire e m) where-    id = identity--    (.) = loop 0-        where-        loop !t2 w2'@(WPure f2) (WPure f1) =-            mkPure $ \dt x'' ->-                let (mx', w1) = f1 dt x'' in-                case mx' of-                  Right x' ->-                      let (mx, w2) = f2 (t2 + dt) x' in-                      (mx, loop 0 w2 w1)-                  Left ex -> (Left ex, loop (t2 + dt) w2' w1)--        loop !t2 w2' w1' =-            mkGen $ \dt x'' -> do-                (mx', w1) <- stepWire w1' dt x''-                case mx' of-                  Right x' -> do-                      (mx, w2) <- stepWire w2' (t2 + dt) x'-                      return (mx, loop 0 w2 w1)-                  Left ex -> return (Left ex, loop (t2 + dt) w2' w1)--instance (Floating b, Monad m) => Floating (Wire e m a b) where-    pi = pure pi-    sqrt = fmap sqrt--    (**) = liftA2 (**)-    exp = fmap exp-    log = fmap log-    logBase = liftA2 logBase--    cos  = fmap cos;  sin  = fmap sin;  tan  = fmap tan-    acos = fmap acos; asin = fmap asin; atan = fmap atan--    cosh  = fmap cosh;  sinh  = fmap sinh;  tanh  = fmap tanh-    acosh = fmap acosh; asinh = fmap asinh; atanh = fmap atanh--instance (Fractional b, Monad m) => Fractional (Wire e m a b) where-    (/) = liftA2 (/)-    fromRational = pure . fromRational-    recip = fmap recip--instance (Monad m) => Functor (Wire e m a) where-    fmap = mapOutput . fmap--instance (HasCross2 b, Monad m) => HasCross2 (Wire e m a b) where-    cross2 = fmap cross2--instance (HasCross3 b, Monad m) => HasCross3 (Wire e m a b) where-    cross3 = liftA2 cross3--instance (HasNormal b, Monad m) => HasNormal (Wire e m a b) where-    normalVec = fmap normalVec--instance (InnerSpace b, Monad m) => InnerSpace (Wire e m a b) where-    (<.>) = liftA2 (<.>)--instance (Monad m, Num b) => Num (Wire e m a b) where-    (+) = liftA2 (+)-    (-) = liftA2 (-)-    (*) = liftA2 (*)--    abs = fmap abs-    signum = fmap signum-    fromInteger = pure . fromInteger--instance (IsString b, Monad m) => IsString (Wire e m a b) where-    fromString = pure . fromString--instance (Monad m, Monoid b) => Monoid (Wire e m a b) where-    mempty  = pure mempty-    mappend = liftA2 mappend--instance (Monad m) => Profunctor (Wire e m) where-    lmap f (WPure g) = WPure (\dt -> second (lmap f) . g dt . f)-    lmap f (WGen g)  = WGen  (\dt -> liftM (second (lmap f)) . g dt . f)--    rmap = fmap--instance (Monad m, Read b) => Read (Wire e m a b) where-    readsPrec n = map (first pure) . readsPrec n--instance (Monad m, VectorSpace b) => VectorSpace (Wire e m a b) where-    type Scalar (Wire e m a b) = Wire e m a (Scalar b)-    (*^) = liftA2 (*^)----- | Wire cons.  Prepend the given value to the wire's output stream.--- This function is infixr like (':').------ * Depends: like argument wire after the first instant.------ * Inhibits: like argument wire after the first instant.--cons :: b -> Wire e m a b -> Wire e m a b-cons x xs = mkPure (\_ _ -> (Right x, xs))--infixr 5 `cons`----- | Variant of 'pure' without the 'Monad' constraint.  Using 'pure' is--- preferable.--constant :: b -> Wire e m a b-constant = mkFix . const . const . Right----- | Convenience combinator for the common case of feedback where you--- ignore the input and produce the feedback value itself with 'loop'.------ * Depends: like looped argument wire.------ * Inhibits: when argument wire inhibits.--fixW :: (MonadFix m) => Wire e m b b -> Wire e m a b-fixW = loop . fmap (\x -> (x, x)) . lmap snd----- | Variant of 'id' without the 'Monad' constraint.  Using 'id' is--- preferable.------ * Depends: current instant.--identity :: Wire e m a a-identity = WPure (\_ x -> (Right x, identity))----- | Map the given function over the raw wire output.--mapOutput :: (Monad m) => (Either e b' -> Either e b) -> Wire e m a b' -> Wire e m a b-mapOutput f (WGen g)  = WGen  (\dt -> liftM (f *** mapOutput f) . g dt)-mapOutput f (WPure g) = WPure (\dt -> (f *** mapOutput f) . g dt)----- | Construct a pure stateless wire from the given function.--mkFix :: (Time -> a -> Either e b) -> Wire e m a b-mkFix f = let w = mkPure (\dt -> (, w) . f dt) in w----- | Construct a stateless effectful wire from the given function.--mkFixM :: (Monad m) => (Time -> a -> m (Either e b)) -> Wire e m a b-mkFixM f = let w = mkGen (\dt -> liftM (, w) . f dt) in w----- | Construct an effectful wire from the given function.--mkGen :: (Time -> a -> m (Either e b, Wire e m a b)) -> Wire e m a b-mkGen = WGen----- | Construct a pure wire from the given function.--mkPure :: (Time -> a -> (Either e b, Wire e m a b)) -> Wire e m a b-mkPure = WPure----- | Construct a pure wire from the given local state transision--- function.--mkState ::-    s-    -> (Time -> (a, s) -> (Either e b, s))-    -> Wire e m a b-mkState s0 f = loop s0-    where-    loop s' =-        mkPure $ \dt x' ->-            let (mx, s) = f dt (x', s') in-            (mx, loop s)----- | Construct a monadic wire from the given local state transision--- function.--mkStateM ::-    (Monad m)-    => s-    -> (Time -> (a, s) -> m (Either e b, s))-    -> Wire e m a b-mkStateM s0 f = loop s0-    where-    loop s' =-        mkGen $ \dt x' -> liftM (second loop) (f dt (x', s'))----- | Variant of 'empty' without the 'Monad' constraint.  Using 'empty'--- is preferable.--never :: (Monoid e) => Wire e m a b-never = mkFix . const . const $ Left mempty----- | Perform an instant of the given wire.--stepWire :: (Monad m) => Wire e m a b -> Time -> a -> m (Either e b, Wire e m a b)-stepWire (WGen f)  dt = f dt-stepWire (WPure f) dt = return . f dt----- | Perform an instant of the given pure wire.--stepWireP :: Wire e Identity a b -> Time -> a -> (Either e b, Wire e Identity a b)-stepWireP (WGen f)  dt = runIdentity . f dt-stepWireP (WPure f) dt = f dt
+ FRP/Netwire.hs view
@@ -0,0 +1,46 @@+-- |+-- Module:     FRP.Netwire+-- Copyright:  (c) 2013 Ertugrul Soeylemez+-- License:    BSD3+-- Maintainer: Ertugrul Soeylemez <es@ertes.de>++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
+ FRP/Netwire/Analyze.hs view
@@ -0,0 +1,310 @@+-- |+-- Module:     FRP.Netwire.Analyze+-- Copyright:  (c) 2013 Ertugrul Soeylemez+-- License:    BSD3+-- Maintainer: Ertugrul Soeylemez <es@ertes.de>++module FRP.Netwire.Analyze+    ( -- * Linear graphs+      lAvg,+      lGraph,+      lGraphN,++      -- * Staircase graphs+      sAvg,+      sGraph,+      sGraphN,++      -- * Peaks+      highPeak,+      highPeakBy,+      lowPeak,+      lowPeakBy,++      -- * Debug+      avgFps,+      framerate+    )+    where++import qualified FRP.Netwire.Utils.Timeline as Tl+import qualified Data.Foldable as F+import qualified Data.Sequence as Seq+import Control.Wire+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])
+ FRP/Netwire/Move.hs view
@@ -0,0 +1,77 @@+-- |+-- Module:     FRP.Netwire.Move+-- Copyright:  (c) 2013 Ertugrul Soeylemez+-- License:    BSD3+-- Maintainer: Ertugrul Soeylemez <es@ertes.de>++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)
+ FRP/Netwire/Noise.hs view
@@ -0,0 +1,98 @@+-- |+-- Module:     FRP.Netwire.Noise+-- Copyright:  (c) 2013 Ertugrul Soeylemez+-- License:    BSD3+-- Maintainer: Ertugrul Soeylemez <es@ertes.de>++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
+ FRP/Netwire/Utils/Timeline.hs view
@@ -0,0 +1,176 @@+-- |+-- Module:     FRP.Netwire.Utils.Timeline+-- Copyright:  (c) 2013 Ertugrul Soeylemez+-- License:    BSD3+-- Maintainer: Ertugrul Soeylemez <es@ertes.de>++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 qualified Data.Map.Strict as M+import Control.Applicative+import Data.Data+import Data.Map.Strict (Map)+++-- | 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)
LICENSE view
@@ -1,5 +1,5 @@-Netwire license-Copyright (c) 2012, Ertugrul Soeylemez+netwire license+Copyright (c) 2013, Ertugrul Soeylemez  All rights reserved.
+ README.md view
@@ -0,0 +1,437 @@+Netwire+=======++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:++    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:++    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`:++    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:++    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:++    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:++    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:++    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:++    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:++    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:++    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:++    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):++    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:++    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++    liftA2 (+) time (pure 17)++we can simply write:++    time + 17++This clock starts at 17 instead of zero.  Let's make it run twice as+fast:++    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:++    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:++    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:++    integral 5 . time++Since `time` denotes $t$ the integral will be $\frac{1}{2} t^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:++    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:++    for 3++This wire acts like the identity wire in that it passes its input signal+through unchanged:++    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*:++    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:++    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:++    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:++    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:++    data Event a++For example the predefined `never` event is the event that never occurs:++    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`:++    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:++    at :: (HasTime t s) => t -> Wire s e m a (Event a)++Example:++    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:++    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:++    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:++    (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:++    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:++    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:++    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:++    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 `-->`:++    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:++    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:++    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:++    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!"
Setup.lhs view
@@ -1,5 +1,5 @@-Netwire setup script-Copyright (C) 2012, Ertugrul Soeylemez+netwire setup script+Copyright (C) 2013, Ertugrul Soeylemez  Please see the LICENSE file for terms and conditions of use, modification and distribution of this package, including this file.
+ default.nix view
@@ -0,0 +1,30 @@+# -*-conf-*-++{ }:+with import <nixpkgs> { };++let+  hs = haskellPackages;+  inherit (hs) cabal;+in rec {++  netwire =+    cabal.mkDerivation (self : rec {+      pname = "netwire";+      version = "5.0.0";+      isLibrary = true;+      isExecutable = false;++      src = ./dist/netwire- + "${version}.tar.gz";++      buildDepends = [+        hs.parallel+        hs.QuickCheck+        hs.semigroups+        hs.testFramework+        hs.testFrameworkQuickcheck2+        hs.testFrameworkTh+      ];+    });++}
netwire.cabal view
@@ -1,90 +1,99 @@-Name:          netwire-Version:       4.0.7-Category:      Control, FRP-Synopsis:      Flexible wire arrows for FRP-Maintainer:    Ertugrul Söylemez <es@ertes.de>-Author:        Ertugrul Söylemez <es@ertes.de>-Copyright:     (c) 2012 Ertugrul Söylemez-License:       BSD3-License-file:  LICENSE-Build-type:    Simple-Stability:     experimental-Cabal-version: >= 1.10-Description:-    Efficient and flexible wire arrows for functional reactive programming-    and other forms of locally stateful programming.+name:          netwire+version:       5.0.0+category:      FRP+synopsis:      Functional reactive programming library+maintainer:    Ertugrul Söylemez <es@ertes.de>+author:        Ertugrul Söylemez <es@ertes.de>+copyright:     (c) 2013 Ertugrul Söylemez+license:       BSD3+license-file:  LICENSE+build-type:    Simple+cabal-version: >= 1.10+extra-source-files: README.md default.nix+description:+    This library provides interfaces for and implements wire arrows+    useful both for functional reactive programming (FRP) and locally+    stateful programming (LSP). +flag TestProgram+    default: False+    description: Build the test program+    manual: True+ Source-repository head     type:     darcs-    location: http://darcs.ertes.de/netwire/+    location: http://hub.darcs.net/ertes/netwire -Library-    Build-depends:-        base          >= 4.0 && < 5,-        bifunctors    >= 0.1 && < 4,-        containers    >= 0.4 && < 1,-        deepseq       >= 1.3 && < 2,-        lifted-base   >= 0.1 && < 1,-        monad-control >= 0.3 && < 1,-        mtl           >= 2.0 && < 3,-        profunctors   >= 0.1 && < 4,-        random        >= 1.0 && < 2,-        semigroups    >= 0.8 && < 1,-        tagged        >= 0.4 && < 1,-        time          >= 1.4 && < 2,-        vector-space  >= 0.8 && < 1-    Default-language: Haskell2010-    Default-extensions:-        BangPatterns+library+    build-depends:+        base         >= 4.5 && < 5,+        containers   >= 0.5 && < 1,+        deepseq      >= 1.3 && < 2,+        parallel     >= 3.2 && < 4,+        random       >= 1.0 && < 2,+        semigroups   >= 0.9 && < 1,+        transformers >= 0.3 && < 1,+        time         >= 1.4 && < 2+    default-language: Haskell2010+    default-extensions:         DeriveDataTypeable-        FlexibleContexts+        DeriveFoldable+        DeriveFunctor+        DeriveTraversable         FlexibleInstances+        FunctionalDependencies+        GADTs         MultiParamTypeClasses         RankNTypes-        ScopedTypeVariables         TupleSections-        TypeFamilies-    GHC-Options: -W-    Exposed-modules:+    ghc-options: -W+    exposed-modules:         Control.Wire-        Control.Wire.Classes-        Control.Wire.Prefab-        Control.Wire.Prefab.Accum-        Control.Wire.Prefab.Analyze-        Control.Wire.Prefab.Effect-        Control.Wire.Prefab.Event-        Control.Wire.Prefab.List-        Control.Wire.Prefab.Move-        Control.Wire.Prefab.Noise-        Control.Wire.Prefab.Queue-        Control.Wire.Prefab.Sample-        Control.Wire.Prefab.Simple-        Control.Wire.Prefab.Time+        Control.Wire.Core+        Control.Wire.Event+        Control.Wire.Interval+        Control.Wire.Run         Control.Wire.Session-        Control.Wire.TimedMap-        Control.Wire.Trans-        Control.Wire.Trans.Combine-        Control.Wire.Trans.Embed-        Control.Wire.Trans.Event-        Control.Wire.Trans.Simple-        Control.Wire.Trans.Switch-        Control.Wire.Trans.Time-        Control.Wire.Types-        Control.Wire.Wire+        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,---         containers,+executable netwire-test+    build-depends:+        base >= 4.5 && < 5,+        containers,+        netwire+    default-language: Haskell2010+    default-extensions:+        Arrows+        OverloadedStrings+        RecursiveDo+    ghc-options: -threaded -rtsopts+    hs-source-dirs: test+    main-is: Test.hs+    if flag(testprogram)+        buildable: True+    else+        buildable: False++-- test-suite tests+--     type: exitcode-stdio-1.0+--     build-depends:+--         base >= 4.5 && < 5, --         netwire,---         random,---         time---     Default-language: Haskell2010---     Default-extensions:---         Arrows---         OverloadedStrings---         RecursiveDo---         TupleSections---     Hs-source-dirs: test---     Main-is: Main.hs---     GHC-Options: -threaded -rtsopts+--         QuickCheck,+--         test-framework,+--         test-framework-quickcheck2,+--         test-framework-th,+--         vty+--     default-language: Haskell2010+--     default-extensions:+--         TemplateHaskell+--     ghc-options: -W -threaded -rtsopts -with-rtsopts=-N+--     hs-source-dirs: test+--     main-is: Props.hs
+ test/Test.hs view
@@ -0,0 +1,20 @@+-- |+-- Module:     Main+-- Copyright:  (c) 2013 Ertugrul Soeylemez+-- License:    BSD3+-- Maintainer: Ertugrul Soeylemez <es@ertes.de>++module Main where++import Control.Monad.Fix+import Control.Wire+import Prelude hiding ((.), id)+++wire :: SimpleWire a String+wire =+    holdFor 0.5 . periodicList 1 (cycle ["a", "b", "c"]) <|> "---"+++main :: IO ()+main = testWire clockSession_ wire