dunai 0.3.0.0 → 0.4.0.0

raw patch · 8 files changed

+143/−84 lines, 8 filesdep +MonadRandomnew-uploaderPVP ok

version bump matches the API change (PVP)

Dependencies added: MonadRandom

API changes (from Hackage documentation)

Files

• dunai.cabal +4/−2
• src/Control/Monad/Trans/MSF.hs +2/−0
• src/Control/Monad/Trans/MSF/Except.hs +34/−10
• src/Control/Monad/Trans/MSF/Maybe.hs +27/−12
• src/Control/Monad/Trans/MSF/Random.hs +50/−0
• src/Data/MonadicStreamFunction/Async.hs +5/−2
• src/Data/MonadicStreamFunction/Core.hs +2/−31
• src/Data/MonadicStreamFunction/Util.hs +19/−27

@@ -1,5 +1,5 @@ name:                dunai-version:             0.3.0.0+version:             0.4.0.0 synopsis:            Generalised reactive framework supporting classic, arrowized and monadic FRP. homepage:            https://github.com/ivanperez-keera/dunai description:@@ -58,6 +58,7 @@                      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.State                      Control.Monad.Trans.MSF.Writer@@ -83,7 +84,8 @@    build-depends:     base >=4.6 && < 5,                      transformers,-                     transformers-base+                     transformers-base,+                     MonadRandom   hs-source-dirs:    src   default-language:  Haskell2010   ghc-options:       -Wall -fno-warn-unused-do-bind

@@ -6,6 +6,7 @@     ( module Control.Monad.Trans.MSF.GenLift     , module Control.Monad.Trans.MSF.Except     , module Control.Monad.Trans.MSF.Maybe+    , module Control.Monad.Trans.MSF.Random     , module Control.Monad.Trans.MSF.Reader     , module Control.Monad.Trans.MSF.State     , module Control.Monad.Trans.MSF.Writer@@ -15,6 +16,7 @@ import Control.Monad.Trans.MSF.GenLift import Control.Monad.Trans.MSF.Except import Control.Monad.Trans.MSF.Maybe+import Control.Monad.Trans.MSF.Random import Control.Monad.Trans.MSF.Reader import Control.Monad.Trans.MSF.State import Control.Monad.Trans.MSF.Writer

@@ -79,11 +79,9 @@ --   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)+catchS msf f = safely $ do+  e <- try msf+  safe $ f e  -- | Similar to Yampa's delayed switching. Looses a 'b' in case of an exception. untilE :: Monad m => MSF m a b -> MSF m b (Maybe e)@@ -114,11 +112,10 @@ -- | 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 e1 -> return $ Left e2-    Right (b, msf') -> return $ Right (b, tagged msf')+tagged msf = runMSFExcept $ do+  e1      <- try $ msf <<< arr fst+  (_, e2) <- currentInput+  return e2   -- * Monad interface for Exception MSFs@@ -198,3 +195,30 @@   (b, e) <- arrM (lift . f) -< a   _      <- throwOn'        -< (n > (1 :: Int), e)   returnA                   -< b++-- * Utilities definable in terms of 'MSFExcept'++-- TODO This is possibly not the best location for these functions,+-- but moving them to Data.MonadicStreamFunction.Util would form an import cycle+-- that could only be broken by moving a few things to Data.MonadicStreamFunction.Core+-- (that probably belong there anyways).++-- | Extract MSF from a monadic action.+--+-- Runs a monadic action that produces an MSF on the first iteration/step, and+-- uses that MSF as the main signal function for all inputs (including the+-- first one).+performOnFirstSample :: Monad m => m (MSF m a b) -> MSF m a b+performOnFirstSample sfaction = safely $ do+  msf <- once_ sfaction+  safe msf++-- | Reactimates an 'MSFExcept' until it throws an exception.+reactimateExcept :: Monad m => MSFExcept m () () e -> m e+reactimateExcept msfe = do+  Left e <- runExceptT $ reactimate $ runMSFExcept msfe+  return e++-- | Reactimates an 'MSF' until it returns 'True'.+reactimateB :: Monad m => MSF m () Bool -> m ()+reactimateB sf = reactimateExcept $ try $ liftMSFTrans sf >>> throwOn ()

@@ -8,6 +8,7 @@ module Control.Monad.Trans.MSF.Maybe   ( module Control.Monad.Trans.MSF.Maybe   , module Control.Monad.Trans.Maybe+  , maybeToExceptS   ) where  -- External@@ -15,6 +16,7 @@   hiding (liftCallCC, liftCatch, liftListen, liftPass) -- Avoid conflicting exports  -- Internal+import Control.Monad.Trans.MSF.Except import Control.Monad.Trans.MSF.GenLift import Data.MonadicStreamFunction @@ -22,18 +24,19 @@  -- | Throw the exception immediately. exit :: Monad m => MSF (MaybeT m) a b-exit = MSF $ const $ MaybeT $ return Nothing+exit = arrM_ $ MaybeT $ return Nothing  -- | Throw the exception when the condition becomes true on the input. exitWhen :: Monad m => (a -> Bool) -> MSF (MaybeT m) a a-exitWhen condition = go-  where-    go = MSF $ \a -> MaybeT $ return $-                       if condition a then Nothing else Just (a, go)+exitWhen condition = proc a -> do+  _ <- exitIf -< condition a+  returnA     -< a  -- | Exit when the incoming value is 'True'. exitIf :: Monad m => MSF (MaybeT m) Bool ()-exitIf = MSF $ \b -> MaybeT $ return $ if b then Nothing else Just ((), exitIf)+exitIf = proc condition -> if condition+  then exit    -< ()+  else returnA -< ()  -- | @Just a@ is passed along, 'Nothing' causes the whole 'MSF' to exit. maybeExit :: Monad m => MSF (MaybeT m) (Maybe a) a@@ -54,12 +57,12 @@   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-  case cont of-    Just (b, msf1') -> return (b, msf1' `catchMaybe` msf2)-    Nothing         -> unMSF msf2 a+catchMaybe+  :: (Functor m, Monad m)+  => MSF (MaybeT m) a b -> MSF m a b -> MSF m a b+catchMaybe msf1 msf2 = safely $ do+  _ <- try $ maybeToExceptS msf1+  safe msf2  -- * Converting to and from 'MaybeT' @@ -104,3 +107,15 @@         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+-- 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

@@ -0,0 +1,50 @@+{-# LANGUAGE Arrows              #-}+module Control.Monad.Trans.MSF.Random +  (+    runRandS+  , evalRandS++  , getRandomS+  , getRandomsS+  , getRandomRS+  , getRandomRS_+  , getRandomsRS+  , getRandomsRS_+  ) where++-- External+import Control.Monad.Random++-- Internal+import Data.MonadicStreamFunction++-- | Updates the generator every step+runRandS :: (RandomGen g, Monad m) +         => MSF (RandT g m) a b +         -> g +         -> 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')++-- | Updates the generator every step but discharges the generator +evalRandS  :: (RandomGen g, Monad m) => MSF (RandT g m) a b -> g -> MSF m a b+evalRandS msf g = runRandS msf g >>> arr snd++getRandomS :: (MonadRandom m, Random b) => MSF m a b+getRandomS = arrM_ getRandom++getRandomsS :: (MonadRandom m, Random b) => MSF m a [b]+getRandomsS = arrM_ getRandoms ++getRandomRS :: (MonadRandom m, Random b) => (b, b) -> MSF m a b+getRandomRS range = arrM_ $ getRandomR range++getRandomRS_ :: (MonadRandom m, Random b) => MSF m (b, b) b+getRandomRS_  = arrM getRandomR+    +getRandomsRS :: (MonadRandom m, Random b) => (b, b) -> MSF m a [b]+getRandomsRS range = arrM_ $ getRandomRs range ++getRandomsRS_ :: (MonadRandom m, Random b) => MSF m (b, b) [b]+getRandomsRS_ = arrM getRandomRs

@@ -13,7 +13,7 @@  Example: ->>> let intstream = concatS $ arrM_ $ putStrLn "Enter a list of Ints:" >> readLn :: MStream IO Int+>>> let intstream = arrM_ $ putStrLn "Enter a list of Ints:" >> readLn :: MStream IO [Int] >>> reactimate $ concatS intstream >>> arrM print Enter a list of Ints: [1,2,33]@@ -47,7 +47,7 @@ But this will be caught in a loop:  >>> let after3Empty = count >>> arr ((<= 3) >>> boolToList)-reactimate $ concatS after3Empty  >>> arrM print+>>> reactimate $ concatS after3Empty  >>> arrM print "Yes" "Yes" "Yes"@@ -60,3 +60,6 @@     tick msf' []     = do       (bs, msf'') <- unMSF msf' ()       tick msf'' bs+-- TODO Maybe this can be written more nicely with exceptions?+-- Similarly takeS :: Int -> MSF m a b -> MSFExcept m a b () throws an exception after n ticks+-- Or with merge?

@@ -127,20 +127,15 @@  -- | Lift inner monadic actions in monad stacks. --- TODO Should be able to express this in terms of MonadBase liftMSFTrans :: (MonadTrans t, Monad m, Monad (t m))              => MSF m a b              -> MSF (t m) a b-liftMSFTrans sf = MSF $ \a -> do-  (b, sf') <- lift $ unMSF sf a-  return (b, liftMSFTrans sf')+liftMSFTrans = liftMSFPurer lift  -- | Lift innermost monadic actions in a monad stacks (generalisation of -- 'liftIO'). liftMSFBase :: (Monad m2, MonadBase m1 m2) => MSF m1 a b -> MSF m2 a b-liftMSFBase sf = MSF $ \a -> do-  (b, sf') <- liftBase $ unMSF sf a-  b `seq` return (b, liftMSFBase sf')+liftMSFBase = liftMSFPurer liftBase  -- *** Generic MSF Lifting @@ -167,18 +162,6 @@   (b, sf') <- liftPurer $ unMSF sf a   b `seq` return (b, liftMSFPurer liftPurer sf') --- ** MSFs within monadic actions---- | Extract MSF from a monadic action.------ Runs a monadic action that produces an MSF on the first iteration/step, and--- uses that MSF as the main signal function for all inputs (including the--- first one).-performOnFirstSample :: Monad m => m (MSF m a b) -> MSF m a b-performOnFirstSample sfaction = MSF $ \a -> do-  sf <- sfaction-  unMSF sf a- -- * Delays  -- | Delay a signal by one sample.@@ -244,15 +227,3 @@ 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--- Control.Monad.Trans.MSF.Maybe-reactimateB :: Monad m => MSF m () Bool -> m ()-reactimateB sf = do-  (b, sf') <- unMSF sf ()-  unless b $ reactimateB sf'

@@ -1,3 +1,4 @@+{-# LANGUAGE Arrows #-} -- | Useful auxiliary functions and definitions. module Data.MonadicStreamFunction.Util where @@ -12,6 +13,7 @@  -- Internal import Data.MonadicStreamFunction.Core+import Data.MonadicStreamFunction.Instances.ArrowChoice import Data.VectorSpace  -- * Streams and sinks@@ -61,13 +63,9 @@ -- | 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-    go = MSF $ \maybeA -> case maybeA of-      Just a -> do-        (b, msf') <- unMSF msf a-        return (Just b, mapMaybeS msf')-      Nothing -> return (Nothing, go)+mapMaybeS msf = proc maybeA -> case maybeA of+  Just a  -> arr Just <<< msf -< a+  Nothing -> returnA          -< Nothing  -- * Adding side effects @@ -91,12 +89,16 @@  -- | 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+next b sf = sf >>> delay b +-- | Buffers and returns the elements in FIFO order,+--   returning 'Nothing' whenever the buffer is empty.+fifo :: Monad m => MSF m [a] (Maybe a)+fifo = feedback [] $ proc (as, accum) -> do+  let accum' = accum ++ as+  returnA -< case accum' of+    []       -> (Nothing, [])+    (a : as) -> (Just a , as)  -- * Folding @@ -138,27 +140,17 @@  -- | 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))+unfold :: Monad m => (a -> (b, a)) -> a -> MSF m () b+unfold f a = feedback a (arr (snd >>> f))  -- | Generate outputs using a step-wise generation function and an initial -- value. Version of 'unfold' in which the output and the new accumulator -- are the same. Should be equal to @\f a -> unfold (f >>> dup) a@. repeatedly :: Monad m => (a -> a) -> a -> MSF m () a-repeatedly f = 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).+repeatedly f = unfold $ f >>> dup+  where+    dup a = (a, a) --- TODO: This is not elementary, it can probably be built using other--- 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