dunai-core (empty) → 0.5.1.0

raw patch · 25 files changed

+2270/−0 lines, 25 filesdep +MonadRandomdep +basedep +transformerssetup-changed

Dependencies added: MonadRandom, base, transformers, transformers-base

Files

• LICENSE +30/−0
• Setup.hs +2/−0
• dunai-core.cabal +83/−0
• src/Control/Arrow/Util.hs +28/−0
• src/Control/Monad/Trans/MSF.hs +22/−0
• src/Control/Monad/Trans/MSF/Except.hs +231/−0
• src/Control/Monad/Trans/MSF/GenLift.hs +138/−0
• src/Control/Monad/Trans/MSF/Maybe.hs +121/−0
• src/Control/Monad/Trans/MSF/RWS.hs +45/−0
• src/Control/Monad/Trans/MSF/Random.hs +74/−0
• src/Control/Monad/Trans/MSF/Reader.hs +109/−0
• src/Control/Monad/Trans/MSF/State.hs +137/−0
• src/Control/Monad/Trans/MSF/Writer.hs +104/−0
• src/Data/MonadicStreamFunction.hs +59/−0
• src/Data/MonadicStreamFunction/Async.hs +65/−0
• src/Data/MonadicStreamFunction/Core.hs +230/−0
• src/Data/MonadicStreamFunction/Instances/ArrowChoice.hs +19/−0
• src/Data/MonadicStreamFunction/Instances/ArrowLoop.hs +23/−0
• src/Data/MonadicStreamFunction/Instances/ArrowPlus.hs +29/−0
• src/Data/MonadicStreamFunction/Instances/Num.hs +64/−0
• src/Data/MonadicStreamFunction/Instances/VectorSpace.hs +42/−0
• src/Data/MonadicStreamFunction/Parallel.hs +23/−0
• src/Data/MonadicStreamFunction/ReactHandle.hs +34/−0
• src/Data/MonadicStreamFunction/Util.hs +235/−0
• src/Data/VectorSpace.hs +323/−0

@@ -0,0 +1,30 @@+Copyright (c) 2016, Ivan Perez and Manuel Bärenz++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 Ivan Perez and Manuel Bärenz 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,83 @@+name:                dunai-core+version:             0.5.1.0+synopsis:            Generalised reactive framework supporting classic, arrowized and monadic FRP.+                     (Core library fork.)+homepage:            https://github.com/turion/dunai-core+description:+  Dunai is a DSL for strongly-typed CPS-based composable transformations.+  .+  Dunai is based on a concept of Monadic Stream Functions (MSFs). MSFs are+  transformations defined by a function @unMSF :: MSF m a b -> a -> m (b, MSF m a b)@+  that executes one step of a simulation, and produces an output in a monadic+  context, and a continuation to be used for future steps.+  .+  MSFs are a generalisation of the implementation mechanism used by Yampa,+  Wormholes and other FRP and reactive implementations.+  .+  When combined with different monads, they produce interesting effects. For+  example, when combined with the @Maybe@ monad, they become transformations+  that may stop producing outputs (and continuations). The @Either@ monad gives+  rise to MSFs that end with a result (akin to Tasks in Yampa, and Monadic+  FRP).+  .+  Flattening, that is, going from some structure @MSF (t m) a b@ to @MSF m a b@+  for a specific transformer @t@ often gives rise to known FRP constructs. For+  instance, flattening with @EitherT@ gives rise to switching, and flattening+  with @ListT@ gives rise to parallelism with broadcasting.+  .+  MSFs can be used to implement many FRP variants, including Arrowized FRP,+  Classic FRP, and plain reactive programming. Arrowized and applicative+  syntax are both supported.+  .+  For a very detailed introduction to MSFs, see:+  <http://dl.acm.org/citation.cfm?id=2976010>+  (mirror: <http://www.cs.nott.ac.uk/~psxip1/#FRPRefactored>).+license:             BSD3+license-file:        LICENSE+author:              Ivan Perez, Manuel Bärenz+maintainer:          programming@manuelbaerenz.de+-- copyright:+category:            Reactivity, FRP+build-type:          Simple+-- extra-source-files:+cabal-version:       1.18++source-repository head+  type:     git+  location: git@github.com:turion/dunai-core+++library+  exposed-modules:   Control.Monad.Trans.MSF+                     Control.Monad.Trans.MSF.Except+                     Control.Monad.Trans.MSF.GenLift+                     Control.Monad.Trans.MSF.Maybe+                     Control.Monad.Trans.MSF.Random+                     Control.Monad.Trans.MSF.Reader+                     Control.Monad.Trans.MSF.RWS+                     Control.Monad.Trans.MSF.State+                     Control.Monad.Trans.MSF.Writer+                     Data.MonadicStreamFunction+                     Data.MonadicStreamFunction.Core+                     Data.MonadicStreamFunction.Async+                     Data.MonadicStreamFunction.Instances.ArrowChoice+                     Data.MonadicStreamFunction.Instances.ArrowLoop+                     Data.MonadicStreamFunction.Instances.ArrowPlus+                     Data.MonadicStreamFunction.Instances.Num+                     Data.MonadicStreamFunction.Instances.VectorSpace+                     Data.MonadicStreamFunction.Parallel+                     Data.MonadicStreamFunction.ReactHandle+                     Data.MonadicStreamFunction.Util++                     -- Auxiliary definitions+                     Data.VectorSpace++  other-modules:     Control.Arrow.Util++  build-depends:     base >=4.10 && < 4.13+                   , transformers == 0.5.*+                   , transformers-base == 0.4.*+                   , MonadRandom == 0.5.*+  hs-source-dirs:    src+  default-language:  Haskell2010+  ghc-options:       -Wall

@@ -0,0 +1,28 @@+-- | Utility functions to work with 'Arrow's.+module Control.Arrow.Util where++import Control.Arrow++-- | Constantly produce the same output.+constantly :: Arrow a => b -> a c b+constantly = arr . const+{-# INLINE constantly #-}++-- import Control.Category (id)+-- import Prelude hiding (id)++-- (&&&!) :: Arrow a => a b c -> a b () -> a b c+-- a1 &&&! a2 = (a1 &&& a2) >>> arr fst++-- sink :: Arrow a => a b c -> a c () -> a b c+-- a1 `sink` a2 = a1 >>> (id &&& a2) >>> arr fst++-- * Apply functions at the end.+--+-- | Alternative name for '^<<'.+elementwise :: Arrow a => (c -> d) -> a b c -> a b d+elementwise = (^<<)++-- | Apply a curried function with two arguments to the outputs of two arrows.+elementwise2 :: Arrow a => (c -> d -> e) -> a b c -> a b d -> a b e+elementwise2 op a1 a2 = (a1 &&& a2) >>^ uncurry op

@@ -0,0 +1,22 @@+{-# LANGUAGE Rank2Types #-}++-- | This module reexports nearly all submodules. RWS is not exported since+-- names collide with Reader, State and Writer.+module Control.Monad.Trans.MSF+    ( module Control.Monad.Trans.MSF.GenLift+    , module Control.Monad.Trans.MSF.Except+    , module Control.Monad.Trans.MSF.Maybe+    , module Control.Monad.Trans.MSF.Random+    , module Control.Monad.Trans.MSF.Reader+    , module Control.Monad.Trans.MSF.State+    , module Control.Monad.Trans.MSF.Writer+    )+  where++import Control.Monad.Trans.MSF.GenLift+import Control.Monad.Trans.MSF.Except+import Control.Monad.Trans.MSF.Maybe+import Control.Monad.Trans.MSF.Random+import Control.Monad.Trans.MSF.Reader+import Control.Monad.Trans.MSF.State+import Control.Monad.Trans.MSF.Writer

@@ -0,0 +1,231 @@+{-# LANGUAGE Arrows              #-}+{-# LANGUAGE Rank2Types          #-}+-- | 'MSF's in the 'ExceptT' monad are monadic stream functions+--   that can throw exceptions,+--   i.e. return an exception value instead of a continuation.+--   This module gives ways to throw exceptions in various ways,+--   and to handle them through a monadic interface.+module Control.Monad.Trans.MSF.Except+  ( module Control.Monad.Trans.MSF.Except+  , module Control.Monad.Trans.Except+  ) where++-- External++import           Control.Applicative+import qualified Control.Category           as Category+import           Control.Monad              (liftM, ap)+import           Control.Monad.Trans.Class+import           Control.Monad.Trans.Except hiding (liftCallCC, liftListen, liftPass) -- Avoid conflicting exports+import           Control.Monad.Trans.Maybe+import           Data.Either                (fromLeft, fromRight)++-- Internal+-- import Control.Monad.Trans.MSF.GenLift+import Data.MonadicStreamFunction++-- * Throwing exceptions++-- | Throw the exception 'e' whenever the function evaluates to 'True'.+throwOnCond :: Monad m => (a -> Bool) -> e -> MSF (ExceptT e m) a a+throwOnCond cond e = proc a -> if cond a+  then throwS  -< e+  else returnA -< a++-- | Variant of 'throwOnCond' for Kleisli arrows.+-- | Throws the exception when the input is 'True'.+throwOnCondM :: Monad m => (a -> m Bool) -> e -> MSF (ExceptT e m) a a+throwOnCondM cond e = proc a -> do+  b <- arrM (lift . cond) -< a+  if b+    then throwS  -< e+    else returnA -< a++-- | Throw the exception when the input is 'True'.+throwOn :: Monad m => e -> MSF (ExceptT e m) Bool ()+throwOn e = proc b -> throwOn' -< (b, e)++-- | Variant of 'throwOn', where the exception may change every tick.+throwOn' :: Monad m => MSF (ExceptT e m) (Bool, e) ()+throwOn' = proc (b, e) -> if b+  then throwS  -< e+  else returnA -< ()++-- | When the input is @Just e@, throw the exception @e@.+--   (Does not output any actual data.)+throwMaybe :: Monad m => MSF (ExceptT e m) (Maybe e) (Maybe a)+throwMaybe = mapMaybeS throwS++-- | Immediately throw the incoming exception.+throwS :: Monad m => MSF (ExceptT e m) e a+throwS = arrM throwE++-- | Immediately throw the given exception.+throw :: Monad m => e -> MSF (ExceptT e m) a b+throw = arrM_ . throwE++-- | Do not throw an exception.+pass :: Monad m => MSF (ExceptT e m) a a+pass = Category.id++-- | Converts an 'MSF' in 'MaybeT' to an 'MSF' in 'ExceptT'.+--   Whenever 'Nothing' is thrown, throw @()@ instead.+maybeToExceptS :: Monad m+               => MSF (MaybeT m) a b -> MSF (ExceptT () m) a b+maybeToExceptS = liftMSFPurer (ExceptT . (maybe (Left ()) Right <$>) . runMaybeT)++-- * Catching exceptions++-- | Catch an exception in an 'MSF'. As soon as an exception occurs,+--   the current continuation is replaced by a new 'MSF', the exception handler,+--   based on the exception value.+--   For exception catching where the handler can throw further exceptions,+--   see 'MSFExcept' further below.+catchS :: Monad m => MSF (ExceptT e m) a b -> (e -> MSF m a b) -> MSF m a b+catchS msf f = safely $ do+  e <- try msf+  safe $ f e++-- | Similar to Yampa's delayed switching. Looses a @b@ in case of an exception.+untilE :: Monad m => MSF m a b -> MSF m b (Maybe e)+       -> MSF (ExceptT e m) a b+untilE msf msfe = proc a -> do+  b  <- liftMSFTrans msf  -< a+  me <- liftMSFTrans msfe -< b+  inExceptT -< ExceptT $ return $ maybe (Right b) Left me++-- | Escape an 'ExceptT' layer by outputting the exception whenever it occurs.+--   If an exception occurs, the current 'MSF' continuation is tested again+--   on the next input.+exceptS :: Monad m => MSF (ExceptT e m) a b -> MSF m a (Either e b)+exceptS msf = go+ where+   go = MSF $ \a -> do+          cont <- runExceptT $ unMSF msf a+          case cont of+            Left e          -> return (Left e,  go)+            Right (b, msf') -> return (Right b, exceptS msf')++-- | Embed an 'ExceptT' value inside the 'MSF'.+--   Whenever the input value is an ordinary value,+--   it is passed on. If it is an exception, it is raised.+inExceptT :: Monad m => MSF (ExceptT e m) (ExceptT e m a) a+inExceptT = arrM id++-- | In case an exception occurs in the first argument,+--   replace the exception by the second component of the tuple.+tagged :: Monad m => MSF (ExceptT e1 m) a b -> MSF (ExceptT e2 m) (a, e2) b+tagged msf = runMSFExcept $ do+  _       <- try $ msf <<< arr fst+  (_, e2) <- currentInput+  return e2+++-- * Monad interface for Exception MSFs++-- | 'MSF's with an 'ExceptT' transformer layer+--   are in fact monads /in the exception type/.+--+--   * 'return' corresponds to throwing an exception immediately.+--   * '>>=' is exception handling:+--     The first value throws an exception,+--     while the Kleisli arrow handles the exception+--     and produces a new signal function,+--     which can throw exceptions in a different type.+--   * @m@: The monad that the 'MSF' may take side effects in.+--   * @a@: The input type+--   * @b@: The output type+--   * @e@: The type of exceptions that can be thrown+newtype MSFExcept m a b e = MSFExcept { runMSFExcept :: MSF (ExceptT e m) a b }++-- | An alias for the 'MSFExcept' constructor,+-- used to enter the 'MSFExcept' monad context.+-- Execute an 'MSF' in 'ExceptT' until it raises an exception.+try :: MSF (ExceptT e m) a b -> MSFExcept m a b e+try = MSFExcept++-- | Immediately throw the current input as an exception.+currentInput :: Monad m => MSFExcept m e b e+currentInput = try throwS++-- | Functor instance for MSFs on the 'Either' monad. Fmapping is the same as+-- applying a transformation to the 'Left' values.+instance Monad m => Functor (MSFExcept m a b) where+  fmap = liftM++-- | Applicative instance for MSFs on the 'Either' monad. The function 'pure'+-- throws an exception.+instance Monad m => Applicative (MSFExcept m a b) where+  pure = MSFExcept . throw+  (<*>) = ap++-- | Monad instance for 'MSFExcept'. Bind uses the exception as the 'return'+-- value in the monad.+instance Monad m => Monad (MSFExcept m a b) where+  MSFExcept msf >>= f = MSFExcept $ MSF $ \a -> do+    cont <- lift $ runExceptT $ unMSF msf a+    case cont of+      Left e          -> unMSF (runMSFExcept $ f e) a+      Right (b, msf') -> return (b, runMSFExcept $ try msf' >>= f)++-- | The empty type. As an exception type, it encodes "no exception possible".+data Empty++-- | If no exception can occur, the 'MSF' can be executed without the 'ExceptT' layer.+safely :: Monad m => MSFExcept m a b Empty -> MSF m a b+safely (MSFExcept msf) = safely' msf+  where+    safely' msf = MSF $ \a -> do+      (b, msf') <- fromRight (error "safely: Received `Left`")+        <$> (runExceptT $ unMSF msf a)+      return (b, safely' msf')++-- | An 'MSF' without an 'ExceptT' layer never throws an exception,+--   and can thus have an arbitrary exception type.+safe :: Monad m => MSF m a b -> MSFExcept m a b e+safe = try . liftMSFTrans++-- | Inside the 'MSFExcept' monad, execute an action of the wrapped monad.+--   This passes the last input value to the action,+--   but doesn't advance a tick.+once :: Monad m => (a -> m e) -> MSFExcept m a b e+once f = try $ arrM (lift . f) >>> throwS++-- | Variant of 'once' without input.+once_ :: Monad m => m e -> MSFExcept m a b e+once_ = once . const++-- | Advances a single tick with the given Kleisli arrow,+--   and then throws an exception.+step :: Monad m => (a -> m (b, e)) -> MSFExcept m a b e+step f = try $ proc a -> do+  n      <- count           -< ()+  (b, e) <- arrM (lift . f) -< a+  _      <- throwOn'        -< (n > (1 :: Int), e)+  returnA                   -< b++-- * Utilities definable in terms of 'MSFExcept'++-- TODO This is possibly not the best location for these functions,+-- but moving them to Data.MonadicStreamFunction.Util would form an import cycle+-- that could only be broken by moving a few things to Data.MonadicStreamFunction.Core+-- (that probably belong there anyways).++-- | Extract an 'MSF' from a monadic action.+--+-- Runs a monadic action that produces an 'MSF' on the first iteration/step, and+-- uses that 'MSF' as the main signal function for all inputs (including the+-- first one).+performOnFirstSample :: Monad m => m (MSF m a b) -> MSF m a b+performOnFirstSample sfaction = safely $ do+  msf <- once_ sfaction+  safe msf++-- | Reactimates an 'MSFExcept' until it throws an exception.+reactimateExcept :: Monad m => MSFExcept m () () e -> m e+reactimateExcept msfe = fromLeft (error "reactimateExcept: Received `Right`")+  <$> (runExceptT $ reactimate $ runMSFExcept msfe)++-- | Reactimates an 'MSF' until it returns 'True'.+reactimateB :: Monad m => MSF m () Bool -> m ()+reactimateB sf = reactimateExcept $ try $ liftMSFTrans sf >>> throwOn ()

@@ -0,0 +1,138 @@+{-# LANGUAGE Rank2Types          #-}++-- | More generic lifting combinators.+--+-- This module contains more generic lifting combinators. It includes several+-- implementations, and obviously should be considered work in progress.  The+-- goal is to make this both simple and conceptually understandable.+module Control.Monad.Trans.MSF.GenLift where++import Control.Applicative+import Data.MonadicStreamFunction++-- | Lifting combinator to move from one monad to another, if one has a+-- function to run computations in one monad into another. Note that, unlike a+-- polymorphic lifting function @forall a . m a -> m1 a@, this auxiliary+-- function needs to be a bit more structured.++-- Attempt at writing a more generic MSF lifting combinator.  This is+-- here only to make it easier to find, in a perfect world we'd move+-- this to a different module/branch, or at least to the bottom of the+-- file.+--+-- TODO: does this also work well with the state and the writer monads?+--+-- Even if this code works, it's difficult to understand the concept.+--+-- It is also unclear how much it helps. Ideally, the auxiliary function+-- should operate only on monadic values, not monadic stream functions.+-- That way we could separate concepts: namely the recursion pattern+-- from the monadic lifting/unlifting/sequencing.+--+-- Maybe if we split f in several functions, one that does some sort of+-- a -> a1 transformation, another that does some b1 -> b+-- transformation, with the monads and continuations somewhere, it'll+-- make more sense.+--+-- Based on this lifting function we can also defined all the other+-- liftings we have in Core:+--+-- liftMSFPurer' :: (Monad m1, Monad m)+--                    => (m1 (b, MSF m1 a b) -> m (b, MSF m1 a b))+--                    -> MSF m1 a b+--                    -> MSF m  a b+-- liftMSFPurer' f = lifterS (\g a -> f $ g a)+--+-- More liftings:+-- liftMSFTrans = liftMSFPurer lift+-- liftMSFBase  = liftMSFPurer liftBase+--+-- And a strict version of liftMSFPurer:+-- liftMStreamPurer' f = liftMSFPurer (f >=> whnfVal)+--   where whnfVal p@(b,_) = b `seq` return p+--+-- MB: I'm not sure we're gaining much insight by rewriting all the lifting+-- functions like that.+-- IP: I said the same thing above ("It is also unclear how much it+-- helps."). It's work in progress.+--+-- MB: The type (a1 -> m1 (b1, MSF m1 a1 b1)) is just MSF m1 a1 b1.+-- IP: I'm looking for a lifting pattern in terms of m m1 a b a1 and b1. By+-- exposing the function, I'm hoping to *eventually see* the pattern. If I hide+-- it in the MSF, then it'll always remain hidden.+lifterS :: (Monad m, Monad m1)+        => ((a1 -> m1 (b1, MSF m1 a1 b1)) -> a -> m (b, MSF m1 a1 b1))+        -> MSF m1 a1 b1+        -> MSF m  a  b+lifterS f msf = MSF $ \a -> do+  (b, msf') <- f (unMSF msf) a+  return (b, lifterS f msf')++-- | Lifting combinator to move from one monad to another, if one has a+-- function to run computations in one monad into another. Note that, unlike a+-- polymorphic lifting function @forall a . m a -> m1 a@, this auxiliary+-- function needs to be a bit more structured, although less structured than+-- 'lifterS'.++transS :: (Monad m1, Monad m2)+       => (a2 -> m1 a1)+       -> (forall c. a2 -> m1 (b1, c) -> m2 (b2, c))+       -> MSF m1 a1 b1 -> MSF m2 a2 b2+transS transformInput transformOutput msf = MSF $ \a2 -> do+    (b2, msf') <- transformOutput a2 $ unMSF msf =<< transformInput a2+    return (b2, transS transformInput transformOutput msf')++-- | Lifting combinator to move from one monad to another, if one has a+-- function to run computations in one monad into another. Note that, unlike a+-- polymorphic lifting function @forall a . m a -> m1 a@, this auxiliary+-- function needs to be a bit more structured, although less structured than+-- 'lifterS'.+transG1 :: (Monad m1, Monad m2)+        => (a2 -> m1 a1)+        -> (forall c. a2 -> m1 (b1, c) -> m2 (b2, c))+        -> MSF m1 a1 b1 -> MSF m2 a2 b2+transG1 transformInput transformOutput msf =+  transG transformInput transformOutput' msf+    where+      -- transformOutput' :: forall c. a2 -> m1 (b1, c) -> m2 (b2, Maybe c)+      transformOutput' a b = second Just <$> transformOutput a b++-- | More general lifting combinator that enables recovery. Note that, unlike a+-- polymorphic lifting function @forall a . m a -> m1 a@, this auxiliary+-- function needs to be a bit more structured, and produces a Maybe value. The+-- previous 'MSF' is used if a new one is not produced.+transG :: (Monad m1, Monad m2)+       => (a2 -> m1 a1)+       -> (forall c. a2 -> m1 (b1, c) -> m2 (b2, Maybe c))+       -> MSF m1 a1 b1 -> MSF m2 a2 b2+transG transformInput transformOutput msf = go+  where go = MSF $ \a2 -> do+               (b2, msf') <- transformOutput a2 $ unMSF msf =<< transformInput a2+               case msf' of+                 Just msf'' -> return (b2, transG transformInput transformOutput msf'')+                 Nothing    -> return (b2, go)++-- transGN :: (Monad m1, Monad m2)+--         => (a2 -> m1 a1)+--         -> (forall c. a2 -> m1 (b1, c) -> m2 (b2, [c]))+--         -> MSF m1 a1 b1 -> MSF m2 a2 b2+-- transGN transformInput transformOutput msf = go+--   where go = MSF $ \a2 -> do+--                (b2, msf') <- transformOutput a2 $ unMSF msf =<< transformInput a2+--                case msf' of+--                  []      -> return (b2, go)+--                  [msf''] -> return (b2, transGN transformInput transformOutput msf'')+--                  ms      ->++-- IP: Alternative formulation (typechecks just fine):+--+-- FIXME: The foralls may get in the way. They may not be necessary.  MB+-- raised the issue already for similar code in Core.+--+-- type Wrapper   m1 m2 t1 t2 = forall a b . (t1 a -> m2 b     ) -> (a    -> m1 (t2 b))+-- type Unwrapper m1 m2 t1 t2 = forall a b . (a    -> m1 (t2 b)) -> (t1 a -> m2 b     )+--+-- Helper type, for when we need some identity * -> * type constructor that+-- does not get in the way.+--+-- type Id a = a

@@ -0,0 +1,121 @@+{-# LANGUAGE Arrows              #-}+{-# LANGUAGE Rank2Types          #-}+{- |+The 'Maybe' monad is very versatile. It can stand for default arguments,+for absent values, and for (nondescript) exceptions.+The latter viewpoint is most natural in the context of 'MSF's.+-}+module Control.Monad.Trans.MSF.Maybe+  ( module Control.Monad.Trans.MSF.Maybe+  , module Control.Monad.Trans.Maybe+  , maybeToExceptS+  ) where++-- External+import Control.Monad.Trans.Maybe+  hiding (liftCallCC, liftCatch, liftListen, liftPass) -- Avoid conflicting exports++-- Internal+import Control.Monad.Trans.MSF.Except+import Control.Monad.Trans.MSF.GenLift+import Data.MonadicStreamFunction++-- * Throwing 'Nothing' as an exception ("exiting")++-- | Throw the exception immediately.+exit :: Monad m => MSF (MaybeT m) a b+exit = arrM_ $ MaybeT $ return Nothing++-- | Throw the exception when the condition becomes true on the input.+exitWhen :: Monad m => (a -> Bool) -> MSF (MaybeT m) a a+exitWhen condition = proc a -> do+  _ <- exitIf -< condition a+  returnA     -< a++-- | Exit when the incoming value is 'True'.+exitIf :: Monad m => MSF (MaybeT m) Bool ()+exitIf = proc condition -> if condition+  then exit    -< ()+  else returnA -< ()++-- | @Just a@ is passed along, 'Nothing' causes the whole 'MSF' to exit.+maybeExit :: Monad m => MSF (MaybeT m) (Maybe a) a+maybeExit = inMaybeT++-- | Embed a 'Maybe' value in the 'MaybeT' layer. Identical to 'maybeExit'.+inMaybeT :: Monad m => MSF (MaybeT m) (Maybe a) a+inMaybeT = arrM $ MaybeT . return+++-- * Catching Maybe exceptions++-- | Run the first @msf@ until the second one produces 'True' from the output of the first.+untilMaybe :: Monad m => MSF m a b -> MSF m b Bool -> MSF (MaybeT m) a b+untilMaybe msf cond = proc a -> do+  b <- liftMSFTrans msf  -< a+  c <- liftMSFTrans cond -< b+  inMaybeT -< if c then Nothing else Just b++-- | When an exception occurs in the first 'msf', the second 'msf' is executed from there.+catchMaybe+  :: Monad m+  => MSF (MaybeT m) a b -> MSF m a b -> MSF m a b+catchMaybe msf1 msf2 = safely $ do+  _ <- try $ maybeToExceptS msf1+  safe msf2++-- * Converting to and from 'MaybeT'++-- | Converts a list to an 'MSF' in 'MaybeT',+--   which outputs an element of the list at each step,+--   throwing 'Nothing' when the list ends.+listToMaybeS :: Monad m => [b] -> MSF (MaybeT m) a b+listToMaybeS = foldr iPost exit++-- * Running 'MaybeT'+-- | Remove the 'MaybeT' layer by outputting 'Nothing' when the exception occurs.+--   The continuation in which the exception occurred is then tested on the next input.+runMaybeS :: Monad m => MSF (MaybeT m) a b -> MSF m a (Maybe b)+runMaybeS msf = go+  where+    go = MSF $ \a -> do+           bmsf <- runMaybeT $ unMSF msf a+           case bmsf of+             Just (b, msf') -> return (Just b, runMaybeS msf')+             Nothing        -> return (Nothing, go)++-- | Different implementation, to study performance.+runMaybeS'' :: Monad m => MSF (MaybeT m) a b -> MSF m a (Maybe b)+runMaybeS'' = transG transformInput transformOutput+  where+    transformInput       = return+    transformOutput _ m1 = do r <- runMaybeT m1+                              case r of+                                Nothing     -> return (Nothing, Nothing)+                                Just (b, c) -> return (Just b,  Just c)++-- mapMaybeS msf == runMaybeS (inMaybeT >>> lift mapMaybeS)++{-+runMaybeS'' :: Monad m => MSF (MaybeT m) a b -> MSF m a (Maybe b)+runMaybeS'' msf = transS transformInput transformOutput msf+  where+    transformInput  = return+    transformOutput _ msfaction = do+      thing <- runMaybeT msfaction+      case thing of+        Just (b, msf') -> return (Just b, msf')+        Nothing        -> return (Nothing, msf)+-}++-- | Reactimates an 'MSF' in the 'MaybeT' monad until it throws 'Nothing'.+reactimateMaybe+  :: Monad m+  => MSF (MaybeT m) () () -> m ()+reactimateMaybe msf = reactimateExcept $ try $ maybeToExceptS msf++-- | Run an 'MSF' fed from a list, discarding results. Useful when one needs to+-- combine effects and streams (i.e., for testing purposes).+embed_ :: Monad m => MSF m a () -> [a] -> m ()++embed_ msf as = reactimateMaybe $ listToMaybeS as >>> liftMSFTrans msf

@@ -0,0 +1,45 @@+-- | This module combines the wrapping and running functions+--   for the 'Reader', 'Writer' and 'State' monad layers in a single layer.+--+-- It is based on the _strict_ 'RWS' monad 'Control.Monad.Trans.RWS.Strict',+-- so when combining it with other modules such as @mtl@'s,+-- the strict version has to be included, i.e. 'Control.Monad.RWS.Strict'+-- instead of 'Control.Monad.RWS' or 'Control.Monad.RWS.Lazy'.+module Control.Monad.Trans.MSF.RWS+  ( module Control.Monad.Trans.MSF.RWS+  , module Control.Monad.Trans.RWS.Strict+  ) where++-- External+import Control.Monad.Trans.RWS.Strict+  hiding (liftCallCC, liftCatch) -- Avoid conflicting exports+import Data.Monoid+import Data.Functor ((<$>))++-- Internal+import Control.Monad.Trans.MSF.GenLift+import Data.MonadicStreamFunction++-- * 'RWS' (Reader-Writer-State) monad++-- | Run the 'RWST' layer by making the state variables explicit.+runRWSS :: (Monad m, Monoid w)+        => MSF (RWST r w s m) a b+        -> MSF m (r, s, a) (w, s, b)+runRWSS = transS transformInput transformOutput+  where+    transformInput  (_, _, a) = return a+    transformOutput (r, s, _) msfaction = sym <$> runRWST msfaction r s+    sym ((b, msf'), s, w) = ((w, s, b), msf')++-- | Wrap an 'MSF' with explicit state variables in 'RWST' monad.+rwsS :: (Monad m, Monoid w)+     => MSF m (r, s, a) (w, s, b)+     -> MSF (RWST r w s m) a b+rwsS = lifterS wrapRWST+  where+    wrapRWST :: Monad m+             => ((r, s, a) -> m ((w, s, b), c)) -> a -> RWST r w s m (b, c)+    wrapRWST f a = RWST $ \r s -> do+      ((w, s', b), c) <- f (r, s, a)+      return ((b, c), s', w)

@@ -0,0 +1,74 @@+-- | In this module, 'MSF's in a monad supporting random number generation+--   (i.e. having the 'RandT' layer in its stack) can be run.+--   Running means supplying an initial random number generator,+--   where the update of the generator at every random number generation+--   is already taken care of.+--+--   Under the hood, 'RandT' is basically just 'StateT',+--   with the current random number generator as mutable state.+++{-# LANGUAGE Arrows              #-}+module Control.Monad.Trans.MSF.Random+  (+    runRandS+  , evalRandS++  , getRandomS+  , getRandomsS+  , getRandomRS+  , getRandomRS_+  , getRandomsRS+  , getRandomsRS_+  ) where++-- External+import Control.Monad.Random++-- Internal+import Data.MonadicStreamFunction++-- | Run an 'MSF' in the 'RandT' random number monad transformer+--   by supplying an initial random generator.+--   Updates the generator every step.+runRandS :: (RandomGen g, Monad m)+         => MSF (RandT g m) a b+         -> g -- ^ The initial random number generator.+         -> MSF m a (g, b)+runRandS msf g = MSF $ \a -> do+  ((b, msf'), g') <- runRandT (unMSF msf a) g+  return ((g', b), runRandS msf' g')++-- | Evaluate an 'MSF' in the 'RandT' transformer,+--   i.e. extract possibly random values+--   by supplying an initial random generator.+--   Updates the generator every step but discharges the generator.+evalRandS  :: (RandomGen g, Monad m) => MSF (RandT g m) a b -> g -> MSF m a b+evalRandS msf g = runRandS msf g >>> arr snd++-- | Create a stream of random values.+getRandomS :: (MonadRandom m, Random b) => MSF m a b+getRandomS = arrM_ getRandom+++-- | Create a stream of lists of random values.+getRandomsS :: (MonadRandom m, Random b) => MSF m a [b]+getRandomsS = arrM_ getRandoms++-- | Create a stream of random values in a given fixed range.+getRandomRS :: (MonadRandom m, Random b) => (b, b) -> MSF m a b+getRandomRS range = arrM_ $ getRandomR range++-- | Create a stream of random values in a given range,+--   where the range is specified on every tick.+getRandomRS_ :: (MonadRandom m, Random b) => MSF m (b, b) b+getRandomRS_  = arrM getRandomR++-- | Create a stream of lists of random values in a given fixed range.+getRandomsRS :: (MonadRandom m, Random b) => (b, b) -> MSF m a [b]+getRandomsRS range = arrM_ $ getRandomRs range++-- | Create a stream of lists of random values in a given range,+--   where the range is specified on every tick.+getRandomsRS_ :: (MonadRandom m, Random b) => MSF m (b, b) [b]+getRandomsRS_ = arrM getRandomRs

@@ -0,0 +1,109 @@+{-# LANGUAGE Rank2Types          #-}++-- | 'MSF's with a 'Reader' monadic layer.+--+-- This module contains functions to work with 'MSF's that include a 'Reader'+-- monadic layer. This includes functions to create new 'MSF's that include an+-- additional layer, and functions to flatten that layer out of the 'MSF`'s+-- transformer stack.+module Control.Monad.Trans.MSF.Reader+  ( module Control.Monad.Trans.Reader+  -- * 'Reader' 'MSF' running and wrapping.+  , readerS+  , runReaderS+  , runReaderS_+  -- ** Alternative implementation using internal type.+  , readerS'+  , runReaderS'+  -- ** Alternative implementation using generic lifting.+  , runReaderS''+  ) where++-- External+import Control.Monad.Trans.Reader+  hiding (liftCallCC, liftCatch) -- Avoid conflicting exports++-- Internal+import Control.Monad.Trans.MSF.GenLift+import Data.MonadicStreamFunction++-- * Reader 'MSF' running and wrapping++-- | Build an 'MSF' in the 'Reader' monad from one that takes the reader+-- environment as an extra input. This is the opposite of 'runReaderS'.+readerS :: Monad m => MSF m (s, a) b -> MSF (ReaderT s m) a b+readerS msf = MSF $ \a -> do+  (b, msf') <- ReaderT $ \s -> unMSF msf (s, a)+  return (b, readerS msf')++-- | Build an 'MSF' that takes an environment as an extra input from one on the+-- 'Reader' monad. This is the opposite of 'readerS'.+runReaderS :: Monad m => MSF (ReaderT s m) a b -> MSF m (s, a) b+runReaderS msf = MSF $ \(s,a) -> do+  (b, msf') <- runReaderT (unMSF msf a) s+  return (b, runReaderS msf')+++-- | Build an 'MSF' /function/ that takes a fixed environment as additional+-- input, from an 'MSF' in the 'Reader' monad.+--+-- This should be always equal to:+--+-- @+-- runReaderS_ msf s = arr (\a -> (s,a)) >>> runReaderS msf+-- @+--+-- although possibly more efficient.++runReaderS_ :: Monad m => MSF (ReaderT s m) a b -> s -> MSF m a b+runReaderS_ msf s = MSF $ \a -> do+  (b, msf') <- runReaderT (unMSF msf a) s+  return (b, runReaderS_ msf' s)++-- ** Alternative implementation using internal type.++-- TODO: One one should exist, ideally.++-- | Alternative version of 'readerS'.+readerS' :: Monad m => MSF m (s, a) b -> MSF (ReaderT s m) a b+readerS' = lifterS wrapReaderT++-- | Alternative version of 'runReaderS' wrapping/unwrapping functions.+runReaderS' :: Monad m => MSF (ReaderT s m) a b -> MSF m (s, a) b+runReaderS' = lifterS unwrapReaderT++wrapReaderT :: ((s, a) -> m b) -> a -> ReaderT s m b+wrapReaderT g i = ReaderT $ g . flip (,) i++unwrapReaderT :: (a -> ReaderT s m b) -> (s, a) -> m b+unwrapReaderT g i = uncurry (flip runReaderT) $ second g i++-- ** Alternative implementation using generic lifting.++-- | Alternative version of 'runReaderS'.+runReaderS'' :: Monad m => MSF (ReaderT s m) a b -> MSF m (s, a) b+runReaderS'' = transG transformInput transformOutput+  where+    transformInput  (_, a) = return a+    transformOutput (s, _) m1 = do (r, c) <- runReaderT m1 s+                                   return (r, Just c)++{-+readerS'' :: Monad m => MSF m (s, a) b -> MSF (ReaderT s m) a b+readerS'' = transS transformInput transformOutput+  where+    transformInput :: a -> m (s, a)+    transformInput a = (,) <$> asks <*> pure a+    transformOutput _ = lift+-}+++-- Another alternative:+--+-- type ReaderWrapper   s m = Wrapper   (ReaderT s m) m ((,) s) Id+-- type ReaderUnwrapper s m = Unwrapper (ReaderT s m) m ((,) s) Id+--+-- and use the types:+--+-- wrapReaderT   :: ReaderWrapper s m+-- unwrapReaderT :: ReaderUnwrapper s m

@@ -0,0 +1,137 @@+{-# LANGUAGE Rank2Types #-}+-- | 'MSF's with a 'State' monadic layer.+--+-- This module contains functions to work with 'MSF's that include a 'State'+-- monadic layer. This includes functions to create new 'MSF's that include an+-- additional layer, and functions to flatten that layer out of the 'MSF`'s+-- transformer stack.+--+-- It is based on the _strict_ state monad 'Control.Monad.Trans.State.Strict',+-- so when combining it with other modules such as @mtl@'s,+-- the strict version has to be included, i.e. 'Control.Monad.State.Strict'+-- instead of 'Control.Monad.State' or 'Control.Monad.State.Lazy'.+module Control.Monad.Trans.MSF.State+  ( module Control.Monad.Trans.State.Strict+  -- * 'State' 'MSF' running and wrapping+  , stateS+  , runStateS+  , runStateS_+  , runStateS__+  -- ** Alternative implementation using 'lifterS'+  , stateS'+  , runStateS'+  -- ** Alternative implementation using 'transS'+  , runStateS''+  -- ** Alternative implementation using 'transG'+  , runStateS'''+  ) where++-- External+import Control.Applicative+import Control.Monad.Trans.State.Strict+  hiding (liftCallCC, liftCatch, liftListen, liftPass) -- Avoid conflicting exports++-- Internal+import Control.Monad.Trans.MSF.GenLift+import Data.MonadicStreamFunction++-- * 'State' 'MSF' running and wrapping++-- | Build an 'MSF' in the 'State' monad from one that takes the state as an+-- extra input. This is the opposite of 'runStateS'.+stateS :: Monad m => MSF m (s, a) (s, b) -> MSF (StateT s m) a b+stateS msf = MSF $ \a -> StateT $ \s -> do+    ((s', b), msf') <- unMSF msf (s, a)+    return ((b, stateS msf'), s')++-- | Build an 'MSF' that takes a state as an extra input from one on the+-- 'State' monad. This is the opposite of 'stateS'.+runStateS :: Monad m => MSF (StateT s m) a b -> MSF m (s, a) (s, b)+runStateS msf = MSF $ \(s, a) -> do+    ((b, msf'), s') <- runStateT (unMSF msf a) s+    return ((s', b), runStateS msf')++-- | Build an 'MSF' /function/ that takes a fixed state as additional input,+-- from an 'MSF' in the 'State' monad, and outputs the new state with every+-- transformation step.+--+-- This should be always equal to:+--+-- @+-- runStateS_ msf s = feedback s $ runStateS msf >>> arr (\(s,b) -> ((s,b), s))+-- @+--+-- although possibly more efficient.+++runStateS_ :: Monad m => MSF (StateT s m) a b -> s -> MSF m a (s, b)+runStateS_ msf s = MSF $ \a -> do+    ((b, msf'), s') <- runStateT (unMSF msf a) s+    return ((s', b), runStateS_ msf' s')++-- | Build an 'MSF' /function/ that takes a fixed state as additional+-- input, from an 'MSF' in the 'State' monad.+--+-- This should be always equal to:+--+-- @+-- runStateS__ msf s = feedback s $ runStateS msf >>> arr (\(s,b) -> (b, s))+-- @+--+-- although possibly more efficient.+++runStateS__ :: Monad m => MSF (StateT s m) a b -> s -> MSF m a b+runStateS__ msf s = MSF $ \a -> do+    ((b, msf'), s') <- runStateT (unMSF msf a) s+    return (b, runStateS__ msf' s')++-- * Alternative implementations+--+-- ** Alternative using running/wrapping 'MSF' combinators using generic lifting++-- ** Alternative using 'lifterS'.++-- | Alternative implementation of 'stateS' using 'lifterS'.+stateS' :: Monad m => MSF m (s, a) (s, b) -> MSF (StateT s m) a b+stateS' = lifterS (\g i -> StateT ((resort <$>) . g . flip (,) i))+ where resort ((s, b), ct) = ((b, ct), s)++-- stateS' :: Monad m => MSF m (s, a) (s, b) -> MSF (StateT s m) a b+-- stateS' = lifterS $ \f a -> StateT $ \s -> do+--   ((s', b), msf') <- f (s, a)+--   return ((b, msf'), s')++-- | Alternative implementation of 'runStateS' using 'lifterS'.+runStateS' :: Monad m => MSF (StateT s m) a b -> MSF m (s, a) (s, b)+runStateS' = lifterS (\g i -> resort <$> uncurry (flip runStateT) (second g i))+ where resort ((b, msf), s) = ((s, b), msf)++-- ** Alternative using 'transS'.++-- | Alternative implementation of 'runStateS' using 'transS'.+runStateS'' :: Monad m => MSF (StateT s m) a b -> MSF m (s, a) (s, b)+runStateS'' = transS transformInput transformOutput+  where+    transformInput  (_, a)           = return a+    transformOutput (s, _) msfaction = sym <$> runStateT msfaction s+    sym ((b, msf), s)                = ((s, b), msf)++{-+stateS'' :: Monad m => MSF m (s, a) (s, b) -> MSF (StateT s m) a b+stateS'' = transS transformInput transformOutput+  where+    transformInput  (_, a) = return a+    transformOutput (s, _) = do+        put s+-}++-- ** Alternative using 'transG'.++-- | Alternative implementation of 'runStateS' using 'transG'.+runStateS''' :: Monad m => MSF (StateT s m) a b -> MSF m (s, a) (s, b)+runStateS''' = transG transformInput transformOutput+  where+    transformInput  (_, a)           = return a+    transformOutput (s, _) msfaction = sym <$> runStateT msfaction s+    sym ((b, msf), s)                = ((s, b), Just msf)

@@ -0,0 +1,104 @@+-- | 'MSF's with a 'Writer' monadic layer.+--+-- This module contains functions to work with 'MSF's that include a 'Writer'+-- monadic layer. This includes functions to create new 'MSF's that include an+-- additional layer, and functions to flatten that layer out of the 'MSF`'s+-- transformer stack.+--+-- It is based on the _strict_ writer monad 'Control.Monad.Trans.Writer.Strict',+-- so when combining it with other modules such as @mtl@'s,+-- the strict version has to be included, i.e. 'Control.Monad.Writer.Strict'+-- instead of 'Control.Monad.Writer' or 'Control.Monad.Writer.Lazy'.+module Control.Monad.Trans.MSF.Writer+  ( module Control.Monad.Trans.Writer.Strict+  -- * 'Writer' 'MSF' running and wrapping+  , writerS+  , runWriterS++  -- ** Alternative implementation using 'lifterS'+  , writerS'+  , runWriterS'++  -- ** Alternative implementation using 'transS'+  , writerS''+  , runWriterS''+  ) where++-- External+import Control.Applicative+import Control.Monad.Trans.Class+import Control.Monad.Trans.Writer.Strict+  hiding (liftCallCC, liftCatch, pass) -- Avoid conflicting exports+import Data.Monoid++-- Internal+import Control.Monad.Trans.MSF.GenLift+import Data.MonadicStreamFunction++-- * 'Writer' 'MSF' running and wrapping++-- | Build an 'MSF' in the 'Writer' monad from one that produces the log as an+-- extra output. This is the opposite of 'runWriterS'.+writerS :: (Monad m, Monoid s) => MSF m a (s, b) -> MSF (WriterT s m) a b+writerS msf = MSF $ \a -> do+    ((s, b), msf') <- lift $ unMSF msf a+    tell s+    return (b, writerS msf')++-- | Build an 'MSF' that produces the log as an extra output from one on the+-- 'Writer' monad. This is the opposite of 'writerS'.+runWriterS :: Monad m => MSF (WriterT s m) a b -> MSF m a (s, b)+runWriterS msf = MSF $ \a -> do+    ((b, msf'), s') <- runWriterT $ unMSF msf a+    return ((s', b), runWriterS msf')++-- * Alternative running/wrapping 'MSF' combinators++-- ** Alternative implementation using 'lifterS'++-- | Alternative implementation of 'writerS' using 'lifterS'.+writerS' :: (Monad m, Monoid s) => MSF m a (s, b) -> MSF (WriterT s m) a b+writerS' = lifterS wrapMSFWriterT++-- | Alternative implementation of 'runWriterS' using 'lifterS'.+runWriterS' :: (Monoid s, Monad m) => MSF (WriterT s m) a b -> MSF m a (s, b)+runWriterS' = lifterS unwrapMSFWriterT++-- ** Alternative implementation using 'transS'++-- | Alternative implementation of 'writerS' using 'transS'.+writerS'' :: (Monad m, Monoid w) => MSF m a (w, b) -> MSF (WriterT w m) a b+writerS'' = transS transformInput transformOutput+  where+    transformInput = return+    transformOutput _ msfaction = do+        ((w, b), msf') <- lift msfaction+        tell w+        return (b, msf')++-- | Alternative implementation of 'runWriterS' using 'transS'.+runWriterS'' :: (Monoid s, Monad m) => MSF (WriterT s m) a b -> MSF m a (s, b)+runWriterS'' = transS transformInput transformOutput+  where+    transformInput              = return+    transformOutput _ msfaction = sym <$> runWriterT msfaction+    sym ((b, msf), s)           = ((s, b), msf)++-- ** Wrapping/unwrapping functions+--+-- TODO: These are *almost*-MSF-agnostic wrapping/unwrapping functions.+-- The continuations (and therefore the stream functions) are still+-- there, but now we know nothing about them, not even their type.+-- Monadic actions carry an extra value, of some polymorphic type ct,+-- which is only necessary to extract the output and the context.+--+-- wrapMSFWriterT :: (Monad m, Functor m) => (a -> WriterT s m (b, ct)) -> a -> m ((s, b), ct)+wrapMSFWriterT :: (Monoid s, Monad m) => (a -> m ((s, b), ct)) -> a -> WriterT s m (b, ct)+wrapMSFWriterT g i = do+  ((s, b), msf) <- lift $ g i+  tell s+  return (b, msf)++unwrapMSFWriterT :: (Monad m, Functor m) => (a -> WriterT s m (b, ct)) -> a -> m ((s, b), ct)+unwrapMSFWriterT g i = resort <$> runWriterT (g i)+  where resort ((b, msf), s) = ((s, b), msf)

@@ -0,0 +1,59 @@+-- | Monadic Stream Functions are synchronized stream functions+--   with side effects.+--+--   'MSF's are defined by a function+--   @unMSF :: MSF m a b -> a -> m (b, MSF m a b)@+--   that executes one step of a simulation, and produces an output in a+--   monadic context, and a continuation to be used for future steps.+--+--   See the module "Data.MonadicStreamFunction.Core" for details.+--+--   'MSF's are a generalisation of the implementation mechanism used by Yampa,+--   Wormholes and other FRP and reactive implementations.+--+--   When combined with different monads, they produce interesting effects. For+--   example, when combined with the 'Maybe' monad, they become transformations+--   that may stop producing outputs (and continuations). The 'Either' monad+--   gives rise to 'MSF's that end with a result (akin to Tasks in Yampa, and+--   Monadic FRP).+--+--   Flattening, that is, going from some structure @MSF (t m) a b@ to @MSF m a b@+--   for a specific transformer @t@ often gives rise to known FRP constructs.+--   For instance, flattening with 'EitherT' gives rise to switching, and+--   flattening with 'ListT' gives rise to parallelism with broadcasting.+--+--   'MSF's can be used to implement many FRP variants, including Arrowized FRP,+--   Classic FRP, and plain reactive programming. Arrowized and applicative+--   syntax are both supported.+--+--   For a very detailed introduction to 'MSF's, see:+--   <http://dl.acm.org/citation.cfm?id=2976010>+--   (mirror: <http://www.cs.nott.ac.uk/~psxip1/#FRPRefactored>).+--+--   Apart from the modules exported, this module exports instances from:+--+--   - "Data.MonadicStreamFunction.Instances.ArrowChoice"+--   - "Data.MonadicStreamFunction.Instances.ArrowLoop"+--   - "Data.MonadicStreamFunction.Instances.ArrowPlus"++module Data.MonadicStreamFunction+  ( module Control.Arrow+  , module Data.MonadicStreamFunction.Core+  , module Data.MonadicStreamFunction.Util+  )+ where++-- External++import Control.Arrow++-- Internal++import Data.MonadicStreamFunction.Core+import Data.MonadicStreamFunction.Util++-- Internal (Instances)++import Data.MonadicStreamFunction.Instances.ArrowChoice ()+import Data.MonadicStreamFunction.Instances.ArrowLoop   ()+import Data.MonadicStreamFunction.Instances.ArrowPlus   ()

@@ -0,0 +1,65 @@+-- | This module contains operations on monadic streams that are asynchronous,+--   i.e. that change the speed at which data enters or leaves the 'MSF'.++module Data.MonadicStreamFunction.Async where++-- Internal+import Data.MonadicStreamFunction.Core+import Data.MonadicStreamFunction.Util (MStream)++{- |+Concatenates a monadic stream of lists to a monadic stream.+The stream of lists will be called exactly when new data is needed.++Example:++>>> let intstream = arrM_ $ putStrLn "Enter a list of Ints:" >> readLn :: MStream IO [Int]+>>> reactimate $ concatS intstream >>> arrM print+Enter a list of Ints:+[1,2,33]+1+2+33+Enter a list of Ints:+[]+Enter a list of Ints:+[]+Enter a list of Ints:+[1,2]+1+2+Enter a list of Ints:+...++Beware that @concatS msf@ becomes unproductive when @msf@ starts outputting empty lists forever.+This is ok:++>>> let boolToList b = if b then ["Yes"] else []+>>> let everyOddEmpty = count >>> arr (even >>> boolToList)+>>> reactimate $ concatS everyOddEmpty >>> arrM print+"Yes"+"Yes"+"Yes"+"Yes"+"Yes"+...++But this will be caught in a loop:++>>> let after3Empty = count >>> arr ((<= 3) >>> boolToList)+>>> reactimate $ concatS after3Empty  >>> arrM print+"Yes"+"Yes"+"Yes"+^CInterrupted.+-}+concatS :: Monad m => MStream m [b] -> MStream m b+concatS msf = MSF $ \_ -> tick msf []+  where+    tick msf' (b:bs) = return (b, MSF $ \_ -> tick msf' bs)+    tick msf' []     = do+      (bs, msf'') <- unMSF msf' ()+      tick msf'' bs+-- TODO Maybe this can be written more nicely with exceptions?+-- Similarly takeS :: Int -> MSF m a b -> MSFExcept m a b () throws an exception after n ticks+-- Or with merge?

@@ -0,0 +1,230 @@+{-# LANGUAGE ExplicitForAll #-}+{-# LANGUAGE Rank2Types     #-}+-- | Monadic Stream Functions are synchronized stream functions+--   with side effects.+--+--   'MSF's are defined by a function+--   @unMSF :: MSF m a b -> a -> m (b, MSF m a b)@+--   that executes one step of a simulation, and produces an output in a+--   monadic context, and a continuation to be used for future steps.+--+--   'MSF's are a generalisation of the implementation mechanism used by Yampa,+--   Wormholes and other FRP and reactive implementations.+--+--   When combined with different monads, they produce interesting effects. For+--   example, when combined with the 'Maybe' monad, they become transformations+--   that may stop producing outputs (and continuations). The 'Either' monad+--   gives rise to 'MSF's that end with a result (akin to Tasks in Yampa, and+--   Monadic FRP).+--+--   Flattening, that is, going from some structure @MSF (t m) a b@ to @MSF m a b@+--   for a specific transformer @t@ often gives rise to known FRP constructs.+--   For instance, flattening with 'EitherT' gives rise to switching, and+--   flattening with 'ListT' gives rise to parallelism with broadcasting.+--+--   'MSF's can be used to implement many FRP variants, including Arrowized FRP,+--   Classic FRP, and plain reactive programming. Arrowized and applicative+--   syntax are both supported.+--+--   For a very detailed introduction to 'MSF's, see:+--   <http://dl.acm.org/citation.cfm?id=2976010>+--   (mirror: <http://www.cs.nott.ac.uk/~psxip1/#FRPRefactored>).++-- NOTE TO IMPLEMENTORS:+--+-- This module contains the core. Only the core. It should be possible+-- to define every function and type outside this module, except for the+-- instances for ArrowLoop, ArrowChoice, etc., without access to the+-- internal constructor for MSF and the function 'unMSF'.+--+-- It's very hard to know what IS essential to framework and if we start+-- adding all the functions and instances that *may* be useful in one+-- module.+--+-- By separating some instances and functions in other modules , we can+-- easily understand what is the essential idea and then analyse how it+-- is affected by an extension. It also helps demonstrate that something+-- works for MSFs + ArrowChoice, or MSFs + ArrowLoop, etc.+--+-- To address potential violations of basic design principles (like 'not+-- having orphan instances'), the main module Data.MonadicStreamFunction+-- exports everything. Users should *never* import this module here+-- individually, but the main module instead.+module Data.MonadicStreamFunction.Core where++-- External+import Control.Arrow+import Control.Applicative+import Control.Category (Category(..))+import Control.Monad+import Control.Monad.Base+import Control.Monad.Trans.Class+import Prelude hiding ((.), id, sum)++-- * Definitions++-- | Stepwise, side-effectful 'MSF's without implicit knowledge of time.+--+-- 'MSF's should be applied to streams or executed indefinitely or until they+-- terminate. See 'reactimate' and 'reactimateB' for details. In general,+-- calling the value constructor 'MSF' or the function 'unMSF' is discouraged.+data MSF m a b = MSF { unMSF :: a -> m (b, MSF m a b) }++-- Instances++-- | Instance definition for 'Category'. Defines 'id' and '.'.+instance Monad m => Category (MSF m) where+  id = go+    where go = MSF $ \a -> return (a, go)+  sf2 . sf1 = MSF $ \a -> do+    (b, sf1') <- unMSF sf1 a+    (c, sf2') <- unMSF sf2 b+    let sf' = sf2' . sf1'+    c `seq` return (c, sf')++-- | 'Arrow' instance for 'MSF's.+instance Monad m => Arrow (MSF m) where++  arr f = go+    where go = MSF $ \a -> return (f a, go)++  first sf = MSF $ \(a,c) -> do+    (b, sf') <- unMSF sf a+    b `seq` return ((b, c), first sf')++-- | 'Functor' instance for 'MSF's.+instance Functor m => Functor (MSF m a) where+  -- fmap f msf == msf >>> arr f+  fmap f msf = MSF $ fmap fS . unMSF msf+    where+      fS (b, cont) = (f b, fmap f cont)++-- | 'Applicative' instance for 'MSF's.+instance Monad m => Applicative (MSF m a) where+  -- It is possible to define this instance with only Applicative m+  pure = arr . const+  fs <*> bs = (fs &&& bs) >>> arr (uncurry ($))++-- * Monadic computations and 'MSF's++-- ** Lifting point-wise computations++-- | Apply a monadic transformation to every element of the input stream.+--+-- Generalisation of 'arr' from 'Arrow' to monadic functions.+arrM :: Monad m => (a -> m b) -> MSF m a b+arrM f = go+  where go = MSF $ \a -> do+               b <- f a+               return (b, go)++-- | Monadic lifting from one monad into another+liftS :: (Monad m2, MonadBase m1 m2) => (a -> m1 b) -> MSF m2 a b+liftS = arrM . (liftBase .)++-- ** Lifting 'MSF's++-- *** Lifting across monad stacks++-- | Lift inner monadic actions in monad stacks.++liftMSFTrans :: (MonadTrans t, Monad m, Monad (t m))+             => MSF m a b+             -> MSF (t m) a b+liftMSFTrans = liftMSFPurer lift++-- | Lift innermost monadic actions in a monad stacks (generalisation of+-- 'liftIO').+liftMSFBase :: (Monad m2, MonadBase m1 m2) => MSF m1 a b -> MSF m2 a b+liftMSFBase = liftMSFPurer liftBase++-- *** Generic 'MSF' Lifting++-- IPerez: There is an alternative signature for liftMStreamPurer that also+-- works, and makes the code simpler:+--+-- liftMSFPurer :: Monad m => (m1 (b, MSF m1 a b) -> m (b, MSF m1 a b)) -> MSF m1 a b -> MSF m a b+--+-- Then we can express:+--+-- liftMSFTrans = liftMSFPurer lift+-- liftMSFBase  = liftMSFPurer liftBase+--+-- We could also define a strict version of liftMSFPurer as follows:+--+-- liftMStreamPurer' f = liftMSFPurer (f >=> whnfVal)+--   where whnfVal p@(b,_) = b `seq` return p+--+-- and leave liftMSFPurer as a lazy version (by default).++-- | Lifting purer monadic actions (in an arbitrary way)+liftMSFPurer :: (Monad m2, Monad m1) => (forall c . m1 c -> m2 c) -> MSF m1 a b -> MSF m2 a b+liftMSFPurer liftPurer sf = MSF $ \a -> do+  (b, sf') <- liftPurer $ unMSF sf a+  b `seq` return (b, liftMSFPurer liftPurer sf')++-- * Delays++-- | Delay a signal by one sample.+iPre :: Monad m+     => a         -- ^ First output+     -> MSF m a a+iPre firsta = MSF $ \a -> return (firsta, delay a)+-- iPre firsta = feedback firsta $ lift swap+--   where swap (a,b) = (b, a)+-- iPre firsta = next firsta identity++-- | See 'iPre'.++-- FIXME: Remove delay from this module. We should try to make this module+-- small, keeping only primitives.+delay :: Monad m => a -> MSF m a a+delay = iPre++-- * Switching++-- | Switching applies one 'MSF' until it produces a 'Just' output, and then+-- "turns on" a continuation and runs it.+--+-- A more advanced and comfortable approach to switching is given by Exceptions+-- in 'Control.Monad.Trans.MSF.Except'+switch :: Monad m => MSF m a (b, Maybe c) -> (c -> MSF m a b) -> MSF m a b+switch sf f = MSF $ \a -> do+  ((b, c), sf') <- unMSF sf a+  return (b, maybe (switch sf' f) f c)++-- * Feedback loops++-- | Well-formed looped connection of an output component as a future input.+feedback :: Monad m => c -> MSF m (a, c) (b, c) -> MSF m a b+feedback c sf = MSF $ \a -> do+  ((b', c'), sf') <- unMSF sf (a, c)+  return (b', feedback c' sf')++-- * Execution/simulation++-- | Apply a monadic stream function to a list.+--+-- Because the result is in a monad, it may be necessary to+-- traverse the whole list to evaluate the value in the results to WHNF.+-- For example, if the monad is the maybe monad, this may not produce anything+-- if the 'MSF' produces 'Nothing' at any point, so the output stream cannot+-- consumed progressively.+--+-- To explore the output progressively, use 'liftMSF' and '(>>>)'', together+-- with some action that consumes/actuates on the output.+--+-- This is called 'runSF' in Liu, Cheng, Hudak, "Causal Commutative Arrows and+-- Their Optimization"+embed :: Monad m => MSF m a b -> [a] -> m [b]+embed _  []     = return []+embed sf (a:as) = do+  (b, sf') <- unMSF sf a+  bs       <- embed sf' as+  return (b:bs)++-- | Run an 'MSF' indefinitely passing a unit-carrying input stream.+reactimate :: Monad m => MSF m () () -> m ()+reactimate sf = do+  (_, sf') <- unMSF sf ()+  reactimate sf'

@@ -0,0 +1,19 @@+{-# LANGUAGE InstanceSigs         #-}+{-# OPTIONS_GHC -fno-warn-orphans #-}+-- | Instance of 'ArrowChoice' for Monadic Stream Functions ('MSF').+--+--   Import this module to include that (orphan) instance.+module Data.MonadicStreamFunction.Instances.ArrowChoice where++import Control.Arrow++import Data.MonadicStreamFunction.Core++-- | 'ArrowChoice' instance for MSFs.+instance Monad m => ArrowChoice (MSF m) where+  left :: MSF m a b -> MSF m (Either a c) (Either b c)+  left sf = MSF f+    where+      f (Left a) = do (b, sf') <- unMSF sf a+                      return (Left b, left sf')+      f (Right c) = return (Right c, left sf)

@@ -0,0 +1,23 @@+{-# LANGUAGE InstanceSigs         #-}+{-# LANGUAGE RecursiveDo          #-}+{-# OPTIONS_GHC -fno-warn-orphans #-}+-- | Instance of 'ArrowLoop' for Monadic Stream Functions ('MSF').+--+--   Import this module to include that (orphan) instance.+--+--   This is only defined for monads that are instances of 'MonadFix'.+module Data.MonadicStreamFunction.Instances.ArrowLoop where++import Data.MonadicStreamFunction.Core++-- External+import Control.Arrow+import Control.Monad.Fix++-- | 'ArrowLoop' instance for MSFs. The monad must be an instance of+-- 'MonadFix'.+instance MonadFix m => ArrowLoop (MSF m) where+  loop :: MSF m (b, d) (c, d) -> MSF m b c+  loop sf = MSF $ \a -> do+              rec ((b,c), sf') <- unMSF sf (a, c)+              return (b, loop sf')

@@ -0,0 +1,29 @@+{-# OPTIONS_GHC -fno-warn-orphans #-}+-- | Instance of 'ArrowPlus' for Monadic Stream Functions ('MSF').+--+--   Import this module to include that (orphan) instance.+--+--   This is only defined for monads that are instances of 'MonadPlus'.+module Data.MonadicStreamFunction.Instances.ArrowPlus where++-- base+import Control.Arrow+import Control.Monad+import Control.Applicative++-- dunai+import Data.MonadicStreamFunction.Core++-- | Instance of 'ArrowZero' for Monadic Stream Functions ('MSF').+--   The monad must be an instance of 'MonadPlus'.+instance (Monad m, MonadPlus m) => ArrowZero (MSF m) where+  zeroArrow = MSF $ const mzero++-- | Instance of 'ArrowPlus' for Monadic Stream Functions ('MSF').+--   The monad must be an instance of 'MonadPlus'.+instance (Monad m, MonadPlus m) => ArrowPlus (MSF m) where+  sf1 <+> sf2 = MSF $ \a -> unMSF sf1 a `mplus` unMSF sf2 a++instance (Monad m, MonadPlus m) => Alternative (MSF m a) where+  empty = zeroArrow+  (<|>) = (<+>)

@@ -0,0 +1,64 @@+{-# LANGUAGE TypeFamilies         #-}+{-# OPTIONS_GHC -fno-warn-orphans #-}++-- | Number instances for 'MSF's that produce numbers. This allows you to use+--   numeric operators with 'MSF's that output numbers, for example,+--   you can write:+--+-- @+-- msf1 :: MSF Input Double -- defined however you want+-- msf2 :: MSF Input Double -- defined however you want+-- msf3 :: MSF Input Double+-- msf3 = msf1 + msf2+-- @+--+-- instead of+--+-- @+-- msf3 = (msf1 &&& msf2) >>> arr (uncurry (+))+-- @+--+-- Instances are provided for the type classes 'Num', 'Fractional'+-- and 'Floating'.++module Data.MonadicStreamFunction.Instances.Num where++import Control.Arrow.Util+import Data.MonadicStreamFunction.Core++-- | 'Num' instance for 'MSF's.+instance (Monad m, Num b) => Num (MSF m a b) where+  (+)         = elementwise2 (+)+  (-)         = elementwise2 (-)+  (*)         = elementwise2 (*)+  abs         = elementwise abs+  signum      = elementwise signum+  negate      = elementwise negate+  fromInteger = constantly . fromInteger++-- | 'Fractional' instance for 'MSF's.+instance (Monad m, Fractional b) => Fractional (MSF m a b) where+  fromRational = constantly . fromRational+  (/)          = elementwise2 (/)+  recip        = elementwise recip++-- | 'Floating' instance for 'MSF's.+instance (Monad m, Floating b) => Floating (MSF m a b) where+  pi      = constantly   pi+  exp     = elementwise  exp+  log     = elementwise  log+  sqrt    = elementwise  sqrt+  (**)    = elementwise2 (**)+  logBase = elementwise2 logBase+  sin     = elementwise  sin+  cos     = elementwise  cos+  tan     = elementwise  tan+  asin    = elementwise  asin+  acos    = elementwise  acos+  atan    = elementwise  atan+  sinh    = elementwise  sinh+  cosh    = elementwise  cosh+  tanh    = elementwise  tanh+  asinh   = elementwise  asinh+  acosh   = elementwise  acosh+  atanh   = elementwise  atanh

@@ -0,0 +1,42 @@+{-# LANGUAGE TypeFamilies         #-}+{-# OPTIONS_GHC -fno-warn-orphans #-}+-- | 'VectorSpace' instances for 'MSF's that produce vector spaces. This allows+-- you to use vector operators with 'MSF's that output vectors, for example, you+-- can write:+--+-- @+-- msf1 :: MSF Input (Double, Double) -- defined however you want+-- msf2 :: MSF Input (Double, Double) -- defined however you want+-- msf3 :: MSF Input (Double, Double)+-- msf3 = msf1 ^+^ msf2+-- @+--+-- instead of+--+-- @+-- msf3 = (msf1 &&& msf2) >>> arr (uncurry (^+^))+-- @+--+--+-- Instances are provided for the type classes 'RModule' and 'VectorSpace'.+module Data.MonadicStreamFunction.Instances.VectorSpace where++import Control.Arrow+import Control.Arrow.Util+import Data.MonadicStreamFunction.Core+import Data.VectorSpace++-- These conflict with Data.VectorSpace.Instances++-- | R-module instance for 'MSF's.+instance (Monad m, RModule v) => RModule (MSF m a v) where+  type Groundring (MSF m a v) = Groundring v+  zeroVector   = constantly zeroVector+  r *^ msf     = msf >>^ (r *^)+  negateVector = (>>^ negateVector)+  (^+^)        = elementwise2 (^+^)+  (^-^)        = elementwise2 (^-^)++-- | Vector-space instance for 'MSF's.+instance (Monad m, VectorSpace v) => VectorSpace (MSF m a v) where+  msf ^/ r = msf >>^ (^/ r)

@@ -0,0 +1,23 @@+-- | Versions of arrow combinators that run things in parallel using 'par', if+-- possible.+module Data.MonadicStreamFunction.Parallel where++-- External+import Control.Arrow+import GHC.Conc++-- Internal+import Data.MonadicStreamFunction++-- | Run two 'MSF's in parallel, taking advantage of parallelism if+--   possible. This is the parallel version of '***'.++(*|*) :: Monad m => MSF m a b -> MSF m c d -> MSF m (a, c) (b, d)+msf1 *|* msf2 = MSF $ \(a, c) -> do+  (b, msf1') <- unMSF msf1 a+  (d, msf2') <- unMSF msf2 c+  b `par` d `pseq` return ((b, d), msf1' *|* msf2')++-- | Parallel version of '&&&'.+(&|&) :: Monad m => MSF m a b -> MSF m a c -> MSF m a (b, c)+msf1 &|& msf2 = arr (\a -> (a, a)) >>> (msf1 *|* msf2)

@@ -0,0 +1,34 @@+-- | 'ReactHandle's.+--+-- Sometimes it is beneficial to give control to an external main loop,+-- for example OpenGL or a hardware-clocked audio server like JACK.+-- This module makes Dunai compatible with external main loops.++module Data.MonadicStreamFunction.ReactHandle where++-- External+import Control.Monad.IO.Class+import Data.IORef++-- Internal+import Data.MonadicStreamFunction+++-- | A storage for the current state of an 'MSF'.+-- The 'MSF' may not require input or produce output data,+-- all such data must be handled through side effects+-- (such as wormholes).+type ReactHandle m = IORef (MSF m () ())+++-- | Needs to be called before the external main loop is dispatched.+reactInit :: MonadIO m => MSF m () () -> m (ReactHandle m)+reactInit = liftIO . newIORef+++-- | The callback that needs to be called by the external loop at every cycle.+react :: MonadIO m => ReactHandle m -> m ()+react handle = do+  msf <- liftIO $ readIORef handle+  (_, msf') <- unMSF msf ()+  liftIO $ writeIORef handle msf'

@@ -0,0 +1,235 @@+{-# LANGUAGE Arrows #-}+-- | Useful auxiliary functions and definitions.+module Data.MonadicStreamFunction.Util where++-- External+import Control.Arrow+import Control.Category+import Control.Monad+import Control.Monad.Base+import Data.Monoid+import Prelude hiding (id, (.))++-- Internal+import Data.MonadicStreamFunction.Core+import Data.MonadicStreamFunction.Instances.ArrowChoice ()+import Data.VectorSpace++-- * Streams and sinks++-- | A stream is an 'MSF' that produces outputs, while ignoring the input.+-- It can obtain the values from a monadic context.+type MStream m a = MSF m () a++-- | A sink is an 'MSF' that consumes inputs, while producing no output.+-- It can consume the values with side effects.+type MSink   m a = MSF m a ()++-- * Lifting++-- | Pre-inserts an input sample.+{-# DEPRECATED insert "Don't use this. arrM id instead" #-}+insert :: Monad m => MSF m (m a) a+insert = arrM id++-- | Lifts a computation into a Stream.+arrM_ :: Monad m => m b -> MSF m a b+arrM_ = arrM . const++-- | Lift the first 'MSF' into the monad of the second.+(^>>>) :: MonadBase m1 m2 => MSF m1 a b -> MSF m2 b c -> MSF m2 a c+sf1 ^>>> sf2 = liftMSFBase sf1 >>> sf2+{-# INLINE (^>>>) #-}++-- | Lift the second 'MSF' into the monad of the first.+(>>>^) :: MonadBase m1 m2 => MSF m2 a b -> MSF m1 b c -> MSF m2 a c+sf1 >>>^ sf2 = sf1 >>> liftMSFBase sf2+{-# INLINE (>>>^) #-}++-- * Analogues of 'map' and 'fmap'++-- | Apply an 'MSF' to every input.+mapMSF :: Monad m => MSF m a b -> MSF m [a] [b]+mapMSF = MSF . consume+  where+    consume :: Monad m => MSF m a t -> [a] -> m ([t], MSF m [a] [t])+    consume sf []     = return ([], mapMSF sf)+    consume sf (a:as) = do+      (b, sf')   <- unMSF sf a+      (bs, sf'') <- consume sf' as+      b `seq` return (b:bs, sf'')++-- | Apply an 'MSF' to every input. Freezes temporarily if the input is+-- 'Nothing', and continues as soon as a 'Just' is received.+mapMaybeS :: Monad m => MSF m a b -> MSF m (Maybe a) (Maybe b)+mapMaybeS msf = proc maybeA -> case maybeA of+  Just a  -> arr Just <<< msf -< a+  Nothing -> returnA          -< Nothing++-- * Adding side effects++-- | Applies a function to produce an additional side effect and passes the+-- input unchanged.+withSideEffect :: Monad m => (a -> m b) -> MSF m a a+withSideEffect method = (id &&& arrM method) >>> arr fst++-- | Produces an additional side effect and passes the input unchanged.+withSideEffect_ :: Monad m => m b -> MSF m a a+withSideEffect_ method = withSideEffect $ const method++-- * Delays++-- See also: 'iPre'++-- | Preprends a fixed output to an 'MSF'. The first input is completely+-- ignored.+iPost :: Monad m => b -> MSF m a b -> MSF m a b+iPost b sf = MSF $ \_ -> return (b, sf)++-- | Preprends a fixed output to an 'MSF', shifting the output.+next :: Monad m => b -> MSF m a b -> MSF m a b+next b sf = sf >>> delay b++-- | Buffers and returns the elements in FIFO order,+--   returning 'Nothing' whenever the buffer is empty.+fifo :: Monad m => MSF m [a] (Maybe a)+fifo = feedback [] $ proc (as, accum) -> do+  let accum' = accum ++ as+  returnA -< case accum' of+    []       -> (Nothing, [])+    (a : as) -> (Just a , as)++-- * Edge detectors++-- | Emits 'True' (once) when the input value changes+--   to the given argument, from any other value.+--+--   (If the input is equal to the given argument on the first tick,+--    'True' is also emitted.+--   )+edgeTo+  :: (Monad m, Eq a)+  => a -- ^ The new value that the signal should have _now_ to trigger the edge+  -> MSF m a Bool+edgeTo aNew = proc a -> do+  maPrevious <- delay Nothing -< Just a+  returnA                     -< a == aNew && maPrevious /= Just aNew++-- | Like 'edgeTo', but triggers as soon when the input changes+--   from the given argument to any value that is _not_ equal to it.+--+--   (Does not trigger on the first tick.)+edgeFrom+  :: (Monad m, Eq a)+	=> a -- ^ The old value that the signal should have directly before the edge+  -> MSF m a Bool+edgeFrom aOld = proc a -> do+  maPrevious <- delay Nothing -< Just a+  returnA                     -< a /= aOld && maPrevious == Just aOld++-- | Triggers when both 'edgeTo' and 'edgeFrom' would trigger,+--   i.e. when the input changes from the first given value to the second.+edgeFromTo+  :: (Monad m, Eq a)+	=> a -- ^ The old value that the signal should have directly before the edge+  -> a -- ^ The new value that the signal should have _now_ to trigger the edge+  -> MSF m a Bool+edgeFromTo aOld aNew = edgeFrom aOld &&& edgeTo aNew >>> arr (uncurry (&&))++-- | Emits 'True' (once) when the input value evaluates to 'True'+--   under the given predicate.+--+--   Example usage: @edgeWhen (> 1)@+edgeWhen+  :: (Monad m, Eq a)+	=> (a -> Bool) -- ^ The predicate that is to be evaluated on the incoming signal+  -> MSF m a Bool+edgeWhen predicate  = arr predicate >>> edgeTo True++++-- * Folding++-- ** Folding for 'VectorSpace' instances++-- | Count the number of simulation steps. Produces 1, 2, 3,...+count :: (Num n, Monad m) => MSF m a n+count = arr (const 1) >>> accumulateWith (+) 0++-- | Sums the inputs, starting from zero.+sumS :: (RModule v, Monad m) => MSF m v v+sumS = sumFrom zeroVector++-- | Sums the inputs, starting from an initial vector.+sumFrom :: (RModule v, Monad m) => v -> MSF m v v+sumFrom = accumulateWith (^+^)++-- ** Folding for monoids++-- | Accumulate the inputs, starting from 'mempty'.+mappendS :: (Monoid n, Monad m) => MSF m n n+mappendS = mappendFrom mempty+{-# INLINE mappendS #-}++-- | Accumulate the inputs, starting from an initial monoid value.+mappendFrom :: (Monoid n, Monad m) => n -> MSF m n n+mappendFrom = accumulateWith mappend++-- ** Generic folding \/ accumulation++-- | Applies a function to the input and an accumulator,+-- outputting the updated accumulator.+-- Equal to @\f s0 -> feedback s0 $ arr (uncurry f >>> dup)@.+accumulateWith :: Monad m => (a -> s -> s) -> s -> MSF m a s+accumulateWith f s0 = feedback s0 $ arr g+  where+    g (a, s) = let s' = f a s in (s', s')++-- | Applies a transfer function to the input and an accumulator,+-- returning the updated accumulator and output.+mealy :: Monad m => (a -> s -> (b, s)) -> s -> MSF m a b+mealy f s0 = feedback s0 $ arr $ uncurry f++-- * Unfolding++-- | Generate outputs using a step-wise generation function and an initial+-- value.+unfold :: Monad m => (a -> (b, a)) -> a -> MSF m arbitrary b+unfold f a = feedback a (arr (snd >>> f))++-- | Generate outputs using a step-wise generation Kleisli arrow and an initial+-- value.+unfoldM :: Monad m => (a -> m (b, a)) -> a -> MSF m arbitrary b+unfoldM f a = feedback a (arrM (snd >>> f))++-- | Generate outputs using a step-wise generation function and an initial+-- value. Version of 'unfold' in which the output and the new accumulator+-- are the same. Should be equal to @\f a -> unfold (f >>> dup) a@.+repeatedly :: Monad m => (a -> a) -> a -> MSF m () a+repeatedly f = unfold $ f >>> dup+  where+    dup a = (a, a)+++-- * Debugging++-- | Outputs every input sample, with a given message prefix.+trace :: Show a => String -> MSF IO a a+trace = traceWith putStrLn++-- | Outputs every input sample, with a given message prefix, using an+-- auxiliary printing function.+traceWith :: (Monad m, Show a) => (String -> m ()) -> String -> MSF m a a+traceWith method msg =+  withSideEffect (method . (msg ++) . show)++-- | Outputs every input sample, with a given message prefix, using an+-- auxiliary printing function, when a condition is met.+traceWhen :: (Monad m, Show a) => (a -> Bool) -> (String -> m ()) -> String -> MSF m a a+traceWhen cond method msg = withSideEffect $ \a ->+  when (cond a) $ method $ msg ++ show a++-- | Outputs every input sample, with a given message prefix, when a condition+-- is met, and waits for some input \/ enter to continue.+pauseOn :: Show a => (a -> Bool) -> String -> MSF IO a a+pauseOn cond = traceWhen cond $ \s -> print s >> getLine >> return ()

@@ -0,0 +1,323 @@+{-# LANGUAGE TypeFamilies               #-}+{-# LANGUAGE FlexibleInstances          #-}+{-# LANGUAGE FlexibleContexts           #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+-- |+-- Module      :  Data.VectorSpace+-- Copyright   :  (c) Ivan Perez and Manuel Bärenz+-- License     :  See the LICENSE file in the distribution.+--+-- Maintainer  :  ivan.perez@keera.co.uk+-- Stability   :  provisional+-- Portability :  non-portable (GHC extensions)+--+-- Vector space type relation and basic instances.+-- Heavily inspired by Yampa's @FRP.Yampa.VectorSpace@ module.++module Data.VectorSpace where++------------------------------------------------------------------------------+-- * Vector space classes+------------------------------------------------------------------------------++infixr 6 *^+infixl 6 ^/+infix 6 `dot`+infixl 5 ^+^, ^-^++-- | R-modules.+--   A module @v@ over a ring @Groundring v@+--   is an abelian group with a linear multiplication.+--   The hat @^@ denotes the side of an operation+--   on which the vector stands,+--   i.e. @a *^ v@ for @v@ a vector.+--+-- A minimal definition should include the type 'Groundring' and the+-- implementations of 'zeroVector', '^+^', and one of '*^' or '^*'.+--+--   The following laws must be satisfied:+--+--   * @v1 ^+^ v2 == v2 ^+^ v1@+--   * @a *^ zeroVector == zeroVector@+--   * @a *^ (v1 ^+^ v2) == a *^ v1 ^+^ a*^ v2+--   * @a *^ v == v ^* a@+--   * @negateVector v == (-1) *^ v@+--   * @v1 ^-^ v2 == v1 ^+^ negateVector v2@+class Num (Groundring v) => RModule v where+    type Groundring v+    zeroVector   :: v++    (*^)         :: Groundring v -> v -> v+    (*^)         = flip (^*)++    (^*)         :: v -> Groundring v -> v+    (^*)         = flip (*^)++    negateVector :: v -> v+    negateVector v = (-1) *^ v++    (^+^)        :: v -> v -> v++    (^-^)        :: v -> v -> v+    v1 ^-^ v2     = v1 ^+^ negateVector v2++-- Maybe norm and normalize should not be class methods, in which case+-- the constraint on the coefficient space (a) should (or, at least, could)+-- be Fractional (roughly a Field) rather than Floating.++-- Minimal instance: zeroVector, (*^), (^+^), dot+-- class Fractional (Groundfield v) => VectorSpace v where++-- | A vector space is a module over a field,+--   i.e. a commutative ring with inverses.+--+--   It needs to satisfy the axiom+--   @v ^/ a == (1/a) *^ v@,+--   which is the default implementation.+class (Fractional (Groundring v), RModule v) => VectorSpace v where+    (^/) :: v -> Groundfield v -> v+    v ^/ a = (1/a) *^ v++-- | The ground ring of a vector space is required to be commutative+--   and to possess inverses.+--   It is then called the "ground field".+--   Commutativity amounts to the law @a * b = b * a@,+--   and the existence of inverses is given+--   by the requirement of the 'Fractional' type class.+type Groundfield v = Groundring v++-- | An inner product space is a module with an inner product,+--   i.e. a map @dot@ satisfying+--+--   * @v1 `dot` v2 == v2 `dot` v1@+--   * @(v1 ^+^ v2) `dot` v3 == v1 `dot` v3 ^+^ v2 `dot` v3@+--   * @(a *^ v1) `dot` v2 == a *^ v1 `dot` v2@+class RModule v => InnerProductSpace v where+  dot :: v -> v -> Groundfield v++-- | A normed space is a module with a norm,+--   i.e. a function @norm@ satisfying+--+--   * @norm (a ^* v) = a ^* norm v@+--   * @norm (v1 ^+^ v2) <= norm v1 ^+^ norm v2@+--     (the "triangle inequality")+--+--   A typical example is @sqrt (v `dot` v)@,+--   for an inner product space.+class (Floating (Groundfield v), InnerProductSpace v, VectorSpace v) => NormedSpace v  where+  norm :: v -> Groundfield v+  norm v = sqrt $ v `dot` v++-- | Divides a vector by its norm, resulting in a vector of norm 1.+--   Throws an error on vectors with norm 0.+normalize :: (Eq (Groundfield v), NormedSpace v) => v -> v+normalize v = if nv /= 0 then v ^/ nv else error "normalize: zero vector"+  where nv = norm v+++-----------------------------+-- Instances for scalar types+-----------------------------+++instance RModule Int where+    type Groundring Int = Int+    (^+^) = (+)+    (^*) = (*)+    zeroVector = 0++instance RModule Integer where+    type Groundring Integer = Integer+    (^+^) = (+)+    (^*) = (*)+    zeroVector = 0++instance RModule Double where+    type Groundring Double = Double+    (^+^) = (+)+    (^*) = (*)+    zeroVector = 0++instance RModule Float where+    type Groundring Float = Float+    (^+^) = (+)+    (^*) = (*)+    zeroVector = 0++instance VectorSpace Double where++instance VectorSpace Float where++-----------------------+-- Instances for tuples+-----------------------+++instance+  ( Groundring a ~ Groundring b+  , RModule a, RModule b+  ) => RModule (a, b) where+    type Groundring (a, b) = Groundring a+    zeroVector = (zeroVector, zeroVector)+    (a, b) ^* x = (a ^* x, b ^* x)+    (a1, b1) ^+^ (a2, b2) = (a1 ^+^ a2, b1 ^+^ b2)++instance+  (Groundfield a ~ Groundfield b+  , VectorSpace a, VectorSpace b+  ) => VectorSpace (a, b) where+    (a, b) ^/ x = (a ^/ x, b ^/ x)++instance (Groundfield a ~ Groundfield b, InnerProductSpace a, InnerProductSpace b) => InnerProductSpace (a, b) where+    (a1, b1) `dot` (a2, b2) = (a1 `dot` a2) + (b1 `dot` b2)++instance (Groundfield a ~ Groundfield b, NormedSpace a, NormedSpace b) => NormedSpace (a, b) where++-- ** Utilities to work with n-tuples for n = 3, 4, 5++break3Tuple :: (a, b, c) -> ((a, b), c)+break3Tuple    (a, b, c) =  ((a, b), c)++join3Tuple  :: ((a, b), c) -> (a, b, c)+join3Tuple     ((a, b), c) =  (a, b, c)++break4Tuple :: (a, b, c, d) -> ((a, b), (c, d))+break4Tuple    (a, b, c, d) =  ((a, b), (c, d))++join4Tuple  :: ((a, b), (c, d)) -> (a, b, c, d)+join4Tuple     ((a, b), (c, d)) =  (a, b, c, d)++break5Tuple :: (a, b, c, d, e) -> ((a, b), (c, d, e))+break5Tuple    (a, b, c, d, e) =  ((a, b), (c, d, e))++join5Tuple  :: ((a, b), (c, d, e)) -> (a, b, c, d, e)+join5Tuple     ((a, b), (c, d, e)) =  (a, b, c, d, e)++++instance+  ( Groundring a ~ Groundring b+  , Groundring a ~ Groundring c+  , RModule a, RModule b, RModule c+  ) => RModule (a, b, c) where+    type Groundring (a, b, c) = Groundring a+    zeroVector = join3Tuple zeroVector+    a *^ v = join3Tuple $ a *^ (break3Tuple v)+    v1 ^+^ v2 = join3Tuple $ break3Tuple v1 ^+^ break3Tuple v2++instance+  ( Groundring a ~ Groundring b+  , Groundring a ~ Groundring c+  , VectorSpace a, VectorSpace b, VectorSpace c+  ) => VectorSpace (a, b, c) where++instance+  ( Groundring a ~ Groundring b+  , Groundring a ~ Groundring c+  , InnerProductSpace a, InnerProductSpace b, InnerProductSpace c+  ) => InnerProductSpace (a, b, c) where+  v1 `dot` v2 = break3Tuple v1 `dot` break3Tuple v2++instance+  ( Groundring a ~ Groundring b+  , Groundring a ~ Groundring c+  , NormedSpace a, NormedSpace b, NormedSpace c+  ) => NormedSpace (a, b, c) where++++instance+  ( Groundring a ~ Groundring b+  , Groundring a ~ Groundring c+  , Groundring a ~ Groundring d+  , RModule a, RModule b, RModule c, RModule d+  ) => RModule (a, b, c, d) where+    type Groundring (a, b, c, d) = Groundring a+    zeroVector = join4Tuple zeroVector+    a *^ v = join4Tuple $ a *^ (break4Tuple v)+    v1 ^+^ v2 = join4Tuple $ break4Tuple v1 ^+^ break4Tuple v2++instance+  ( Groundring a ~ Groundring b+  , Groundring a ~ Groundring c+  , Groundring a ~ Groundring d+  , VectorSpace a, VectorSpace b, VectorSpace c, VectorSpace d+  ) => VectorSpace (a, b, c, d) where++instance+  ( Groundring a ~ Groundring b+  , Groundring a ~ Groundring c+  , Groundring a ~ Groundring d+  , InnerProductSpace a, InnerProductSpace b+  , InnerProductSpace c, InnerProductSpace d+  ) => InnerProductSpace (a, b, c, d) where+  v1 `dot` v2 = break4Tuple v1 `dot` break4Tuple v2++instance+  ( Groundring a ~ Groundring b+  , Groundring a ~ Groundring c+  , Groundring a ~ Groundring d+  , NormedSpace a, NormedSpace b, NormedSpace c, NormedSpace d+  ) => NormedSpace (a, b, c, d) where++++instance+  ( Groundring a ~ Groundring b+  , Groundring a ~ Groundring c+  , Groundring a ~ Groundring d+  , Groundring a ~ Groundring e+  , RModule a, RModule b, RModule c, RModule d, RModule e+  ) => RModule (a, b, c, d, e) where+    type Groundring (a, b, c, d, e) = Groundring a+    zeroVector = join5Tuple zeroVector+    a *^ v = join5Tuple $ a *^ (break5Tuple v)+    v1 ^+^ v2 = join5Tuple $ break5Tuple v1 ^+^ break5Tuple v2++instance+  ( Groundring a ~ Groundring b+  , Groundring a ~ Groundring c+  , Groundring a ~ Groundring d+  , Groundring a ~ Groundring e+  , VectorSpace a, VectorSpace b, VectorSpace c, VectorSpace d, VectorSpace e+  ) => VectorSpace (a, b, c, d, e) where++instance+  ( Groundring a ~ Groundring b+  , Groundring a ~ Groundring c+  , Groundring a ~ Groundring d+  , Groundring a ~ Groundring e+  , InnerProductSpace a, InnerProductSpace b, InnerProductSpace c+  , InnerProductSpace d, InnerProductSpace e+  ) => InnerProductSpace (a, b, c, d, e) where+  v1 `dot` v2 = break5Tuple v1 `dot` break5Tuple v2++instance+  ( Groundring a ~ Groundring b+  , Groundring a ~ Groundring c+  , Groundring a ~ Groundring d+  , Groundring a ~ Groundring e+  , NormedSpace a, NormedSpace b, NormedSpace c, NormedSpace d, NormedSpace e+  ) => NormedSpace (a, b, c, d, e) where+++-- * Vector spaces from arbitrary 'Fractional's++-- | Wrap an arbitrary 'Fractional' in this newtype+--   in order to get 'VectorSpace', and related instances.+newtype FractionalVectorSpace a = FractionalVectorSpace { getFractional :: a }+  deriving (Num, Fractional)+++instance Num a => RModule (FractionalVectorSpace a) where+  type Groundring (FractionalVectorSpace a) = a+  v1 ^+^ v2 = FractionalVectorSpace $ getFractional v1 + getFractional v2+  v ^* a = FractionalVectorSpace $ getFractional v * a+  zeroVector = FractionalVectorSpace 0++instance Fractional a => VectorSpace (FractionalVectorSpace a) where++instance Num a => InnerProductSpace (FractionalVectorSpace a) where+  v1 `dot` v2 = getFractional v1 * getFractional v2++instance Floating a => NormedSpace (FractionalVectorSpace a) where