packages feed

dunai 0.4.0.0 → 0.5

raw patch · 27 files changed

+800/−962 lines, 27 files

Files

dunai.cabal view
@@ -1,5 +1,5 @@ name:                dunai-version:             0.4.0.0+version:             0.5 synopsis:            Generalised reactive framework supporting classic, arrowized and monadic FRP. homepage:            https://github.com/ivanperez-keera/dunai description:@@ -56,10 +56,10 @@ 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@@ -70,15 +70,13 @@                      Data.MonadicStreamFunction.Instances.ArrowPlus                      Data.MonadicStreamFunction.Instances.Num                      Data.MonadicStreamFunction.Instances.VectorSpace+                     Data.MonadicStreamFunction.InternalCore                      Data.MonadicStreamFunction.Parallel                      Data.MonadicStreamFunction.ReactHandle                      Data.MonadicStreamFunction.Util                       -- Auxiliary definitions                      Data.VectorSpace-                     Data.VectorSpace.Fractional-                     Data.VectorSpace.Tuples-                     Data.VectorSpace.Specific    other-modules:     Control.Arrow.Util @@ -94,6 +92,7 @@   type: exitcode-stdio-1.0   main-is: hlint.hs   hs-source-dirs: tests+  default-language:  Haskell2010   if !flag(test-hlint)     buildable: False   else@@ -107,6 +106,7 @@   main-is: HaddockCoverage.hs   ghc-options: -Wall   hs-source-dirs: tests+  default-language:  Haskell2010    if !flag(test-doc-coverage)     buildable: False
src/Control/Arrow/Util.hs view
@@ -8,18 +8,6 @@ constantly = arr . const {-# INLINE constantly #-} --- | Alternative implementation of '<<<' that binds more strongly.-infixr 4 <-<-(<-<) :: Arrow a => a c d -> a b c -> a b d-(<-<) = (<<<)-{-# INLINE (<-<) #-}---- | Alternative implementation of '>>>' that binds more strongly.-infixr 4 >->-(>->) :: Arrow a => a b c -> a c d -> a b d-(>->) = (>>>)-{-# INLINE (>->) #-}- -- import Control.Category (id) -- import Prelude hiding (id)
src/Control/Monad/Trans/MSF.hs view
@@ -3,8 +3,7 @@ -- | 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.Except     , module Control.Monad.Trans.MSF.Maybe     , module Control.Monad.Trans.MSF.Random     , module Control.Monad.Trans.MSF.Reader@@ -13,7 +12,6 @@     )   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
src/Control/Monad/Trans/MSF/Except.hs view
@@ -20,8 +20,8 @@ import           Control.Monad.Trans.Maybe  -- Internal--- import Control.Monad.Trans.MSF.GenLift import Data.MonadicStreamFunction+import Data.MonadicStreamFunction.InternalCore  -- * Throwing exceptions @@ -50,7 +50,7 @@   then throwS  -< e   else returnA -< () --- | When the input is 'Just e', throw the exception 'e'.+-- | 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@@ -61,15 +61,17 @@  -- | Immediately throw the given exception. throw :: Monad m => e -> MSF (ExceptT e m) a b-throw = arrM_ . throwE+throw = constM . throwE  -- | Do not throw an exception. pass :: Monad m => MSF (ExceptT e m) a a pass = Category.id --- | Whenever 'Nothing' is thrown, throw '()' instead.-maybeToExceptS :: (Functor m, Monad m) => MSF (MaybeT m) a b -> MSF (ExceptT () m) a b-maybeToExceptS = liftMSFPurer (ExceptT . (maybe (Left ()) Right <$>) . runMaybeT)+-- | Converts an 'MSF' in 'MaybeT' to an 'MSF' in 'ExceptT'.+--   Whenever 'Nothing' is thrown, throw @()@ instead.+maybeToExceptS :: (Functor m, Monad m)+               => MSF (MaybeT m) a b -> MSF (ExceptT () m) a b+maybeToExceptS = morphS (ExceptT . (maybe (Left ()) Right <$>) . runMaybeT)  -- * Catching exceptions @@ -83,25 +85,24 @@   e <- try msf   safe $ f e --- | Similar to Yampa's delayed switching. Looses a 'b' in case of an exception.+-- | Similar to Yampa's delayed switching. Loses 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+  b  <- liftTransS msf  -< a+  me <- liftTransS msfe -< b   inExceptT -< ExceptT $ return $ maybe (Right b) Left me +-- TODO This needs to be renamed as 'runExceptS'!+-- 'exceptS' would have type @MSF m a (Either e b) -> MSF (ExceptT e m) a b@ -- | 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')+exceptS :: (Functor m, Monad m) => MSF (ExceptT e m) a b -> MSF m a (Either e b)+exceptS = transG return $ const $ fmap f . runExceptT+  where+    f (Left e)       = (Left e , Nothing)+    f (Right (b, c)) = (Right b, Just c )  -- | Embed an 'ExceptT' value inside the 'MSF'. --   Whenever the input value is an ordinary value,@@ -113,7 +114,7 @@ --   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-  e1      <- try $ msf <<< arr fst+  _       <- try $ msf <<< arr fst   (_, e2) <- currentInput   return e2 @@ -124,15 +125,19 @@ --   are in fact monads /in the exception type/. -- --   * 'return' corresponds to throwing an exception immediately.---   * '(>>=)' is exception handling:+--   * '>>=' 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.+-- | 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@@ -152,30 +157,41 @@   pure = MSFExcept . throw   (<*>) = ap --- | Monad instance for 'MSFExcept'. Bind uses the exception as the "return"+-- | 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)+  MSFExcept msf >>= f = MSFExcept $ handleExceptT msf $ runMSFExcept . f +handleExceptT+  :: Monad m+  => MSF (ExceptT e1 m) a b+  -> (e1 -> MSF (ExceptT e2 m) a b)+  -> MSF (ExceptT e2 m) a b+handleExceptT msf f = flip handleGen msf $ \a mbcont -> do+  ebcont <- lift $ runExceptT mbcont+  case ebcont of+    Left e          -> unMSF (f e) a+    Right (b, msf') -> return (b, handleExceptT 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+safely (MSFExcept msf) = morphS fromExcept msf   where-    safely' msf = MSF $ \a -> do-      Right (b, msf') <- runExceptT $ unMSF msf a-      return (b, safely' msf')+    fromExcept ma = do+      -- We can assume that the pattern @Left e@ will not occur,+      -- since @e@ would have to be of type @Empty@.+      Right a <- runExceptT ma+      return a  -- | 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+safe = try . liftTransS  -- | Inside the 'MSFExcept' monad, execute an action of the wrapped monad. --   This passes the last input value to the action,@@ -203,10 +219,10 @@ -- that could only be broken by moving a few things to Data.MonadicStreamFunction.Core -- (that probably belong there anyways). --- | Extract MSF from a monadic action.+-- | 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+-- 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@@ -221,4 +237,33 @@  -- | Reactimates an 'MSF' until it returns 'True'. reactimateB :: Monad m => MSF m () Bool -> m ()-reactimateB sf = reactimateExcept $ try $ liftMSFTrans sf >>> throwOn ()+reactimateB sf = reactimateExcept $ try $ liftTransS sf >>> throwOn ()++-- * Analog to Yampa's switch, with Maybe instead of Event+switch :: Monad m => MSF m a (b, Maybe c) -> (c -> MSF m a b) -> MSF m a b+switch sf f = catchS ef  f+  where+    ef = proc a -> do+           (b,me)  <- liftTransS sf -< a+           inExceptT -< ExceptT $ return $ maybe (Right b) Left me++-- | 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)++handleGen :: (a -> m1 (b1, MSF m1 a b1) -> m2 (b2, MSF m2 a b2))+          -> MSF m1 a b1+          -> MSF m2 a b2+handleGen handler msf = MSF $ \a -> handler a (unMSF msf a)
− src/Control/Monad/Trans/MSF/GenLift.hs 
@@ -1,138 +0,0 @@-{-# 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, Functor m2, 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
src/Control/Monad/Trans/MSF/Maybe.hs view
@@ -17,14 +17,13 @@  -- 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+exit = constM $ MaybeT $ return Nothing  -- | Throw the exception when the condition becomes true on the input. exitWhen :: Monad m => (a -> Bool) -> MSF (MaybeT m) a a@@ -52,8 +51,8 @@ -- | 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+  b <- liftTransS msf  -< a+  c <- liftTransS 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.@@ -75,47 +74,21 @@ -- * 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+runMaybeS :: (Functor m, Monad m) => MSF (MaybeT m) a b -> MSF m a (Maybe b)+runMaybeS msf = exceptS (maybeToExceptS msf) >>> arr eitherToMaybe   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)+    eitherToMaybe (Left ()) = Nothing+    eitherToMaybe (Right b) = Just b --- | 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   :: (Functor m, 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+-- | Run an 'MSF' fed from a list, discarding results. Useful when one needs to -- combine effects and streams (i.e., for testing purposes). embed_ :: (Functor m, Monad m) => MSF m a () -> [a] -> m () -embed_ msf as = reactimateMaybe $ listToMaybeS as >>> liftMSFTrans msf+embed_ msf as = reactimateMaybe $ listToMaybeS as >>> liftTransS msf
+ src/Control/Monad/Trans/MSF/RWS.hs view
@@ -0,0 +1,37 @@+-- | 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 Data.MonadicStreamFunction++-- * 'RWS' (Reader-Writer-State) monad+++-- | Wrap an 'MSF' with explicit state variables in 'RWST' monad.+rwsS :: (Functor m, Monad m, Monoid w)+     => MSF m (r, s, a) (w, s, b)+     -> MSF (RWST r w s m) a b+rwsS = morphGS $ \f a -> RWST $ \r s -> (\((w, s', b), c) -> ((b, c), s', w))+   <$> f (r, s, a)++-- | Run the 'RWST' layer by making the state variables explicit.+runRWSS :: (Functor m, Monad m, Monoid w)+        => MSF (RWST r w s m) a b+        -> MSF m (r, s, a) (w, s, b)+runRWSS = morphGS $ \f (r, s, a) -> (\((b, c), s', w) -> ((w, s', b), c))+      <$> runRWST (f a) r s
src/Control/Monad/Trans/MSF/Random.hs view
@@ -1,5 +1,15 @@+-- | 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 +module Control.Monad.Trans.MSF.Random   (     runRandS   , evalRandS@@ -17,34 +27,48 @@  -- Internal import Data.MonadicStreamFunction+import Control.Monad.Trans.MSF.State --- | Updates the generator every step-runRandS :: (RandomGen g, Monad m) -         => MSF (RandT g m) a b -         -> g +-- | Run an 'MSF' in the 'RandT' random number monad transformer+--   by supplying an initial random generator.+--   Updates the generator every step.+runRandS :: (RandomGen g, Functor m, 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')+runRandS = runStateS_ . morphS (StateT . runRandT) --- | 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+-- | 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, Functor m, 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+getRandomS = constM getRandom ++-- | Create a stream of lists of random values. getRandomsS :: (MonadRandom m, Random b) => MSF m a [b]-getRandomsS = arrM_ getRandoms +getRandomsS = constM 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+getRandomRS range = constM $ 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 +getRandomsRS range = constM $ 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
src/Control/Monad/Trans/MSF/Reader.hs view
@@ -1,22 +1,17 @@ {-# LANGUAGE Rank2Types          #-} --- | MSFs with a Reader monadic layer.+-- | 'MSF's with a 'Reader' monadic layer. ----- This module contains functions to work with MSFs that include a 'Reader'--- monadic layer. This includes functions to create new MSFs that include an--- additional layer, and functions to flatten that layer out of the MSF's+-- 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 wrapping/unwrapping.+  -- * 'Reader' 'MSF' running and wrapping.   , readerS   , runReaderS   , runReaderS_-  -- ** Alternative implementation using internal type.-  , readerS'-  , runReaderS'-  -- ** Alternative implementation using generic lifting.-  , runReaderS''   ) where  -- External@@ -24,86 +19,22 @@   hiding (liftCallCC, liftCatch) -- Avoid conflicting exports  -- Internal-import Control.Monad.Trans.MSF.GenLift import Data.MonadicStreamFunction --- * Reader MSF wrapping/unwrapping+-- * Reader 'MSF' running and wrapping --- | Build an MSF in the 'Reader' monad from one that takes the reader+-- | 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')+readerS :: Monad m => MSF m (r, a) b -> MSF (ReaderT r m) a b+readerS = morphGS $ \f a -> ReaderT $ \r -> f (r, a) --- | Build an MSF that takes an environment as an extra input from one on the+-- | 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')+runReaderS :: Monad m => MSF (ReaderT r m) a b -> MSF m (r, a) b+runReaderS = morphGS $ \f (r, a) -> runReaderT (f a) r  --- | Build an MSF /function/ that takes a fixed environment as additional+-- | 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+runReaderS_ msf s = arr (\a -> (s,a)) >>> runReaderS msf
src/Control/Monad/Trans/MSF/State.hs view
@@ -1,132 +1,57 @@ {-# LANGUAGE Rank2Types #-}--- | MSFs with a State monadic layer.+-- | 'MSF's with a 'State' monadic layer. ----- This module contains functions to work with MSFs that include a 'State'--- monadic layer. This includes functions to create new MSFs that include an--- additional layer, and functions to flatten that layer out of the MSF's+-- 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/wrapping/unwrapping+  -- * '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+import Data.Tuple (swap)  -- Internal-import Control.Monad.Trans.MSF.GenLift-import Data.MonadicStreamFunction+import Data.MonadicStreamFunction.Core+import Data.MonadicStreamFunction.InternalCore --- * State MSF running/wrapping/unwrapping+-- * 'State' 'MSF' running and wrapping --- | Build an MSF in the 'State' monad from one that takes the state as an+-- | 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')+stateS :: (Functor m, Monad m) => MSF m (s, a) (s, b) -> MSF (StateT s m) a b+stateS = morphGS $ \f a -> StateT $ \s -> (\((s', b), c) -> ((b, c), s'))+     <$> f (s, a) --- | Build an MSF that takes a state as an extra input from one on the+-- | 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')+runStateS :: (Functor m, Monad m) => MSF (StateT s m) a b -> MSF m (s, a) (s, b)+runStateS = morphGS $ \f (s, a) -> (\((b, c), s') -> ((s', b), c))+        <$> runStateT (f a) s --- | 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+-- | 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' :: (Functor m, 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' :: (Functor m, 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'' :: (Functor m, 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'.+runStateS_ :: (Functor m, Monad m) => MSF (StateT s m) a b -> s -> MSF m a (s, b)+runStateS_ msf s = feedback s+                 $ arr swap >>> runStateS msf >>> arr (\(s', b) -> ((s', b), s')) --- | Alternative implementation of 'runStateS' using 'transG'.-runStateS''' :: (Functor m, 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)+-- TODO Rename this to execStateS!+-- | Build an 'MSF' /function/ that takes a fixed state as additional+-- input, from an 'MSF' in the 'State' monad.+runStateS__ :: (Functor m, Monad m) => MSF (StateT s m) a b -> s -> MSF m a b+runStateS__ msf s = runStateS_ msf s >>> arr snd
src/Control/Monad/Trans/MSF/Writer.hs view
@@ -1,99 +1,41 @@--- | MSFs with a Writer monadic layer.+-- | 'MSF's with a 'Writer' monadic layer. ----- This module contains functions to work with MSFs that include a 'Writer'--- monadic layer. This includes functions to create new MSFs that include an--- additional layer, and functions to flatten that layer out of the MSF's+-- 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 \/ wrapping \/ unwrapping+  -- * '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.Functor ((<$>)) import Data.Monoid  -- Internal-import Control.Monad.Trans.MSF.GenLift import Data.MonadicStreamFunction --- * Writer MSF running/wrapping/unwrapping+-- * 'Writer' 'MSF' running and wrapping --- | Build an MSF in the 'Writer' monad from one that produces the log as an+-- | 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')+writerS :: (Functor m, Monad m, Monoid w)+        => MSF m a (w, b) -> MSF (WriterT w m) a b+writerS = morphGS $ \f a -> WriterT $ (\((w, b), c) -> ((b, c), w)) <$> f a --- | Build an MSF that produces the log as an extra output from one on the+-- | 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, Functor m, 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, Functor m, 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)+runWriterS :: (Functor m, Monad m)+           => MSF (WriterT s m) a b -> MSF m a (s, b)+runWriterS = morphGS $ \f a -> (\((b, c), s) -> ((s, b), c))+         <$> runWriterT (f a)
src/Data/MonadicStreamFunction.hs view
@@ -1,31 +1,32 @@ -- | Monadic Stream Functions are synchronized stream functions --   with side effects. -----   MSFs are defined by a function @unMSF :: MSF m a b -> a -> m (b, MSF m a b)@+--   '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. -----   MSFs are a generalisation of the implementation mechanism used by Yampa,+--   '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 MSFs that end with a result (akin to Tasks in Yampa, and+--   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.+--   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,+--   '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 MSFs, see:+--   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>). --
src/Data/MonadicStreamFunction/Async.hs view
@@ -5,6 +5,7 @@  -- Internal import Data.MonadicStreamFunction.Core+import Data.MonadicStreamFunction.InternalCore import Data.MonadicStreamFunction.Util (MStream)  {- |@@ -13,7 +14,7 @@  Example: ->>> let intstream = arrM_ $ putStrLn "Enter a list of Ints:" >> readLn :: MStream IO [Int]+>>> let intstream = constS $ putStrLn "Enter a list of Ints:" >> readLn :: MStream IO [Int] >>> reactimate $ concatS intstream >>> arrM print Enter a list of Ints: [1,2,33]
src/Data/MonadicStreamFunction/Core.hs view
@@ -1,229 +1,189 @@-{-# LANGUAGE ExplicitForAll #-}-{-# LANGUAGE Rank2Types     #-}+{-# LANGUAGE Rank2Types #-} -- | Monadic Stream Functions are synchronized stream functions --   with side effects. -----   MSFs are defined by a function @unMSF :: MSF m a b -> a -> m (b, MSF m a b)@+--   '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. -----   MSFs are a generalisation of the implementation mechanism used by Yampa,+--   '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 MSFs that end with a result (akin to Tasks in Yampa, and+--   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.+--   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,+--   '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 MSFs, see:+--   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+module Data.MonadicStreamFunction.Core+  ( -- * Types+    MSF+    -- * Lifting and Monadic transformations+    -- ** Lifting point-wise computations+  , constM+  , arrM+  , liftBaseM+    -- ** Trans-monadic MSF combinators+    -- *** MonadBase+  , liftBaseS+  , (^>>>)+  , (>>>^)+    -- *** MonadTrans+  , liftTransS+    -- *** Generic Monadic Transformations+  , morphS+  , morphGS+    -- * Depending on the past+  , feedback+    -- * Simulation+  , reactimate+  , embed+  , module Control.Arrow+  )+  where --- External-import Control.Arrow import Control.Applicative-import Control.Category (Category(..))-import Control.Monad+import Control.Arrow+import Control.Category as C import Control.Monad.Base import Control.Monad.Trans.Class+import Data.Tuple (swap) import Prelude hiding ((.), id, sum) +import Data.MonadicStreamFunction.InternalCore (MSF, morphGS, feedback, reactimate, embed)+ -- * Definitions --- | Stepwise, side-effectful MSFs without implicit knowledge of time.------ MSFs 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) }+-- | 'Arrow' instance for 'MSF's.+instance Monad m => Arrow (MSF m) where --- Instances+  arr f = arrM (return . f) --- | 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')+  -- first sf = MSF $ \(a,c) -> do+  --   (b, sf') <- unMSF sf a+  --   b `seq` return ((b, c), first sf') --- | 'Arrow' instance for MSFs.-instance Monad m => Arrow (MSF m) where+  first = morphGS $ \f (a,c) -> do+            (b, msf') <- f a+            return ((b, c), msf') -  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 and applicative instances --- | Functor instance for MSFs.-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)+-- | 'Functor' instance for 'MSF's.+instance Monad 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 MSFs.+-- | 'Applicative' instance for 'MSF's. instance (Functor m, 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 MSFs  -- ** Lifting point-wise computations +-- | Lifts a monadic computation into a Stream.+constM :: Monad m => m b -> MSF m a b+constM = arrM . const+ -- | 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)+--arrM f = go+--  where go = MSF $ \a -> do+--               b <- f a+--               return (b, go)+arrM f = morphGS (\i a -> i a >>= \(_,c) -> f a >>= \b -> return (b, c)) C.id  -- | Monadic lifting from one monad into another-liftS :: (Monad m2, MonadBase m1 m2) => (a -> m1 b) -> MSF m2 a b-liftS = arrM . (liftBase .)+liftBaseM :: (Monad m2, MonadBase m1 m2) => (a -> m1 b) -> MSF m2 a b+liftBaseM = arrM . (liftBase .) --- ** Lifting MSFs+-- ** MSF combinators that apply monad transformations --- *** Lifting across monad stacks+-- | Lift innermost monadic actions in monad stack (generalisation of+-- 'liftIO').+liftBaseS :: (Monad m2, MonadBase m1 m2) => MSF m1 a b -> MSF m2 a b+liftBaseS = morphS liftBase +-- *** MonadBase+-- | 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 = liftBaseS 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 >>> liftBaseS sf2+{-# INLINE (>>>^) #-}++-- *** MonadTrans+ -- | 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+liftTransS :: (MonadTrans t, Monad m, Monad (t m))+           => MSF m a b+           -> MSF (t m) a b+liftTransS = morphS 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 monadic transformation --- *** Generic MSF Lifting+-- | Apply trans-monadic actions (in an arbitrary way).+--+-- This is just a convenience function when you have a function to move across+-- monads, because the signature of 'morphGS' is a bit complex.+morphS :: (Monad m2, Monad m1)+      => (forall c . m1 c -> m2 c)+      -> MSF m1 a b+      -> MSF m2 a b+morphS morph = morphGS morph'+  where+    -- The following makes the a's and the b's the same, and it just says:+    -- whatever function m1F you give me to apply to every sample, I use morph+    -- on the result to go from m1 to m2.+    --+    -- Remember that:+    -- morphGS :: Monad m2+    --         => (forall c . (a1 -> m1 (b1, c)) -> (a2 -> m2 (b2, c)))+    --           -- ^ The natural transformation. @mi@, @ai@ and @bi@ for @i = 1, 2@+    --           --   can be chosen freely, but @c@ must be universally quantified+    --         -> MSF m1 a1 b1+    --         -> MSF m2 a2 b2+    --+    --  morph' :: (forall c . (a -> m1 (b, c)) -> (a -> m2 (b, c)))+        morph' m1F = morph . m1F  -- 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+-- morphS :: 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+-- liftTransS = morphS lift+-- liftBaseS  = morphS liftBase ----- We could also define a strict version of liftMSFPurer as follows:+-- We could also define a strict version of morphS as follows: ----- liftMStreamPurer' f = liftMSFPurer (f >=> whnfVal)+-- morphS'  f = morphS (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'+-- and leave morphS as a lazy version (by default).
src/Data/MonadicStreamFunction/Instances/ArrowChoice.hs view
@@ -8,6 +8,7 @@ import Control.Arrow  import Data.MonadicStreamFunction.Core+import Data.MonadicStreamFunction.InternalCore  -- | 'ArrowChoice' instance for MSFs. instance Monad m => ArrowChoice (MSF m) where
src/Data/MonadicStreamFunction/Instances/ArrowLoop.hs view
@@ -9,6 +9,7 @@ module Data.MonadicStreamFunction.Instances.ArrowLoop where  import Data.MonadicStreamFunction.Core+import Data.MonadicStreamFunction.InternalCore  -- External import Control.Arrow@@ -16,7 +17,7 @@  -- | 'ArrowLoop' instance for MSFs. The monad must be an instance of -- 'MonadFix'.-instance (Monad m, MonadFix m) => ArrowLoop (MSF m) where+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)
src/Data/MonadicStreamFunction/Instances/ArrowPlus.hs view
@@ -6,10 +6,14 @@ --   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+import Data.MonadicStreamFunction.InternalCore  -- | Instance of 'ArrowZero' for Monadic Stream Functions ('MSF'). --   The monad must be an instance of 'MonadPlus'.@@ -20,3 +24,7 @@ --   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 (Functor m, Monad m, MonadPlus m) => Alternative (MSF m a) where+  empty = zeroArrow+  (<|>) = (<+>)
src/Data/MonadicStreamFunction/Instances/Num.hs view
@@ -1,8 +1,9 @@ {-# LANGUAGE TypeFamilies         #-} {-# OPTIONS_GHC -fno-warn-orphans #-} --- | Number instances for MSFs that produce numbers. This allows you to use--- numeric operators with MSFs that output numbers, for example, you can write:+-- | 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@@ -25,7 +26,7 @@ import Control.Arrow.Util import Data.MonadicStreamFunction.Core --- | 'Num' instance for MSFs.+-- | 'Num' instance for 'MSF's. instance (Monad m, Num b) => Num (MSF m a b) where   (+)         = elementwise2 (+)   (-)         = elementwise2 (-)@@ -35,13 +36,13 @@   negate      = elementwise negate   fromInteger = constantly . fromInteger --- | 'Fractional' instance for MSFs.+-- | '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 MSFs.+-- | 'Floating' instance for 'MSF's. instance (Monad m, Floating b) => Floating (MSF m a b) where   pi      = constantly   pi   exp     = elementwise  exp
src/Data/MonadicStreamFunction/Instances/VectorSpace.hs view
@@ -1,7 +1,7 @@ {-# LANGUAGE TypeFamilies         #-} {-# OPTIONS_GHC -fno-warn-orphans #-}--- | 'VectorSpace' instances for MSFs that produce vector spaces. This allows--- you to use vector operators with MSFs that output vectors, for example, you+-- | '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: -- -- @@@ -28,7 +28,7 @@  -- These conflict with Data.VectorSpace.Instances --- | R-module instance for MSFs.+-- | 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@@ -37,6 +37,6 @@   (^+^)        = elementwise2 (^+^)   (^-^)        = elementwise2 (^-^) --- | Vector-space instance for MSFs.+-- | Vector-space instance for 'MSF's. instance (Monad m, VectorSpace v) => VectorSpace (MSF m a v) where   msf ^/ r = msf >>^ (^/ r)
+ src/Data/MonadicStreamFunction/InternalCore.hs view
@@ -0,0 +1,135 @@+{-# 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.+--+--   This modules defines only the minimal core. Hopefully, other functions can be+--   defined in terms of the functions in this module without accessing the+--   MSF constuctor.+++-- 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.InternalCore 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')++-- * Monadic computations and 'MSF's++-- | Generic lifting of a morphism to the level of 'MSF's.+--+-- Natural transformation to the level of 'MSF's.+--+-- __Mathematical background:__ The type @a -> m (b, c)@ is a functor in @c@,+-- and @MSF m a b@ is its greatest fixpoint, i.e. it is isomorphic to the type+-- @a -> m (b, MSF m a b)@, by definition.+-- The types @m@, @a@ and @b@ are parameters of the functor.+-- Taking a fixpoint is functorial itself, meaning that a morphism+-- (a natural transformation) of two such functors gives a morphism+-- (an ordinary function) of their fixpoints.+--+-- This is in a sense the most general "abstract" lifting function,+-- i.e. the most general one that only changes input, output and side effect+-- types, and doesn't influence control flow.+-- Other handling functions like exception handling or 'ListT' broadcasting+-- necessarily change control flow.+morphGS :: Monad m2+        => (forall c . (a1 -> m1 (b1, c)) -> (a2 -> m2 (b2, c)))+          -- ^ The natural transformation. @mi@, @ai@ and @bi@ for @i = 1, 2@+          --   can be chosen freely, but @c@ must be universally quantified+        -> MSF m1 a1 b1+        -> MSF m2 a2 b2+morphGS morph msf = MSF $ \a2 -> do+  (b2, msf') <- morph (unMSF msf) a2+  return (b2, morphGS morph msf')++-- * 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'
src/Data/MonadicStreamFunction/Parallel.hs view
@@ -8,9 +8,10 @@  -- Internal import Data.MonadicStreamFunction+import Data.MonadicStreamFunction.InternalCore --- | Run two MSFs in parallel, taking advantage of parallelism if---   possible. This is the parallel version of '(***)'.+-- | 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@@ -18,6 +19,6 @@   (d, msf2') <- unMSF msf2 c   b `par` d `pseq` return ((b, d), msf1' *|* msf2') --- | Parallel version of '(&&&)'.+-- | 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)
src/Data/MonadicStreamFunction/ReactHandle.hs view
@@ -1,5 +1,5 @@--- | ReactHandle-+-- | '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.@@ -12,34 +12,24 @@  -- Internal import Data.MonadicStreamFunction+import Data.MonadicStreamFunction.InternalCore  --- | A storage for the current state of an MSF+-- | 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+-- | 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 main loop at every cycle+-- | 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'----- | Creates two ends of a synchronisation wormhole---- Often, the external framework may have several parallel loops,--- for example, OpenGL with a display callback, an idle callback and a keyboard callback.--- In such cases, one would like to let the different parts communicate.--- This is done through a wormhole, which is a shared mutable variable--- that can be written from one part and read from the other.--createWormhole :: MonadIO m => a -> m (MSF m a (), MSF m () a)-createWormhole a = liftIO $ do-  ref <- newIORef a-  return (arrM $ liftIO . writeIORef ref, arrM_ $ liftIO $ readIORef ref)
src/Data/MonadicStreamFunction/Util.hs view
@@ -1,66 +1,41 @@-{-# LANGUAGE Arrows #-}+{-# LANGUAGE Arrows     #-}+{-# LANGUAGE Rank2Types #-} -- | Useful auxiliary functions and definitions. module Data.MonadicStreamFunction.Util where  -- External-import Control.Applicative 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.MonadicStreamFunction.Instances.ArrowChoice () import Data.VectorSpace+import Prelude hiding (id, (.)) +import Control.Monad.Trans.MSF.State+ -- * Streams and sinks --- | A stream is an MSF that produces outputs ignoring the input. It can--- obtain the values from a monadic context.+-- | 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 stream is an MSF that produces outputs producing no output. It can--- consume the values with side effects.+-- | 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 (^>>>) #-}+-- * Analogues of 'map' and 'fmap' --- | 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+-- | 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@@ -82,14 +57,26 @@  -- See also: 'iPre' --- | Preprends a fixed output to an MSF. The first input is completely+-- | Delay a signal by one sample.+iPre :: Monad m+     => a         -- ^ First output+     -> MSF m a a+-- iPre firsta = MSF $ \a -> return (firsta, iPre a)+iPre firsta = feedback firsta $ arr swap+  where swap (a,b) = (b, a)+-- iPre firsta = next firsta identity+++-- | 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)+iPost b sf = sf >>> (feedback (Just b) $ arr $ \(c, ac) -> case ac of+  Nothing -> (c, Nothing)+  Just b' -> (b', Nothing)) --- | Preprends a fixed output to an MSF, shifting the output.+-- | 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+next b sf = sf >>> iPre b  -- | Buffers and returns the elements in FIFO order, --   returning 'Nothing' whenever the buffer is empty.@@ -102,7 +89,7 @@  -- * Folding --- ** Folding for VectorSpace instances+-- ** Folding for 'VectorSpace' instances  -- | Count the number of simulation steps. Produces 1, 2, 3,... count :: (Num n, Monad m) => MSF m a n@@ -129,12 +116,18 @@  -- ** Generic folding \/ accumulation --- | Applies a function to the input and an accumulator, outputing the--- accumulator. Equal to @\f s0 -> feedback s0 $ arr (uncurry f >>> dup)@.+-- | 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
src/Data/VectorSpace.hs view
@@ -1,6 +1,7 @@-{-# LANGUAGE TypeFamilies           #-}-{-# LANGUAGE FlexibleContexts       #-}-{-# LANGUAGE UndecidableInstances   #-}+{-# LANGUAGE TypeFamilies               #-}+{-# LANGUAGE FlexibleInstances          #-}+{-# LANGUAGE FlexibleContexts           #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-} -- | -- Module      :  Data.VectorSpace -- Copyright   :  (c) Ivan Perez and Manuel Bärenz@@ -16,7 +17,7 @@ module Data.VectorSpace where  --------------------------------------------------------------------------------- Vector space type relation+-- * Vector space classes ------------------------------------------------------------------------------  infixr 6 *^@@ -77,15 +78,13 @@     (^/) :: v -> Groundfield v -> v     v ^/ a = (1/a) *^ v --- TODO Why is this not a type synonym? -- | 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 family Groundfield v :: *-type instance Groundfield v = Groundring v+type Groundfield v = Groundring v  -- | An inner product space is a module with an inner product, --   i.e. a map @dot@ satisfying@@ -105,15 +104,220 @@ -- --   A typical example is @sqrt (v `dot` v)@, --   for an inner product space.-class RModule v => NormedSpace v  where+class (Floating (Groundfield v), InnerProductSpace v, VectorSpace v) => NormedSpace v  where   norm :: v -> Groundfield v+  norm v = sqrt $ v `dot` v -{--instance (Floating (Groundfield v), VectorSpace v, InnerProductSpace v) => NormedSpace v where-    norm v = sqrt (v `dot` v)--}-{- I'd like to know why this won't work-normalize :: (Eq a, NormedSpace v a) => v -> 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-    -}+  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
− src/Data/VectorSpace/Fractional.hs 
@@ -1,37 +0,0 @@-{-# LANGUAGE FlexibleInstances      #-}-{-# LANGUAGE TypeFamilies           #-}-{-# LANGUAGE UndecidableInstances   #-}-{-# OPTIONS_GHC -fno-warn-orphans   #-}--- | VectorSpace instances for Num/Fractional types.------ This module includes instances for:------    * 'InnerProductSpace' and 'RModule' for 'Num'------    * 'VectorSpace' for 'Fractional's-module Data.VectorSpace.Fractional where---- These sometimes clash with user-defined instances.--- (See https://github.com/ivanperez-keera/dunai/issues/11, where this--- module used to be called Data.VectorSpace.Instances)--import Data.VectorSpace---- | R-module instance for any number, where '^+^ is '+' and multiplication is--- normal multiplication.-instance Num a => RModule a where-    type Groundring a = a-    zeroVector     = 0-    a *^ x         = a * x-    negateVector x = -x-    x1 ^+^ x2      = x1 + x2-    x1 ^-^ x2      = x1 - x2---- | Vector-space instance for any fractional, where vectorial division is--- normal number division.-instance Fractional a => VectorSpace a where-    a ^/ x = a / x---- | Inner-product instance for any number.-instance Num a => InnerProductSpace a where-    x1 `dot` x2 = x1 * x2
− src/Data/VectorSpace/Specific.hs 
@@ -1,48 +0,0 @@-{-# LANGUAGE TypeFamilies         #-}-{-# OPTIONS_GHC -fno-warn-orphans #-}--- | Vector space instances for concrete/specific types.------ This module contains:------     * 'RModule' instances for 'Int', 'Integer', 'Double' and 'Float'.------     * 'VectorSpace' for 'Double' and 'Float'.--module Data.VectorSpace.Specific where--import Data.VectorSpace---- | R-mobule instance for 'Int's.-instance RModule Int where-    type Groundring Int = Int-    (^+^) = (+)-    (^*) = (*)-    zeroVector = 0---- | R-mobule instance for 'Integer's.-instance RModule Integer where-    type Groundring Integer = Integer-    (^+^) = (+)-    (^*) = (*)-    zeroVector = 0----- | R-mobule instance for 'Double's.-instance RModule Double where-    type Groundring Double = Double-    (^+^) = (+)-    (^*) = (*)-    zeroVector = 0---- | R-mobule instance for 'Floating's.-instance RModule Float where-    type Groundring Float = Float-    (^+^) = (+)-    (^*) = (*)-    zeroVector = 0---- | Vector-space instance for 'Double'.-instance VectorSpace Double where---- | Vector-space instance for 'Floating's.-instance VectorSpace Float where
− src/Data/VectorSpace/Tuples.hs 
@@ -1,98 +0,0 @@-{-# LANGUAGE FlexibleInstances      #-}-{-# LANGUAGE TypeFamilies           #-}-{-# OPTIONS_GHC -fno-warn-orphans   #-}--- | Vector space instances for small tuples of 'Fractional'.------ This module contains 'RModule', 'VectorSpace' and 'InnerProductSpace' for--- tuples of up to five elements.--module Data.VectorSpace.Tuples where--import Data.VectorSpace---- | R-module instance 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)---- | Vector-space instance for tuples.-instance (Groundfield a ~ Groundfield b, VectorSpace a, VectorSpace b) => VectorSpace (a, b) where-    (a, b) ^/ x = (a ^/ x, b ^/ x)---- | Inner Product Space instance for tuples.-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 Num a => RModule (a,a) where-    type Groundring (a,a) = a-    zeroVector = (0,0)-    a *^ (x,y) = (a * x, a * y)-    negateVector (x,y) = (-x, -y)-    (x1,y1) ^+^ (x2,y2) = (x1 + x2, y1 + y2)-    (x1,y1) ^-^ (x2,y2) = (x1 - x2, y1 - y2)--instance Fractional a => VectorSpace (a,a) where-    (x,y) ^/ a = (x / a, y / a)---instance Fractional a => InnerProductSpace (a,a) where-    (x1,y1) `dot` (x2,y2) = x1 * x2 + y1 * y2---}---- | R-module instance for tuples with 3 elements.-instance Num a => RModule (a,a,a) where-    type Groundring (a,a,a) = a-    zeroVector = (0,0,0)-    a *^ (x,y,z) = (a * x, a * y, a * z)-    negateVector (x,y,z) = (-x, -y, -z)-    (x1,y1,z1) ^+^ (x2,y2,z2) = (x1+x2, y1+y2, z1+z2)-    (x1,y1,z1) ^-^ (x2,y2,z2) = (x1-x2, y1-y2, z1-z2)---- | Vector-space instance for tuples with 3 elements.-instance Fractional a => VectorSpace (a,a,a) where-    (x,y,z) ^/ a = (x / a, y / a, z / a)---- | Inner Product Space instance for tuples with 3 elements.-instance Num a => InnerProductSpace (a,a,a) where-    (x1,y1,z1) `dot` (x2,y2,z2) = x1 * x2 + y1 * y2 + z1 * z2----- | R-module instance for tuples with 4 elements.-instance Num a => RModule (a,a,a,a) where-    type Groundring (a,a,a,a) = a-    zeroVector = (0,0,0,0)-    a *^ (x,y,z,u) = (a * x, a * y, a * z, a * u)-    negateVector (x,y,z,u) = (-x, -y, -z, -u)-    (x1,y1,z1,u1) ^+^ (x2,y2,z2,u2) = (x1+x2, y1+y2, z1+z2, u1+u2)-    (x1,y1,z1,u1) ^-^ (x2,y2,z2,u2) = (x1-x2, y1-y2, z1-z2, u1-u2)---- | Vector-space instance for tuples with 4 elements.-instance Fractional a => VectorSpace (a,a,a,a) where-    (x,y,z,u) ^/ a = (x / a, y / a, z / a, u / a)---- | Inner Product Space instance for tuples with 4 elements.-instance Num a => InnerProductSpace (a,a,a,a) where-    (x1,y1,z1,u1) `dot` (x2,y2,z2,u2) = x1 * x2 + y1 * y2 + z1 * z2 + u1 * u2----- | R-module instance for tuples with 5 elements.-instance Num a => RModule (a,a,a,a,a) where-    type Groundring (a,a,a,a,a) = a-    zeroVector = (0,0,0,0,0)-    a *^ (x,y,z,u,v) = (a * x, a * y, a * z, a * u, a * v)-    negateVector (x,y,z,u,v) = (-x, -y, -z, -u, -v)-    (x1,y1,z1,u1,v1) ^+^ (x2,y2,z2,u2,v2) = (x1+x2, y1+y2, z1+z2, u1+u2, v1+v2)-    (x1,y1,z1,u1,v1) ^-^ (x2,y2,z2,u2,v2) = (x1-x2, y1-y2, z1-z2, u1-u2, v1-v2)---- | Vector-space instance for tuples with 5 elements.-instance Fractional a => VectorSpace (a,a,a,a,a) where-    (x,y,z,u,v) ^/ a = (x / a, y / a, z / a, u / a, v / a)---- | Inner Product Space instance for tuples with 5 elements.-instance Num a => InnerProductSpace (a,a,a,a,a) where-    (x1,y1,z1,u1,v1) `dot` (x2,y2,z2,u2,v2) =-        x1 * x2 + y1 * y2 + z1 * z2 + u1 * u2 + v1 * v2