netwire 1.2.5 → 1.2.6

raw patch · 4 files changed

+95/−8 lines, 4 files

Files

• FRP/NetWire.hs +1/−0
• FRP/NetWire/Event.hs +17/−0
• FRP/NetWire/Request.hs +71/−6
• netwire.cabal +6/−2

@@ -11,6 +11,7 @@ module FRP.NetWire     ( -- * Wires       Wire, Output, Time,+      mkGen, toGen,        -- * Reactive sessions       Session,

@@ -16,6 +16,7 @@       edgeJust,       never,       once,+      periodically,       repeatedly,       repeatedlyList, @@ -229,6 +230,22 @@  once :: Monad m => Wire m a a once = mkGen $ \_ x -> return (Right x, never)+++-- | Emits a '()' signal each time the signal interval passes.  This is+-- a simpler variant of 'repeatedly'.++periodically :: forall m. Monad m => Wire m Time ()+periodically = periodically' 0+    where+    periodically' :: Time -> Wire m Time ()+    periodically' t' =+        mkGen $ \(wsDTime -> dt) int ->+            let t = t' + dt in+            if t >= int+              then let nextT = fmod t int+                   in nextT `seq` return (Right (), periodically' nextT)+              else return (Left noEvent, periodically' t)   -- | Emit the right signal event each time the left signal interval

@@ -4,10 +4,14 @@ -- License:    BSD3 -- Maintainer: Ertugrul Soeylemez <es@ertes.de> ----- Unique identifiers and context-sensitive wires.+-- Object managers, unique identifiers and context-sensitive wires.  module FRP.NetWire.Request-    ( -- * Context-sensitive mutation+    ( -- * Containers+      MgrMsg(..),+      manager,++      -- * Context-sensitive mutation       context,       contextInt,       contextLimited,@@ -25,15 +29,50 @@  import qualified Data.IntMap as IM import qualified Data.Map as M+import qualified Data.Traversable as T import Control.Arrow import Control.Monad.IO.Class import Control.Concurrent.STM import Data.IntMap (IntMap) import Data.Map (Map)+import Data.Monoid import FRP.NetWire.Wire-import FRP.NetWire.Tools  +-- | Messages to wire managers (see the 'manager' wire).++data MgrMsg k m a b+    -- | Do nothing.  Send this, if the wire shouldn't be changed in an+    -- instant.+    = MgrNop++    -- | Perform two operations in an instant.+    | MgrMulti (MgrMsg k m a b) (MgrMsg k m a b)++    -- | Add the given wire with the given key.  If the manager already+    -- has a wire with this key, it is overwritten.+    | MgrAdd k (Wire m a b)++    -- | Delete the wire with the given key, if it exists.+    | MgrDel k++-- | The monoid instance can be used to combine multiple manager+-- operations.  They are performed from left to right.  This instance+-- tries hard to optimize operations away without sacrificing+-- performance.++instance Eq k => Monoid (MgrMsg k m a b) where+    mempty = MgrNop++    mappend MgrNop y = y+    mappend x MgrNop = x+    mappend (MgrAdd k1 _) y@(MgrAdd k2 _) | k1 == k2 = y+    mappend (MgrDel k1)   y@(MgrAdd k2 _) | k1 == k2 = y+    mappend (MgrAdd k1 _)   (MgrDel k2)   | k1 == k2 = MgrNop+    mappend (MgrDel k1)   y@(MgrDel k2)   | k1 == k2 = y+    mappend x y = MgrMulti x y++ -- | Make the given wire context-sensitive.  The left input signal is a -- context and the argument wire will mutate individually for each such -- context.@@ -159,9 +198,9 @@     contextLimitedInt (arr fst >>> w0)  --- | Choose a unique identifier when switching in and keep it.+-- | Choose a new unique identifier at every instant. ----- Never inhibits.+-- Never inhibits.  Feedback by delay.  identifier :: MonadIO m => Wire m a Int identifier =@@ -172,4 +211,30 @@                    let req = succ req'                    req `seq` writeTVar reqVar (succ req')                    return req'-        return (Right req, constant req)+        return (Right req, identifier)+++-- | Wire manager, which can be manipulated during the session.  This is+-- a convenient alternative to parallel switches.+--+-- This wire manages a set of subwires, each indexed by a key.  Through+-- messages new subwires can be added and existing ones can be deleted.+--+-- Inhibits, whenever one of the managed wires inhibits.  Inherits+-- feedback behaviour from the worst managed wire.++manager :: forall a b k m. (Monad m, Ord k) => Wire m (a, MgrMsg k m a b) (Map k b)+manager = mgr M.empty+    where+    mgr :: Map k (Wire m a b) -> Wire m (a, MgrMsg k m a b) (Map k b)+    mgr wires'' =+        mkGen $ \ws (x', msg) -> do+            let wires' = processMsg msg wires''+            wires <- T.mapM (\w -> toGen w ws x') wires'+            return (T.sequenceA (fmap fst wires), mgr (fmap snd wires))++    processMsg :: MgrMsg k m a b -> Map k (Wire m a b) -> Map k (Wire m a b)+    processMsg MgrNop = id+    processMsg (MgrMulti m1 m2) = processMsg m2 . processMsg m1+    processMsg (MgrAdd k w) = M.insert k w+    processMsg (MgrDel k) = M.delete k

@@ -1,5 +1,5 @@ Name:          netwire-Version:       1.2.5+Version:       1.2.6 Category:      FRP, Network Synopsis:      Arrowized FRP implementation Maintainer:    Ertugrul Söylemez <es@ertes.de>@@ -60,8 +60,12 @@ --     Build-depends: --         base >= 4 && <= 5, --         containers,+--         instinct, --         netwire,---         transformers+--         OpenGL,+--         SDL,+--         transformers,+--         vector --     Extensions: --         Arrows --         ScopedTypeVariables