dunai 0.2.0.0 → 0.3.0.0

raw patch · 21 files changed

+585/−250 lines, 21 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• dunai.cabal +5/−2
• src/Control/Arrow/Util.hs +8/−3
• src/Control/Monad/Trans/MSF.hs +2/−3
• src/Control/Monad/Trans/MSF/Except.hs +80/−44
• src/Control/Monad/Trans/MSF/GenLift.hs +30/−8
• src/Control/Monad/Trans/MSF/Maybe.hs +29/−42
• src/Control/Monad/Trans/MSF/Reader.hs +58/−21
• src/Control/Monad/Trans/MSF/State.hs +67/−17
• src/Control/Monad/Trans/MSF/Writer.hs +33/−5
• src/Data/MonadicStreamFunction/Core.hs +12/−5
• src/Data/MonadicStreamFunction/Instances/ArrowChoice.hs +1/−0
• src/Data/MonadicStreamFunction/Instances/ArrowLoop.hs +2/−0
• src/Data/MonadicStreamFunction/Instances/ArrowPlus.hs +4/−0
• src/Data/MonadicStreamFunction/Instances/Num.hs +23/−0
• src/Data/MonadicStreamFunction/Instances/VectorSpace.hs +22/−0
• src/Data/MonadicStreamFunction/Parallel.hs +2/−8
• src/Data/MonadicStreamFunction/Util.hs +108/−72
• src/Data/VectorSpace.hs +55/−8
• src/Data/VectorSpace/Fractional.hs +13/−2
• src/Data/VectorSpace/Specific.hs +14/−1
• src/Data/VectorSpace/Tuples.hs +17/−9

@@ -1,8 +1,9 @@ name:                dunai-version:             0.2.0.0+version:             0.3.0.0 synopsis:            Generalised reactive framework supporting classic, arrowized and monadic FRP.+homepage:            https://github.com/ivanperez-keera/dunai description:-  Dunai is DSL for strongly-typed CPS-based composable transformations.+  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)@@@ -42,11 +43,13 @@  -- You can disable the hlint test suite with -f-test-hlint flag test-hlint+  description: Enable hlint test suite   default: False   manual: True  -- You can disable the haddock coverage test suite with -f-test-doc-coverage flag test-doc-coverage+  description: Enable haddock coverage test suite   default: False   manual: True 

@@ -1,18 +1,20 @@+-- | Utility functions to work with 'Arrow's. module Control.Arrow.Util where  import Control.Arrow --- Hah! I shall implement this for TimelessSFs and SFs at the same time!+-- | Constantly produce the same output. constantly :: Arrow a => b -> a c b constantly = arr . const {-# INLINE constantly #-} --- More strongly bound arrow combinators+-- | 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 (>->) = (>>>)@@ -27,9 +29,12 @@ -- sink :: Arrow a => a b c -> a c () -> a b c -- a1 `sink` a2 = a1 >>> (id &&& a2) >>> arr fst --- Apply functions at the end+-- * 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

@@ -1,5 +1,7 @@ {-# 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@@ -9,9 +11,6 @@     , module Control.Monad.Trans.MSF.Writer     )   where---- Caution: RWS is not exported since names collide with Reader, State and--- Writer  import Control.Monad.Trans.MSF.GenLift import Control.Monad.Trans.MSF.Except

@@ -1,17 +1,23 @@ {-# 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           Control.Monad.Trans.Maybe  -- Internal -- import Control.Monad.Trans.MSF.GenLift@@ -19,70 +25,77 @@  -- * 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 arrM throwE -< e-    else returnA -< 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 arrM throwE -< e-      else returnA -< a+  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 arrM throwE -< e-    else returnA -< ()+  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 $ arrM throwE+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  -- | Whenever 'Nothing' is thrown, throw '()' instead.-maybeToExceptS :: Monad m => MSF (MaybeT m) a b -> MSF (ExceptT () m) a b+maybeToExceptS :: (Functor m, Monad m) => MSF (MaybeT m) a b -> MSF (ExceptT () m) a b maybeToExceptS = liftMSFPurer (ExceptT . (maybe (Left ()) Right <$>) . runMaybeT)  -- * Catching exceptions -{--catchS' :: Monad m => MSF (ExceptT e m) a b -> (e -> m (b, MSF m a b)) -> MSF m a b-catchS' msf f = MSF $ \a -> (unMSF msf a) f `catchFinal` f--}+-- | 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 = MSF $ \a -> do-    cont <- runExceptT $ unMSF msf a-    case cont of-        Left e          -> unMSF (f e) a-        Right (b, msf') -> return (b, msf' `catchS` f)---- catchFinal :: Monad m => ExceptT e m a -> (e -> m a) -> m a--- catchFinal action f = do---     ea <- runExceptT action---     case ea of---         Left  e -> f e---         Right a -> return a+  cont <- runExceptT $ unMSF msf a+  case cont of+    Left e          -> unMSF (f e) a+    Right (b, msf') -> return (b, msf' `catchS` f) --- Similar to delayed switching. Looses a b in case of exception+-- | 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)+  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@@ -92,22 +105,38 @@             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 -- extracts value from monadic action+inExceptT = arrM id -{--tagged :: MSF (ExceptT e m) a b -> MSF (ExceptT t m) (a, t) b-tagged msf = MSF $ \(a, t) -> ExceptT $ do+-- | 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 = MSF $ \(a, e2) -> ExceptT $ do   cont <- runExceptT $ unMSF msf a   case cont of-    Left  e     -> _ return t-    Right bmsf' -> _ return bmsf'-    -}+    Left e1 -> return $ Left e2+    Right (b, msf') -> return $ Right (b, tagged msf') + -- * 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. 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 @@ -115,13 +144,19 @@ 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@@ -129,8 +164,10 @@       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@@ -138,12 +175,18 @@       Right (b, msf') <- 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 @@ -155,10 +198,3 @@   (b, e) <- arrM (lift . f) -< a   _      <- throwOn'        -< (n > (1 :: Int), e)   returnA                   -< b--tagged :: Monad m => MSF (ExceptT e1 m) a b -> MSF (ExceptT e2 m) (a, e2) b-tagged msf = MSF $ \(a, e2) -> ExceptT $ do-  cont <- runExceptT $ unMSF msf a-  case cont of-    Left  _e1       -> return $ Left e2-    Right (b, msf') -> return $ Right (b, tagged msf')

@@ -1,10 +1,21 @@ {-# 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 --- * Attempt at writing a more generic MSF lifting combinator.  This is+-- | 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.@@ -57,7 +68,12 @@   (b, msf') <- f (unMSF msf) a   return (b, lifterS f msf') --- ** Another wrapper idea+-- | 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))@@ -66,7 +82,11 @@     (b2, msf') <- transformOutput a2 $ unMSF msf =<< transformInput a2     return (b2, transS transformInput transformOutput msf') --- ** A more general lifting mechanism that enables recovery.+-- | 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))@@ -77,6 +97,10 @@       -- 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))@@ -100,17 +124,15 @@ --                  [msf''] -> return (b2, transGN transformInput transformOutput msf'') --                  ms      -> --- ** Wrapping/unwrapping--- -- 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     )+-- 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+-- type Id a = a

@@ -1,5 +1,10 @@ {-# 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@@ -13,45 +18,42 @@ import Control.Monad.Trans.MSF.GenLift import Data.MonadicStreamFunction -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)----- * Throwing Nothing as an exception ("exiting")+-- * Throwing 'Nothing' as an exception ("exiting") +-- | Throw the exception immediately. exit :: Monad m => MSF (MaybeT m) a b exit = MSF $ const $ 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 = go   where     go = MSF $ \a -> MaybeT $ return $                        if condition a then Nothing else Just (a, go) +-- | Exit when the incoming value is 'True'. exitIf :: Monad m => MSF (MaybeT m) Bool () exitIf = MSF $ \b -> MaybeT $ return $ if b then Nothing else Just ((), exitIf) --- Just a is passed along, Nothing causes the whole MSF to exit+-- | @Just a@ is passed along, 'Nothing' causes the whole 'MSF' to exit. maybeExit :: Monad m => MSF (MaybeT m) (Maybe a) a-maybeExit = MSF $ MaybeT . return . fmap (\x -> (x, maybeExit))+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+  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 = MSF $ \a -> do   cont <- runMaybeT $ unMSF msf1 a@@ -67,7 +69,9 @@ listToMaybeS :: Monad m => [b] -> MSF (MaybeT m) a b listToMaybeS = foldr iPost exit --- * Running MaybeT+-- * 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@@ -77,36 +81,19 @@              Just (b, msf') -> return (Just b, runMaybeS msf')              Nothing        -> return (Nothing, go) --- mapMaybeS msf == runMaybeS (inMaybeT >>> lift mapMaybeS)+-- | 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) -{--maybeS :: Monad m => MSF m a (Maybe b) -> MSF (MaybeT m) a b-maybeS msf = MSF $ \a -> MaybeT $ return $ unMSF msf a--- maybeS msf == lift msf >>> inMaybeT--}+-- mapMaybeS msf == runMaybeS (inMaybeT >>> lift mapMaybeS)  {---- MB: Doesn't typecheck, I don't know why------ IP: Because of the forall in runTS.------ From the action runMaybeT msfaction it does not know that--- the second element of the pair in 'thing' will be a continuation.------ The first branch of the case works because you are passing the--- msf' as is.------ In the second one, you are passing msf, which has the specific type--- MSF (MaybeT m) a b.------ Two things you can try (to help you see that this is indeed why GHC is--- complaining):---   - Make the second continuation undefined. Then it typechecks.---   - Use ScopedTypeVariables and a let binding to type msf' in the---   first branch of the case selector. It'll complain about the type---   of msf' if you say it's forcibly a MSF (MaybeT m) a b.---- runMaybeS'' :: Monad m => MSF (MaybeT m) a b -> MSF m a (Maybe b) runMaybeS'' msf = transS transformInput transformOutput msf   where

@@ -1,51 +1,86 @@ {-# LANGUAGE Rank2Types          #-}++-- | MSFs 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+-- transformer stack. module Control.Monad.Trans.MSF.Reader-  ( module Control.Monad.Trans.MSF.Reader-  , module Control.Monad.Trans.Reader+  ( module Control.Monad.Trans.Reader+  -- * Reader MSF wrapping/unwrapping.+  , 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 wrapping/unwrapping --- * Reader monad+-- | 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') --- ** Alternative wrapping/unwrapping MSF combinators using generic lifting -runReaderS' :: Monad m => MSF (ReaderT s m) a b -> MSF m (s, a) b-runReaderS' = lifterS unwrapReaderT+-- | 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) -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+-- ** 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 -readerS' :: Monad m => MSF m (s, a) b -> MSF (ReaderT s m) a b-readerS' = lifterS wrapReaderT+-- ** 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@@ -62,11 +97,13 @@     transformOutput _ = lift -} --- ** Auxiliary functions related to ReaderT --- IP: Is runReaderS_ msf s = arr (\a -> (s,a)) >>> runReaderS msf ?--- MB: Yes, but 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)+-- 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

@@ -1,7 +1,24 @@-{-# LANGUAGE Rank2Types          #-}+{-# LANGUAGE Rank2Types #-}+-- | MSFs 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+-- transformer stack. module Control.Monad.Trans.MSF.State-  ( module Control.Monad.Trans.MSF.State-  , module Control.Monad.Trans.State.Strict+  ( module Control.Monad.Trans.State.Strict+  -- * State MSF running/wrapping/unwrapping+  , stateS+  , runStateS+  , runStateS_+  , runStateS__+  -- ** Alternative implementation using 'lifterS'+  , stateS'+  , runStateS'+  -- ** Alternative implementation using 'transS'+  , runStateS''+  -- ** Alternative implementation using 'transG'+  , runStateS'''   ) where  -- External@@ -13,44 +30,64 @@ import Control.Monad.Trans.MSF.GenLift import Data.MonadicStreamFunction -+-- * State MSF running/wrapping/unwrapping --- * 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') --- * Auxiliary functions+-- | 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. --- IP: Is runStateS_ msf s = feedback s $ runStateS msf >>> arr (\(s,b) -> ((s,b), s)) ?+ 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') --- IP: Is runStateS__ msf s = feedback s $ runStateS msf >>> arr (\(s,b) -> (b, 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 -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)+-- ** Alternative using 'lifterS'. --- * Alternative running/wrapping MSF combinators using generic lifting------ IPerez: TODO: Is this exactly the same as stateS?+-- | 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)@@ -60,11 +97,14 @@ --   ((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@@ -80,3 +120,13 @@     transformOutput (s, _) = do         put s -}++-- ** Alternative using 'transG'.++-- | 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)

@@ -1,6 +1,22 @@+-- | MSFs 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+-- transformer stack. module Control.Monad.Trans.MSF.Writer-  ( module Control.Monad.Trans.MSF.Writer-  , module Control.Monad.Trans.Writer.Strict+  ( module Control.Monad.Trans.Writer.Strict+  -- * Writer MSF running \/ wrapping \/ unwrapping+  , writerS+  , runWriterS++  -- ** Alternative implementation using 'lifterS'+  , writerS'+  , runWriterS'++  -- ** Alternative implementation using 'transS'+  , writerS''+  , runWriterS''   ) where  -- External@@ -8,33 +24,44 @@ import Control.Monad.Trans.Class import Control.Monad.Trans.Writer.Strict   hiding (liftCallCC, liftCatch, pass) -- Avoid conflicting exports--- import Data.Monoid+import Data.Monoid  -- Internal import Control.Monad.Trans.MSF.GenLift import Data.MonadicStreamFunction --- * Writer monad+-- * Writer MSF running/wrapping/unwrapping++-- | 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 running/wrapping MSF combinators using generic lifting+-- ** 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@@ -44,6 +71,7 @@         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

@@ -71,6 +71,7 @@  -- Instances +-- | Instance definition for 'Category'. Defines 'id' and '.'. instance Monad m => Category (MSF m) where   id = go     where go = MSF $ \a -> return (a, go)@@ -80,6 +81,7 @@     let sf' = sf2' . sf1'     c `seq` return (c, sf') +-- | 'Arrow' instance for MSFs. instance Monad m => Arrow (MSF m) where    arr f = go@@ -89,12 +91,14 @@     (b, sf') <- unMSF sf a     b `seq` return ((b, c), first sf') +-- | 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) +-- | Applicative instance for MSFs. instance (Functor m, Monad m) => Applicative (MSF m a) where   -- It is possible to define this instance with only Applicative m   pure = arr . const@@ -198,8 +202,8 @@ -- | 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 givin by Exceptions--- in "Control.Monad.Trans.MSF.Except"+-- 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@@ -223,10 +227,10 @@ -- if the MSF produces Nothing at any point, so the output stream cannot -- consumed progressively. ----- To explore the output progressively, use liftMSF and (>>>), together+-- 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+-- 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 []@@ -235,12 +239,15 @@   bs       <- embed sf' as   return (b:bs) --- | Run an MSF indefinitely passing a unit-carrying input stream.+-- | Run an 'MSF' indefinitely passing a unit-carrying input stream. reactimate :: Monad m => MSF m () () -> m () reactimate sf = do   (_, sf') <- unMSF sf ()   reactimate sf' +-- | Run an 'MSF' indefinitely passing a unit-carrying input stream.+-- A more high-level approach to this would be the use of 'MaybeT'+-- in 'Control.Monad.Trans.MSF.Maybe'. -- | Run an MSF indefinitely passing a unit-carrying input stream.  -- TODO: A more high-level approach to this would be the use of MaybeT in

@@ -9,6 +9,7 @@  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

@@ -14,6 +14,8 @@ import Control.Arrow import Control.Monad.Fix +-- | 'ArrowLoop' instance for MSFs. The monad must be an instance of+-- 'MonadFix'. instance (Monad m, MonadFix m) => ArrowLoop (MSF m) where   loop :: MSF m (b, d) (c, d) -> MSF m b c   loop sf = MSF $ \a -> do

@@ -11,8 +11,12 @@  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

@@ -1,10 +1,31 @@ {-# 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:+--+-- @+-- 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 MSFs. instance (Monad m, Num b) => Num (MSF m a b) where   (+)         = elementwise2 (+)   (-)         = elementwise2 (-)@@ -14,11 +35,13 @@   negate      = elementwise negate   fromInteger = constantly . fromInteger +-- | 'Fractional' instance for MSFs. instance (Monad m, Fractional b) => Fractional (MSF m a b) where   fromRational = constantly . fromRational   (/)          = elementwise2 (/)   recip        = elementwise recip +-- | 'Floating' instance for MSFs. instance (Monad m, Floating b) => Floating (MSF m a b) where   pi      = constantly   pi   exp     = elementwise  exp

@@ -1,5 +1,24 @@ {-# 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+-- 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@@ -8,6 +27,8 @@ import Data.VectorSpace  -- These conflict with Data.VectorSpace.Instances++-- | R-module instance for MSFs. instance (Monad m, RModule v) => RModule (MSF m a v) where   type Groundring (MSF m a v) = Groundring v   zeroVector   = constantly zeroVector@@ -16,5 +37,6 @@   (^+^)        = elementwise2 (^+^)   (^-^)        = elementwise2 (^-^) +-- | Vector-space instance for MSFs. instance (Monad m, VectorSpace v) => VectorSpace (MSF m a v) where   msf ^/ r = msf >>^ (^/ r)

@@ -1,3 +1,5 @@+-- | Versions of arrow combinators that run things in parallel using 'par', if+-- possible. module Data.MonadicStreamFunction.Parallel where  -- External@@ -9,14 +11,6 @@  -- | Run two MSFs in parallel, taking advantage of parallelism if --   possible. This is the parallel version of '(***)'.---- IPerez: This should be similar to the following:--- (msf1 *** msf2) >>> parS--- where parS             = arr parTuple---       parTuple p@(a,b) = (a `par` b `pseq` p)--- Manuel: but we added strictness annotations to first--- and so (***) might be strict in both arguments and not take--- full advantage of parallelism.  (*|*) :: Monad m => MSF m a b -> MSF m c d -> MSF m (a, c) (b, d) msf1 *|* msf2 = MSF $ \(a, c) -> do

@@ -1,3 +1,4 @@+-- | Useful auxiliary functions and definitions. module Data.MonadicStreamFunction.Util where  -- External@@ -13,51 +14,40 @@ import Data.MonadicStreamFunction.Core import Data.VectorSpace --- * Useful aliases-type MStream m a = MSF m () a-type MSink   m a = MSF m a ()----- * Stateful accumulation--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')---- ** Accumulation for monoids--mappendS :: (Monoid n, Monad m) => MSF m n n-mappendS = mappendFrom mempty-{-# INLINE mappendS #-}--mappendFrom :: (Monoid n, Monad m) => n -> MSF m n n-mappendFrom = accumulateWith mappend+-- * Streams and sinks --- ** Accumulation for VectorSpace instances+-- | A stream is an MSF that produces outputs ignoring the input. It can+-- obtain the values from a monadic context.+type MStream m a = MSF m () a -sumFrom :: (RModule v, Monad m) => v -> MSF m v v-sumFrom = accumulateWith (^+^)+-- | A stream is an MSF that produces outputs producing no output. It can+-- consume the values with side effects.+type MSink   m a = MSF m a () -sumS :: (RModule v, Monad m) => MSF m v v-sumS = sumFrom zeroVector+-- * Lifting -count :: (Num n, Monad m) => MSF m a n-count = arr (const 1) >>> accumulateWith (+) 0+-- | 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 --- * Generating Signals+-- | Lifts a computation into a Stream.+arrM_ :: Monad m => m b -> MSF m a b+arrM_ = arrM . const -unfold :: Monad m => (a -> (b,a)) -> a -> MSF m () b-unfold f a = MSF $ \_ -> let (b,a') = f a in b `seq` return (b, unfold f a')--- unfold f x = feedback x (arr (snd >>> f))+-- | 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 (^>>>) #-} -repeatedly :: Monad m => (a -> a) -> a -> MSF m () a-repeatedly f = repeatedly'- where repeatedly' a = MSF $ \() -> let a' = f a in a' `seq` return (a, repeatedly' a')--- repeatedly f x = feedback x (arr (f >>> \x -> (x,x)))+-- | 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@@ -68,6 +58,8 @@       (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 = go   where@@ -77,68 +69,89 @@         return (Just b, mapMaybeS msf')       Nothing -> return (Nothing, go) -- -- * 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 --- * Debugging+-- * Delays -traceWith :: (Monad m, Show a) => (String -> m ()) -> String -> MSF m a a-traceWith method msg =-  withSideEffect (method . (msg ++) . show)+-- See also: 'iPre' -trace :: Show a => String -> MSF IO a a-trace = traceWith putStrLn+-- | 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) -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+-- | 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 = MSF $ \a -> do+  (b', sf') <- unMSF sf a+  return (b, next b' sf')+-- rather, once delay is tested:+-- next b sf = sf >>> delay b -pauseOn :: Show a => (a -> Bool) -> String -> MSF IO a a-pauseOn cond = traceWhen cond $ \s -> print s >> getLine >> return () +-- * Folding --- * Inserting monadic actions into MSFs+-- ** Folding for VectorSpace instances -{-# DEPRECATED insert "Don't use this. arrM id instead" #-}-insert :: Monad m => MSF m (m a) a-insert = arrM id+-- | 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 -arrM_ :: Monad m => m b -> MSF m a b-arrM_ = arrM . const+-- | Sums the inputs, starting from zero.+sumS :: (RModule v, Monad m) => MSF m v v+sumS = sumFrom zeroVector --- * Lifting from one monad into another+-- | Sums the inputs, starting from an initial vector.+sumFrom :: (RModule v, Monad m) => v -> MSF m v v+sumFrom = accumulateWith (^+^) +-- ** Folding for monoids -(^>>>) :: MonadBase m1 m2 => MSF m1 a b -> MSF m2 b c -> MSF m2 a c-sf1 ^>>> sf2 = liftMSFBase sf1 >>> sf2-{-# INLINE (^>>>) #-}+-- | Accumulate the inputs, starting from 'mempty'.+mappendS :: (Monoid n, Monad m) => MSF m n n+mappendS = mappendFrom mempty+{-# INLINE mappendS #-} -(>>>^) :: MonadBase m1 m2 => MSF m2 a b -> MSF m1 b c -> MSF m2 a c-sf1 >>>^ sf2 = sf1 >>> liftMSFBase sf2-{-# INLINE (>>>^) #-}+-- | Accumulate the inputs, starting from an initial monoid value.+mappendFrom :: (Monoid n, Monad m) => n -> MSF m n n+mappendFrom = accumulateWith mappend --- * Delays and signal overwriting+-- ** Generic folding \/ accumulation --- See also: 'iPre'+-- | Applies a function to the input and an accumulator, outputing the+-- 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') -iPost :: Monad m => b -> MSF m a b -> MSF m a b-iPost b sf = MSF $ \_ -> return (b, sf)+-- * Unfolding -next :: Monad m => b -> MSF m a b -> MSF m a b-next b sf = MSF $ \a -> do-  (b', sf') <- unMSF sf a-  return (b, next b' sf')--- rather, once delay is tested:--- next b sf = sf >>> delay b+-- | Generate outputs using a step-wise generation function and an initial+-- value.+unfold :: Monad m => (a -> (b,a)) -> a -> MSF m () b+unfold f a = MSF $ \_ -> let (b,a') = f a in b `seq` return (b, unfold f a')+-- unfold f x = feedback x (arr (snd >>> f)) --- * Alternative running functions+-- | 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 = repeatedly'+ where repeatedly' a = MSF $ \() -> let a' = f a in a' `seq` return (a, repeatedly' a')+-- repeatedly f x = feedback x (arr (f >>> \x -> (x,x))) +-- * Running functions+ -- | Run an MSF fed from a list, discarding results. Useful when one needs to -- combine effects and streams (i.e., for testing purposes). @@ -146,3 +159,26 @@ -- construts. Move to a non-core module? embed_ :: (Functor m, Monad m) => MSF m a () -> [a] -> m () embed_ msf as = void $ foldM (\sf a -> snd <$> unMSF sf a) msf as++-- * 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 ()

@@ -11,6 +11,7 @@ -- 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 @@ -23,15 +24,33 @@ infix 6 `dot` infixl 5 ^+^, ^-^ --- TODO Add laws this should satisfy-+-- | 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 (*^)-    (*^) = flip (^*)+    (^*)         = flip (*^)      negateVector :: v -> v     negateVector v = (-1) *^ v@@ -41,25 +60,53 @@     (^-^)        :: 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 -> 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 +-- | 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+  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 RModule v => NormedSpace v  where-    norm         :: v -> Groundfield v+  norm :: v -> Groundfield v  {- instance (Floating (Groundfield v), VectorSpace v, InnerProductSpace v) => NormedSpace v where

@@ -2,15 +2,23 @@ {-# 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 --- VectorSpace instances for Num/Fractional types. These sometimes clash with--- user-defined instances.+-- 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@@ -19,8 +27,11 @@     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

@@ -1,16 +1,25 @@ {-# 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     (^+^) = (+)@@ -18,18 +27,22 @@     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

@@ -1,25 +1,27 @@ {-# 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 ---------------------------------------------------------------------------------- Vector space instances for small tuples of Fractional----------------------------------------------------------------------------------+-- | 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) @@ -41,6 +43,7 @@  -} +-- | 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)@@ -49,14 +52,16 @@     (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)@@ -65,14 +70,16 @@     (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)@@ -81,10 +88,11 @@     (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