reactive-banana (empty) → 0.1.0.0

raw patch · 6 files changed

+635/−0 lines, 6 filesdep +basesetup-changed

Dependencies added: base

Files

• LICENSE +30/−0
• Setup.hs +2/−0
• reactive-banana.cabal +39/−0
• src/Reactive.hs +15/−0
• src/Reactive/Classes.hs +29/−0
• src/Reactive/Core.hs +520/−0

@@ -0,0 +1,30 @@+Copyright (c)2011, Heinrich Apfelmus++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.++    * Neither the name of Heinrich Apfelmus nor the names of other+      contributors may 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,2 @@+import Distribution.Simple+main = defaultMain

@@ -0,0 +1,39 @@+Name:                reactive-banana+Version:             0.1.0.0+Synopsis:            Small but flexible+                     functional reactive programming (FRP) library.+Description:         +    A small but flexible library for functional reactive programming (FRP).+    .+    The main selling point of this library is that it+    can be hooked into /any/ existing event-based framework.+    In a sense, @reactive-banana@ is a fresh way to think+    about callback functions.+    .+    In other words, you can freely mix FRP and imperative code.+    Bored of writing imperative GUIs? Write some parts with FRP!+    Don't know how to express something with FRP?+    Switch back to imperative style!+    .+    In the spectrum of possible FRP implementations,+    this one features simple semantics but modest expressivity.+    Predicting space & time usage should be easy.+Homepage:            https://github.com/HeinrichApfelmus/Haskell-BlackBoard+License:             BSD3+License-file:        LICENSE+Author:              Heinrich Apfelmus+Maintainer:          Heinrich Apfelmus <apfelmus quantentunnel de>+Stability:           Experimental+Category:            FRP++Build-type:          Simple++-- Constraint on the version of Cabal needed to build this package.+Cabal-version:       >=1.6+++Library+    hs-source-dirs:     src+    extensions:         MultiParamTypeClasses, FlexibleInstances+    build-depends:      base == 4.2.*+    exposed-modules:    Reactive, Reactive.Classes, Reactive.Core

@@ -0,0 +1,15 @@+{-----------------------------------------------------------------------------+    Reactive Banana++    A tiny library for functional reactive programming.+------------------------------------------------------------------------------}++module Reactive (+    module Control.Applicative,+    module Reactive.Core,+    module Reactive.Classes,+    ) where++import Control.Applicative+import Reactive.Core+import Reactive.Classes

@@ -0,0 +1,29 @@+{-# LANGUAGE MultiParamTypeClasses, FlexibleInstances #-}+{-----------------------------------------------------------------------------+    Reactive-Banana+------------------------------------------------------------------------------}+module Reactive.Classes (+    -- $doc+    ReactiveSyntax(..)+    ) where++import Reactive.Core++{-$doc+This module provides a syntactically convenient 'accumulate' function.+This is an extra module because it uses type class extensions.+-}++-- | Convenient type class for automatically+-- selecting the right 'accumulate' function by type.+class ReactiveSyntax b t where+    accumulate :: (a -> b -> t) -> b -> Event a -> Behavior b++instance ReactiveSyntax b b where+    accumulate = accumulate'+instance ReactiveSyntax b (Change b) where+    accumulate = accumulateChange+instance ReactiveSyntax b (IO b) where+    accumulate = accumulateIO+instance ReactiveSyntax b (IO (Change b)) where+    accumulate = accumulateIOChange

@@ -0,0 +1,520 @@+{-----------------------------------------------------------------------------+    reactive-banana+------------------------------------------------------------------------------}++{-----------------------------------------------------------------------------++    TODO:+    What should we do with the variants involving time-varying functions?+    Should they get the same, or a different name?+    +    For example:+    +    map   ::          (a -> b) -> Event a -> Event b+    apply :: Behavior (a -> b) -> Event a -> Event b +    +    filter  ::          (a -> Bool) -> Event a -> Event a+    filterB :: Behavior (a -> Bool) -> Event a -> Event a +++    accumulate  doesn't need a  Behavior  variant!+    ->  accumulate ($) b $ apply behavior event++    TODO:+    At some point, we probably need a function to dynamically switch+    between events, something like this+    +        join :: Event (Event a) -> Event a++    Not sure about this particular functions,+    but the point is that event handlers are being registered,+    and also *unregisterered* while the program is running.+    At the moment, everything is set up statically.++------------------------------------------------------------------------------}++module Reactive.Core (+    -- * Events+    -- $Event+    Event, never, fromEventSource, reactimate,+    mapIO, filter, filterChanges,+    union, merge, orderedDuplicate,+    traceEvent,+    +    -- * Behaviors+    -- $Behavior+    Behavior, behavior, always, initial, changes, apply,+    accumulate', accumulateChange, accumulateIO, accumulateIOChange,+    mapAccum,+    +    -- * The @Change@ data type+    Change(..), isChange, isKeep,+    +    -- * Event Sources+    -- $EventSource+    EventSource(..), Prepare, newEventSource, fire,+    +    -- * Internal+    testCounter, testApply+    ) where++import Prelude hiding (map, filter)+import Control.Applicative+import Control.Monad+import Data.IORef+import Data.Maybe+import Data.Monoid+import System.IO.Unsafe+import System.IO++import Debug.Trace++{-----------------------------------------------------------------------------  +    Prepare+------------------------------------------------------------------------------}++-- | The 'Prepare' monad is just a type synonym for 'IO'.+-- The idea is that the event flow is set up in the 'Prepare' monad;+-- all 'Prepare' actions should be called+-- during the program initialization, but not while the event loop+-- is running.+type Prepare a = IO a++{-----------------------------------------------------------------------------  +    EventSource - "I'll call you back"+------------------------------------------------------------------------------}+{-$EventSource+    +    After having read all about 'Event's and 'Behavior's,+    you want to hook things up to an existing event-based framework,+    like @wxHaskell@ or @Gtk2Hs@.+    How do you do that?+    +    'EventSource's are a small bookkeeping device that helps you with that.+    Basically, they store event handlers. Often, you can just obtain them from+    corresponding bookkeeping devices from your framework,+    but sometimes you have to create your own 'EventSource'+    and use the 'fire' function to hook it into the framework.+    Event sources are also useful for testing.+    +    After creating an 'EventSource',+    you can finally obtain an 'Event' via the `fromEventSource' function.+-}+++-- | An 'EventSource' is a facility where you can register+-- callback functions, aka event handlers.+-- 'EventSource's are the precursor of proper 'Event's.+data EventSource a = EventSource {+                    -- | Replace all event handlers by this one.+                      setEventHandler :: (a -> IO ()) -> Prepare ()+                    -- | Retrieve the currently registered event handler.+                    , getEventHandler :: Prepare (a -> IO ()) }++-- add an additional event handler to the source+addEventHandler :: EventSource a -> (a -> IO ()) -> Prepare ()+addEventHandler es f = do+    g <- getEventHandler es+    setEventHandler es (\a -> g a >> f a)+++-- | Fire the event handler of an event source manually.+-- Useful for hooking into external event sources.+fire :: EventSource a -> a -> IO ()+fire es a = getEventHandler es >>= ($ a)+    -- here, the purpose of the Prepare monad is intentionally violated++-- | Create a new store for callback functions.+-- They have to be fired manually with the 'fire' function.+newEventSource :: Prepare (EventSource a)+newEventSource = do+    handlerRef <- newIORef (const $ return ())+    return $ EventSource+        { setEventHandler = writeIORef handlerRef+        , getEventHandler = readIORef handlerRef }++{-----------------------------------------------------------------------------+    Event+------------------------------------------------------------------------------}+{-$Event++The 'Event' type constructor is one of the cornerstones of the present+approach to functional reactive programmings.+It represents a stream of values as they occur in time.++-}+++-- who would have thought that the implementation is this simple+type AddHandler a = (a -> IO ()) -> Prepare ()++{- | @Event a@ represents a stream of events as they occur in time.+Semantically, you can think of @Event a@ as an infinite list of values+that are tagged with their corresponding time of occurence,++> type Event a = [(Time,a)]++Note that this is a semantic model;+the type is not actually implement that way,+but you can often treat it as if it where.+In particular, most of the subsequent operations+will be explained in terms of this model.++-}+data Event a      = Never+                  | Event { addHandler :: AddHandler a }++-- smart constructor, ensures proper sharing+mkEvent :: AddHandler a -> Event a+mkEvent =+    -- What happens when  unsafePerformIO  is accidentally exectued twice?+    -- In that case, work will be duplicated as there will be two+    -- buffers (event sources) for one and the same event.+    -- But this is the same as the situation without any sharing at all,+    -- so there's no harm done.+    -- There might be a problem with executing IO actions twice, though.+    \h -> unsafePerformIO $ share $ Event { addHandler = h }+    where+    -- Cache the value of an event,+    -- so that it's not recalculated for multiple consumers+    share :: Event a -> Prepare (Event a)+    share e1 = do+        es2 <- newEventSource+        addHandler e1 (fire es2) -- sharing happens through call-by-need+        return $ fromEventSource es2++-- | Derive an 'Event' from an 'EventSource'.+-- Apart from 'never', this is the only way to construct events.+fromEventSource :: EventSource a -> Event a+fromEventSource s = Event { addHandler = addEventHandler s }++-- | Schedule an IO event to be executed whenever it happens.+-- This is the only way to observe events.+-- Semantically, you could write it as something like this+--+-- > reactimate ((time,action):es) = atTime time action >> reactimate es +-- +-- The 'Prepare' monad indicates that you should call this function+-- during program initialization only.+reactimate :: Event (IO ()) -> Prepare ()+reactimate Never = return ()+reactimate e     = addHandler e id++-- | The value 'never' denotes the event that never happens.+-- We can model it as the empty stream of events, @never = []@.+never :: Event a+never = Never++-- | The 'Functor' instance allows you to map the values of type 'a'.+-- Semantically,+-- +-- > fmap f ((time,a):es) = (time, f a) : fmap f es+instance Functor Event where+    fmap f Never = Never+    fmap f e     = mkEvent addHandler'+        where addHandler' g = addHandler e (g . f)++-- | Version of 'fmap' that performs an 'IO' action for each event occurence.+mapIO :: (a -> IO b) -> Event a -> Event b+mapIO f Never = Never+mapIO f e     = mkEvent addHandler'+    where addHandler' g = addHandler e (g <=< f)+++-- | Merge two event streams of the same type. Semantically, we have+-- +-- > union ((time1,a1):es1) ((time2,a2):es2)+-- >    | time1 < time2 = (time1,a1) : union es1 ((time2,a2):es2)+-- >    | time1 > time2 = (time2,a2) : union ((time1,a1):es1) es2+-- >    | otherwise     = ... -- either of the previous two cases+-- +-- Note that the order of events that happen simultaneously is /undefined/.+-- This is not a problem most of the time,+-- but sometimes you have to force a certain order.+-- In that case, you have to combine this with the 'orderedDuplicate' function. +union :: Event a -> Event a -> Event a+union Never e2    = e2+union e1    Never = e1+union e1    e2    = mkEvent addHandler'+    where addHandler' g = addHandler e1 g >> addHandler e2 g++-- | The 'Monoid' instance allows you to merge event streams,+-- see the 'union' function below.+-- +-- > mempty  = never+-- > mappend = union+instance Monoid (Event a) where+    mempty  = never+    mappend = union++-- | Merge two event streams that have differen types. Semantically, we have+-- +-- > merge e1 e2 = fmap Left e1 `union` fmap Right e2+merge :: Event a -> Event b -> Event (Either a b)+merge e1 e2 = fmap Left e1 `union` fmap Right e2+++-- | Duplicate an event stream while paying attention to ordering.+-- Events from the first duplicate (and anything derived from them)+-- will always happen+-- before the events from the second duplicate.+-- Use this function to fine-tune the order of events.+orderedDuplicate :: Event a -> (Event a, Event a)+orderedDuplicate Never = (never, never)+orderedDuplicate e     =+    unsafePerformIO $ do      -- should be safe, though, only for sharing+        es1 <- newEventSource+        es2 <- newEventSource+        addHandler e $ \a -> fire es1 a >> fire es2 a+        return (fromEventSource es1, fromEventSource es2)++-- | Pass all events that fulfill the predicate, discard the rest. Semantically,+-- +-- > filter p es = [(time,a) | (time,a) <- es, p a]+filter :: (a -> Bool) -> Event a -> Event a+filter p Never = Never+filter p e     = mkEvent addHandler'+    where addHandler' g = addHandler e $ \a -> when (p a) (g a)++-- | Unpacks event values of the form @Change _@ and discards+-- everything else.+filterChanges :: Event (Change a) -> Event a+filterChanges = fmap (\(Change x) -> x) . filter isChange+++-- | Debugging helper. Prints the first argument and the value of the event+-- whenever it happens to 'stderr'.+traceEvent :: Show a => String -> Event a -> Event a+traceEvent s = mapIO (\a -> hPutStrLn stderr (s ++ " : " ++ show a) >> return a)++{-----------------------------------------------------------------------------+    Behavior+------------------------------------------------------------------------------}+{-+FIXME: exporting  initial  to users might cause space leaks+where the initial value is retained long beyond the point where+it was consumed.+However, if we want the user to implement optimized behaviors+himself, like  TimeGraphic , we have to provide a mechanism+similar to this one.+Alternative: keep current value in a IORef. This will eliminate+this particular space leak? Probably not. I think it's fine the way it is.+-}++{-$Behavior++The 'Behavior' type constructor is the other cornerstone of the+present approach to functional reactive programming.+It represents a value that changes with time.++-}++{-| @Behavior a@ represents a value in time. Think of it as++> type Behavior a = Time -> a++However, note that this model misses an important point:+we only allow /piecewise constant/ functions.+Continuous behaviors like++> badbehavior = \time -> 2*time++cannot be implemented.++-}+data Behavior a = Behavior {+    initial :: a,       -- ^ The value that the behavior initially has.+    changes :: Event a+        -- ^ An event stream recording how the behavior changes+        -- Remember that behaviors are piecewise constant functions.+    }++-- | Smart constructor. Supply an initial value and a sequence of changes.+-- In particular,+-- +-- > initial (behavior a es) = a+-- > changes (behavior a es) = es+behavior :: a -> Event a -> Behavior a+behavior = Behavior++-- | The constant behavior. Semantically,+-- +-- > always a = \time -> a+always :: a -> Behavior a+always a = Behavior { initial = a, changes = never }++    -- trigger an event whenever the value changes.+-- changes :: Behavior a -> Event a++-- | Version of 'accumulate' that involves the 'Change' data type+-- and performs an 'IO' action to update the value.+-- +-- It is recommended that you use the 'accumulate' function from+-- 'Reactive.Classes' to pick types automatically.+accumulateIOChange :: (b -> a -> IO (Change a)) -> a -> Event b -> Behavior a+accumulateIOChange f a Never = always a+accumulateIOChange f a eb    =+    Behavior { initial = a , changes = mkEvent addHandler' }+    where+    addHandler' g = addHandler eb (handler g)+    +    -- we need a global state+    -- FIXME: NOINLINE pragma!+    ref = unsafePerformIO $ newIORef a+    handler g = \b -> do+        a   <- readIORef ref    -- read old value+        ma' <- f b a            -- accumulate+        case ma' of+            Keep      -> return ()+            Change a' -> do+                writeIORef ref $! a'    -- use new value+                g a'++{- | The most important way to create behaviors.+The 'accumulate'' function is similar to a strict left fold, 'foldl''.+It starts with an initial value and combines it with incoming events.+For example, semantically+ +> accumulate' (++) "x" [(time1,"y"),(time2,"z")]+>    = behavior "x" [(time1,"yx"),(time2,"zyx")]+ +Note that the accumulated value is evaluated /strictly/.+This prevents space leaks.++It is recommended that you use the 'accumulate' function from+'Reactive.Classes' to pick types automatically.+-}+accumulate' :: (b -> a -> a) -> a -> Event b -> Behavior a+accumulate' f = accumulateIOChange (\b a -> return . Change $ f b a)++-- | Version of 'accumulate' that involves the 'Change' data type.+-- Use the 'Keep' constructor to indicate that the incoming event +-- hasn't changed the value. No change event will be propagated in that case.+-- +-- It is recommended that you use the 'accumulate' function from+-- 'Reactive.Classes' to pick types automatically.+accumulateChange :: (b -> a -> Change a) -> a -> Event b -> Behavior a+accumulateChange f = accumulateIOChange (\b a -> return $ f b a)+++-- | Version of 'accumulate' that performs an 'IO' action to update the value.+--     +-- It is recommended that you use the 'accumulate' function from+-- 'Reactive.Classes' to pick types automatically.+accumulateIO :: (b -> a -> IO a) -> a -> Event b -> Behavior a+accumulateIO f = accumulateIOChange (\b a -> fmap Change $ f b a)+    -- Note: IO would be unsound without sharing!+++-- | The 'Functor' instance allows you to map the values of type @a@.+-- Semantically, +-- +-- > fmap f behavior = \time -> f (behavior time)+instance Functor Behavior where+    fmap f b = Behavior+        { initial = f (initial b), changes = fmap f (changes b) }++-- | The 'Applicative' instance is one most of the most important ways+-- to combine behaviors. Semantically,+-- +-- > pure a    = always a+-- > bf <*> bx = \time -> bf time $ bx time +instance Applicative Behavior where+    pure a    = always a+    +    -- optimize the cases where the event never fires+    (Behavior f Never) <*> bx = fmap (f $) bx+    bf <*> (Behavior x Never) = fmap ($ x) bf+    bf <*> bx                 = fmap (uncurry ($)) $+        accumulate' go (initial bf, initial bx) (changes bf `merge` changes bx)+        where+        go (Left  f') (f,x) = (f',x)+        go (Right x') (f,x) = (f,x')++    -- store the occurences of an event in a behavior+-- latch :: Event a -> Behavior (Maybe a)+-- latch = accumulate' (\a _ -> Just a) Nothing++-- | Map events while threading state.+-- Similar to the standard 'mapAccumL' function.+mapAccum :: (acc -> x -> (acc,y)) -> acc -> Event x -> (Behavior acc, Event y)+mapAccum f acc Never = (always acc, never) +mapAccum f acc xs    =+    (fmap fst result, fmap snd $ changes result)+    where+    result = accumulate' (\x (acc,_) -> f acc x) (acc,undefined) xs++-- | The most important way to combine behaviors and events.+-- The 'apply' function applies a time-varying function to a stream of events.+-- Semantically,+-- +-- > apply bf es = [(time, bf time a) | (time, a) <- es]+-- +-- (Theoretically inclined people might+-- be wondering whether we could achieve the same effect with+-- the 'Applicative' instance. The answer is no, the semantics of+-- 'apply' and '<*>' are subtly different. That's why we need to distinguish+-- between behaviors and events.)+apply :: Behavior (a -> b) -> Event a -> Event b+apply (Behavior f Never) ex    = fmap f ex+apply bf                 Never = Never+apply bf                 ex    =+    filterChanges . snd . mapAccum go (initial bf) $ changes bf `merge` ex+    where+    go _ (Left  f) = (f, Keep)+    go f (Right x) = (f, Change $ f x)++{-----------------------------------------------------------------------------+    Change+------------------------------------------------------------------------------}+{- | Data type to indicate that a value has changed.+Used in conjunction with the 'accumulate' functions.++This is basically the @Maybe@ type with a different name.+Using a different name improves program readability+and makes it easier to automatically select the right 'accumulate'+function by type, see the 'Reactive.Classes' module.+-}+data Change a =+    Keep            -- ^ Signals that the value has not changed.+    | Change a      -- ^ Indicates a change to some value of type @a@.+    deriving (Eq, Show, Read)++instance Functor Change where+    fmap _ Keep       = Keep+    fmap f (Change a) = Change (f a)++-- | The 'isChange' function returns 'True' iff its argument is of the form @Change _@.+isChange :: Change a -> Bool+isChange (Change _) = True+isChange _          = False++-- | The 'isKeep' function returns 'True' iff its argument is of the form @Keep@.+isKeep :: Change a -> Bool+isKeep Keep = True+isKeep _    = False++{-----------------------------------------------------------------------------+    Test examples+    +    The examples return event sources that you can fire.+------------------------------------------------------------------------------}+testCounter :: Prepare (EventSource Int)+testCounter = do+    es <- newEventSource+    let e = fromEventSource es+    reactimate . changes $ print <$> accumulate' (+) 0 e+    return es++-- test the  apply  function+testApply :: Prepare (EventSource Int, EventSource Int)+testApply = do+    es1 <- newEventSource+    let e1 = fromEventSource es1+    +    es2 <- newEventSource+    let e2 = fromEventSource es2++    reactimate . fmap print $ apply (fmap (+) (Behavior 0 e1)) e1+    return (es1, es2)+