Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

Sign up for GitHub

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Jump to bottom

Local clock #291

Draft
wants to merge 2 commits into
base: master
Choose a base branch
from
Draft

Local clock #291

Changes from all commits
Commits
Show all changes
2 commits
Select commit Hold shift + click to select a range
11abfb5
Define addLocalClock
turion Feb 23, 2024
087d055
Refactor lastS safely
turion Feb 23, 2024
File filter

Filter by extension

Filter by extension
Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
17 changes: 14 additions & 3 deletions rhine/src/FRP/Rhine/ClSF/Util.hs
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -16,7 +16,8 @@ module FRP.Rhine.ClSF.Util where
import Control.Arrow
import Control.Category (Category)
import qualified Control.Category (id)
import Data.Maybe (fromJust)
import Data.Functor (($>))
import Data.Maybe (fromMaybe)
import Data.Monoid (Last (Last), getLast)

-- containers
Expand All @@ -26,7 +27,7 @@ import Data.Sequence
import Control.Monad.Trans.Reader (ask, asks)

-- dunai
import Control.Monad.Trans.MSF.Reader (readerS)
import Control.Monad.Trans.MSF.Reader (readerS, runReaderS)
import Data.MonadicStreamFunction.Instances.Num ()
import Data.MonadicStreamFunction.Instances.VectorSpace ()

Expand Down Expand Up @@ -436,10 +437,20 @@ scaledTimer ::
BehaviorF (ExceptT () m) td a (Diff td)
scaledTimer diff = timer diff >>> arr (/ diff)

-- * Ad-hoc re-clocking utilities

-- | Define a local clock for one 'BehaviourF' which ticks exactly when the input is @'Just' a@.
onLocalClock :: (Monad m, TimeDomain td) => BehaviourF m td a b -> BehaviourF m td (Maybe a) (Maybe b)
onLocalClock behaviour = readerS $ proc (ti, aMaybe) -> do
let now = absolute ti
x <- iPre mempty <<< mappendS -< Last $ aMaybe $> now
let sinceLast' = maybe (sinceLast ti) (`diffTime` now) $ getLast x
mapMaybeS $ runReaderS behaviour -< (ti {sinceLast = sinceLast'},) <$> aMaybe

-- * To be ported to Dunai

{- | Remembers the last 'Just' value,
defaulting to the given initialisation value.
-}
lastS :: (Monad m) => a -> MSF m (Maybe a) a
lastS a = arr Last >>> mappendFrom (Last (Just a)) >>> arr (getLast >>> fromJust)
lastS a = arr Last >>> mappendS >>> arr (getLast >>> fromMaybe a)
Loading