packages feed

elerea 1.0.0 → 1.1.0

raw patch · 7 files changed

+891/−2 lines, 7 filesdep +ghc-primPVP ok

version bump matches the API change (PVP)

Dependencies added: ghc-prim

API changes (from Hackage documentation)

+ FRP.Elerea.Experimental: (&&@) :: Signal p Bool -> Signal p Bool -> Signal p Bool
+ FRP.Elerea.Experimental: (/=@) :: (Eq a) => Signal p a -> Signal p a -> Signal p Bool
+ FRP.Elerea.Experimental: (<=@) :: (Ord a) => Signal p a -> Signal p a -> Signal p Bool
+ FRP.Elerea.Experimental: (<@) :: (Ord a) => Signal p a -> Signal p a -> Signal p Bool
+ FRP.Elerea.Experimental: (==@) :: (Eq a) => Signal p a -> Signal p a -> Signal p Bool
+ FRP.Elerea.Experimental: (>=@) :: (Ord a) => Signal p a -> Signal p a -> Signal p Bool
+ FRP.Elerea.Experimental: (>@) :: (Ord a) => Signal p a -> Signal p a -> Signal p Bool
+ FRP.Elerea.Experimental: (||@) :: Signal p Bool -> Signal p Bool -> Signal p Bool
+ FRP.Elerea.Experimental: edge :: Signal p Bool -> SignalGen p (Signal p Bool)
+ FRP.Elerea.Experimental: storeJust :: a -> Signal p (Maybe a) -> SignalGen p (Signal p a)
+ FRP.Elerea.Experimental.Param: data Signal p a
+ FRP.Elerea.Experimental.Param: data SignalGen p a
+ FRP.Elerea.Experimental.Param: debug :: String -> SignalGen p ()
+ FRP.Elerea.Experimental.Param: delay :: a -> Signal p a -> SignalGen p (Signal p a)
+ FRP.Elerea.Experimental.Param: external :: a -> IO (Signal p a, a -> IO ())
+ FRP.Elerea.Experimental.Param: generator :: Signal p (SignalGen p a) -> SignalGen p (Signal p a)
+ FRP.Elerea.Experimental.Param: instance (Bounded t) => Bounded (Signal p t)
+ FRP.Elerea.Experimental.Param: instance (Enum t) => Enum (Signal p t)
+ FRP.Elerea.Experimental.Param: instance (Floating t) => Floating (Signal p t)
+ FRP.Elerea.Experimental.Param: instance (Fractional t) => Fractional (Signal p t)
+ FRP.Elerea.Experimental.Param: instance (Integral t) => Integral (Signal p t)
+ FRP.Elerea.Experimental.Param: instance (Num t) => Num (Signal p t)
+ FRP.Elerea.Experimental.Param: instance (Ord t) => Ord (Signal p t)
+ FRP.Elerea.Experimental.Param: instance (Real t) => Real (Signal p t)
+ FRP.Elerea.Experimental.Param: instance Applicative (Signal p)
+ FRP.Elerea.Experimental.Param: instance Applicative (SignalGen p)
+ FRP.Elerea.Experimental.Param: instance Eq (Signal p a)
+ FRP.Elerea.Experimental.Param: instance Functor (Signal p)
+ FRP.Elerea.Experimental.Param: instance Functor (SignalGen p)
+ FRP.Elerea.Experimental.Param: instance Monad (Signal p)
+ FRP.Elerea.Experimental.Param: instance Monad (SignalGen p)
+ FRP.Elerea.Experimental.Param: instance MonadFix (SignalGen p)
+ FRP.Elerea.Experimental.Param: instance Show (Signal p a)
+ FRP.Elerea.Experimental.Param: memo :: Signal p a -> SignalGen p (Signal p a)
+ FRP.Elerea.Experimental.Param: start :: SignalGen p (Signal p a) -> IO (p -> IO a)
+ FRP.Elerea.Experimental.Param: stateful :: a -> (p -> a -> a) -> SignalGen p (Signal p a)
+ FRP.Elerea.Experimental.Param: transfer :: a -> (p -> t -> a -> a) -> Signal p t -> SignalGen p (Signal p a)
+ FRP.Elerea.Experimental.Simple: data Signal a
+ FRP.Elerea.Experimental.Simple: data SignalGen a
+ FRP.Elerea.Experimental.Simple: delay :: a -> Signal a -> SignalGen (Signal a)
+ FRP.Elerea.Experimental.Simple: external :: a -> IO (Signal a, a -> IO ())
+ FRP.Elerea.Experimental.Simple: generator :: Signal (SignalGen a) -> SignalGen (Signal a)
+ FRP.Elerea.Experimental.Simple: instance (Bounded t) => Bounded (Signal t)
+ FRP.Elerea.Experimental.Simple: instance (Enum t) => Enum (Signal t)
+ FRP.Elerea.Experimental.Simple: instance (Floating t) => Floating (Signal t)
+ FRP.Elerea.Experimental.Simple: instance (Fractional t) => Fractional (Signal t)
+ FRP.Elerea.Experimental.Simple: instance (Integral t) => Integral (Signal t)
+ FRP.Elerea.Experimental.Simple: instance (Num t) => Num (Signal t)
+ FRP.Elerea.Experimental.Simple: instance (Ord t) => Ord (Signal t)
+ FRP.Elerea.Experimental.Simple: instance (Real t) => Real (Signal t)
+ FRP.Elerea.Experimental.Simple: instance Applicative Signal
+ FRP.Elerea.Experimental.Simple: instance Applicative SignalGen
+ FRP.Elerea.Experimental.Simple: instance Eq (Signal a)
+ FRP.Elerea.Experimental.Simple: instance Functor Signal
+ FRP.Elerea.Experimental.Simple: instance Functor SignalGen
+ FRP.Elerea.Experimental.Simple: instance Monad Signal
+ FRP.Elerea.Experimental.Simple: instance Monad SignalGen
+ FRP.Elerea.Experimental.Simple: instance MonadFix SignalGen
+ FRP.Elerea.Experimental.Simple: instance Show (Signal a)
+ FRP.Elerea.Experimental.Simple: memo :: Signal a -> SignalGen (Signal a)
+ FRP.Elerea.Experimental.Simple: start :: SignalGen (Signal a) -> IO (IO a)
+ FRP.Elerea.Experimental.Simple: stateful :: a -> (a -> a) -> SignalGen (Signal a)
+ FRP.Elerea.Experimental.Simple: transfer :: a -> (t -> a -> a) -> Signal t -> SignalGen (Signal a)

Files

CHANGES view
@@ -1,3 +1,6 @@+1.1.0 - 091126+* added experimental branch with a cleaner semantics+ 1.0.0 - 090726 * completely renewed interface by introducing the SignalMonad 
FRP/Elerea.hs view
@@ -31,6 +31,10 @@ a general idea how to use the library, check out the sources in the @elerea-examples@ package. +The "FRP.Elerea.Experimental" branch provides a similar interface with+a rather different underlying structure, which is likely to be more+efficient.+ -}  module FRP.Elerea
+ FRP/Elerea/Experimental.hs view
@@ -0,0 +1,116 @@+{-|++This branch is an experimental version of Elerea that does not build+an actual graph of the dataflow network, just maintains a list of+actions to update signals.  Each signal consists of a mutable+variable, an aging action and a finalising action.  The variables can+only be accessed through a sampling action, and they are only referred+to in the corresponding aging and finalising action.  These actions+can be accessed through weak pointers that get invalidated when all+other references to the corresponding variable are lost.++This approach has both advantages and disadvantages.  On the plus+side, we don't have to create nodes for the applicative operations any+more, because they can be encoded in the sampling actions in an+efficient way.  Also, since we have a list of independent actions to+update the network, we can achieve nearly perfect parallelism, just+like with a raytracer: all we need is a clever way of assigning+actions to processing units.  The downside is that we have to+explicitly memoise the results of applicative operations in case they+are used more than once.++The modules below implement the basic idea in two variations:++* "FRP.Elerea.Experimental.Simple" provides discrete signals,+  i.e. streams;++* "FRP.Elerea.Experimental.Param" adds an extra parameter that's+  accessible to every node during the update, which can be used to+  provide a time step between samplings, or any other input necessary;++An extension of the second version with automatic delays will be+released later.++This module exports the parametric version along with a few utility+functions.++-}++{-+* "FRP.Elerea.Experimental.Delayed" adds automatic delays, which+  violates referential transparency in a limited way, but improves the+  usability of the API when this doesn't matter.+-}++module FRP.Elerea.Experimental+       ( module FRP.Elerea.Experimental.Param+       , storeJust+       , edge+       , (==@), (/=@), (<@), (<=@), (>=@), (>@)+       , (&&@), (||@)+       ) where++import Control.Applicative+import FRP.Elerea.Experimental.Param++infix  4 ==@, /=@, <@, <=@, >=@, >@+infixr 3 &&@+infixr 2 ||@++{-| The 'edge' transfer function takes a bool signal and emits another+bool signal that turns true only at the moment when there is a rising+edge on the input. -}++edge :: Signal p Bool -> SignalGen p (Signal p Bool)+edge b = delay True b >>= \db -> return $ (not <$> db) &&@ b++{-| The 'storeJust' transfer function behaves as a latch on a 'Maybe'+input: it keeps its state when the input is 'Nothing', and replaces it+with the input otherwise. -}++storeJust :: a                        -- ^ Initial output+          -> Signal p (Maybe a)       -- ^ Maybe signal to latch on+          -> SignalGen p (Signal p a)+storeJust x0 s = transfer x0 store s+    where store _ Nothing  x = x+          store _ (Just x) _ = x++{-| Point-wise equality of two signals. -}++(==@) :: Eq a => Signal p a -> Signal p a -> Signal p Bool+(==@) = liftA2 (==)++{-| Point-wise inequality of two signals. -}++(/=@) :: Eq a => Signal p a -> Signal p a -> Signal p Bool+(/=@) = liftA2 (/=)++{-| Point-wise comparison of two signals. -}++(<@) :: Ord a => Signal p a -> Signal p a -> Signal p Bool+(<@) = liftA2 (<)++{-| Point-wise comparison of two signals. -}++(<=@) :: Ord a => Signal p a -> Signal p a -> Signal p Bool+(<=@) = liftA2 (<=)++{-| Point-wise comparison of two signals. -}++(>=@) :: Ord a => Signal p a -> Signal p a -> Signal p Bool+(>=@) = liftA2 (>=)++{-| Point-wise comparison of two signals. -}++(>@) :: Ord a => Signal p a -> Signal p a -> Signal p Bool+(>@) = liftA2 (>)++{-| Point-wise OR of two boolean signals. -}++(||@) :: Signal p Bool -> Signal p Bool -> Signal p Bool+(||@) = liftA2 (||)++{-| Point-wise AND of two boolean signals. -}++(&&@) :: Signal p Bool -> Signal p Bool -> Signal p Bool+(&&@) = liftA2 (&&)
+ FRP/Elerea/Experimental/Param.hs view
@@ -0,0 +1,342 @@+{-|++This version differs from the simple one in providing an extra+argument to the sampling action that will be globally distributed to+every node and can be used to update the state.  For instance, it can+hold the time step between the two samplings, but it could also encode+all the external input to the system.++The interface of this module differs from the old Elerea in the+following ways:++* the delta time argument is generalised to an arbitrary type, so it+  is possible to do without 'external' altogether in case someone+  wants to do so;++* there is no 'sampler' any more, it is substituted by 'join', as+  signals are monads;++* 'generator' has been conceptually simplified, so it's a more basic+  primitive now;++* there is no automatic delay in order to preserve semantic soundness+  (e.g. the monad laws for signals);++* all signals are aged regardless of whether they are sampled+  (i.e. their behaviour doesn't depend on the context any more);++* the user needs to cache the results of applicative operations to be+  reused in multiple places explicitly using the 'memo' combinator.++-}++module FRP.Elerea.Experimental.Param+    ( Signal+    , SignalGen+    , start+    , external+    , delay+    , stateful+    , transfer+    , memo+    , generator+    , debug+    ) where++import Control.Applicative+import Control.Monad+import Control.Monad.Fix+import Data.IORef+import Data.Maybe+import System.Mem.Weak++--import FRP.Elerea.Experimental.WeakRef++{-| A signal can be thought of as a function of type @Nat -> a@, and+its 'Monad' instance agrees with that intuition.  Internally, is+represented by a sampling computation. -}++newtype Signal p a = S { unS :: p -> IO a }++{-| A dynamic set of actions to update a network without breaking+consistency. -}++type UpdatePool p = [Weak (p -> IO (), IO ())]++{-| A signal generator is the only source of stateful signals.+Internally, computes a signal structure and adds the new variables to+an existing update pool. -}++newtype SignalGen p a = SG { unSG :: IORef (UpdatePool p) -> IO a }++{-| The phases every signal goes through during a superstep: before or+after sampling. -}++data Phase s a = Ready s | Aged s a++instance Functor (Signal p) where+  fmap = liftM++instance Applicative (Signal p) where+  pure = return+  (<*>) = ap++instance Monad (Signal p) where+  return = S . const . return+  S g >>= f = S $ \p -> g p >>= \x -> unS (f x) p++instance Functor (SignalGen p) where+  fmap = liftM++instance Applicative (SignalGen p) where+  pure = return+  (<*>) = ap++instance Monad (SignalGen p) where+  return = SG . const . return+  SG g >>= f = SG $ \p -> g p >>= \x -> unSG (f x) p++instance MonadFix (SignalGen p) where+  mfix f = SG $ \p -> mfix (($p).unSG.f)++{-| Embedding a signal into an 'IO' environment.  Repeated calls to+the computation returned cause the whole network to be updated, and+the current sample of the top-level signal is produced as a+result. The computation accepts a global parameter that will be+distributed to all signals.  For instance, this can be the time step,+if we want to model continuous-time signals. -}++start :: SignalGen p (Signal p a) -- ^ the generator of the top-level signal+      -> IO (p -> IO a)           -- ^ the computation to sample the signal+start (SG gen) = do+  pool <- newIORef []+  (S sample) <- gen pool++  ptrs0 <- readIORef pool+  writeIORef pool []+  (as0,cs0) <- unzip . map fromJust <$> mapM deRefWeak ptrs0+  let ageStatic param = mapM_ ($param) as0+      commitStatic = sequence_ cs0++  return $ \param -> do+    let update [] ptrs age commit = do+          writeIORef pool ptrs+          ageStatic param >> age+          commitStatic >> commit+        update (p:ps) ptrs age commit = do+          r <- deRefWeak p+          case r of+            Nothing -> update ps ptrs age commit+            Just (a,c) -> update ps (p:ptrs) (age >> a param) (commit >> c)++    res <- sample param+    ptrs <- readIORef pool+    update ptrs [] (return ()) (return ())+    return res++{-| Auxiliary function used by all the primitives that create a+mutable variable. -}++addSignal :: (p -> Phase s a -> IO a)  -- ^ sampling function+          -> (p -> Phase s a -> IO ()) -- ^ aging function+          -> IORef (Phase s a)         -- ^ the mutable variable behind the signal+          -> IORef (UpdatePool p)      -- ^ the pool of update actions+          -> IO (Signal p a)+addSignal sample age ref pool = do+  let  commit (Aged s _)  = Ready s+       commit _           = error "commit error: signal not aged"++       sig = S $ \p -> readIORef ref >>= sample p+  +  update <- mkWeak sig (\p -> readIORef ref >>= age p, modifyIORef ref commit) Nothing+  modifyIORef pool (update:)+  return sig++{-| The 'delay' transfer function emits the value of a signal from the+previous superstep, starting with the filler value given in the first+argument. -}++delay :: a                        -- ^ initial output+      -> Signal p a               -- ^ the signal to delay+      -> SignalGen p (Signal p a)+delay x0 (S s) = SG $ \pool -> do+  ref <- newIORef (Ready x0)++  let  sample _ (Ready x)   = return x+       sample _ (Aged _ x)  = return x++       age p (Ready x)  = s p >>= \x' -> x' `seq` writeIORef ref (Aged x' x)+       age _ _          = return ()++  addSignal sample age ref pool++{-| Memoising combinator.  It can be used to cache results of+applicative combinators in case they are used in several places. Other+than that, it is equivalent to 'return'. -}++memo :: Signal p a               -- ^ signal to memoise+     -> SignalGen p (Signal p a)+memo (S s) = SG $ \pool -> do+  ref <- newIORef (Ready undefined)++  let  sample p (Ready _)      = s p >>= \x -> writeIORef ref (Aged undefined x) >> return x+       sample _ (Aged _ x)     = return x++       age p (Ready _)      = s p >>= \x -> writeIORef ref (Aged undefined x)+       age _ _              = return ()++  addSignal sample age ref pool++{-| A reactive signal that takes the value to output from a monad+carried by its input.  It is possible to create new signals in the+monad. -}++generator :: Signal p (SignalGen p a) -- ^ a stream of generators to potentially run+          -> SignalGen p (Signal p a)+generator (S gen) = SG $ \pool -> do+  ref <- newIORef (Ready undefined)++  let  next p = ($pool).unSG =<< gen p+       +       sample p (Ready _)  = next p >>= \x' -> writeIORef ref (Aged x' x') >> return x'+       sample _ (Aged _ x) = return x++       age p (Ready _) = next p >>= \x' -> writeIORef ref (Aged x' x')+       age _ _         = return ()++  addSignal sample age ref pool++{-| A signal that can be directly fed through the sink function+returned.  This can be used to attach the network to the outer world.+Note that this is optional, as all the input of the network can be fed+in through the global parameter, although that is not really+convenient for many signals. -}++external :: a                           -- ^ initial value+         -> IO (Signal p a, a -> IO ()) -- ^ the signal and an IO function to feed it+external x = do+  ref <- newIORef x+  return (S (const (readIORef ref)), writeIORef ref)++{-| A pure stateful signal.  The initial state is the first output,+and every following output is calculated from the previous one and the+value of the global parameter. -}++stateful :: a -> (p -> a -> a) -> SignalGen p (Signal p a)+stateful x0 f = SG $ \pool -> do+  ref <- newIORef (Ready x0)++  let  sample _ (Ready x)  = return x+       sample _ (Aged _ x) = return x++       age p (Ready x) = let x' = f p x in x' `seq` writeIORef ref (Aged x' x)+       age _ _         = return ()++  addSignal sample age ref pool++{-| A stateful transfer function.  The current input affects the+current output, i.e. the initial state given in the first argument is+considered to appear before the first output, and can never be+observed.  Every output is derived from the current value of the input+signal, the global parameter and the previous output. -}++transfer :: a -> (p -> t -> a -> a) -> Signal p t -> SignalGen p (Signal p a)+transfer x0 f (S s) = SG $ \pool -> do+  ref <- newIORef (Ready x0)++  let  sample p (Ready x)  = s p >>= \y -> let x' = f p y x in+                                            x' `seq` writeIORef ref (Aged x' x') >> return x'+       sample _ (Aged _ x) = return x++       age p (Ready x) = s p >>= \y -> let x' = f p y x in+                                        x' `seq` writeIORef ref (Aged x' x')+       age _ _         = return ()++  addSignal sample age ref pool++{-| A printing action within the |SignalGen| monad. -}++debug :: String -> SignalGen p ()+debug = SG . const . putStrLn++{-| The @Show@ instance is only defined for the sake of 'Num'... -}++instance Show (Signal p a) where+  showsPrec _ _ s = "<SIGNAL>" ++ s++{-| Equality test is impossible. -}++instance Eq (Signal p a) where+  _ == _ = False+  +{-| Error message for unimplemented instance functions. -}++unimp :: String -> a+unimp = error . ("Signal: "++)++instance Ord t => Ord (Signal p t) where+  compare = unimp "compare"+  min = liftA2 min+  max = liftA2 max++instance Enum t => Enum (Signal p t) where+  succ = fmap succ+  pred = fmap pred+  toEnum = pure . toEnum+  fromEnum = unimp "fromEnum"+  enumFrom = unimp "enumFrom"+  enumFromThen = unimp "enumFromThen"+  enumFromTo = unimp "enumFromTo"+  enumFromThenTo = unimp "enumFromThenTo"++instance Bounded t => Bounded (Signal p t) where+  minBound = pure minBound+  maxBound = pure maxBound++instance Num t => Num (Signal p t) where+  (+) = liftA2 (+)+  (-) = liftA2 (-)+  (*) = liftA2 (*)+  signum = fmap signum+  abs = fmap abs+  negate = fmap negate+  fromInteger = pure . fromInteger++instance Real t => Real (Signal p t) where+  toRational = unimp "toRational"++instance Integral t => Integral (Signal p t) where+  quot = liftA2 quot+  rem = liftA2 rem+  div = liftA2 div+  mod = liftA2 mod+  quotRem a b = (fst <$> qrab,snd <$> qrab)+    where qrab = quotRem <$> a <*> b+  divMod a b = (fst <$> dmab,snd <$> dmab)+    where dmab = divMod <$> a <*> b+  toInteger = unimp "toInteger"++instance Fractional t => Fractional (Signal p t) where+  (/) = liftA2 (/)+  recip = fmap recip+  fromRational = pure . fromRational++instance Floating t => Floating (Signal p t) where+  pi = pure pi+  exp = fmap exp+  sqrt = fmap sqrt+  log = fmap log+  (**) = liftA2 (**)+  logBase = liftA2 logBase+  sin = fmap sin+  tan = fmap tan+  cos = fmap cos+  asin = fmap asin+  atan = fmap atan+  acos = fmap acos+  sinh = fmap sinh+  tanh = fmap tanh+  cosh = fmap cosh+  asinh = fmap asinh+  atanh = fmap atanh+  acosh = fmap acosh
+ FRP/Elerea/Experimental/Simple.hs view
@@ -0,0 +1,417 @@+{-# LANGUAGE GeneralizedNewtypeDeriving #-}++{-|++This module provides efficient higher-order discrete signals.  For a+non entirely trivial example, let's create a dynamic collection of+countdown timers, where each expired timer is removed from the+collection.  First of all, we'll need a simple tester function:++@+ sigtest gen = 'replicateM' 15 '=<<' 'start' gen+@++We can try it with a trivial example:++@+ \> sigtest $ 'stateful' 2 (+3)+ [2,5,8,11,14,17,20,23,26,29,32,35,38,41,44,47]+@++Our first definition will be a signal representing a simple named+timer:++@+ countdown :: String -\> Int -\> SignalGen (Signal (String,Maybe Int))+ countdown name t = do+   let tick prev = do { t \<- prev ; 'guard' (t \> 0) ; 'return' (t-1) }+   timer \<- 'stateful' (Just t) tick+   'return' ((,) name '<$>' timer)+@++Let's see if it works:++@+ \> sigtest $ countdown \"foo\" 4+ [(\"foo\",Just 4),(\"foo\",Just 3),(\"foo\",Just 2),(\"foo\",Just 1),(\"foo\",Just 0),+  (\"foo\",Nothing),(\"foo\",Nothing),(\"foo\",Nothing),...]+@++Next, we will define a timer source that takes a list of timer names,+starting values and start times and creates a signal that delivers the+list of new timers at every point:++@+ timerSource :: [(String, Int, Int)] -\> SignalGen (Signal [Signal (String, Maybe Int)])+ timerSource ts = do+   let gen t = 'mapM' ('uncurry' countdown) newTimers+           where newTimers = [(n,v) | (n,v,st) \<- ts, st == t]+   cnt \<- 'stateful' 0 (+1)+   'generator' (gen '<$>' cnt)+@++Now we need to encapsulate the timer source signal in another signal+expression that takes care of maintaining the list of live timers.+Since working with dynamic collections is a recurring task, let's+define a generic combinator that maintains a dynamic list of signals+given a source and a test that tells from the output of each signal+whether it should be kept.  We can use @mdo@ expressions (a variant of+@do@ expressions allowing forward references) as syntactic sugar for+'mfix' to make life easier:++@+ collection :: Signal [Signal a] -\> (a -\> Bool) -\> SignalGen (Signal [a])+ collection source isAlive = mdo+   sig \<- 'delay' [] ('map' 'snd' '<$>' collWithVals')+   coll \<- 'memo' ('liftA2' (++) source sig)+   let collWithVals = 'zip' '<$>' ('sequence' '=<<' coll) '<*>' coll+   collWithVals' \<- 'memo' ('filter' (isAlive . 'fst') '<$>' collWithVals)+   'return' $ 'map' 'fst' '<$>' collWithVals'+@++We need recursion to define the @coll@ signal as a delayed version of+its continuation, which does not contain signals that need to be+removed in the current sample.  At every point of time the running+collection is concatenated with the source.  We define @collWithVals@,+which simply pairs up every signal with its current output.  The+output is obtained by extracting the current value of the signal+container and sampling each element with 'sequence'.  We can then+derive @collWithVals'@, which contains only the signals that must be+kept for the next round along with their output.  Both @coll@ and+@collWithVals'@ have to be memoised, because they are used more than+once (the program would work without that, but it would recalculate+both signals each time they are used).  By throwing out the respective+parts, we can get both the final output and the collection for the+next step (@coll'@).++Now we can easily finish the original task:++@+ timers :: [(String, Int, Int)] -\> SignalGen (Signal [(String, Int)])+ timers timerData = do+   src \<- timerSource timerData+   getOutput '<$>' collection src ('isJust' . 'snd')+     where getOutput = 'fmap' ('map' (\\(name,Just val) -> (name,val)))+@++As a test, we can start four timers: /a/ at t=0 with value 3, /b/ and+/c/ at t=1 with values 5 and 3, and /d/ at t=3 with value 4:++@+ \> sigtest $ timers [(\"a\",3,0),(\"b\",5,1),(\"c\",3,1),(\"d\",4,3)]+ [[(\"a\",3)],[(\"b\",5),(\"c\",3),(\"a\",2)],[(\"b\",4),(\"c\",2),(\"a\",1)],+  [(\"d\",4),(\"b\",3),(\"c\",1),(\"a\",0)],[(\"d\",3),(\"b\",2),(\"c\",0)],+  [(\"d\",2),(\"b\",1)],[(\"d\",1),(\"b\",0)],[(\"d\",0)],[],[],[],[],[],[],[]]+@++If the noise of the applicative lifting operators feels annoying, she+(<http://personal.cis.strath.ac.uk/~conor/pub/she/>) comes to the+save.  Among other features it provides idiom brackets, which can+substitute the explicit lifting.  For instance, it allows us to define+@collection@ this way:++@+ collection :: Stream [Stream a] -> (a -> Bool) -> StreamGen (Stream [a])+ collection source isAlive = mdo+   sig \<- 'delay' [] (|'map' ~'snd' collWithVals'|)+   coll \<- 'memo' (|source ++ sig|)+   collWithVals' \<- 'memo' (|'filter' ~(isAlive . 'fst') (|'zip' ('sequence' '=<<' coll) coll|)|)+   'return' (|'map' ~'fst' collWithVals'|)+@++-}++module FRP.Elerea.Experimental.Simple+    ( Signal+    , SignalGen+    , start+    , external+    , delay+    , generator+    , memo+    , stateful+    , transfer+    ) where++import Control.Applicative+import Control.Monad+import Control.Monad.Fix+import Data.IORef+import Data.Maybe+import System.Mem.Weak++{-| A signal can be thought of as a function of type @Nat -> a@, where+the argument is the sampling time, and the 'Monad' instance agrees+with the intuition (bind corresponds to extracting the current+sample). -}++newtype Signal a = S (IO a) deriving (Functor, Applicative, Monad)++{-| A dynamic set of actions to update a network without breaking+consistency. -}++type UpdatePool = [Weak (IO (),IO ())]++{-| A signal generator is the only source of stateful signals.  It can+be thought of as a function of type @Nat -> a@, where the result is an+arbitrary data structure that can potentially contain new signals, and+the argument is the creation time of these new signals.  It exposes+the 'MonadFix' interface, which makes it possible to define signals in+terms of each other. -}++newtype SignalGen a = SG { unSG :: IORef UpdatePool -> IO a }++{-| The phases every signal goes through during a superstep. -}++data Phase a = Ready a | Updated a a++instance Functor SignalGen where+  fmap = (<*>).pure++instance Applicative SignalGen where+  pure = return+  (<*>) = ap+        +instance Monad SignalGen where+  return = SG . const . return+  SG g >>= f = SG $ \p -> g p >>= \x -> unSG (f x) p++instance MonadFix SignalGen where+  mfix f = SG $ \p -> mfix (($p).unSG.f)++{-| Embedding a signal into an 'IO' environment.  Repeated calls to+the computation returned cause the whole network to be updated, and+the current sample of the top-level signal is produced as a result.+This is the only way to extract a signal generator outside the+network, and it is equivalent to passing zero to the function+representing the generator. -}++start :: SignalGen (Signal a) -- ^ the generator of the top-level signal+      -> IO (IO a)            -- ^ the computation to sample the signal+start (SG gen) = do+  pool <- newIORef []+  S sample <- gen pool+  return $ do+    let deref ptr = (fmap.fmap) ((,) ptr) (deRefWeak ptr)+    res <- sample+    (ptrs,acts) <- unzip.catMaybes <$> (mapM deref =<< readIORef pool)+    writeIORef pool ptrs+    mapM_ fst acts+    mapM_ snd acts+    return res++{-| Auxiliary function used by all the primitives that create a+mutable variable. -}++addSignal :: (a -> IO a)      -- ^ sampling function+          -> (a -> IO ())     -- ^ aging function+          -> IORef (Phase a)  -- ^ the mutable variable behind the signal+          -> IORef UpdatePool -- ^ the pool of update actions+          -> IO (Signal a)    -- ^ the signal created+addSignal sample update ref pool = do+  let  upd = readIORef ref >>= \v -> case v of+               Ready x  -> update x+               _        -> return ()++       fin = readIORef ref >>= \v -> case v of+               Updated x _  -> writeIORef ref $! Ready x+               _            -> error "Signal not updated!"++       sig = S $ readIORef ref >>= \v -> case v of+               Ready x      -> sample x+               Updated _ x  -> return x+  +  updateActions <- mkWeak sig (upd,fin) Nothing+  modifyIORef pool (updateActions:)+  return sig++{-| The 'delay' transfer function emits the value of a signal from the+previous superstep, starting with the filler value given in the first+argument.  It can be thought of as the following function (which+should also make it clear why the return value is 'SignalGen'):++@+ delay x0 s t_start t_sample+   | t_start == t_sample = x0+   | t_start < t_sample  = s (t_sample-1)+   | otherwise           = error \"Premature sample!\"+@++The way signal generators are extracted ensures that the error can+never happen. -}++delay :: a                    -- ^ initial output at creation time+      -> Signal a             -- ^ the signal to delay+      -> SignalGen (Signal a) -- ^ the delayed signal+delay x0 (S s) = SG $ \pool -> do+  ref <- newIORef (Ready x0)++  let update x = s >>= \x' -> x' `seq` writeIORef ref (Updated x' x)++  addSignal return update ref pool++{-| A reactive signal that takes the value to output from a signal+generator carried by its input with the sampling time provided as the+time of generation.  It is possible to create new signals in the+monad.  It can be thought of as the following function:++@+ generator g t_start t_sample = g t_sample t_sample+@++It has to live in the 'SignalGen' monad, because it needs to maintain+an internal state to be able to cache the current sample for+efficiency reasons. However, this state is not carried between+samples, therefore starting time doesn't matter and can be ignored.++-}++generator :: Signal (SignalGen a) -- ^ the signal of generators to run+          -> SignalGen (Signal a) -- ^ the signal of generated structures+generator (S s) = SG $ \pool -> do+  ref <- newIORef (Ready undefined)+  +  let sample = do  SG g <- s+                   x <- g pool+                   writeIORef ref (Updated undefined x)+                   return x++  addSignal (const sample) (const (sample >> return ())) ref pool++{-| Memoising combinator.  It can be used to cache results of+applicative combinators in case they are used in several places.  It+is observationally equivalent to 'return' in the 'SignalGen' monad. -}++memo :: Signal a             -- ^ the signal to cache+     -> SignalGen (Signal a) -- ^ a signal observationally equivalent to the argument+memo (S s) = SG $ \pool -> do+  ref <- newIORef (Ready undefined)++  let sample = s >>= \x -> writeIORef ref (Updated undefined x) >> return x++  addSignal (const sample) (const (sample >> return ())) ref pool++{-| A signal that can be directly fed through the sink function+returned.  This can be used to attach the network to the outer+world. -}++external :: a                         -- ^ initial value+         -> IO (Signal a, a -> IO ()) -- ^ the signal and an IO function to feed it+external x = do+  ref <- newIORef x+  return (S (readIORef ref), writeIORef ref)++{-| A pure stateful signal.  The initial state is the first output,+and every subsequent state is derived from the preceding one by+applying a pure transformation.  It is equivalent to the following+expression:++@+ stateful x0 f = 'mfix' $ \sig -> 'delay' x0 (f '<$>' sig)+@+-}++stateful :: a                    -- ^ initial state+         -> (a -> a)             -- ^ state transformation+         -> SignalGen (Signal a)+stateful x0 f = mfix $ \sig -> delay x0 (f <$> sig)++{-| A stateful transfer function.  The current input affects the+current output, i.e. the initial state given in the first argument is+considered to appear before the first output, and can never be+observed, and subsequent states are determined by combining the+preceding state with the current output of the input signal using the+function supplied.  It is equivalent to the following expression:++@+ transfer x0 f s = 'mfix' $ \sig -> 'liftA2' f s '<$>' 'delay' x0 sig+@+-}++transfer :: a                    -- ^ initial internal state+         -> (t -> a -> a)        -- ^ state updater function+         -> Signal t             -- ^ input signal+         -> SignalGen (Signal a)+transfer x0 f s = mfix $ \sig -> liftA2 f s <$> delay x0 sig++{-| The @Show@ instance is only defined for the sake of 'Num'... -}++instance Show (Signal a) where+  showsPrec _ _ s = "<SIGNAL>" ++ s++{-| Equality test is impossible. -}++instance Eq (Signal a) where+  _ == _ = False+  +{-| Error message for unimplemented instance functions. -}++unimp :: String -> a+unimp = error . ("Signal: "++)++instance Ord t => Ord (Signal t) where+  compare = unimp "compare"+  min = liftA2 min+  max = liftA2 max++instance Enum t => Enum (Signal t) where+  succ = fmap succ+  pred = fmap pred+  toEnum = pure . toEnum+  fromEnum = unimp "fromEnum"+  enumFrom = unimp "enumFrom"+  enumFromThen = unimp "enumFromThen"+  enumFromTo = unimp "enumFromTo"+  enumFromThenTo = unimp "enumFromThenTo"++instance Bounded t => Bounded (Signal t) where+  minBound = pure minBound+  maxBound = pure maxBound++instance Num t => Num (Signal t) where+  (+) = liftA2 (+)+  (-) = liftA2 (-)+  (*) = liftA2 (*)+  signum = fmap signum+  abs = fmap abs+  negate = fmap negate+  fromInteger = pure . fromInteger++instance Real t => Real (Signal t) where+  toRational = unimp "toRational"++instance Integral t => Integral (Signal t) where+  quot = liftA2 quot+  rem = liftA2 rem+  div = liftA2 div+  mod = liftA2 mod+  quotRem a b = (fst <$> qrab,snd <$> qrab)+    where qrab = quotRem <$> a <*> b+  divMod a b = (fst <$> dmab,snd <$> dmab)+    where dmab = divMod <$> a <*> b+  toInteger = unimp "toInteger"++instance Fractional t => Fractional (Signal t) where+  (/) = liftA2 (/)+  recip = fmap recip+  fromRational = pure . fromRational++instance Floating t => Floating (Signal t) where+  pi = pure pi+  exp = fmap exp+  sqrt = fmap sqrt+  log = fmap log+  (**) = liftA2 (**)+  logBase = liftA2 logBase+  sin = fmap sin+  tan = fmap tan+  cos = fmap cos+  asin = fmap asin+  atan = fmap atan+  acos = fmap acos+  sinh = fmap sinh+  tanh = fmap tanh+  cosh = fmap cosh+  asinh = fmap asinh+  atanh = fmap atanh+  acosh = fmap acosh
FRP/Elerea/Internal.hs view
@@ -166,6 +166,10 @@     -- | A constant signal     pure = makeSignalUnsafe . SNK     -- | Point-wise application of a function and a data signal (like @ZipList@)++--  --mf <*> mx = sampler (fmap (\f -> sampler (fmap (pure . f) mx)) mf)+--  sf <*> sx = sampler (makeSignalUnsafe (SNF1 (\f -> sampler (makeSignalUnsafe (SNF1 (pure . f) sx))) sf))+     f@(S rf) <*> x@(S rx) = unsafePerformIO $ do       -- General fall-back case       c <- newIORef (Ready (SNA f x))
elerea.cabal view
@@ -1,5 +1,5 @@ Name:                elerea-Version:             1.0.0+Version:             1.1.0 Cabal-Version:       >= 1.2 Synopsis:            A minimalistic FRP library Category:            reactivity, FRP@@ -40,6 +40,9 @@     FRP.Elerea     FRP.Elerea.Internal     FRP.Elerea.Graph+    FRP.Elerea.Experimental+    FRP.Elerea.Experimental.Simple+    FRP.Elerea.Experimental.Param -  Build-Depends:       base >= 3 && < 5, containers+  Build-Depends:       base >= 3 && < 5, containers, ghc-prim   ghc-options:         -Wall -O2