packages feed

rhine 1.6 → 1.7

raw patch · 14 files changed

+146/−46 lines, 14 filesdep ~automatondep ~monad-scheduledep ~time-domain

Dependency ranges changed: automaton, monad-schedule, time-domain

Files

rhine.cabal view
@@ -1,6 +1,6 @@ cabal-version: 2.2 name: rhine-version: 1.6+version: 1.7 synopsis: Functional Reactive Programming with type-level clocks description:   Rhine is a library for synchronous and asynchronous Functional Reactive Programming (FRP).@@ -49,13 +49,14 @@  common opts   build-depends:-    automaton ^>=1.6,+    automaton ^>=1.7,     base >=4.16 && <4.22,-    monad-schedule ^>=1.6,+    monad-schedule ^>=1.7,     mtl >=2.2 && <2.4,     selective ^>=0.7,     text >=1.2 && <2.2,     time >=1.8,+    time-domain ^>=1.7,     transformers >=0.5,     vector-sized >=1.4, @@ -159,7 +160,6 @@     sop-core ^>=0.5,     text >=1.2 && <2.2,     time >=1.8,-    time-domain ^>=1.6,     transformers >=0.5,    -- Directories containing source files.
src/FRP/Rhine/ClSF/Except.hs view
@@ -61,6 +61,7 @@   if b     then throwS -< e     else returnA -< ()+{-# INLINEABLE throwOn' #-}  -- | Throw the exception 'e' whenever the function evaluates to 'True'. throwOnCond :: (Monad m) => (a -> Bool) -> e -> ClSF (ExceptT e m) cl a a
src/FRP/Rhine/ClSF/Util.hs view
@@ -45,6 +45,7 @@  {- | Utility to apply functions to the current 'TimeInfo', such as record selectors:+ @ printAbsoluteTime :: ClSF IO cl () () printAbsoluteTime = timeInfoOf absolute >>> arrMCl print
src/FRP/Rhine/Clock.hs view
@@ -58,13 +58,15 @@   -- | The time domain, i.e. type of the time stamps the clock creates.   type Time cl -  -- | Additional information that the clock may output at each tick,-  --   e.g. if a realtime promise was met, if an event occurred,-  --   if one of its subclocks (if any) ticked.+  {- | Additional information that the clock may output at each tick,+  e.g. if a realtime promise was met, if an event occurred,+  if one of its subclocks (if any) ticked.+  -}   type Tag cl -  -- | The method that produces to a clock value a running clock,-  --   i.e. an effectful stream of tagged time stamps together with an initialisation time.+  {- | The method that produces to a clock value a running clock,+  i.e. an effectful stream of tagged time stamps together with an initialisation time.+  -}   initClock ::     -- | The clock value, containing e.g. settings or device parameters     cl ->@@ -190,8 +192,9 @@   { unscaledClockS :: cl   -- ^ The clock before the rescaling   , rescaleS :: RescalingSInit m cl time tag-  -- ^ The rescaling stream function, and rescaled initial time,-  --   depending on the initial time before rescaling+  {- ^ The rescaling stream function, and rescaled initial time,+  depending on the initial time before rescaling+  -}   }  instance
src/FRP/Rhine/Clock/FixedStep.hs view
@@ -24,6 +24,9 @@ import Control.Monad.Schedule.Class import Control.Monad.Schedule.Trans (ScheduleT, wait) +-- time-domain+import Data.TimeDomain (Seconds (..))+ -- automaton import Data.Automaton (accumulateWith, arrM) @@ -43,11 +46,11 @@   FixedStep :: (KnownNat n) => FixedStep n -- TODO Does the constraint bring any benefit?  -- | Extract the type-level natural number as an integer.-stepsize :: FixedStep n -> Integer-stepsize fixedStep@FixedStep = natVal fixedStep+stepsize :: FixedStep n -> Seconds Integer+stepsize fixedStep@FixedStep = Seconds $ natVal fixedStep -instance (MonadSchedule m, Monad m) => Clock (ScheduleT Integer m) (FixedStep n) where-  type Time (FixedStep n) = Integer+instance (MonadSchedule m, Monad m) => Clock (ScheduleT (Seconds Integer) m) (FixedStep n) where+  type Time (FixedStep n) = Seconds Integer   type Tag (FixedStep n) = ()   initClock cl =     let step = stepsize cl
src/FRP/Rhine/Clock/Periodic.hs view
@@ -22,6 +22,9 @@ -- monad-schedule import Control.Monad.Schedule.Trans +-- time-domain+import Data.TimeDomain (Seconds (..))+ -- automaton import Data.Automaton (Automaton (..), accumulateWith, concatS, withSideEffect) @@ -43,9 +46,9 @@  instance   (Monad m, NonemptyNatList v) =>-  Clock (ScheduleT Integer m) (Periodic v)+  Clock (ScheduleT (Seconds Integer) m) (Periodic v)   where-  type Time (Periodic v) = Integer+  type Time (Periodic v) = Seconds Integer   type Tag (Periodic v) = ()   initClock cl =     return@@ -68,16 +71,16 @@ tailCl Periodic = Periodic  class NonemptyNatList (v :: [Nat]) where-  theList :: Periodic v -> NonEmpty Integer+  theList :: Periodic v -> NonEmpty (Seconds Integer)  instance (KnownNat n) => NonemptyNatList '[n] where-  theList cl = headCl cl :| []+  theList cl = Seconds (headCl cl) :| []  instance   (KnownNat n1, KnownNat n2, NonemptyNatList (n2 : ns)) =>   NonemptyNatList (n1 : n2 : ns)   where-  theList cl = headCl cl <| theList (tailCl cl)+  theList cl = Seconds (headCl cl) <| theList (tailCl cl)  -- * Utilities
src/FRP/Rhine/Clock/Realtime/Audio.hs view
@@ -34,7 +34,7 @@ import Data.Automaton.Trans.Except hiding (step)  -- time-domain-import Data.TimeDomain (diffTime)+import Data.TimeDomain (Seconds (..), diffTime)  -- rhine import FRP.Rhine.Clock@@ -119,7 +119,7 @@         currentTime <- once_ $ liftIO getCurrentTime         let           lateDiff = currentTime `diffTime` bufferFullTime-          late = if lateDiff > 0 then Just lateDiff else Nothing+          late = if lateDiff > 0 then Just $ getSeconds lateDiff else Nothing         safe $ runningClock bufferFullTime late     initialTime <- liftIO getCurrentTime     return@@ -148,12 +148,12 @@   thePureRateNum = fromInteger . thePureRateIntegral  instance (Monad m, PureAudioClockRate rate) => Clock m (PureAudioClock rate) where-  type Time (PureAudioClock rate) = Double+  type Time (PureAudioClock rate) = Seconds Double   type Tag (PureAudioClock rate) = ()    initClock audioClock =     return-      ( arr (const (1 / thePureRateNum audioClock)) >>> sumS &&& arr (const ())+      ( arr (const (1 / thePureRateNum audioClock)) >>> sumN &&& arr (const ())       , 0       )   {-# INLINE initClock #-}@@ -170,5 +170,5 @@ pureAudioClockF =   RescaledClock     { unscaledClock = PureAudioClock-    , rescale = double2Float+    , rescale = double2Float . getSeconds     }
src/FRP/Rhine/Clock/Realtime/Millisecond.hs view
@@ -17,6 +17,8 @@ import Data.Time.Clock  -- rhine++import Data.TimeDomain (Seconds (..)) import FRP.Rhine.Clock import FRP.Rhine.Clock.FixedStep import FRP.Rhine.Clock.Proxy@@ -35,16 +37,16 @@ where 'Nothing' represents successful realtime, and @'Just' lag@ a lag (in seconds). -}-newtype Millisecond (n :: Nat) = Millisecond (WaitUTCClock IO (RescaledClock (UnscheduleClock IO (FixedStep n)) Double))+newtype Millisecond (n :: Nat) = Millisecond (WaitUTCClock IO (RescaledClock (UnscheduleClock IO (FixedStep n)) (Seconds Double)))  instance Clock IO (Millisecond n) where   type Time (Millisecond n) = UTCTime   type Tag (Millisecond n) = Maybe Double-  initClock (Millisecond cl) = initClock cl <&> first (>>> arr (second snd))+  initClock (Millisecond cl) = initClock cl <&> first (>>> arr (second (fmap getSeconds . snd)))   {-# INLINE initClock #-}  instance GetClockProxy (Millisecond n)  -- | Tries to achieve real time by using 'waitUTC', see its docs. waitClock :: (KnownNat n) => Millisecond n-waitClock = Millisecond $ waitUTC $ RescaledClock (unyieldClock FixedStep) ((/ 1000) . fromInteger)+waitClock = Millisecond $ waitUTC $ RescaledClock (unyieldClock FixedStep) ((/ 1000) . fromInteger . getSeconds)
src/FRP/Rhine/Clock/Select.hs view
@@ -34,9 +34,10 @@ -} 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'.+  {- ^ 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   }
src/FRP/Rhine/ResamplingBuffer.hs view
@@ -53,14 +53,16 @@       a ->       s ->       m s-  -- ^ Store one input value of type 'a' at a given time stamp,-  --   and return an updated state.+  {- ^ Store one input value of type 'a' at a given time stamp,+  and return an updated state.+  -}   , get ::       TimeInfo clb ->       s ->       m (Result s b)-  -- ^ Retrieve one output value of type 'b' at a given time stamp,-  --   and an updated state.+  {- ^ Retrieve one output value of type 'b' at a given time stamp,+  and an updated state.+  -}   }  -- | A type synonym to allow for abbreviation.
src/FRP/Rhine/ResamplingBuffer/ClSF.hs view
@@ -24,10 +24,11 @@ -} clsfBuffer ::   (Monad m) =>-  -- | The clocked signal function that consumes-  --   and a list of timestamped inputs,-  --   and outputs a single value.-  --   The list will contain the /newest/ element in the head.+  {- | The clocked signal function that consumes+  and a list of timestamped inputs,+  and outputs a single value.+  The list will contain the /newest/ element in the head.+  -}   ClSF m cl2 [(TimeInfo cl1, a)] b ->   ResamplingBuffer m cl1 cl2 a b clsfBuffer = clsfBuffer' . toStreamT . getAutomaton
src/FRP/Rhine/ResamplingBuffer/Interpolation.hs view
@@ -67,8 +67,9 @@   , s ~ Diff (Time cl1)   , s ~ Diff (Time cl2)   ) =>-  -- | The size of the interpolation window-  --   (for how long in the past to remember incoming values)+  {- | The size of the interpolation window+  (for how long in the past to remember incoming values)+  -}   s ->   ResamplingBuffer m cl1 cl2 v v sinc windowSize =
src/FRP/Rhine/ResamplingBuffer/Util.hs view
@@ -5,9 +5,15 @@ -} module FRP.Rhine.ResamplingBuffer.Util where +-- base+import Data.Function ((&))+ -- transformers import Control.Monad.Trans.Reader (runReaderT) +-- time-domain+import Data.TimeDomain (TimeDomain (..))+ -- automaton import Data.Stream (StreamT (..)) import Data.Stream.Internal (JointState (..))@@ -18,6 +24,7 @@ import FRP.Rhine.ClSF hiding (step, toStreamT) import FRP.Rhine.Clock import FRP.Rhine.ResamplingBuffer+import FRP.Rhine.Schedule (ParallelClock)  -- * Utilities to build 'ResamplingBuffer's from smaller components @@ -102,3 +109,75 @@   (forall b. ResamplingBuffer m cl clf b (f b)) ->   ResamplingBuffer m cl clf a (f (a, TimeInfo cl)) timestamped resBuf = (clId &&& timeInfo) ^->> resBuf++infixl 4 |-|++-- | Combine two 'ResamplingBuffer's in parallel input time.+--+-- The resulting 'ResamplingBuffer' will consume input whenever either of the input clocks ticks.+--+-- Caution: The time differences are split up between the two buffers, so the total passed time on the inputs is not the same as on the output.+(|-|) ::+  ( Monad m,+    TimeDomain (Time cl),+    Time clL ~ Time cl,+    Time clR ~ Time cl+  ) =>+  ResamplingBuffer m clL cl a b ->+  ResamplingBuffer m clR cl a c ->+  ResamplingBuffer m (ParallelClock clL clR) cl a (b, c)+ResamplingBuffer stateL putL getL |-| ResamplingBuffer stateR putR getR =+  ResamplingBuffer+    { buffer = JointState (JointState Nothing stateL) (JointState Nothing stateR),+      put = \theTimeInfo a (JointState (JointState lastTimeMaybeL sL) (JointState lastTimeMaybeR sR)) -> do+        let now = absolute theTimeInfo+        case tag theTimeInfo of+          Left tagL -> do+            sL' <- putL (theTimeInfo & retag (const tagL) & fixSinceLast lastTimeMaybeL) a sL+            pure $! JointState (JointState (Just now) sL') (JointState lastTimeMaybeR sR)+          Right tagR -> do+            sR' <- putR (theTimeInfo & retag (const tagR) & fixSinceLast lastTimeMaybeR) a sR+            pure $! JointState (JointState lastTimeMaybeL sL) (JointState (Just now) sR'),+      get = \theTimeInfo (JointState (JointState lastTimeMaybeL sL) (JointState lastTimeMaybeR sR)) -> do+        Result sL' b <- getL theTimeInfo sL+        Result sR' c <- getR theTimeInfo sR+        pure $! Result (JointState (JointState lastTimeMaybeL sL') (JointState lastTimeMaybeR sR')) (b, c)+    }++infixl 4 ||-||++-- | Combine two 'ResamplingBuffer's in parallel output time.+--+-- The resulting 'ResamplingBuffer' will produce output whenever either of the output clocks ticks.+--+-- Caution: The time differences are split up between the two buffers, so the total passed time on the input is not the same as on the outputs.+(||-||) ::+  ( Monad m,+    TimeDomain (Time cl),+    Time clL ~ Time cl,+    Time clR ~ Time cl+  ) =>+  ResamplingBuffer m cl                clL      a b ->+  ResamplingBuffer m cl                    clR  a b ->+  ResamplingBuffer m cl (ParallelClock clL clR) a b+ResamplingBuffer stateL putL getL ||-|| ResamplingBuffer stateR putR getR =+  ResamplingBuffer+    { buffer = JointState (JointState Nothing stateL) (JointState Nothing stateR),+      put = \theTimeInfo a (JointState (JointState lastTimeMaybeL sL) (JointState lastTimeMaybeR sR)) -> do+        sL' <- putL theTimeInfo a sL+        sR' <- putR theTimeInfo a sR+        pure $! JointState (JointState lastTimeMaybeL sL') (JointState lastTimeMaybeR sR'),+      get = \theTimeInfo (JointState (JointState lastTimeMaybeL sL) (JointState lastTimeMaybeR sR)) -> case tag theTimeInfo of+        Left tagL -> do+          Result sL' b <- getL (theTimeInfo & retag (const tagL) & fixSinceLast lastTimeMaybeL) sL+          pure $! Result (JointState (JointState lastTimeMaybeL sL') (JointState lastTimeMaybeR sR)) b+        Right tagR -> do+          Result sR' b <- getR (theTimeInfo & retag (const tagR) & fixSinceLast lastTimeMaybeR) sR+          pure $! Result (JointState (JointState lastTimeMaybeL sL) (JointState lastTimeMaybeR sR')) b+    }++-- | Helper function for 'ResamplingBuffer's over 'ParallelClock's to fix the 'sinceLast' field of the 'TimeInfo'.+fixSinceLast :: (TimeDomain (Time cl)) => Maybe (Time cl) -> TimeInfo cl -> TimeInfo cl+fixSinceLast lastTimeMaybe theTimeInfo = case lastTimeMaybe of+  Nothing -> theTimeInfo+  Just lastTime -> theTimeInfo {sinceLast = absolute theTimeInfo `diffTime` lastTime}
test/Schedule.hs view
@@ -16,6 +16,9 @@ -- monad-schedule import Control.Monad.Schedule.Trans (Schedule, runScheduleT, wait) +-- time-domain+import Data.TimeDomain (Seconds)+ -- automaton import Data.Automaton (accumulateWith, constM, embed) @@ -31,10 +34,10 @@     [ testGroup         "scheduleList"         [ testCase "schedule waits chronologically" $ do-            let output = runIdentity $ runScheduleT (const (pure ())) $ embed (scheduleList $ (\n -> constM (wait n $> n) >>> accumulateWith (+) 0) <$> [3 :: Integer, 5]) $ replicate 6 ()+            let output = runIdentity $ runScheduleT (const (pure ())) $ embed (scheduleList $ (\n -> constM (wait n $> n) >>> accumulateWith (+) 0) <$> [3 :: Seconds Integer, 5]) $ replicate 6 ()             output @?= pure <$> [3, 5, 6, 9, 10, 12]         , testCase "schedule waits chronologically (mirrored)" $ do-            let output = runSchedule $ embed (scheduleList $ (\n -> constM (wait n $> n) >>> accumulateWith (+) 0) <$> [5 :: Integer, 3]) $ replicate 6 ()+            let output = runSchedule $ embed (scheduleList $ (\n -> constM (wait n $> n) >>> accumulateWith (+) 0) <$> [5 :: Seconds Integer, 3]) $ replicate 6 ()             output @?= pure <$> [3, 5, 6, 9, 10, 12]         ]     , testGroup@@ -42,8 +45,8 @@         [ testCase "chronological ticks" $ do             let clA = FixedStep @5                 clB = FixedStep @3-                (runningClockA, _) = runSchedule (initClock clA :: RunningClockInit (Schedule Integer) Integer ())-                (runningClockB, _) = runSchedule (initClock clB :: RunningClockInit (Schedule Integer) Integer ())+                (runningClockA, _) = runSchedule (initClock clA :: RunningClockInit (Schedule (Seconds Integer)) (Seconds Integer) ())+                (runningClockB, _) = runSchedule (initClock clB :: RunningClockInit (Schedule (Seconds Integer)) (Seconds Integer) ())                 output = runSchedule $ embed (runningSchedule clA clB runningClockA runningClockB) $ replicate 6 ()             output               @?= [ (3, Right ())@@ -58,7 +61,7 @@         "ParallelClock"         [ testCase "chronological ticks" $ do             let-              (runningClock, _time) = runSchedule (initClock $ ParallelClock (FixedStep @5) (FixedStep @3) :: RunningClockInit (Schedule Integer) Integer (Either () ()))+              (runningClock, _time) = runSchedule (initClock $ ParallelClock (FixedStep @5) (FixedStep @3) :: RunningClockInit (Schedule (Seconds Integer)) (Seconds Integer) (Either () ()))               output = runSchedule $ embed runningClock $ replicate 6 ()             output               @?= [ (3, Right ())