packages feed

netwire 1.1.0 → 1.2.0

raw patch · 13 files changed

+407/−308 lines, 13 files

Files

FRP/NetWire.hs view
@@ -10,7 +10,7 @@  module FRP.NetWire     ( -- * Wires-      Wire, Event, Output, Time,+      Wire, Output, Time,        -- * Reactive sessions       Session,@@ -24,6 +24,11 @@       stepSF,       stepWirePure, +      -- * Inhibition+      InhibitException(..),+      inhibitEx,+      noEvent,+       -- * Netwire Reexports       module FRP.NetWire.Analyze,       module FRP.NetWire.Calculus,@@ -36,10 +41,14 @@       module FRP.NetWire.Tools,        -- * Other convenience reexports+      module Control.Monad.IO.Class,+      module Control.Monad.IO.Control,       module Data.Functor.Identity     )     where +import Control.Monad.IO.Class+import Control.Monad.IO.Control import Data.Functor.Identity import FRP.NetWire.Analyze import FRP.NetWire.Calculus
FRP/NetWire/Analyze.hs view
@@ -36,6 +36,8 @@ -- -- If you need an average over all samples ever produced, consider using -- 'avgAll' instead.+--+-- Never inhibits.  Feedback by delay.  avg :: forall m v. (Fractional v, Monad m, NFData v, U.Unbox v) => Int -> Wire m v v avg n = mkGen $ \_ x -> return (Right x, avg' (U.replicate n (x/d)) x 0)@@ -46,12 +48,12 @@             let cur = let cur = succ cur' in if cur >= n then 0 else cur                 x' = samples' U.! cur                 samples =-                    x' `seq` runST $ do+                    x' `deepseq` runST $ do                         s <- U.unsafeThaw samples'                         UM.write s cur x                         U.unsafeFreeze s             let s = s' - x' + x-            s `deepseq` return (Right s, avg' samples s cur)+            s' `deepseq` cur `seq` return (Right s, avg' samples s cur)      d :: v     d = realToFrac n@@ -62,6 +64,8 @@ -- Please note that somewhat surprisingly this wire runs in constant -- space and is generally faster than 'avg', but most applications will -- benefit from averages over only the last few samples.+--+-- Never inhibits.  Feedback by delay.  avgAll :: forall m v. (Fractional v, Monad m, NFData v) => Wire m v v avgAll = mkGen $ \_ x -> return (Right x, avgAll' 1 x)@@ -71,7 +75,7 @@         mkGen $ \_ x ->             let n = n' + 1                 a = a' - a'/n + x/n in-            n `deepseq` a `deepseq` return (Right a, avgAll' n a)+            n `deepseq` a' `deepseq` return (Right a, avgAll' n a)   -- | Calculate the average number of frames per virtual second for the@@ -81,6 +85,8 @@ -- using the stepping functions in "FRP.NetWire.Session".  If this clock -- doesn't represent real time, then the output of this wire won't -- either.+--+-- Never inhibits.  avgFps :: forall a m. Monad m => Int -> Wire m a Double avgFps = avgFps' . avg@@ -95,35 +101,43 @@ -- | Emits an event, whenever the input signal changes.  The event -- contains the last input value and the time elapsed since the last -- change.+--+-- Inhibits on no change. -diff :: forall a m. (Eq a, Monad m) => Wire m a (Event (a, Time))+diff :: forall a m. (Eq a, Monad m) => Wire m a (a, Time) diff =     mkGen $ \(wsDTime -> dt) x' ->-        return (Right Nothing, diff' dt x')+        return (Left noEvent, diff' dt x')      where-    diff' :: Time -> a -> Wire m a (Event (a, Time))+    diff' :: Time -> a -> Wire m a (a, Time)     diff' t' x' =         mkGen $ \(wsDTime -> dt) x ->             let t = t' + dt in             if x' == x-              then return (Right Nothing, diff' t x')-              else return (Right (Just (x', t)), diff' 0 x)+              then return (Left noEvent, diff' t x')+              else return (Right (x', t), diff' 0 x)   -- | Return the high peak.+--+-- Never inhibits.  Feedback by delay.  highPeak :: (Monad m, NFData a, Ord a) => Wire m a a highPeak = peakBy compare   -- | Return the low peak.+--+-- Never inhibits.  Feedback by delay.  lowPeak :: (Monad m, NFData a, Ord a) => Wire m a a lowPeak = peakBy (flip compare)   -- | Return the high peak with the given comparison function.+--+-- Never inhibits.  Feedback by delay.  peakBy :: forall a m. (Monad m, NFData a) => (a -> a -> Ordering) -> Wire m a a peakBy comp = mkGen $ \_ x -> return (Right x, peakBy' x)@@ -132,4 +146,4 @@     peakBy' p' =         mkGen $ \_ x -> do             let p = if comp x p' == GT then x else p'-            p `deepseq` return (Right p, peakBy' p)+            p' `deepseq` return (Right p, peakBy' p)
FRP/NetWire/Calculus.hs view
@@ -19,7 +19,9 @@ import FRP.NetWire.Wire  --- | Differentiate over time.  Inhibits at first instant.+-- | Differentiate over time.+--+-- Inhibits at first instant.  derivative :: (Monad m, NFData v, VectorSpace v, Scalar v ~ Double) => Wire m v v derivative =@@ -30,19 +32,28 @@  -- | Differentiate over time.  The argument is the value before the -- first instant.+--+-- Never inhibits.  Direct feedback. -derivativeFrom :: (Monad m, NFData v, VectorSpace v, Scalar v ~ Double) => v -> Wire m v v-derivativeFrom y1 =-    mkGen $ \(wsDTime -> dt) y2 -> do-        let dy = (y2 ^-^ y1) ^/ dt-        dy `deepseq` return (Right dy, derivativeFrom y2)+derivativeFrom ::+    forall m v. (Monad m, NFData v, VectorSpace v, Scalar v ~ Double) =>+    v -> Wire m v v+derivativeFrom y1 = derivativeFrom' zeroV y1+    where+    derivativeFrom' :: v -> v -> Wire m v v+    derivativeFrom' dy' y1 =+        mkGen $ \(wsDTime -> dt) y2 -> do+            let dy = (y2 ^-^ y1) ^/ dt+            dy' `deepseq` return (Right dy', derivativeFrom' dy y2)   -- | Integrate over time.  The argument is the integration constant.+--+-- Never inhibits.  Direct feedback.  integral :: (Monad m, NFData v, VectorSpace v, Scalar v ~ Double) => v -> Wire m v v integral x1 =     mkGen $ \ws dx -> do         let dt = wsDTime ws             x2 = x1 ^+^ dt *^ dx-        x2 `deepseq` return (Right x2, integral x2)+        x1 `deepseq` return (Right x1, integral x2)
FRP/NetWire/Concurrent.hs view
@@ -25,7 +25,7 @@ import FRP.NetWire.Wire  --- | Concurrent version of '(***)'.  Passes its input signals to both+-- | Concurrent version of '***'.  Passes its input signals to both -- argument wires concurrently.  (~*~) :: Wire IO a c -> Wire IO b d -> Wire IO (a, b) (c, d)@@ -41,7 +41,7 @@ infixr 3 ~*~  --- | Concurrent version of '(&&&)'.  Passes its input signal to both+-- | Concurrent version of '&&&'.  Passes its input signal to both -- argument wires concurrently.  (~&~) :: Wire IO a b -> Wire IO a c -> Wire IO a (b, c)@@ -50,7 +50,7 @@ infixr 3 ~&~  --- | Concurrent version of '(<+>)'.  Passes its input signal to both+-- | Concurrent version of '<+>'.  Passes its input signal to both -- argument wires concurrently, returning the result of the first wire -- which does not inhibit.
FRP/NetWire/Event.hs view
@@ -4,7 +4,8 @@ -- License:    BSD3 -- Maintainer: Ertugrul Soeylemez <es@ertes.de> ----- Events.+-- Events.  None of these wires supports feedback, because they all can+-- inhibit.  module FRP.NetWire.Event     ( -- * Producing events@@ -14,14 +15,10 @@       edgeBy,       edgeJust,       never,-      now,       once,       repeatedly,       repeatedlyList, -      -- * Wire transformers-      wait,-       -- * Event transformers       -- ** Delaying events       dam,@@ -33,10 +30,8 @@       notYet,       takeEvents,       takeFor,-      -- ** Manipulating events-      accum,-      -- ** Mapping to continuous signals-      hold, dHold+      -- ** Tools+      event     )     where @@ -49,32 +44,16 @@ import FRP.NetWire.Wire  --- | This function corresponds to the 'iterate' function for lists.--- Begins with an initial output value, which is not emitted.  Each time--- an input event is received, its function is applied to the current--- accumulator and the new value is emitted.--accum :: forall a m. Monad m => a -> Wire m (Event (a -> a)) (Event a)-accum ee' = accum'-    where-    accum' :: Wire m (Event (a -> a)) (Event a)-    accum' =-        mkGen $ \_ ->-            return .-            maybe (Right Nothing, accum')-                  (\f -> let ee = f ee' in ee `seq` (Right (Just ee), accum ee))----- | Produce an event once after the specified delay and never again.+-- | Produce a signal once after the specified delay and never again. -- The event's value will be the input signal at that point. -after :: Monad m => Time -> Wire m a (Event a)+after :: Monad m => Time -> Wire m a a after t' =     mkGen $ \(wsDTime -> dt) x ->         let t = t' - dt in         if t <= 0-          then return (Right (Just x), never)-          else return (Right Nothing, after t)+          then return (Right x, never)+          else return (Left noEvent, after t)   -- | Produce an event according to the given list of time deltas and@@ -83,18 +62,18 @@ -- produces the event @'a'@ after one second, @'b'@ after three seconds -- and @'c'@ after six seconds. -afterEach :: forall a b m. Monad m => [(Time, b)] -> Wire m a (Event b)+afterEach :: forall a b m. Monad m => [(Time, b)] -> Wire m a b afterEach = afterEach' 0     where-    afterEach' :: Time -> [(Time, b)] -> Wire m a (Event b)+    afterEach' :: Time -> [(Time, b)] -> Wire m a b     afterEach' _ [] = never     afterEach' t' d@((int, x):ds) =         mkGen $ \(wsDTime -> dt) _ ->             let t = t' + dt in             if t >= int               then let nextT = t - int-                   in nextT `seq` return (Right (Just x), afterEach' (t - int) ds)-              else return (Right Nothing, afterEach' t d)+                   in nextT `seq` return (Right x, afterEach' (t - int) ds)+              else return (Left noEvent, afterEach' t d)   -- | Event dam.  Collects all values from the input list and emits one@@ -103,15 +82,15 @@ -- Note that this combinator can cause event congestion.  If you feed -- values faster than it can produce, it will leak memory. -dam :: forall a m. Monad m => Wire m [a] (Event a)+dam :: forall a m. Monad m => Wire m [a] a dam = dam' []     where-    dam' :: [a] -> Wire m [a] (Event a)+    dam' :: [a] -> Wire m [a] a     dam' xs =         mkGen $ \_ ys ->             case xs ++ ys of-              []        -> return (Right Nothing, dam' [])-              (ee:rest) -> return (Right (Just ee), dam' rest)+              []       -> return (Left noEvent, dam' [])+              (x:rest) -> return (Right x, dam' rest)   -- | Delay events by the time interval in the left signal.@@ -122,19 +101,19 @@ -- starts to drop), it will leak memory.  Use 'delayEventSafe' to -- prevent this. -delayEvents :: forall a m. Monad m => Wire m (Time, Event a) (Event a)+delayEvents :: forall a m. Monad m => Wire m (Time, Maybe a) a delayEvents = delayEvent' Seq.empty 0     where-    delayEvent' :: Seq (Time, a) -> Time -> Wire m (Time, Event a) (Event a)+    delayEvent' :: Seq (Time, a) -> Time -> Wire m (Time, Maybe a) a     delayEvent' es' t' =         mkGen $ \(wsDTime -> dt) (int, ev) -> do             let t = t' + dt                 es = t `seq` maybe es' (\ee -> es' |> (t + int, ee)) ev             case Seq.viewl es of-              Seq.EmptyL -> return (Right Nothing, delayEvent' es 0)+              Seq.EmptyL -> return (Left noEvent, delayEvent' es 0)               (et, ee) :< rest-                  | t >= et   -> return (Right (Just ee), delayEvent' rest t)-                  | otherwise -> return (Right Nothing, delayEvent' es t)+                  | t >= et   -> return (Right ee, delayEvent' rest t)+                  | otherwise -> return (Left noEvent, delayEvent' es t)   -- | Delay events by the time interval in the left signal.  The event@@ -146,66 +125,49 @@ -- However, if it's decreased below the number of currently queued -- events, the events are not deleted. -delayEventsSafe :: forall a m. Monad m => Wire m (Time, Int, Event a) (Event a)+delayEventsSafe :: forall a m. Monad m => Wire m (Time, Int, Maybe a) a delayEventsSafe = delayEventSafe' Seq.empty 0     where-    delayEventSafe' :: Seq (Time, a) -> Time -> Wire m (Time, Int, Event a) (Event a)+    delayEventSafe' :: Seq (Time, a) -> Time -> Wire m (Time, Int, Maybe a) a     delayEventSafe' es' t' =         mkGen $ \(wsDTime -> dt) (int, maxEvs, ev') -> do             let t = t' + dt                 ev = guard (Seq.length es' < maxEvs) >> ev'                 es = t `seq` maybe es' (\ee -> es' |> (t + int, ee)) ev             case Seq.viewl es of-              Seq.EmptyL -> return (Right Nothing, delayEventSafe' es 0)+              Seq.EmptyL -> return (Left noEvent, delayEventSafe' es 0)               (et, ee) :< rest-                  | t >= et   -> return (Right (Just ee), delayEventSafe' rest t)-                  | otherwise -> return (Right Nothing, delayEventSafe' es t)----- | Decoupled variant of 'hold'.--dHold :: forall a m. Monad m => a -> Wire m (Event a) a-dHold x0 = dHold'-    where-    dHold' :: Wire m (Event a) a-    dHold' =-        mkGen $ \_ ->-            return . maybe (Right x0, dHold') (\x1 -> (Right x0, dHold x1))+                  | t >= et   -> return (Right ee, delayEventSafe' rest t)+                  | otherwise -> return (Left noEvent, delayEventSafe' es t)   -- | Drop the given number of events, before passing events through. -dropEvents :: forall a m. Monad m => Int -> Wire m (Event a) (Event a)+dropEvents :: forall a m. Monad m => Int -> Wire m a a dropEvents 0 = identity-dropEvents n = drop'-    where-    drop' :: Wire m (Event a) (Event a)-    drop' =-        mkGen $ \_ ->-            return .-            maybe (Right Nothing, drop')-                  (const (Right Nothing, dropEvents (pred n)))+dropEvents n =+    mkGen $ \_ x -> return (Right x, dropEvents (pred n))   -- | Timed event gate for the right signal, which begins closed and -- opens after the time interval in the left signal has passed. -dropFor :: forall a m. Monad m => Wire m (Time, Event a) (Event a)+dropFor :: forall a m. Monad m => Wire m (Time, a) a dropFor = dropFor' 0     where-    dropFor' :: Time -> Wire m (Time, Event a) (Event a)+    dropFor' :: Time -> Wire m (Time, a) a     dropFor' t' =-        mkGen $ \(wsDTime -> dt) (int, ev) ->+        mkGen $ \(wsDTime -> dt) (int, x) ->             let t = t' + dt in             if t >= int-              then return (Right ev, arr snd)-              else return (Right Nothing, dropFor' t)+              then return (Right x, arr snd)+              else return (Left noEvent, dropFor' t)   -- | Produce a single event with the right signal whenever the left -- signal switches from 'False' to 'True'. -edge :: Monad m => Wire m (Bool, a) (Event a)+edge :: Monad m => Wire m (Bool, a) a edge = edgeBy fst snd  @@ -213,141 +175,113 @@ -- to 'True' for the input signal, produce an event carrying the value -- given by applying the second argument function to the input signal. -edgeBy :: forall a b m. Monad m => (a -> Bool) -> (a -> b) -> Wire m a (Event b)+edgeBy :: forall a b m. Monad m => (a -> Bool) -> (a -> b) -> Wire m a b edgeBy p f = edgeBy'     where-    edgeBy' :: Wire m a (Event b)+    edgeBy' :: Wire m a b     edgeBy' =         mkGen $ \_ subject ->             if p subject-              then return (Right (Just (f subject)), switchBack)-              else return (Right Nothing, edgeBy')+              then return (Right (f subject), switchBack)+              else return (Left noEvent, edgeBy') -    switchBack :: Wire m a (Event b)+    switchBack :: Wire m a b     switchBack =         mkGen $ \_ subject ->-            return (Right Nothing, if p subject then switchBack else edgeBy')+            return (Left noEvent, if p subject then switchBack else edgeBy')   -- | Produce a single event carrying the value of the input signal, -- whenever the input signal switches to 'Just'. -edgeJust :: Monad m => Wire m (Maybe a) (Event a)+edgeJust :: Monad m => Wire m (Maybe a) a edgeJust = edgeBy isJust fromJust  --- | Turn discrete events into continuous signals.  Initially produces--- the argument value.  Each time an event occurs, the produced value is--- switched to the event's value.+-- | Variant of 'exhibit', which produces a 'Maybe' instead of an+-- 'Either'.+--+-- Never inhibits.  Same feedback properties as argument wire. -hold :: forall a m. Monad m => a -> Wire m (Event a) a-hold x0 = hold'-    where-    hold' :: Wire m (Event a) a-    hold' =-        mkGen $ \_ ->-            return .-            maybe (Right x0, hold')-                  (Right &&& hold)+event :: Monad m => Wire m a b -> Wire m a (Maybe b)+event w' =+    mkGen $ \ws x' -> do+        (mx, w) <- toGen w' ws x'+        case mx of+          Left _  -> return (Right Nothing, event w)+          Right x -> return (Right (Just x), event w)  --- | Never produce an event.+-- | Never produce an event.  This is equivalent to 'inhibit', but with+-- a contextually more appropriate exception message. -never :: Monad m => Wire m a (Event b)-never = constant Nothing+never :: Monad m => Wire m a b+never = mkGen $ \_ _ -> return (Left noEvent, never)   -- | Suppress the first event occurence. -notYet :: Monad m => Wire m (Event a) (Event a)-notYet = mkGen $ \_ -> return . maybe (Right Nothing, notYet) (const (Right Nothing, identity))+notYet :: Monad m => Wire m a a+notYet = mkGen $ \_ _ -> return (Left noEvent, identity)   -- | Produce an event at the first instant and never again. -now :: Monad m => b -> Wire m a (Event b)-now x = constantAfter Nothing (Just x)----- | Pass the first event occurence through and suppress all future--- events.--once :: Monad m => Wire m (Event a) (Event a)-once =-    mkGen $ \_ ev ->-        case ev of-          Nothing -> return (Right Nothing, once)-          Just _  -> return (Right ev, constant Nothing)+once :: Monad m => Wire m a a+once = mkGen $ \_ x -> return (Right x, never)   -- | Emit the right signal event each time the left signal interval -- passes. -repeatedly :: forall a m. Monad m => Wire m (Time, a) (Event a)+repeatedly :: forall a m. Monad m => Wire m (Time, a) a repeatedly = repeatedly' 0     where-    repeatedly' :: Time -> Wire m (Time, a) (Event a)+    repeatedly' :: Time -> Wire m (Time, a) a     repeatedly' t' =         mkGen $ \(wsDTime -> dt) (int, x) ->             let t = t' + dt in             if t >= int               then let nextT = fmod t int-                   in nextT `seq` return (Right (Just x), repeatedly' nextT)-              else return (Right Nothing, repeatedly' t)+                   in nextT `seq` return (Right x, repeatedly' nextT)+              else return (Left noEvent, repeatedly' t)   -- | Each time the signal interval passes emit the next element from the -- given list. -repeatedlyList :: forall a m. Monad m => [a] -> Wire m Time (Event a)+repeatedlyList :: forall a m. Monad m => [a] -> Wire m Time a repeatedlyList = repeatedly' 0     where-    repeatedly' :: Time -> [a] -> Wire m Time (Event a)-    repeatedly' _ [] = constant Nothing+    repeatedly' :: Time -> [a] -> Wire m Time a+    repeatedly' _ [] = never     repeatedly' t' x@(x0:xs) =         mkGen $ \(wsDTime -> dt) int ->             let t = t' + dt in             if t >= int               then let nextT = fmod t int-                   in nextT `seq` return (Right (Just x0), repeatedly' nextT xs)-              else return (Right Nothing, repeatedly' t x)+                   in nextT `seq` return (Right x0, repeatedly' nextT xs)+              else return (Left noEvent, repeatedly' t x)   -- | Pass only the first given number of events.  Then suppress events -- forever. -takeEvents :: forall a m. Monad m => Int -> Wire m (Event a) (Event a)-takeEvents 0 = constant Nothing-takeEvents n = take'-    where-    take' :: Wire m (Event a) (Event a)-    take' =-        mkGen $ \_ ev ->-            case ev of-              Nothing -> return (Right Nothing, take')-              Just _  -> return (Right ev, takeEvents (pred n))+takeEvents :: forall a m. Monad m => Int -> Wire m a a+takeEvents 0 = never+takeEvents n = mkGen $ \_ x -> return (Right x, takeEvents (pred n))   -- | Timed event gate for the right signal, which starts open and slams -- shut after the left signal time interval passed. -takeFor :: forall a m. Monad m => Wire m (Time, Event a) (Event a)+takeFor :: forall a m. Monad m => Wire m (Time, a) a takeFor = takeFor' 0     where-    takeFor' :: Time -> Wire m (Time, Event a) (Event a)+    takeFor' :: Time -> Wire m (Time, a) a     takeFor' t' =-        mkGen $ \(wsDTime -> dt) (int, ev) ->+        mkGen $ \(wsDTime -> dt) (int, x) ->             let t = t' + dt in             if t >= int-              then return (Right Nothing, constant Nothing)-              else return (Right ev, takeFor' t)----- | Inhibit the signal, unless an event occurs.--wait :: Monad m => Wire m (Event a) a-wait =-    mkGen $ \_ ev ->-        case ev of-          Nothing -> return (Left (inhibitEx "Waiting for event"), wait)-          Just ee -> return (Right ee, wait)+              then return (Left noEvent, never)+              else return (Right x, takeFor' t)
FRP/NetWire/IO.hs view
@@ -9,7 +9,6 @@ module FRP.NetWire.IO     ( -- * IO Actions       execute,-      executeEvery,       executeOnce     )     where@@ -25,34 +24,17 @@ -- -- Note: If the action throws an exception, then this wire inhibits the -- signal.+--+-- Inhibits on exception.  No feedback.  execute :: MonadControlIO m => Wire m (m a) a-execute =-    mkGen $ \_ c -> liftM (, execute) (try c)----- | Executes the IO action in the right input signal periodically--- keeping its most recent result value.--executeEvery :: forall a m. MonadControlIO m => Wire m (Time, m a) a-executeEvery = executeEvery' True 0 (Left (inhibitEx "No result yet."))-    where-    executeEvery' :: Bool -> Time -> Output a -> Wire m (Time, m a) a-    executeEvery' firstRun t' mx' =-        mkGen $ \(wsDTime -> dt) (int, c) ->-            let t = t' + dt in-            if t >= int || firstRun-              then do-                  let nextT = fmod t int-                  mx <- nextT `seq` try c-                  case mx of-                    Left _  -> return (mx', executeEvery' False nextT mx')-                    Right _ -> return (mx, executeEvery' False nextT mx)-              else return (mx', executeEvery' False t mx')+execute = mkGen $ \_ c -> liftM (, execute) (try c)   -- | Executes the IO action in the input signal and inhibits, until it -- succeeds without an exception.  Keeps the result forever.+--+-- Inhibits until the first result value.  No feedback.  executeOnce :: MonadControlIO m => Wire m (m a) a executeOnce =
FRP/NetWire/Random.hs view
@@ -28,12 +28,16 @@   -- | Impure noise between 0 (inclusive) and 1 (exclusive).+--+-- Never inhibits.  noise :: MonadIO m => Wire m a Double noise = noiseGen   -- | Impure noise between -1 (inclusive) and 1 (exclusive).+--+-- Never inhibits.  noise1 :: MonadIO m => Wire m a Double noise1 =@@ -43,6 +47,8 @@   -- | Impure noise.+--+-- Never inhibits.  noiseGen :: (MonadIO m, MTRandom b) => Wire m a b noiseGen =@@ -52,19 +58,23 @@   -- | Impure noise between 0 (inclusive) and the input signal--- (exclusive).  Note:  The noise is generated by multiplying a+-- (exclusive).  Note:  The noise is generated by multiplying with a -- 'Double', hence the precision is limited.+--+-- Never inhibits.  Feedback by delay.  noiseR :: (MonadIO m, Real a, Integral b) => Wire m a b noiseR =     mkGen $ \(wsRndGen -> mt) n -> do         x' <- liftIO (random mt)         let x = floor ((x' :: Double) * realToFrac n)-        x `seq` return (Right x, noiseR)+        return (Right x, noiseR)   -- | Pure noise.  For impure wires it's recommended to use the impure -- noise generators.+--+-- Never inhibits.  pureNoise :: (Monad m, R.RandomGen g, R.Random b) => g -> Wire m a b pureNoise g' =@@ -75,15 +85,19 @@  -- | Pure noise in a range.  For impure wires it's recommended to use -- the impure noise generators.+--+-- Never inhibits.  Feedback by delay.  pureNoiseR :: (Monad m, R.RandomGen g, R.Random b) => g -> Wire m (b, b) b pureNoiseR g' =     mkGen $ \_ range ->         let (x, g) = R.randomR range g'-        in x `seq` return (Right x, pureNoise g)+        in return (Right x, pureNoise g)   -- | Impure random boolean.+--+-- Never inhibits.  wackelkontakt :: MonadIO m => Wire m a Bool wackelkontakt = noiseGen
FRP/NetWire/Request.hs view
@@ -18,6 +18,8 @@   -- | Choose a unique identifier when switching in and keep it.+--+-- Never inhibits.  identifier :: MonadIO m => Wire m a Int identifier =
FRP/NetWire/Session.hs view
@@ -19,40 +19,53 @@  import Control.Applicative import Control.Concurrent.STM-import Control.Exception+import Control.Exception.Control+import Control.Monad.IO.Class+import Control.Monad.IO.Control import Data.IORef import Data.Time.Clock import FRP.NetWire.Wire  --- | Reactive sessions with the given time type.+-- | Reactive sessions with the given input and output types over the+-- given monad.  The monad must have a 'MonadControlIO' instance to be+-- usable with the stepping functions. -data Session a b =+data Session m a b =     Session {-      sessFreeVar  :: TVar Bool,             -- ^ False, if in use.-      sessStateRef :: IORef (WireState IO),  -- ^ State of the last instant.-      sessTimeRef  :: IORef UTCTime,         -- ^ Time of the last instant.-      sessWireRef  :: IORef (Wire IO a b)    -- ^ Wire for the next instant.+      sessFreeVar  :: TVar Bool,            -- ^ False, if in use.+      sessStateRef :: IORef (WireState m),  -- ^ State of the last instant.+      sessTimeRef  :: IORef UTCTime,        -- ^ Time of the last instant.+      sessWireRef  :: IORef (Wire m a b)    -- ^ Wire for the next instant.     }   -- | Feed the given input value into the reactive system performing the -- next instant using real time. -stepWire :: a -> Session a b -> IO (Output b)+stepWire ::+    MonadControlIO m+    => a              -- ^ Input value.+    -> Session m a b  -- ^ Session to step.+    -> m (Output b)   -- ^ System's output. stepWire x' sess =     withBlock sess $ do-        t <- getCurrentTime+        t <- liftIO getCurrentTime         stepWireTime' t x' sess   -- | Feed the given input value into the reactive system performing the -- next instant using the given time delta. -stepWireDelta :: NominalDiffTime -> a -> Session a b -> IO (Output b)+stepWireDelta ::+    MonadControlIO m+    => NominalDiffTime  -- ^ Time delta.+    -> a                -- ^ Input value.+    -> Session m a b    -- ^ Session to step.+    -> m (Output b)     -- ^ System's output. stepWireDelta dt x' sess =     withBlock sess $ do-        t' <- readIORef (sessTimeRef sess)+        t' <- liftIO (readIORef $ sessTimeRef sess)         let t@(UTCTime td tt) = addUTCTime dt t'         td `seq` tt `seq` t `seq` stepWireTime' t x' sess @@ -61,55 +74,76 @@ -- next instant, which is at the given time.  This function is -- thread-safe. -stepWireTime :: UTCTime -> a -> Session a b -> IO (Output b)+stepWireTime ::+    MonadControlIO m+    => UTCTime        -- ^ Absolute time of the instant to perform.+    -> a              -- ^ Input value.+    -> Session m a b  -- ^ Session to step.+    -> m (Output b)   -- ^ System's output. stepWireTime t' x' sess = withBlock sess (stepWireTime' t' x' sess)   -- | Feed the given input value into the reactive system performing the--- next instant, which is at the given time.  This function is *not*+-- next instant, which is at the given time.  This function is /not/ -- thread-safe. -stepWireTime' :: UTCTime -> a -> Session a b -> IO (Output b)+stepWireTime' ::+    MonadIO m+    => UTCTime        -- ^ Absolute time of the instant to perform.+    -> a              -- ^ Input value.+    -> Session m a b  -- ^ Session to step.+    -> m (Output b)   -- ^ System's output. stepWireTime' t x' sess = do     let Session { sessTimeRef = tRef, sessStateRef = wsRef, sessWireRef = wRef                 } = sess      -- Time delta.-    t' <- readIORef tRef+    t' <- liftIO (readIORef tRef)     let dt = realToFrac (diffUTCTime t t')-    dt `seq` writeIORef tRef t+    dt `seq` liftIO (writeIORef tRef t)      -- Wire state.-    ws' <- readIORef wsRef+    ws' <- liftIO (readIORef wsRef)     let ws = ws' { wsDTime = dt }-    ws `seq` writeIORef wsRef ws+    ws `seq` liftIO (writeIORef wsRef ws)      -- Wire.-    w' <- readIORef wRef+    w' <- liftIO (readIORef wRef)     (x, w) <- toGen w' ws x'-    w `seq` writeIORef wRef w+    w `seq` liftIO (writeIORef wRef w)      return x   -- | Perform an interlocked step function. -withBlock :: Session a b -> IO c -> IO c+withBlock ::+    MonadControlIO m+    => Session m a b  -- ^ The session to mark as locked for the+                      -- duration of the given computation.+    -> m c            -- ^ Computation to perform.+    -> m c            -- ^ Result. withBlock (Session { sessFreeVar = freeVar }) c = do-    atomically (readTVar freeVar >>= check >> writeTVar freeVar False)-    c `finally` atomically (writeTVar freeVar True)+    liftIO (atomically $ readTVar freeVar >>= check >> writeTVar freeVar False)+    c `finally` liftIO (atomically $ writeTVar freeVar True)   -- | Initialize a reactive session and pass it to the given -- continuation. -withWire :: Wire IO a b -> (Session a b -> IO c) -> IO c+withWire ::+    MonadControlIO m+    => Wire m a b              -- ^ Initial wire of the session.+    -> (Session m a b -> m c)  -- ^ Continuation, which receives the+                               -- session data.+    -> m c                     -- ^ Continuation's result. withWire w k = do-    t@(UTCTime td tt) <- getCurrentTime-    ws <- initWireState+    t@(UTCTime td tt) <- liftIO getCurrentTime+    ws <- liftIO initWireState      sess <-         td `seq` tt `seq` t `seq` ws `seq`+        liftIO $         Session         <$> newTVarIO True         <*> newIORef ws@@ -118,4 +152,4 @@      seq sess (k sess)         `finally`-        (readIORef (sessStateRef sess) >>= cleanupWireState)+        (liftIO $ readIORef (sessStateRef sess) >>= cleanupWireState)
FRP/NetWire/Switch.hs view
@@ -35,7 +35,7 @@     (Applicative m, Monad m, Traversable f) =>     (forall w. a -> f w -> f (b, w)) ->     f (Wire m b c) ->-    Wire m (a, Event (f (Wire m b c) -> f (Wire m b c))) (f c)+    Wire m (a, Maybe (f (Wire m b c) -> f (Wire m b c))) (f c) drpSwitch route wires''' =     WGen $ \ws (x'', ev) -> do         let wires'' = route x'' wires'''@@ -51,7 +51,7 @@ drpSwitchB ::     (Applicative m, Monad m, Traversable f) =>     f (Wire m a b) ->-    Wire m (a, Event (f (Wire m a b) -> f (Wire m a b))) (f b)+    Wire m (a, Maybe (f (Wire m a b) -> f (Wire m a b))) (f b) drpSwitchB wires'' =     WGen $ \ws (x', ev) -> do         r <- T.sequenceA $ fmap (\w' -> toGen w' ws x') wires''@@ -63,7 +63,7 @@  -- | Decoupled variant of 'rSwitch'. -drSwitch :: Monad m => Wire m a b -> Wire m (a, Event (Wire m a b)) b+drSwitch :: Monad m => Wire m a b -> Wire m (a, Maybe (Wire m a b)) b drSwitch w1' =     WGen $ \ws (x', swEv) -> do         (mx, w1) <- toGen w1' ws x'@@ -73,7 +73,7 @@  -- | Decoupled variant of 'switch'. -dSwitch :: Monad m => Wire m a (b, Event c) -> (c -> Wire m a b) -> Wire m a b+dSwitch :: Monad m => Wire m a (b, Maybe c) -> (c -> Wire m a b) -> Wire m a b dSwitch w1' f =     WGen $ \ws x' -> do         (m, w1) <- toGen w1' ws x'@@ -124,7 +124,7 @@     (Applicative m, Monad m, Traversable f) =>     (forall w. a -> f w -> f (b, w)) ->     f (Wire m b c) ->-    Wire m (a, Event (f (Wire m b c) -> f (Wire m b c))) (f c)+    Wire m (a, Maybe (f (Wire m b c) -> f (Wire m b c))) (f c) rpSwitch route wires''' =     WGen $ \ws (x'', ev) -> do         let wires'' = maybe id id ev wires'''@@ -144,7 +144,7 @@  rpSwitchB ::     (Applicative m, Monad m, Traversable f) =>-    f (Wire m a b) -> Wire m (a, Event (f (Wire m a b) -> f (Wire m a b))) (f b)+    f (Wire m a b) -> Wire m (a, Maybe (f (Wire m a b) -> f (Wire m a b))) (f b) rpSwitchB wires'' =     WGen $ \ws (x', ev) -> do         let wires' = maybe id id ev wires''@@ -158,7 +158,7 @@ -- switch takes switching events and switches to the wires contained in -- the events.  The first argument is the initial wire. -rSwitch :: Monad m => Wire m a b -> Wire m (a, Event (Wire m a b)) b+rSwitch :: Monad m => Wire m a b -> Wire m (a, Maybe (Wire m a b)) b rSwitch w1 =     WGen $ \ws (x', swEv) -> do         let w' = maybe w1 id swEv@@ -173,7 +173,7 @@ -- event at some point.  When this event is produced, then the signal -- path switches to the wire produced by the second argument function. -switch :: Monad m => Wire m a (b, Event c) -> (c -> Wire m a b) -> Wire m a b+switch :: Monad m => Wire m a (b, Maybe c) -> (c -> Wire m a b) -> Wire m a b switch w1' f =     WGen $ \ws x' -> do         (m, w1) <- toGen w1' ws x'
FRP/NetWire/Tools.hs view
@@ -16,10 +16,14 @@       timeFrom,        -- * Signal transformers+      accum,+      delay,       discrete,+      hold,       keep,        -- * Inhibitors+      forbid,       inhibit,       require, @@ -33,11 +37,6 @@       (-=>),       (>=-), -      -- * Switches-      -- ** Unconditional switches-      constantAfter,-      initially,-       -- * Arrow tools       mapA, @@ -56,17 +55,23 @@   -- | Override the output value at the first non-inhibited instant.+--+-- Same inhibition properties as argument wire.  Same feedback+-- properties as argument wire.  (-->) :: Monad m => b -> Wire m a b -> Wire m a b y --> w' =     WGen $ \ws x -> do         (mx, w) <- toGen w' ws x         case mx of-          e@(Left _) -> return (e, y --> w)-          Right _    -> return (Right y, w)+          Left _  -> return (mx, y --> w)+          Right _ -> return (Right y, w)   -- | Override the input value, until the wire starts producing.+--+-- Same inhibition properties as argument wire.  Same feedback+-- properties as argument wire.  (>--) :: Monad m => a -> Wire m a b -> Wire m a b x' >-- w' =@@ -77,41 +82,64 @@  -- | Apply a function to the wire's output at the first non-inhibited -- instant.+--+-- Same inhibition properties as argument wire.  Same feedback+-- properties as argument wire.  (-=>) :: Monad m => (b -> b) -> Wire m a b -> Wire m a b f -=> w' =     WGen $ \ws x' -> do         (mx, w) <- toGen w' ws x'         case mx of-          e@(Left _) -> return (e, f -=> w)-          Right x    -> return (Right (f x), w)+          Left _  -> return (mx, f -=> w)+          Right x -> return (Right (f x), w)   -- | Apply a function to the wire's input, until the wire starts -- producing.+--+-- Same inhibition properties as argument wire.  Same feedback+-- properties as argument wire.  (>=-) :: Monad m => (a -> a) -> Wire m a b -> Wire m a b f >=- w' =     WGen $ \ws x' -> do         (mx, w) <- toGen w' ws (f x')-        case mx of-          e@(Left _) -> return (e, f >=- w)-          Right _    -> return (mx, w)+        return (mx, either (const (f >=- w)) (const w) mx)  +-- | This function corresponds to the 'iterate' function for lists.+-- Begins with an initial output value.  Each time an input function is+-- received, it is applied to the current accumulator and the new value+-- is emitted.+--+-- Never inhibits.  Direct feedback.++accum :: Monad m => a -> Wire m (a -> a) a+accum x = mkGen $ \_ f -> x `seq` return (Right x, accum (f x))++ -- | The constant wire.  Please use this function instead of @arr (const -- c)@.+--+-- Never inhibits.  constant :: b -> Wire m a b constant = WConst  --- | Produce the value of the second argument at the first instant.--- Then produce the second value forever.+-- | One-instant delay.  Delay the signal for an instant returning the+-- argument value at the first instant.  This wire is mainly useful to+-- add feedback support to wires, which wouldn't support it by+-- themselves.  For example, the 'FRP.NetWire.Analyze.avg' wire does not+-- support feedback by itself, but the following works:+--+-- > do rec x <- delay 1 <<< avg 1000 -< x+--+-- Never inhibits.  Direct feedback. -constantAfter :: Monad m => b -> b -> Wire m a b-constantAfter x1 x0 =-    mkGen $ \_ _ -> return (Right x0, constant x1)+delay :: Monad m => a -> Wire m a a+delay r = mkGen $ \_ x -> return (Right r, delay x)   -- | Turn a continuous signal into a discrete one.  This transformer@@ -119,6 +147,8 @@ -- -- The interval length is followed in real time.  If it's zero, then -- this wire acts like @second id@.+--+-- Never inhibits.  Feedback by delay.  discrete :: forall a m. Monad m => Wire m (Time, a) a discrete =@@ -142,7 +172,9 @@   -- | This function corresponds to 'try' for exceptions, allowing you to--- observe inhibited signals.+-- observe inhibited signals.  See also 'FRP.NetWire.Event.event'.+--+-- Never inhibits.  Same feedback properties as argument wire.  exhibit :: Monad m => Wire m a b -> Wire m a (Output b) exhibit w' =@@ -158,12 +190,26 @@ fmod n d = n - d * realToFrac (floor $ n/d)  +-- | Inhibit, when the left signal is true.+--+-- Inhibits on true left signal.  No feedback.++forbid :: Monad m => Wire m (Bool, a) a+forbid =+    mkGen $ \_ (b, x) ->+        return (if b then Left (inhibitEx "Forbidden condition met") else Right x,+                forbid)++ -- | Effectively prevent a wire from rewiring itself.  This function -- will turn any stateful wire into a stateless wire, rendering most -- wires useless. -- -- Note:  This function should not be used normally.  Use it only, if -- you know exactly what you're doing.+--+-- Same inhibition properties as first instant of argument wire.  Same+-- feedback properties as first instant of argument wire.  freeze :: Monad m => Wire m a b -> Wire m a b freeze w =@@ -172,28 +218,49 @@         return (mx, w)  +-- | Keep the latest output.+--+-- Inhibits until first signal from argument wire.  Same feedback+-- properties as argument wire.++hold :: forall a b m. Monad m => Wire m a b -> Wire m a b+hold w' =+    mkGen $ \ws x' -> do+        (mx, w) <- toGen w' ws x'+        case mx of+          Right x -> return (mx, hold' x w)+          Left _  -> return (mx, hold w)++    where+    hold' :: b -> Wire m a b -> Wire m a b+    hold' x0 w' =+        mkGen $ \ws x' -> do+            (mx, w) <- toGen w' ws x'+            case mx of+              Left _  -> return (Right x0, hold' x0 w)+              Right x -> return (Right x, hold' x w)++ -- | Identity signal transformer.  Outputs its input.+--+-- Never inhibits.  Feedback by delay.  identity :: Monad m => Wire m a a identity = id   -- | Unconditional inhibition with the given inhibition exception.+--+-- Always inhibits.  inhibit :: (Exception e, Monad m) => Wire m e b inhibit =     WGen $ \_ ex -> return (Left (toException ex), inhibit)  --- | Produce the argument value at the first instant.  Then act as the--- identity signal transformer forever.--initially :: Monad m => a -> Wire m a a-initially x0 =-    mkGen $ \_ _ -> return (Right x0, identity)-- -- | Keep the value in the first instant forever.+--+-- Never inhibits.  Feedback by delay.  keep :: Monad m => Wire m a a keep = mkGen $ \_ x -> return (Right x, constant x)@@ -209,7 +276,9 @@           (x0:xs) -> arr (uncurry (:)) <<< a *** mapA a -< (x0, xs)  --- | Inhibit right signal, when the left signal is false.+-- | Inhibit, when the left signal is false.+--+-- Inhibits on false left signal.  No feedback.  require :: Monad m => Wire m (Bool, a) a require =@@ -220,10 +289,13 @@  -- | Sample the given wire at specific intervals.  Use this instead of -- 'discrete', if you want to prevent the signal from passing through--- the wire all the time.+-- the wire all the time.  Returns the most recent result. -- -- The left signal interval is allowed to become zero, at which point -- the signal is passed through the wire at every instant.+--+-- Inhibits until the first result from the argument wire.  Same+-- feedback properties as argument wire.  sample :: forall a b m. Monad m => Wire m a b -> Wire m (Time, a) b sample w' =@@ -238,14 +310,18 @@             let t = t' + dt in             if t >= int || int <= 0               then do-                  (mx, w) <- toGen w' ws x''-                  let nextT = fmod t int-                  nextT `seq` return (either (const mx') (const mx) mx, sample' nextT mx' w)+                  (mmx, w) <- toGen w' (ws { wsDTime = t }) x''+                  let mx = either (const mx') (const mmx) mmx+                      nextT = fmod t int+                  () `seq` return (mx, sample' nextT mx w)               else                   return (mx', sample' t mx' w')   -- | Wait for the first signal from the given wire and keep it forever.+--+-- Inhibits until signal from argument wire.  Direct feedback, if+-- argument wire never inhibits, otherwise no feedback.  swallow :: Monad m => Wire m a b -> Wire m a b swallow w' =@@ -261,12 +337,16 @@   -- | Get the local time.+--+-- Never inhibits.  time :: Monad m => Wire m a Time time = timeFrom 0   -- | Get the local time, assuming it starts from the given value.+--+-- Never inhibits.  timeFrom :: Monad m => Time -> Wire m a Time timeFrom t' =
FRP/NetWire/Wire.hs view
@@ -12,8 +12,7 @@       WireState(..),        -- * Auxilliary types-      Event,-      InhibitException,+      InhibitException(..),       Output,       SF,       Time,@@ -23,6 +22,7 @@       inhibitEx,       initWireState,       mkGen,+      noEvent,       toGen     )     where@@ -32,6 +32,8 @@ import Control.Category import Control.Concurrent.STM import Control.Exception (Exception(..), SomeException)+import Control.Monad+import Control.Monad.Fix import Control.Monad.IO.Class import Data.Functor.Identity import Data.Typeable@@ -42,7 +44,7 @@ -- | Events are signals, which can be absent.  They usually denote -- discrete occurences of certain events. -type Event = Maybe+--type Event = Maybe   -- | Inhibition exception with an informative message.  This exception@@ -56,8 +58,7 @@ instance Exception InhibitException  --- | The output of a wire.  When the wire inhibits, then this will be a--- 'Left' value with an exception.+-- | Functor for output signals.  type Output = Either SomeException @@ -81,36 +82,37 @@     WId    :: Wire m a a  +-- | This instance corresponds to the 'ArrowPlus' and 'ArrowZero'+-- instances.+ instance Monad m => Alternative (Wire m a) where     empty = zeroArrow     (<|>) = (<+>)  +-- | Applicative interface to signal networks.+ instance Monad m => Applicative (Wire m a) where     pure = WConst      wf' <*> wx' =         WGen $ \ws x' -> do-            (mf, wf) <- toGen wf' ws x'-            (mx, wx) <- toGen wx' ws x'-            return (mf <*> mx, wf <*> wx)+            (cf, wf) <- toGen wf' ws x'+            (cx, wx) <- toGen wx' ws x'+            return (cf <*> cx, wf <*> wx)  +-- | Arrow interface to signal networks.+ instance Monad m => Arrow (Wire m) where     arr = WArr -    first (WGen f) =-        WGen $ \ws (x', y) -> do-            (mx, w) <- f ws x'-            return (fmap (,y) mx, first w)+    first (WGen f) = WGen $ \ws (x', y) -> liftM (fmap (, y) *** first) (f ws x')     first (WArr f) = WArr (first f)     first (WConst c) = WArr (first (const c))     first WId = WId -    second (WGen f) =-        WGen $ \ws (x, y') -> do-            (my, w) <- f ws y'-            return (fmap (x,) my, second w)+    second (WGen f) = WGen $ \ws (x, y') -> liftM (fmap (x,) *** second) (f ws y')     second (WArr f) = WArr (second f)     second (WConst c) = WArr (second (const c))     second WId = WId@@ -119,59 +121,64 @@     WId *** wg = second wg     wf' *** wg' =         WGen $ \ws (x', y') -> do-            (mx, wf) <- toGen wf' ws x'-            (my, wg) <- toGen wg' ws y'-            return (liftA2 (,) mx my, wf *** wg)+            (cx, wf) <- toGen wf' ws x'+            (cy, wg) <- toGen wg' ws y'+            return (liftA2 (,) cx cy, wf *** wg)      wf' &&& wg' =         WGen $ \ws x' -> do-            (mx1, wf) <- toGen wf' ws x'-            (mx2, wg) <- toGen wg' ws x'-            return (liftA2 (,) mx1 mx2, wf &&& wg)+            (cx1, wf) <- toGen wf' ws x'+            (cx2, wg) <- toGen wg' ws x'+            return (liftA2 (,) cx1 cx2, wf &&& wg)  +-- | Signal routing.  Unused routes are frozen, until they are put back+-- into use.+ instance Monad m => ArrowChoice (Wire m) where     left w' = wl         where         wl =             WGen $ \ws mx' ->                 case mx' of-                  Left x' -> do-                      (mx, w) <- toGen w' ws x'-                      return (fmap Left mx, left w)-                  Right x -> return (Right (Right x), wl)+                  Left x' -> liftM (fmap Left *** left) (toGen w' ws x')+                  Right x -> return (pure (Right x), wl)      right w' = wl         where         wl =             WGen $ \ws mx' ->                 case mx' of-                  Right x' -> do-                      (mx, w) <- toGen w' ws x'-                      return (fmap Right mx, right w)-                  Left x -> return (Right (Left x), wl)+                  Right x' -> liftM (fmap Right *** right) (toGen w' ws x')+                  Left x   -> return (pure (Left x), wl)      wf' +++ wg' =         WGen $ \ws mx' ->             case mx' of-              Left x' -> do-                  (mx, wf) <- toGen wf' ws x'-                  return (fmap Left mx, wf +++ wg')-              Right x' -> do-                  (mx, wg) <- toGen wg' ws x'-                  return (fmap Right mx, wf' +++ wg)+              Left x'  -> liftM (fmap Left *** (+++ wg')) (toGen wf' ws x')+              Right x' -> liftM (fmap Right *** (wf' +++)) (toGen wg' ws x')      wf' ||| wg' =         WGen $ \ws mx' ->             case mx' of-              Left x' -> do-                  (mx, wf) <- toGen wf' ws x'-                  return (mx, wf ||| wg')-              Right x' -> do-                  (mx, wg) <- toGen wg' ws x'-                  return (mx, wf' ||| wg)+              Left x'  -> liftM (second (||| wg')) (toGen wf' ws x')+              Right x' -> liftM (second (wf' |||)) (toGen wg' ws x')  +-- | Value recursion.  Warning: Recursive signal networks must never+-- inhibit.  Use 'FRP.NetWire.Tools.exhibit' or 'FRP.NetWire.Event.event'.++instance MonadFix m => ArrowLoop (Wire m) where+    loop w' =+        WGen $ \ws x' -> do+            rec (Right (x, d), w) <- toGen w' ws (x', d)+            return (Right x, loop w)+++-- | Left-biased signal network combination.  If the left arrow+-- inhibits, the right arrow is tried.  If both inhibit, their+-- combination inhibits.+ instance Monad m => ArrowPlus (Wire m) where     WGen f <+> wg =         WGen $ \ws x' -> do@@ -187,12 +194,14 @@     WId           <+> _ = WId  +-- | The zero arrow always inhibits.+ instance Monad m => ArrowZero (Wire m) where-    zeroArrow =-        mkGen $ \_ _ ->-            return (Left (inhibitEx "Signal inhibited"), zeroArrow)+    zeroArrow = mkGen $ \_ _ -> return (Left (inhibitEx "Signal inhibited"), zeroArrow)  +-- | Identity signal network and signal network sequencing.+ instance Monad m => Category (Wire m) where     id = WId @@ -235,6 +244,8 @@     w1 . WId = w1  +-- | Map over the result of a signal network.+ instance Monad m => Functor (Wire m a) where     fmap f (WGen w') =         WGen $ \ws x' -> do@@ -285,6 +296,13 @@  mkGen :: (WireState m -> a -> m (Output b, Wire m a b)) -> Wire m a b mkGen = WGen+++-- | Construct an 'InhibitException' wrapped in a 'SomeException' with a+-- message indicating that a certain event did not happen.++noEvent :: SomeException+noEvent = inhibitEx "No event"   -- | Extract the transition function of a wire.
netwire.cabal view
@@ -1,5 +1,5 @@ Name:          netwire-Version:       1.1.0+Version:       1.2.0 Category:      FRP, Network Synopsis:      Arrowized FRP implementation Maintainer:    Ertugrul Söylemez <es@ertes.de>@@ -11,10 +11,10 @@ Stability:     beta Cabal-version: >= 1.8 Description:-     This library provides an arrowized functional reactive programming-    (FRP) implementation.  It is similar to Yampa and Animas, but has a-    much simpler internal representation and a lot of new features.+    (FRP) implementation.  From the basic idea it is similar to Yampa+    and Animas, but has a much simpler internal representation and a lot+    of new features.  Library     Build-depends:@@ -32,6 +32,7 @@     Extensions:         Arrows         DeriveDataTypeable+        FlexibleInstances         GADTs         RankNTypes         ScopedTypeVariables@@ -57,12 +58,12 @@ -- Executable netwire-test --     Build-depends: --         base >= 4 && <= 5,---         gloss, --         netwire,---         time+--         transformers --     Extensions:---         Arrows,+--         Arrows --         ScopedTypeVariables+--         ViewPatterns --     Hs-Source-Dirs: test --     Main-is: Main.hs --     GHC-Options: -W -threaded -rtsopts