rhine 0.1.0.0 → 0.1.1.0

raw patch · 10 files changed

+244/−46 lines, 10 filesdep ~dunaidep ~transformersPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependency ranges changed: dunai, transformers

API changes (from Hackage documentation)

Files

• README.md +1/−1
• rhine.cabal +8/−5
• src/FRP/Rhine/Clock.hs +11/−0
• src/FRP/Rhine/Clock/Realtime/Audio.hs +19/−9
• src/FRP/Rhine/Clock/Realtime/Stdin.hs +35/−0
• src/FRP/Rhine/Clock/Select.hs +70/−0
• src/FRP/Rhine/Reactimation/Tick.hs +1/−16
• src/FRP/Rhine/SyncSF.hs +24/−14
• src/FRP/Rhine/SyncSF/Except.hs +70/−0
• src/FRP/Rhine/TimeDomain.hs +5/−1

@@ -1,4 +1,4 @@-* README+# README --------  Rhine is a library for synchronous and asynchronous Functional Reactive Programming (FRP).

@@ -1,6 +1,6 @@ name:                rhine -version:             0.1.0.0+version:             0.1.1.0  synopsis: Functional Reactive Programming with type-level clocks @@ -17,7 +17,7 @@   To schedule the components and allow them to communicate,   several standard scheduling and resampling solutions are implemented.   Own schedules and resampling buffers can be implemented in a reusable fashion.-  A (synchronous) program outputting "Hello World" every tenth of a second looks like this:+  A (synchronous) program outputting "Hello World!" every tenth of a second looks like this:   @flow $ arrMSync_ (putStrLn "Hello World!") @@ (waitClock :: Millisecond 100)@  @@ -44,7 +44,7 @@ source-repository this   type:     git   location: git@github.com:turion/rhine.git-  tag:      v0.1.0.0+  tag:      v0.1.1.0   library@@ -57,6 +57,8 @@     FRP.Rhine.Clock.Realtime.Audio     FRP.Rhine.Clock.Realtime.Busy     FRP.Rhine.Clock.Realtime.Millisecond+    FRP.Rhine.Clock.Realtime.Stdin+    FRP.Rhine.Clock.Select     FRP.Rhine.Clock.Step     FRP.Rhine.Reactimation     FRP.Rhine.Reactimation.Tick@@ -74,6 +76,7 @@     FRP.Rhine.SF     FRP.Rhine.SF.Combinators     FRP.Rhine.SyncSF+    FRP.Rhine.SyncSF.Except     FRP.Rhine.TimeDomain    -- LANGUAGE extensions used by modules in this package.@@ -81,8 +84,8 @@    -- Other library packages from which modules are imported.   build-depends:       base         >= 4.7   && < 5-                    ,  dunai        >= 0.1.1 && < 0.2-                    ,  transformers >= 0.5   && < 0.6+                    ,  dunai        == 0.1.1.*+                    ,  transformers >= 0.4   && < 0.6                     ,  time         >= 1.6   && < 1.7                     ,  free         >= 4.12  && < 4.13                     ,  containers   >= 0.5   && < 0.6

@@ -7,6 +7,9 @@ {-# LANGUAGE TypeFamilies          #-} module FRP.Rhine.Clock where +-- transformers+import Control.Monad.Trans.Class (lift, MonadTrans)+ -- dunai import Data.MonadicStreamFunction @@ -139,3 +142,11 @@       ( hoistMSF monadMorphism runningClock       , initialTime       )++type LiftClock m t cl = HoistClock m (t m) cl++liftClock :: (Monad m, MonadTrans t) => cl -> LiftClock m t cl+liftClock hoistedClock = HoistClock+  { monadMorphism = lift+  , ..+  }

@@ -5,7 +5,8 @@ {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE TypeFamilies          #-} -{-# OPTIONS_GHC -Wno-unticked-promoted-constructors #-}+-- {-# OPTIONS_GHC -Wno-unticked-promoted-constructors #-}+-- TODO Find out exact version of cabal? GHC? that have a problem with this  module FRP.Rhine.Clock.Realtime.Audio   ( AudioClock (..)@@ -20,13 +21,15 @@ import GHC.TypeLits    (Nat, natVal, KnownNat) import Data.Time.Clock --- transformers?+-- transformers -- TODO Delete as soon as dunai is updated import Control.Monad.Trans.Class (lift)+import Control.Monad.IO.Class   -- dunai import Control.Monad.Trans.MSF.Except+  hiding (once, once_) -- TODO Delete with dunai 0.1.2  -- rhine import FRP.Rhine@@ -87,7 +90,8 @@ theBufferSize = fromInteger . natVal  -instance (KnownNat bufferSize, AudioClockRate rate) => Clock IO (AudioClock rate bufferSize) where+instance (MonadIO m, KnownNat bufferSize, AudioClockRate rate)+      => Clock m (AudioClock rate bufferSize) where   type TimeDomainOf (AudioClock rate bufferSize) = UTCTime   type Tag          (AudioClock rate bufferSize) = Maybe Double @@ -96,22 +100,20 @@       step       = picosecondsToDiffTime -- The only sufficiently precise conversion function                      $ round (10 ^ (12 :: Integer) / theRateNum audioClock :: Double)       bufferSize = theBufferSize audioClock-      once f = try $ arrM (lift . f) >>> throwS -- TODO Delete once dunai is updated-      once_ = once . const -      runningClock :: UTCTime -> Maybe Double -> MSF IO () (UTCTime, Maybe Double)+      runningClock :: MonadIO m => UTCTime -> Maybe Double -> MSF m () (UTCTime, Maybe Double)       runningClock initialTime maybeWasLate = safely $ do         bufferFullTime <- try $ proc () -> do           n <- count    -< ()           let nextTime = (realToFrac step * fromIntegral (n :: Int)) `addUTCTime` initialTime           _ <- throwOn' -< (n >= bufferSize, nextTime)           returnA       -< (nextTime, if n == 0 then maybeWasLate else Nothing)-        currentTime <- once_ getCurrentTime+        currentTime <- once_ $ liftIO getCurrentTime         let-          lateDiff = realToFrac $ currentTime `diffUTCTime` bufferFullTime+          lateDiff = currentTime `diffTime` bufferFullTime           late     = if lateDiff > 0 then Just lateDiff else Nothing         safe $ runningClock bufferFullTime late-    initialTime <- getCurrentTime+    initialTime <- liftIO getCurrentTime     return       ( runningClock initialTime Nothing       , initialTime@@ -153,3 +155,11 @@   { unscaledClock = PureAudioClock   , rescale       = double2Float }++-- ** To be ported to @dunai@++once :: Monad m => (a -> m e) -> MSFExcept m a b e+once f = try $ arrM (lift . f) >>> throwS+-- TODO Delete once dunai is updated+once_ :: Monad m => m e -> MSFExcept m a b e+once_ = once . const

@@ -0,0 +1,35 @@+{-# LANGUAGE FlexibleInstances     #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE TypeFamilies          #-}+module FRP.Rhine.Clock.Realtime.Stdin where++-- base+import Data.Time.Clock++-- transformers+import Control.Monad.IO.Class++-- rhine+import FRP.Rhine++{- |+A clock that ticks for every line entered on the console,+outputting the entered line as its |Tag|.+-}+data StdinClock = StdinClock++instance MonadIO m => Clock m StdinClock where+  type TimeDomainOf StdinClock = UTCTime+  type Tag          StdinClock = String++  startClock _ = do+    initialTime <- liftIO getCurrentTime+    return+      (     arrM_ (liftIO getCurrentTime)+        &&& arrM_ (liftIO getLine)+      , initialTime+      )++instance Monoid StdinClock where+  mempty      = StdinClock+  mappend _ _ = StdinClock

@@ -0,0 +1,70 @@+{-# LANGUAGE Arrows                #-}+{-# LANGUAGE FlexibleInstances     #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE RecordWildCards       #-}+{-# LANGUAGE TupleSections         #-}+{-# LANGUAGE TypeFamilies          #-}+module FRP.Rhine.Clock.Select where++-- rhine+import FRP.Rhine++-- dunai+-- import Data.MonadicStreamFunction.Async (concatS)+-- TODO dunai 0.1.2++-- base+import Data.Maybe (catMaybes, maybeToList)++-- | A clock that selects certain subevents of type 'a',+--   from the tag of a main clock.+data SelectClock cl a = SelectClock+  { mainClock :: cl -- ^ The main clock+  -- | Return 'Nothing' if no tick of the subclock is required,+  --   or 'Just a' if the subclock should tick, with tag 'a'.+  , select    :: Tag cl -> Maybe a+  }+++instance (Monad m, Clock m cl) => Clock m (SelectClock cl a) where+  type TimeDomainOf (SelectClock cl _) = TimeDomainOf cl+  type Tag          (SelectClock cl a) = a+  startClock SelectClock {..} = do+    (runningClock, initialTime) <- startClock mainClock+    let+      runningSelectClock = filterS $ proc _ -> do+        (time, tag) <- runningClock -< ()+        returnA                     -< (time, ) <$> select tag+    return (runningSelectClock, initialTime)+++-- | A universal schedule for two subclocks of the same main clock.+--   The main clock must be a monoid (e.g. a singleton).+schedSelectClocks+  :: (Monad m, Monoid cl, Clock m cl)+  => Schedule m (SelectClock cl a) (SelectClock cl b)+schedSelectClocks = Schedule {..}+  where+    startSchedule subClock1 subClock2 = do+      (runningClock, initialTime) <- startClock+        $ mainClock subClock1 `mappend` mainClock subClock2+      let+        runningSelectClocks = concatS $ proc _ -> do+          (time, tag) <- runningClock -< ()+          returnA                     -< catMaybes+            [ (time, ) . Left  <$> select subClock1 tag+            , (time, ) . Right <$> select subClock2 tag ]+      return (runningSelectClocks, initialTime)++-- ** To be ported to @dunai@++concatS :: Monad m => MStream m [b] -> MStream m b+concatS msf = MSF $ \_ -> tick msf []+  where+    tick msf (b:bs) = return (b, MSF $ \_ -> tick msf bs)+    tick msf []     = do+      (bs, msf') <- unMSF msf ()+      tick msf' bs++filterS :: Monad m => MSF m () (Maybe b) -> MSF m () b+filterS = concatS . (>>> arr maybeToList)

@@ -206,22 +206,7 @@         , buffer2  = buffer2 rightTickable         , lastTime = ParallelLastTime lastTimeA (lastTime rightTickable)         }-tick Tickable-  { ticksf   = Synchronous _-  , lastTime = SequentialLastTime {}-  } _ _ = error "Impossible pattern in tick"-tick Tickable-  { ticksf   = Synchronous _-  , lastTime = ParallelLastTime {}-  } _ _ = error "Impossible pattern in tick"-tick Tickable-  { ticksf   = Sequential {}-  , lastTime = LeafLastTime _-  } _ _ = error "Impossible pattern in tick"-tick Tickable-  { ticksf   = Parallel {}-  , lastTime = LeafLastTime _-  } _ _ = error "Impossible pattern in tick"+tick Tickable {} _ _ = error "Impossible pattern in tick"  -- TODO It seems wasteful to unwrap and rewrap log(N) Tickables -- (where N is the size of the clock tree) each tick,

@@ -8,11 +8,12 @@  -- base import Control.Arrow+import Control.Category (Category) import qualified Control.Category (id)  -- transformers import Control.Monad.Trans.Reader-  ( ReaderT, ask, asks, mapReaderT, withReaderT)+  (ReaderT, ask, asks, mapReaderT, withReaderT)  -- dunai import Data.MonadicStreamFunction@@ -31,10 +32,14 @@ --   that is, reading the current 'TimeInfo' of the clock 'cl'. type SyncSF m cl a b = MSF (ReaderT (TimeInfo cl) m) a b +-- | A synchronous signal is a |SyncSF| with no input required.+--   It produces its output on its own.+type SyncSignal m cl a = SyncSF m cl () a+ -- | A (side-effectful) behaviour is a time-aware stream --   that doesn't depend on a particular clock.---   'td' denotes the time domain.-type Behaviour m td a = forall cl. td ~ TimeDomainOf cl => SyncSF m cl () a+--   'td' denotes the |TimeDomain|.+type Behaviour m td a = forall cl. td ~ TimeDomainOf cl => SyncSignal m cl a  -- | Compatibility to U.S. american spelling. type Behavior  m td a = Behaviour m td a@@ -80,24 +85,29 @@  -- * Useful aliases +-- TODO Is it cleverer to generalise to Arrow? {- | Alias for 'Control.Category.>>>' (sequential composition) with higher operator precedence, designed to work with the other operators, e.g.:  > syncsf1 >-> syncsf2 @@ clA **@ sched @** syncsf3 >-> syncsf4 @@ clB++The type signature specialises e.g. to++> (>->) :: Monad m => SyncSF m cl a b -> SyncSF m cl b c -> SyncSF m cl a c -}-infixr 4 >->-(>->) :: Monad m-      => SyncSF m cl a b-      -> SyncSF m cl   b c-      -> SyncSF m cl a   c+infixr 6 >->+(>->) :: Category cat+      => cat a b+      -> cat   b c+      -> cat a   c (>->) = (>>>) --- | Alias for 'Control.Arrow.<<<'.-infixl 4 <-<-(<-<) :: Monad m-      => SyncSF m cl   b c-      -> SyncSF m cl a b-      -> SyncSF m cl a   c+-- | Alias for 'Control.Category.<<<'.+infixl 6 <-<+(<-<) :: Category cat+      => cat   b c+      -> cat a b+      -> cat a   c (<-<) = (<<<)  {- | Output a constant value.

@@ -0,0 +1,70 @@+{-# LANGUAGE Arrows #-}+module FRP.Rhine.SyncSF.Except+  ( module FRP.Rhine.SyncSF.Except+  , module X+  , safe, safely, Empty, exceptS, runMSFExcept+  )+  where++-- transformers+import Control.Monad.Trans.Class (lift)+import Control.Monad.Trans.Except as X+import Control.Monad.Trans.Reader++-- dunai+import Control.Monad.Trans.MSF.Except hiding (try, once, once_, throwOn, throwOn', throwS)+-- TODO Find out whether there is a cleverer way to handle exports+import qualified Control.Monad.Trans.MSF.Except as MSFE++-- rhine+import FRP.Rhine+++type SyncExcept m cl a b e = MSFExcept (ReaderT (TimeInfo cl) m) a b e++-- | Commute the effects of the |ReaderT| and the |ExceptT| monad.+commuteReaderExcept :: ReaderT r (ExceptT e m) a -> ExceptT e (ReaderT r m) a+commuteReaderExcept a = ExceptT $ ReaderT $ \r -> runExceptT $ runReaderT a r++-- | Enter the monad context in the exception+--   for |SyncSF|s in the |ExceptT| monad.+try :: Monad m => SyncSF (ExceptT e m) cl a b -> SyncExcept m cl a b e+try = MSFE.try . liftMSFPurer commuteReaderExcept++-- | Within the same tick, perform a monadic action,+--   and immediately throw the value as an exception.+once :: Monad m => (a -> m e) -> SyncExcept m cl a b e+-- once f = MSFE.once $ lift . f -- TODO dunai 0.1.2+once f = try $ arrMSync (lift . f) >>> throwS++-- | A variant of |once| without input.+once_ :: Monad m => m e -> SyncExcept m cl a b e+once_ = once . const++-- |+throwS :: Monad m => SyncSF (ExceptT e m) cl e a+throwS = arrMSync throwE++throwOn' :: Monad m => SyncSF (ExceptT e m) cl (Bool, e) ()+throwOn' = proc (b, e) -> if b+  then throwS  -< e+  else returnA -< ()++throwOn :: Monad m => e -> SyncSF (ExceptT e m) cl Bool ()+throwOn e = proc b -> throwOn' -< (b, e)+++-- ** Will be in dunai-0.1.2++-- | Advances a single tick with the given Kleisli arrow,+--   and then throws an exception.+step :: Monad m => (a -> m (b, e)) -> SyncExcept m cl a b e+step f = try $ proc a -> do+  n      <- count               -< ()+  (b, e) <- arrMSync (lift . f) -< a+  _      <- throwOn'            -< (n > (1 :: Int), e)+  returnA                       -< b++-- | Immediately throw the current input as an exception.+currentInput :: Monad m => SyncExcept m cl e b e+currentInput = try throwS

@@ -1,7 +1,11 @@ {-# LANGUAGE FlexibleInstances          #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE TypeFamilies               #-}-module FRP.Rhine.TimeDomain where+module FRP.Rhine.TimeDomain+  ( module FRP.Rhine.TimeDomain+  , UTCTime+  )+  where  -- time import Data.Time.Clock (UTCTime, diffUTCTime)