reactive-banana-bunch (empty) → 1.0

raw patch · 6 files changed

+246/−0 lines, 6 filesdep +basedep +non-emptydep +reactive-bananasetup-changed

Dependencies added: base, non-empty, reactive-banana, transformers, utility-ht

Files

• LICENSE +31/−0
• Setup.lhs +3/−0
• reactive-banana-bunch.cabal +43/−0
• src/Reactive/Banana/Bunch/Combinators.hs +84/−0
• src/Reactive/Banana/Bunch/Frameworks.hs +71/−0
• src/Reactive/Banana/Bunch/Private.hs +14/−0

@@ -0,0 +1,31 @@+Copyright (c) 2016, Henning Thielemann++All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are+met:++    * Redistributions of source code must retain the above copyright+      notice, this list of conditions and the following disclaimer.++    * Redistributions in binary form must reproduce the above+      copyright notice, this list of conditions and the following+      disclaimer in the documentation and/or other materials provided+      with the distribution.++    * The names of contributors may not be used to endorse or promote+      products derived from this software without specific prior+      written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.

@@ -0,0 +1,3 @@+#! /usr/bin/env runhaskell+> import Distribution.Simple+> main = defaultMain

@@ -0,0 +1,43 @@+Name:             reactive-banana-bunch+Version:          1.0+License:          BSD3+License-File:     LICENSE+Author:           Henning Thielemann <haskell@henning-thielemann.de>+Maintainer:       Henning Thielemann <haskell@henning-thielemann.de>+Homepage:         http://hub.darcs.net/thielema/reactive-banana-bunch/+Category:         FRP+Build-Type:       Simple+Synopsis:         Extend reactive-banana to multiple events per time point+Description:+   This package provides a wrapper around @Reactive.Banana.Event@+   that somehow restores the behavior of @reactive-banana < 1.0@.+   That is, at every point in time there can be multiple events.+   The advantage is that you have a @RB.union@ without a combination function,+   the disadvantage is that there cannot be an @RB.unionWith@.+Tested-With:      GHC==7.8.4+Cabal-Version:    >=1.6+Build-Type:       Simple+Source-Repository head+  type:     darcs+  location: http://hub.darcs.net/thielema/reactive-banana-bunch/++Source-Repository this+  type:     darcs+  location: http://hub.darcs.net/thielema/reactive-banana-bunch/+  tag:      1.0++Library+  Build-Depends:+    reactive-banana >=1.1 && <1.2,+    non-empty >=0.2.1 && <0.4,+    utility-ht >=0.0.5 && <0.1,+    transformers >=0.2 && <0.6,+    base >=4 && <5++  GHC-Options:      -Wall+  Hs-Source-Dirs:   src+  Exposed-Modules:+    Reactive.Banana.Bunch.Combinators+    Reactive.Banana.Bunch.Frameworks+  Other-Modules:+    Reactive.Banana.Bunch.Private

@@ -0,0 +1,84 @@+module Reactive.Banana.Bunch.Combinators (+   Event,+   Behavior,+   MonadMoment(liftMoment),+   apply,+   (<@>),+   union,+   filterE,+   filterJust,+   accumB,+   accumE,+   mapAccum,+   stepper,+   RB.valueBLater,++   collect,+   spill,+   ) where++import qualified Reactive.Banana.Combinators as RB+import Reactive.Banana.Bunch.Private (Event(Event))+import Reactive.Banana.Combinators (MonadMoment, Behavior)++import Control.Monad (liftM, join)+import Control.Applicative ((<$>))++import qualified Data.NonEmpty.Class as NonEmptyC+import qualified Data.NonEmpty as NonEmpty+import qualified Data.Traversable as Trav+import Data.Maybe (catMaybes)+import Data.Tuple.HT (swap, mapFst)+++infixl 4 <@>+++(<@>), apply :: Behavior (a -> b) -> Event a -> Event b+(<@>) = apply++apply fs (Event ass) = Event $ fmap <$> fs RB.<@> ass++union :: Event a -> Event a -> Event a+union (Event xs) (Event ys) = Event $ RB.unionWith NonEmptyC.append xs ys++filterE :: (a -> Bool) -> Event a -> Event a+filterE = filterGen . filter++filterJust :: Event (Maybe a) -> Event a+filterJust = filterGen catMaybes++filterGen :: ([a] -> [b]) -> Event a -> Event b+filterGen f (Event xs) =+   Event $ RB.filterJust $ fmap (NonEmpty.fetch . f . NonEmpty.flatten) xs++stepper :: MonadMoment m => a -> Event a -> m (Behavior a)+stepper a (Event as) = RB.stepper a $ NonEmpty.last <$> as++accumE :: MonadMoment m => a -> Event (a -> a) -> m (Event a)+accumE acc (Event fss) = liftM (Event . fst) $ mapAccumGen double acc fss++accumB :: MonadMoment m => a -> Event (a -> a) -> m (Behavior a)+accumB acc (Event fss) = liftM snd $ mapAccumGen double acc fss++double :: a -> (a,a)+double a = (a,a)++mapAccum ::+   MonadMoment m => acc -> Event (acc -> (x, acc)) -> m (Event x, Behavior acc)+mapAccum acc (Event fss) = liftM (mapFst Event) $ mapAccumGen swap acc fss++mapAccumGen ::+   (MonadMoment m, Trav.Traversable t) =>+   (s -> (acc, a)) -> acc ->+   RB.Event (t (acc -> s)) -> m (RB.Event (t a), Behavior acc)+mapAccumGen g acc =+   RB.mapAccum acc .+   fmap (\fs a -> swap $ Trav.mapAccumL (\a0 f -> g $ f a0) a fs)+++collect :: Event a -> Event (NonEmpty.T [] a)+collect (Event as) = Event (NonEmpty.singleton <$> as)++spill :: Event (NonEmpty.T [] a) -> Event a+spill (Event as) = Event (join <$> as)

@@ -0,0 +1,71 @@+module Reactive.Banana.Bunch.Frameworks (+   RBF.MomentIO,+   RBF.Handler,+   AddHandler,+   newAddHandler,+   fromAddHandler,+   fromChanges,+   RBF.Future,+   RBF.compile,+   RBF.actuate,+   RBF.pause,+   RBF.liftIO,+   changes,+   newEvent,+   reactimate,+   reactimate',+   plainChanges,+   ) where++import qualified Reactive.Banana.Bunch.Combinators as RB+import Reactive.Banana.Bunch.Private (Event(Event))++import qualified Reactive.Banana.Frameworks as RBF++import Control.Monad (liftM)+import Control.Applicative ((<$>))++import qualified Data.NonEmpty as NonEmpty+import qualified Data.Foldable as Fold+import Data.Functor.Compose (Compose(Compose, getCompose))+import Data.Tuple.HT (mapPair)+++changes :: RB.Behavior a -> RBF.MomentIO (Event (RBF.Future a))+changes = liftM (Event . fmap NonEmpty.singleton) . RBF.changes++reactimate :: Event (IO ()) -> RBF.MomentIO ()+reactimate (Event xs) = RBF.reactimate $ Fold.sequence_ <$> xs++reactimate' :: Event (RBF.Future (IO ())) -> RBF.MomentIO ()+reactimate' (Event xs) =+   RBF.reactimate' $ (getCompose . Fold.sequenceA_ . fmap Compose) <$> xs+++newEvent :: RBF.MomentIO (Event a, RBF.Handler a)+newEvent = liftM (mapPair (Event, (. NonEmpty.singleton))) $ RBF.newEvent+++{- |+This is a bit of a hack.+The events will occur slightly after the behavior changes.+-}+plainChanges :: RB.Behavior a -> RBF.MomentIO (Event a)+plainChanges x = do+   (evs, handle) <- RBF.newEvent+   xs <- RBF.changes x+   RBF.reactimate' $ fmap (fmap handle) xs+   return $ Event $ NonEmpty.singleton <$> evs+++newtype AddHandler a = AddHandler (RBF.AddHandler (NonEmpty.T [] a))++fromAddHandler :: AddHandler a -> RBF.MomentIO (Event a)+fromAddHandler (AddHandler h) = liftM Event $ RBF.fromAddHandler h++fromChanges :: a -> AddHandler a -> RBF.MomentIO (RB.Behavior a)+fromChanges a h = RB.stepper a =<< fromAddHandler h++newAddHandler :: IO (AddHandler a, RBF.Handler a)+newAddHandler =+   liftM (mapPair (AddHandler, (. NonEmpty.singleton))) $ RBF.newAddHandler

@@ -0,0 +1,14 @@+module Reactive.Banana.Bunch.Private where++import qualified Reactive.Banana.Combinators as RB++import Control.Applicative ((<$>))++import qualified Data.NonEmpty as NonEmpty+++newtype Event a = Event (RB.Event (NonEmpty.T [] a))++instance Functor Event where+   fmap f (Event xs) = Event $ fmap f <$> xs+