netwire 5.0.0 → 5.0.1

raw patch · 10 files changed

+154/−86 lines, 10 filesdep +profunctorsdep ~randomdep ~semigroupssetup-changed

Dependencies added: profunctors

Dependency ranges changed: random, semigroups

Files

• Control/Wire/Core.hs +49/−0
• Control/Wire/Event.hs +13/−0
• Control/Wire/Session.hs +1/−1
• Control/Wire/Switch.hs +46/−1
• Control/Wire/Time.hs +1/−1
• LICENSE +2/−2
• Setup.lhs +0/−6
• default.nix +0/−30
• netwire.cabal +34/−45
• shell.nix +8/−0

@@ -45,6 +45,7 @@ import Control.Monad import Control.Monad.Fix import Control.Parallel.Strategies+import Data.Profunctor import Data.Monoid import Data.String import Prelude hiding ((.), id)@@ -63,6 +64,11 @@ instance (Monad m, Monoid e) => Alternative (Wire s e m a) where     empty = WConst (Left mempty) +    w1@(WConst (Right _)) <|> _ = w1+    w1@WId <|> _ = w1++    WConst (Left ex) <|> w2 = mapLeft (ex <>) w2+     w1' <|> w2' =         WGen $ \ds mx' ->             liftM2 (\(mx1, w1) (mx2, w2) -> lstrict (choose mx1 mx2, w1 <|> w2))@@ -166,6 +172,10 @@             (mx2, w2) <- stepWire w2' ds mx1             mx2 `seq` return (mx2, w2 . w1) +instance (Monad m, Monoid e) => Choice (Wire s e m) where+  left' = left+  right' = right+ instance (Monad m, Floating b) => Floating (Wire s e m a b) where     (**) = liftA2 (**)     acos = fmap acos@@ -214,10 +224,29 @@     signum = fmap signum     fromInteger = pure . fromInteger +instance (Monad m) => Profunctor (Wire s e m) where+    dimap f g (WArr h)    = WArr (fmap g . h . fmap f)+    dimap _ g (WConst mx) = WConst (fmap g mx)+    dimap f g (WGen h)    = WGen (\ds -> liftM (fmap g ***! dimap f g) . h ds . fmap f)+    dimap f g WId         = WArr (fmap (g . f))+    dimap f g (WPure h)   = WPure (\ds -> (fmap g ***! dimap f g) . h ds . fmap f)++    lmap f (WArr g)       = WArr (g . fmap f)+    lmap _ (WConst mx)    = WConst mx+    lmap f (WGen g)       = WGen (\ds -> liftM (fmap (lmap f)) . g ds . fmap f)+    lmap f WId            = WArr (fmap f)+    lmap f (WPure g)      = WPure (\ds -> fmap (lmap f) . g ds . fmap f)++    rmap = fmap+ instance (Monad m, Sg.Semigroup b) => Sg.Semigroup (Wire s e m a b) where     (<>) = liftA2 (Sg.<>) +instance (Monad m, Monoid e) => Strong (Wire s e m) where+  first' = first+  second' = second + -- | Left-strict version of '&&&' for functions.  (&&&!) :: (a -> b) -> (a -> c) -> (a -> (b, c))@@ -289,6 +318,26 @@  lstrict :: (a, b) -> (a, b) lstrict (x, y) = x `seq` (x, y)+++-- | Apply the given function to the wire's inhibition value.++mapLeft :: (Monad m) => (e -> e) -> Wire s e m a b -> Wire s e m a b+mapLeft _ w1@WId = w1+mapLeft f' w = mapOutput f w+    where+    f (Left ex) = Left (f' ex)+    f (Right x) = Right x+++-- | Apply the given function to the wire's output.++mapOutput :: (Monad m) => (Either e b' -> Either e b) -> Wire s e m a b' -> Wire s e m a b+mapOutput f (WArr g)    = WArr (f . g)+mapOutput f (WConst mx) = WConst (f mx)+mapOutput f (WGen g)    = WGen (\ds -> liftM (f *** mapOutput f) . g ds)+mapOutput f WId         = WArr f+mapOutput f (WPure g)   = WPure (\ds -> (f *** mapOutput f) . g ds)   -- | Apply the given monad morphism to the wire's underlying monad.

@@ -18,6 +18,7 @@       -- * Signal analysis       became,       noLonger,+      edge,        -- * Modifiers       (<&),@@ -230,6 +231,18 @@     where     off = mkSFN $ \x -> if p x then (NoEvent, off) else (Event x, on)     on = mkSFN $ \x -> (NoEvent, if p x then off else on)+++-- | Events occur first when the predicate is false then when it is+-- true, and then this pattern repeats.+--+-- * Depends: now.++edge :: (a -> Bool) -> Wire s e m a (Event a)+edge p = off+    where+    off = mkSFN $ \x -> if p x then (Event x, on) else (NoEvent, off)+    on = mkSFN $ \x -> if p x then (NoEvent, on) else (Event x, off)   -- | Forget the first occurrence.

@@ -107,5 +107,5 @@  -- | Non-extending version of 'countSession'. -countSession_ :: (Applicative m, MonadIO m) => t -> Session m (Timed t ())+countSession_ :: (Applicative m) => t -> Session m (Timed t ()) countSession_ dt = countSession dt <*> pure ()

@@ -7,7 +7,7 @@ module Control.Wire.Switch     ( -- * Simple switching       (-->),-+      (>--),       -- * Context switching       modes, @@ -21,6 +21,7 @@       -- ** Extrinsic       rSwitch,       drSwitch,+      alternate,       -- ** Extrinsic continuable       krSwitch,       dkrSwitch@@ -56,7 +57,27 @@  infixr 1 --> +-- | Acts like the first wire until the second starts producing, at which point+-- it switches to the second wire.  Infixr 1.+--+-- * Depends: like current wire.+--+-- * Inhibits: after switching like the second wire.+--+-- * Switch: now. +(>--) :: (Monad m) => Wire s e m a b -> Wire s e m a b -> Wire s e m a b+w1' >-- w2' =+    WGen $ \ds mx' -> do+        (m2, w2) <- stepWire w2' ds mx'+        case m2 of+          Right _ -> m2 `seq` return (m2, w2)+          _       -> do (m1, w1) <- stepWire w1' ds mx'+                        m1 `seq` return (m1, w1 >-- w2)++infixr 1 >--++ -- | Intrinsic continuable switch:  Delayed version of 'kSwitch'. -- -- * Inhibits: like the first argument wire, like the new wire after@@ -93,6 +114,30 @@         let nw w | Right (_, Event w1) <- mx' = w1                  | otherwise = w         in liftM (second (drSwitch . nw)) (stepWire w' ds (fmap fst mx'))+++-- | Acts like the first wire until an event occurs then switches+-- to the second wire. Behaves like this wire until the event occurs+-- at which point a *new* instance of the first wire is switched to.+--+-- * Depends: like current wire.+--+-- * Inhibits: like the argument wires.+--+-- * Switch: once, now, restart state.++alternate ::+  (Monad m)+  => Wire s e m a b+  -> Wire s e m a b+  -> Wire s e m (a, Event x) b+alternate w1 w2 = go w1 w2 w1+    where+    go w1' w2' w' =+        WGen $ \ds mx' ->+            let (w1, w2, w) | Right (_, Event _) <- mx' = (w2', w1', w2')+                            | otherwise  = (w1', w2', w')+            in liftM (second (go w1 w2)) (stepWire w ds (fmap fst mx'))   -- | Intrinsic switch:  Delayed version of 'switch'.

@@ -35,4 +35,4 @@ timeFrom t' =     mkSF $ \ds _ ->         let t = t' + dtime ds-        in t `seq` (t, timeFrom t)+        in lstrict (t, timeFrom t)

@@ -1,5 +1,5 @@-netwire license-Copyright (c) 2013, Ertugrul Soeylemez+Netwire license+Copyright (c) 2014, Ertugrul Soeylemez  All rights reserved. 

@@ -1,9 +1,3 @@-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.- > module Main where > > import Distribution.Simple

@@ -1,30 +0,0 @@-# -*-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-      ];-    });--}

@@ -1,39 +1,47 @@-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+name:     netwire+version:  5.0.1+category: FRP+synopsis: Functional reactive programming library++maintainer:   Ertugrul Söylemez <ertesx@gmx.de>+author:       Ertugrul Söylemez <ertesx@gmx.de>+copyright:    (c) 2014 Ertugrul Söylemez+homepage:     http://hub.darcs.net/ertes/netwire+bug-reports:  http://hub.darcs.net/ertes/netwire/issues+license:      BSD3+license-file: LICENSE+ description:     This library provides interfaces for and implements wire arrows     useful both for functional reactive programming (FRP) and locally     stateful programming (LSP). -flag TestProgram-    default: False-    description: Build the test program-    manual: True+build-type:    Simple+cabal-version: >= 1.10+extra-source-files:+    README.md+    shell.nix  Source-repository head     type:     darcs     location: http://hub.darcs.net/ertes/netwire +flag TestProgram+    default: False+    description: Build the test program+    manual: True+ 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+        base         >= 4.5  && < 5,+        containers   >= 0.5  && < 1,+        deepseq      >= 1.3  && < 2,+        parallel     >= 3.2  && < 4,+        profunctors  >= 4.3  && < 5,+        random       >= 1.1  && < 2,+        semigroups   >= 0.15 && < 1,+        transformers >= 0.3  && < 1,+        time         >= 1.4  && < 2     default-language: Haskell2010     default-extensions:         DeriveDataTypeable@@ -73,27 +81,8 @@         Arrows         OverloadedStrings         RecursiveDo-    ghc-options: -threaded -rtsopts+    ghc-options: -threaded     hs-source-dirs: test     main-is: Test.hs-    if flag(testprogram)-        buildable: True-    else+    if !flag(testprogram)         buildable: False---- test-suite tests---     type: exitcode-stdio-1.0---     build-depends:---         base >= 4.5 && < 5,---         netwire,---         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

@@ -0,0 +1,8 @@+{ pkgs ? import <nixpkgs> { } }:+let hsPkgs = pkgs.haskellPackages.override {+        extension = self: super: {+            thisDevPkg = self.callPackage ./. {};+        };+    };++in hsPkgs.thisDevPkg