netwire 1.2.4 → 1.2.5

raw patch · 4 files changed

+100/−39 lines, 4 filesPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

API changes (from Hackage documentation)

Files

• FRP/NetWire/Request.hs +62/−26
• FRP/NetWire/Session.hs +12/−12
• FRP/NetWire/Tools.hs +25/−0
• netwire.cabal +1/−1

@@ -4,14 +4,19 @@ -- License:    BSD3 -- Maintainer: Ertugrul Soeylemez <es@ertes.de> ----- Unique identifiers.+-- Unique identifiers and context-sensitive wires.  module FRP.NetWire.Request-    ( -- * Context-sensitive time+    ( -- * Context-sensitive mutation       context,       contextInt,       contextLimited,       contextLimitedInt,+      -- ** Simple variants+      context_,+      contextInt_,+      contextLimited_,+      contextLimitedInt_,        -- * Identifiers.       identifier@@ -20,6 +25,7 @@  import qualified Data.IntMap as IM import qualified Data.Map as M+import Control.Arrow import Control.Monad.IO.Class import Control.Concurrent.STM import Data.IntMap (IntMap)@@ -28,68 +34,80 @@ import FRP.NetWire.Tools  --- | Make the given wire context-sensitive.  The input signal is a--- context and the argument wire will evolve individually for each such+-- | Make the given wire context-sensitive.  The left input signal is a+-- context and the argument wire will mutate individually for each such -- context. -- -- Inherits inhibition and feedback behaviour from the current context's -- wire. -context :: forall a b m. (Ord a, Monad m) => Wire m a b -> Wire m a b+context :: forall a b ctx m. (Ord ctx, Monad m) => Wire m (ctx, a) b -> Wire m (ctx, a) b context w0 = context' M.empty 0     where-    context' :: Map a (Time, Wire m a b) -> Time -> Wire m a b+    context' :: Map ctx (Time, Wire m (ctx, a) b) -> Time -> Wire m (ctx, a) b     context' tm' t' =-        mkGen $ \ws@(wsDTime -> dt') ctx -> do+        mkGen $ \ws@(wsDTime -> dt') inp@(ctx, _) -> do             let t = t' + dt'             let (dt, w') = case M.lookup ctx tm' of-                             Nothing       -> (t, w0)+                             Nothing       -> (0, w0)                              Just (lt, w') -> (t - lt, w')-            (mx, w) <- dt `seq` toGen w' (ws { wsDTime = dt }) ctx+            (mx, w) <- dt `seq` toGen w' (ws { wsDTime = dt }) inp             let tm = M.insert ctx (t, w) tm'             return (mx, context' tm t)  +-- | Simplified variant of 'context'.  Takes a context signal only.++context_ :: (Ord ctx, Monad m) => Wire m ctx b -> Wire m ctx b+context_ w0 = arr (, ()) >>> context (arr fst >>> w0)++ -- | Specialized version of 'context'.  Use this one, if your contexts -- are 'Int's and you have a lot of them. -- -- Inherits inhibition and feedback behaviour from the current context's -- wire. -contextInt :: forall b m. Monad m => Wire m Int b -> Wire m Int b+contextInt :: forall a b m. Monad m => Wire m (Int, a) b -> Wire m (Int, a) b contextInt w0 = context' IM.empty 0     where-    context' :: IntMap (Time, Wire m Int b) -> Time -> Wire m Int b+    context' :: IntMap (Time, Wire m (Int, a) b) -> Time -> Wire m (Int, a) b     context' tm' t' =-        mkGen $ \ws@(wsDTime -> dt') ctx -> do+        mkGen $ \ws@(wsDTime -> dt') inp@(ctx, _) -> do             let t = t' + dt'             let (dt, w') = case IM.lookup ctx tm' of-                             Nothing       -> (t, w0)+                             Nothing       -> (0, w0)                              Just (lt, w') -> (t - lt, w')-            (mx, w) <- dt `seq` toGen w' (ws { wsDTime = dt }) ctx+            (mx, w) <- dt `seq` toGen w' (ws { wsDTime = dt }) inp             let tm = IM.insert ctx (t, w) tm'             return (mx, context' tm t)  --- | Same as 'context', but with a time limit.  The left signal--- specifies a threshold and the middle signal specifies a maximum age.+-- | Simplified variant of 'contextInt'.  Takes a context signal only.++contextInt_ :: Monad m => Wire m Int b -> Wire m Int b+contextInt_ w0 = arr (, ()) >>> contextInt (arr fst >>> w0)+++-- | Same as 'context', but with a time limit.  The first signal+-- specifies a threshold and the second signal specifies a maximum age. -- If the current number of contexts exceeds the threshold, then all -- contexts exceeding the maximum age are deleted. -- -- Inherits inhibition and feedback behaviour from the current context's -- wire. -contextLimited :: forall a b m. (Ord a, Monad m) => Wire m a b -> Wire m (Int, Time, a) b+contextLimited :: forall a b ctx m. (Ord ctx, Monad m) => Wire m (ctx, a) b -> Wire m (Int, Time, ctx, a) b contextLimited w0 = context' M.empty 0     where-    context' :: Map a (Time, Wire m a b) -> Time -> Wire m (Int, Time, a) b+    context' :: Map ctx (Time, Wire m (ctx, a) b) -> Time -> Wire m (Int, Time, ctx, a) b     context' tm'' t' =-        mkGen $ \ws@(wsDTime -> dt') (limit, maxAge, ctx) -> do+        mkGen $ \ws@(wsDTime -> dt') (limit, maxAge, ctx, x') -> do             let t = t' + dt'             let (dt, w') = case M.lookup ctx tm'' of-                             Nothing       -> (t, w0)+                             Nothing       -> (0, w0)                              Just (lt, w') -> (t - lt, w')-            (mx, w) <- dt `seq` toGen w' (ws { wsDTime = dt }) ctx+            (mx, w) <- dt `seq` toGen w' (ws { wsDTime = dt }) (ctx, x')             let tm' = M.insert ctx (t, w) tm''                 tm = if M.size tm' <= limit                        then tm'@@ -98,29 +116,47 @@             return (mx, context' tm t)  +-- | Simplified variant of 'contextLimited'.  Takes a context signal+-- only.++contextLimited_ :: (Ord ctx, Monad m) => Wire m ctx b -> Wire m (Int, Time, ctx) b+contextLimited_ w0 =+    arr (\(thr, maxAge, ctx) -> (thr, maxAge, ctx, ())) >>>+    contextLimited (arr fst >>> w0)++ -- | Specialized version of 'contextLimited'.  Use this one, if your -- contexts are 'Int's and you have a lot of them. -- -- Inherits inhibition and feedback behaviour from the current context's -- wire. -contextLimitedInt :: forall b m. Monad m => Wire m Int b -> Wire m (Int, Time, Int) b+contextLimitedInt :: forall a b m. Monad m => Wire m (Int, a) b -> Wire m (Int, Time, Int, a) b contextLimitedInt w0 = context' IM.empty 0     where-    context' :: IntMap (Time, Wire m Int b) -> Time -> Wire m (Int, Time, Int) b+    context' :: IntMap (Time, Wire m (Int, a) b) -> Time -> Wire m (Int, Time, Int, a) b     context' tm'' t' =-        mkGen $ \ws@(wsDTime -> dt') (limit, maxAge, ctx) -> do+        mkGen $ \ws@(wsDTime -> dt') (limit, maxAge, ctx, x') -> do             let t = t' + dt'             let (dt, w') = case IM.lookup ctx tm'' of-                             Nothing       -> (t, w0)+                             Nothing       -> (0, w0)                              Just (lt, w') -> (t - lt, w')-            (mx, w) <- dt `seq` toGen w' (ws { wsDTime = dt }) ctx+            (mx, w) <- dt `seq` toGen w' (ws { wsDTime = dt }) (ctx, x')             let tm' = IM.insert ctx (t, w) tm''                 tm = if IM.size tm' <= limit                        then tm'                        else IM.filter (\(ct, _) -> t - ct <= maxAge) tm'              return (mx, context' tm t)+++-- | Simplified variant of 'contextLimitedInt'.  Takes a context signal+-- only.++contextLimitedInt_ :: Monad m => Wire m Int b -> Wire m (Int, Time, Int) b+contextLimitedInt_ w0 =+    arr (\(thr, maxAge, ctx) -> (thr, maxAge, ctx, ())) >>>+    contextLimitedInt (arr fst >>> w0)   -- | Choose a unique identifier when switching in and keep it.

@@ -46,10 +46,10 @@  -- | Start a wire session. -sessionStart :: MonadIO m => Wire m a b -> m (Session m a b)+sessionStart :: MonadIO m => Wire m a b -> IO (Session m a b) sessionStart w = do-    t@(UTCTime td tt) <- liftIO getCurrentTime-    ws <- liftIO initWireState+    t@(UTCTime td tt) <- getCurrentTime+    ws <- initWireState      sess <-         td `seq` tt `seq` t `seq` ws `seq`@@ -65,9 +65,9 @@  -- | Clean up a wire session. -sessionStop :: MonadIO m => Session m a b -> m ()+sessionStop :: Session m a b -> IO () sessionStop sess =-    liftIO $ readIORef (sessStateRef sess) >>= cleanupWireState+    readIORef (sessStateRef sess) >>= cleanupWireState   -- | Feed the given input value into the reactive system performing the@@ -162,11 +162,11 @@ -- continuation.  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.+    (MonadControlIO m, MonadIO sm)+    => Wire sm a b              -- ^ Initial wire of the session.+    -> (Session sm a b -> m c)  -- ^ Continuation, which receives the+                                -- session data.+    -> m c                      -- ^ Continuation's result. withWire w k = do-    sess <- sessionStart w-    k sess `finally` sessionStop sess+    sess <- liftIO (sessionStart w)+    k sess `finally` liftIO (sessionStop sess)

@@ -20,6 +20,8 @@       delay,       discrete,       hold,+      inject,+      injectMaybe,       keep,        -- * Inhibitors@@ -279,6 +281,29 @@  inhibit_ :: Monad m => Wire m a b inhibit_ = zeroArrow+++-- | Inject the input 'Either' signal.+--+-- Inhibits on 'Left' signals.++inject :: forall a e m. (Exception e, Monad m) => Wire m (Either e a) a+inject = mkGen $ \_ mx -> return (leftToEx mx, inject)+    where+    leftToEx :: Either e a -> Either SomeException a+    leftToEx (Right x) = Right x+    leftToEx (Left ex) = Left (toException ex)+++-- | Inject the input 'Maybe' signal.+--+-- Inhibits on 'Nothing' signals.++injectMaybe :: Monad m => Wire m (Maybe a) a+injectMaybe =+    mkGen $ \_ mx ->+        return (maybe (Left (inhibitEx "No signal to inject")) Right mx,+                injectMaybe)   -- | Keep the value in the first instant forever.

@@ -1,5 +1,5 @@ Name:          netwire-Version:       1.2.4+Version:       1.2.5 Category:      FRP, Network Synopsis:      Arrowized FRP implementation Maintainer:    Ertugrul Söylemez <es@ertes.de>