diff --git a/CHANGELOG b/CHANGELOG --- a/CHANGELOG +++ b/CHANGELOG @@ -1,3 +1,10 @@ +2021-10-07 Ivan Perez + * Yampa.cabal: Version bump (0.13.3) (#193), add modules missing from + other modules (#181). + * src/: Code cleaning and style fixes (#190, #191, #192). + * README.md: Restructure documentation (#184), fix installation + instructions (#186), add new games (#188), remove note (#189). + 2021-09-15 Ivan Perez * Yampa.cabal: Version bump (0.13.2), change cabal-version, add default language (#180). diff --git a/Yampa.cabal b/Yampa.cabal --- a/Yampa.cabal +++ b/Yampa.cabal @@ -1,5 +1,5 @@ name: Yampa -version: 0.13.2 +version: 0.13.3 cabal-version: >= 1.10 license: BSD3 license-file: LICENSE @@ -132,6 +132,36 @@ test-suite regression type: exitcode-stdio-1.0 main-is: testAFRPMain.hs + other-modules: + AFRPTests + AFRPTestsAccum + AFRPTestsArr + AFRPTestsBasicSF + AFRPTestsCOC + AFRPTestsCommon + AFRPTestsComp + AFRPTestsDelay + AFRPTestsDer + AFRPTestsEmbed + AFRPTestsEvSrc + AFRPTestsFirstSecond + AFRPTestsKSwitch + AFRPTestsLaws + AFRPTestsLoop + AFRPTestsLoopIntegral + AFRPTestsLoopLaws + AFRPTestsLoopPre + AFRPTestsPSwitch + AFRPTestsPre + AFRPTestsRPSwitch + AFRPTestsRSwitch + AFRPTestsReact + AFRPTestsSscan + AFRPTestsSwitch + AFRPTestsTask + AFRPTestsUtils + AFRPTestsWFG + hs-source-dirs: tests if !flag(test-regression) buildable: False diff --git a/src/FRP/Yampa.hs b/src/FRP/Yampa.hs --- a/src/FRP/Yampa.hs +++ b/src/FRP/Yampa.hs @@ -1,6 +1,7 @@ -{-# LANGUAGE GADTs, Rank2Types, CPP #-} - ------------------------------------------------------------------------------------------ +{-# LANGUAGE CPP #-} +{-# LANGUAGE GADTs #-} +{-# LANGUAGE Rank2Types #-} +-------------------------------------------------------------------------------- -- | -- Module : FRP.Yampa -- Copyright : (c) Antony Courtney and Henrik Nilsson, Yale University, 2003 @@ -10,7 +11,6 @@ -- Stability : provisional -- Portability : non-portable (GHC extensions) -- --- -- Domain-specific language embedded in Haskell for programming deterministic -- hybrid (mixed discrete-time and continuous-time) systems. Yampa is based on -- the concepts of Functional Reactive Programming (FRP) and is structured @@ -111,43 +111,47 @@ -- -- * Main Yampa module -- --- * "FRP.Yampa" -- Exports all FRP-related functions +-- * "FRP.Yampa" -- Exports all FRP-related functions. -- -- * Different FRP aspects -- --- * "FRP.Yampa.Basic" -- Primitive SFs +-- * "FRP.Yampa.Basic" -- Primitive SFs. -- --- * "FRP.Yampa.Conditional" -- Apply one SF or another depending on a condition +-- * "FRP.Yampa.Conditional" -- Apply one SF or another depending on +-- a condition. -- --- * "FRP.Yampa.Delays" -- Delay a signal +-- * "FRP.Yampa.Delays" -- Delay a signal. -- --- * "FRP.Yampa.Event" -- Event combinators +-- * "FRP.Yampa.Event" -- Event combinators. -- --- * "FRP.Yampa.EventS" -- Event Signal Functions +-- * "FRP.Yampa.EventS" -- Event Signal Functions. -- --- * "FRP.Yampa.Hybrid" -- Continuous-time to Discrete-time combinators +-- * "FRP.Yampa.Hybrid" -- Continuous-time to Discrete-time +-- combinators. -- --- * "FRP.Yampa.Integration" -- Integration and derivation and sums +-- * "FRP.Yampa.Integration" -- Integration and derivation and sums. -- --- * "FRP.Yampa.Loop" -- Feedback loops +-- * "FRP.Yampa.Loop" -- Feedback loops. -- --- * "FRP.Yampa.Random" -- Random signals +-- * "FRP.Yampa.Random" -- Random signals. -- --- * "FRP.Yampa.Scan" -- Scanning or folding a signal +-- * "FRP.Yampa.Scan" -- Scanning or folding a signal. -- --- * "FRP.Yampa.Switches" -- Dynamically changing an SF based on the value of a signal +-- * "FRP.Yampa.Switches" -- Dynamically changing an SF based on the +-- value of a signal. -- --- * "FRP.Yampa.Task" -- SFs that terminate and are followed by other SFs. +-- * "FRP.Yampa.Task" -- SFs that terminate and are followed by +-- other SFs. -- --- * "FRP.Yampa.Time" -- Signals that represent time +-- * "FRP.Yampa.Time" -- Signals that represent time. -- -- * Execution -- --- * "FRP.Yampa.Simulation" -- Reactimation/evaluation +-- * "FRP.Yampa.Simulation" -- Reactimation/evaluation. -- -- * Auxiliary modules -- --- * "FRP.Yampa.Arrow" -- Arrow-generic functions +-- * "FRP.Yampa.Arrow" -- Arrow-generic functions. -- ToDo: -- @@ -231,7 +235,7 @@ -- looking for opt. opportunities, whereas a plain "SF'" would -- indicate that things NEVER are going to change, and thus we can just -- as well give up? ------------------------------------------------------------------------------------------ +-------------------------------------------------------------------------------- module FRP.Yampa ( @@ -434,10 +438,12 @@ -- -> SF a b -- -> IO () ReactHandle, - reactInit, -- IO a -- init - -- -> (ReactHandle a b -> Bool -> b -> IO Bool) -- actuate - -- -> SF a b - -- -> IO (ReactHandle a b) + reactInit, -- :: IO a -- init + -- -> (ReactHandle a b -> Bool -> b -> IO Bool) + -- -- actuate + -- -> SF a b + -- -> IO (ReactHandle a b) + -- process a single input sample: react, -- ReactHandle a b -- -> (DTime,Maybe a) diff --git a/src/FRP/Yampa/Arrow.hs b/src/FRP/Yampa/Arrow.hs --- a/src/FRP/Yampa/Arrow.hs +++ b/src/FRP/Yampa/Arrow.hs @@ -1,6 +1,6 @@ {-# LANGUAGE CPP #-} {-# LANGUAGE FlexibleInstances #-} ------------------------------------------------------------------------------------------ +-------------------------------------------------------------------------------- -- | -- Module : FRP.Yampa.Arrow -- Copyright : (c) Antony Courtney and Henrik Nilsson, Yale University, 2003 @@ -12,7 +12,7 @@ -- -- Arrow helper functions. -- ------------------------------------------------------------------------------------------ +-------------------------------------------------------------------------------- module FRP.Yampa.Arrow ( -- * Arrow plumbing aids diff --git a/src/FRP/Yampa/Basic.hs b/src/FRP/Yampa/Basic.hs --- a/src/FRP/Yampa/Basic.hs +++ b/src/FRP/Yampa/Basic.hs @@ -1,5 +1,7 @@ -{-# LANGUAGE GADTs, Rank2Types, CPP #-} - +{-# LANGUAGE CPP #-} +{-# LANGUAGE GADTs #-} +{-# LANGUAGE Rank2Types #-} +-- | -- Module : FRP.Yampa.Basic -- Copyright : (c) Antony Courtney and Henrik Nilsson, Yale University, 2003 -- License : BSD-style (see the LICENSE file in the distribution) @@ -7,8 +9,8 @@ -- Maintainer : ivan.perez@keera.co.uk -- Stability : provisional -- Portability : non-portable (GHC extensions) - --- | Defines basic signal functions, and elementary ways of altering them. +-- +-- Defines basic signal functions, and elementary ways of altering them. -- -- This module defines very basic ways of creating and modifying signal -- functions. In particular, it defines ways of creating constant output diff --git a/src/FRP/Yampa/Conditional.hs b/src/FRP/Yampa/Conditional.hs --- a/src/FRP/Yampa/Conditional.hs +++ b/src/FRP/Yampa/Conditional.hs @@ -1,4 +1,13 @@ --- | Apply SFs only under certain conditions. +-- | +-- Module : FRP.Yampa +-- Copyright : (c) Antony Courtney and Henrik Nilsson, Yale University, 2003 +-- License : BSD-style (see the LICENSE file in the distribution) +-- +-- Maintainer : ivan.perez@keera.co.uk +-- Stability : provisional +-- Portability : non-portable (GHC extensions) +-- +-- Apply SFs only under certain conditions. module FRP.Yampa.Conditional ( provided -- :: (a -> Bool) -> SF a b -> SF a b -> SF a b , pause -- :: b -> SF a b -> SF a Bool -> SF a b @@ -18,12 +27,12 @@ -- -- This is similar to 'ArrowChoice', except that this resets the SFs after each -- transition. --- +-- -- For example, the following integrates the incoming input numbers, using one -- integral if the numbers are even, and another if the input numbers are odd. -- Note how, every time we "switch", the old value of the integral is -- discarded. --- +-- -- >>> embed (provided (even . round) integral integral) (deltaEncode 1 [1, 1, 1, 2, 2, 2, 1, 1, 1, 2, 2, 2 :: Double]) -- [0.0,1.0,2.0,0.0,2.0,4.0,0.0,1.0,2.0,0.0,2.0,4.0] diff --git a/src/FRP/Yampa/Delays.hs b/src/FRP/Yampa/Delays.hs --- a/src/FRP/Yampa/Delays.hs +++ b/src/FRP/Yampa/Delays.hs @@ -1,4 +1,4 @@ ------------------------------------------------------------------------------------------ +-------------------------------------------------------------------------------- -- | -- Module : FRP.Yampa.Delays -- Copyright : (c) Antony Courtney and Henrik Nilsson, Yale University, 2003 @@ -11,7 +11,7 @@ -- SF primitives and combinators to delay signals, introducing new values in -- them. -- ------------------------------------------------------------------------------------------ +-------------------------------------------------------------------------------- module FRP.Yampa.Delays ( diff --git a/src/FRP/Yampa/Diagnostics.hs b/src/FRP/Yampa/Diagnostics.hs --- a/src/FRP/Yampa/Diagnostics.hs +++ b/src/FRP/Yampa/Diagnostics.hs @@ -1,4 +1,4 @@ ------------------------------------------------------------------------------------------ +-------------------------------------------------------------------------------- -- | -- Module : FRP.Yampa.Diagnostics -- Copyright : (c) Antony Courtney and Henrik Nilsson, Yale University, 2003 @@ -9,7 +9,7 @@ -- Portability : portable -- -- Standarized error-reporting for Yampa ------------------------------------------------------------------------------------------ +-------------------------------------------------------------------------------- module FRP.Yampa.Diagnostics where diff --git a/src/FRP/Yampa/Event.hs b/src/FRP/Yampa/Event.hs --- a/src/FRP/Yampa/Event.hs +++ b/src/FRP/Yampa/Event.hs @@ -1,14 +1,14 @@ {-# LANGUAGE CPP #-} {-# OPTIONS_GHC -fno-warn-warnings-deprecations #-} ------------------------------------------------------------------------------------------ +-------------------------------------------------------------------------------- -- | --- Module : FRP.Yampa.Event --- Copyright : (c) Antony Courtney and Henrik Nilsson, Yale University, 2003 --- License : BSD-style (see the LICENSE file in the distribution) +-- Module : FRP.Yampa.Event +-- Copyright : (c) Antony Courtney and Henrik Nilsson, Yale University, 2003 +-- License : BSD-style (see the LICENSE file in the distribution) -- --- Maintainer : ivan.perez@keera.co.uk --- Stability : provisional --- Portability : portable +-- Maintainer : ivan.perez@keera.co.uk +-- Stability : provisional +-- Portability : portable -- -- Events in Yampa represent discrete time-signals, meaning those that do not -- change continuously. Examples of event-carrying signals would be mouse @@ -18,8 +18,8 @@ -- The type 'Event' is isomorphic to 'Maybe' (@Event a = NoEvent | Event a@) -- but, semantically, a 'Maybe'-carrying signal could change continuously, -- whereas an 'Event'-carrying signal should not: for two events in subsequent --- samples, there should be an small enough sampling frequency such that we sample --- between those two samples and there are no 'Event's between them. +-- samples, there should be an small enough sampling frequency such that we +-- sample between those two samples and there are no 'Event's between them. -- Nevertheless, no mechanism in Yampa will check this or misbehave if this -- assumption is violated. -- @@ -30,29 +30,27 @@ -- -- Note on naming conventions used in this module. -- --- Names here might have to be rethought. It's really a bit messy. --- In general, the aim has been short and convenient names (like 'tag', --- 'attach', 'lMerge') and thus we have tried to stay away from suffixing/ --- prefixing conventions. E.g. 'Event' as a common suffix would be very --- verbose. +-- Names here might have to be rethought. It's really a bit messy. In general, +-- the aim has been short and convenient names (like 'tag', 'attach', 'lMerge') +-- and thus we have tried to stay away from suffixing/ prefixing conventions. +-- E.g. 'Event' as a common suffix would be very verbose. -- -- However, part of the names come from a desire to stay close to similar --- functions for the Maybe type. e.g. 'event', 'fromEvent', 'isEvent'. --- In many cases, this use of 'Event' could be understood to refer to the --- constructor 'Event', not to the type name 'Event'. Thus this use of --- event should not be seen as a suffixing-with-type-name convention. But --- that is obviously not easy to see, and, more over, interpreting 'Event' --- as the name of the type might make equally good or better sense. E.g. --- 'fromEvent' can also be seen as a function taking an event signal, --- which is a partial function on time, to a normal signal. The latter is --- then undefined when the source event function is undefined. +-- functions for the Maybe type. e.g. 'event', 'fromEvent', 'isEvent'. In many +-- cases, this use of 'Event' could be understood to refer to the constructor +-- 'Event', not to the type name 'Event'. Thus this use of event should not be +-- seen as a suffixing-with-type-name convention. But that is obviously not +-- easy to see, and, more over, interpreting 'Event' as the name of the type +-- might make equally good or better sense. E.g. 'fromEvent' can also be seen +-- as a function taking an event signal, which is a partial function on time, +-- to a normal signal. The latter is then undefined when the source event +-- function is undefined. -- -- In other cases, it has been necessary to somehow stay out of the way of --- names used by the prelude or other commonly imported modules/modules --- which could be expected to be used heavily in Yampa code. In those cases --- a suffix 'E' have been added. Examples are 'filterE' (exists in Prelude) --- and 'joinE' (exists in Monad). Maybe the suffix isn't necessary in the --- last case. +-- names used by the prelude or other commonly imported modules/modules which +-- could be expected to be used heavily in Yampa code. In those cases a suffix +-- 'E' have been added. Examples are 'filterE' (exists in Prelude) and 'joinE' +-- (exists in Monad). Maybe the suffix isn't necessary in the last case. -- -- Some functions (actually only one currently, 'mapFilterE') have got an 'E' -- suffix just because they're closely related (by name or semantics) to one @@ -60,27 +58,27 @@ -- complement 'joinE'. But events carrying pairs could obviously have other -- sources than a 'joinE', so currently it is called 'split'. -- --- 2003-05-19: Actually, have now changed to 'splitE' to avoid a clash --- with the method 'split' in the class RandomGen. +-- 2003-05-19: Actually, have now changed to 'splitE' to avoid a clash with the +-- method 'split' in the class RandomGen. -- -- 2003-05-19: What about 'gate'? Stands out compared to e.g. 'filterE'. -- -- Currently the 'E' suffix is considered an exception. Maybe we should use --- completely different names to avoid the 'E' suffix. If the functions --- are not used that often, 'Event' might be approriate. Alternatively the --- suffix 'E' should be adopted globaly (except if the name already contains --- 'event' in some form?). +-- completely different names to avoid the 'E' suffix. If the functions are not +-- used that often, 'Event' might be approriate. Alternatively the suffix 'E' +-- should be adopted globaly (except if the name already contains 'event' in +-- some form?). -- -- Arguably, having both a type 'Event' and a constructor 'Event' is confusing -- since there are more than one constructor. But the name 'Event' for the --- constructor is quite apt. It's really the type name that is wrong. But --- no one has found a better name, and changing it would be a really major --- undertaking. Yes, the constructor 'Event' is not exported, but we still --- need to talk conceptually about them. On the other hand, if we consider +-- constructor is quite apt. It's really the type name that is wrong. But no +-- one has found a better name, and changing it would be a really major +-- undertaking. Yes, the constructor 'Event' is not exported, but we still need +-- to talk conceptually about them. On the other hand, if we consider -- Event-signals as partial functions on time, maybe it isn't so confusing: -- they just don't have a value between events, so 'NoEvent' does not really -- exist conceptually. ------------------------------------------------------------------------------------------ +-------------------------------------------------------------------------------- module FRP.Yampa.Event where diff --git a/src/FRP/Yampa/EventS.hs b/src/FRP/Yampa/EventS.hs --- a/src/FRP/Yampa/EventS.hs +++ b/src/FRP/Yampa/EventS.hs @@ -1,6 +1,17 @@ -{-# LANGUAGE GADTs, Rank2Types, CPP #-} --- | Event Signal Functions and SF combinators. +{-# LANGUAGE CPP #-} +{-# LANGUAGE GADTs #-} +{-# LANGUAGE Rank2Types #-} +-- | +-- Module : FRP.Yampa.EventS +-- Copyright : (c) Antony Courtney and Henrik Nilsson, Yale University, 2003 +-- License : BSD-style (see the LICENSE file in the distribution) -- +-- Maintainer : ivan.perez@keera.co.uk +-- Stability : provisional +-- Portability : non-portable (GHC extensions) +-- +-- Event Signal Functions and SF combinators. +-- -- Events represent values that only exist instantaneously, at discrete points -- in time. Examples include mouse clicks, zero-crosses of monotonic continuous -- signals, and square waves. @@ -9,15 +20,7 @@ -- events we can observe in a time period, no matter how much we increase the -- sampling frequency. --- Module : FRP.Yampa.EventS --- Copyright : (c) Antony Courtney and Henrik Nilsson, Yale University, 2003 --- License : BSD-style (see the LICENSE file in the distribution) --- --- Maintainer : ivan.perez@keera.co.uk --- Stability : provisional --- Portability : non-portable (GHC extensions) - module FRP.Yampa.EventS ( -- * Basic event sources @@ -269,49 +272,49 @@ -- delayEventCat q | q < 0 = usrErr "AFRP" "delayEventCat" "Negative delay." -- | q == 0 = arr (fmap (:[])) -- | otherwise = SF {sfTF = tf0} --- where --- tf0 NoEvent = (noPendingEvent, NoEvent) --- tf0 (Event x) = (pendingEvents (-q) [] [] (-q) x, NoEvent) +-- where +-- tf0 NoEvent = (noPendingEvent, NoEvent) +-- tf0 (Event x) = (pendingEvents (-q) [] [] (-q) x, NoEvent) -- --- noPendingEvent = SF' tf -- True --- where --- tf _ NoEvent = (noPendingEvent, NoEvent) --- tf _ (Event x) = (pendingEvents (-q) [] [] (-q) x, NoEvent) +-- noPendingEvent = SF' tf -- True +-- where +-- tf _ NoEvent = (noPendingEvent, NoEvent) +-- tf _ (Event x) = (pendingEvents (-q) [] [] (-q) x, NoEvent) -- --- -- t_next is the present time w.r.t. the next scheduled event. --- -- t_last is the present time w.r.t. the last scheduled event. --- -- In the event queues, events are associated with their time --- -- w.r.t. to preceding event (positive). --- pendingEvents t_last rqxs qxs t_next x = SF' tf -- True --- where --- tf dt NoEvent = tf1 (t_last + dt) rqxs (t_next + dt) --- tf dt (Event x') = tf1 (-q) ((q', x') : rqxs) t_next' --- where --- t_next' = t_next + dt --- t_last' = t_last + dt --- q' = t_last' + q +-- -- t_next is the present time w.r.t. the next scheduled event. +-- -- t_last is the present time w.r.t. the last scheduled event. +-- -- In the event queues, events are associated with their time +-- -- w.r.t. to preceding event (positive). +-- pendingEvents t_last rqxs qxs t_next x = SF' tf -- True +-- where +-- tf dt NoEvent = tf1 (t_last + dt) rqxs (t_next + dt) +-- tf dt (Event x') = tf1 (-q) ((q', x') : rqxs) t_next' +-- where +-- t_next' = t_next + dt +-- t_last' = t_last + dt +-- q' = t_last' + q -- --- tf1 t_last' rqxs' t_next' --- | t_next' >= 0 = --- emitEventsScheduleNext t_last' rqxs' qxs t_next' [x] --- | otherwise = --- (pendingEvents t_last' rqxs' qxs t_next' x, NoEvent) +-- tf1 t_last' rqxs' t_next' +-- | t_next' >= 0 = +-- emitEventsScheduleNext t_last' rqxs' qxs t_next' [x] +-- | otherwise = +-- (pendingEvents t_last' rqxs' qxs t_next' x, NoEvent) -- --- -- t_next is the present time w.r.t. the *scheduled* time of the --- -- event that is about to be emitted (i.e. >= 0). --- -- The time associated with any event at the head of the event --- -- queue is also given w.r.t. the event that is about to be emitted. --- -- Thus, t_next - q' is the present time w.r.t. the event at the head --- -- of the event queue. --- emitEventsScheduleNext t_last [] [] t_next rxs = --- (noPendingEvent, Event (reverse rxs)) --- emitEventsScheduleNext t_last rqxs [] t_next rxs = --- emitEventsScheduleNext t_last [] (reverse rqxs) t_next rxs --- emitEventsScheduleNext t_last rqxs ((q', x') : qxs') t_next rxs --- | q' > t_next = (pendingEvents t_last rqxs qxs' (t_next - q') x', --- Event (reverse rxs)) --- | otherwise = emitEventsScheduleNext t_last rqxs qxs' (t_next-q') --- (x' : rxs) +-- -- t_next is the present time w.r.t. the *scheduled* time of the +-- -- event that is about to be emitted (i.e. >= 0). +-- -- The time associated with any event at the head of the event +-- -- queue is also given w.r.t. the event that is about to be emitted. +-- -- Thus, t_next - q' is the present time w.r.t. the event at the head +-- -- of the event queue. +-- emitEventsScheduleNext t_last [] [] t_next rxs = +-- (noPendingEvent, Event (reverse rxs)) +-- emitEventsScheduleNext t_last rqxs [] t_next rxs = +-- emitEventsScheduleNext t_last [] (reverse rqxs) t_next rxs +-- emitEventsScheduleNext t_last rqxs ((q', x') : qxs') t_next rxs +-- | q' > t_next = (pendingEvents t_last rqxs qxs' (t_next - q') x', +-- Event (reverse rxs)) +-- | otherwise = emitEventsScheduleNext t_last rqxs qxs' (t_next-q') +-- (x' : rxs) -- | Delay an event by a given delta and catenate events that occur so closely -- so as to be /inseparable/. @@ -508,8 +511,8 @@ -- | Event source with a single occurrence at or as soon after (local) time --- @t_ev@ as possible. The value of the event is obtained by sampling the input a --- that time. +-- @t_ev@ as possible. The value of the event is obtained by sampling the input +-- a that time. snapAfter :: Time -> SF a (Event a) snapAfter t_ev = switch (never &&& (identity diff --git a/src/FRP/Yampa/Hybrid.hs b/src/FRP/Yampa/Hybrid.hs --- a/src/FRP/Yampa/Hybrid.hs +++ b/src/FRP/Yampa/Hybrid.hs @@ -1,4 +1,4 @@ ------------------------------------------------------------------------------------------ +-------------------------------------------------------------------------------- -- | -- Module : FRP.Yampa.Hybrid -- Copyright : (c) Antony Courtney and Henrik Nilsson, Yale University, 2003 @@ -9,7 +9,7 @@ -- Portability : non-portable (GHC extensions) -- -- Discrete to continuous-time signal functions. ------------------------------------------------------------------------------------------ +-------------------------------------------------------------------------------- module FRP.Yampa.Hybrid ( @@ -107,8 +107,8 @@ trackAndHold :: a -> SF (Maybe a) a trackAndHold a_init = arr (maybe NoEvent Event) >>> hold a_init --- | Tracks input signal when available, holding the last value when the input is 'Nothing', --- with a delay. +-- | Tracks input signal when available, holding the last value when the input +-- is 'Nothing', with a delay. -- -- This behaves similarly to 'hold', but there is a conceptual difference, as -- it takes a signal of input @Maybe a@ (for some @a@) and not @Event@. @@ -133,7 +133,8 @@ accum :: a -> SF (Event (a -> a)) (Event a) accum a_init = epPrim f a_init NoEvent where - f a g = (a', Event a', NoEvent) -- Accumulator, output if Event, output if no event + f a g = (a', Event a', NoEvent) -- Accumulator, output if Event, + -- output if no event where a' = g a diff --git a/src/FRP/Yampa/Integration.hs b/src/FRP/Yampa/Integration.hs --- a/src/FRP/Yampa/Integration.hs +++ b/src/FRP/Yampa/Integration.hs @@ -1,4 +1,4 @@ ------------------------------------------------------------------------------------------ +-------------------------------------------------------------------------------- -- | -- Module : FRP.Yampa.Integration -- Copyright : (c) Antony Courtney and Henrik Nilsson, Yale University, 2003 @@ -25,7 +25,7 @@ -- example with other vector types like V2, V1, etc. from the library linear. -- For an example, see -- . ------------------------------------------------------------------------------------------ +-------------------------------------------------------------------------------- module FRP.Yampa.Integration ( diff --git a/src/FRP/Yampa/InternalCore.hs b/src/FRP/Yampa/InternalCore.hs --- a/src/FRP/Yampa/InternalCore.hs +++ b/src/FRP/Yampa/InternalCore.hs @@ -1,5 +1,7 @@ -{-# LANGUAGE GADTs, Rank2Types, CPP #-} ------------------------------------------------------------------------------------------ +{-# LANGUAGE CPP #-} +{-# LANGUAGE GADTs #-} +{-# LANGUAGE Rank2Types #-} +-------------------------------------------------------------------------------- -- | -- Module : FRP.Yampa -- Copyright : (c) Antony Courtney and Henrik Nilsson, Yale University, 2003 @@ -138,7 +140,7 @@ -- looking for opt. opportunities, whereas a plain "SF'" would -- indicate that things NEVER are going to change, and thus we can just -- as well give up? ------------------------------------------------------------------------------------------ +-------------------------------------------------------------------------------- module FRP.Yampa.InternalCore ( module Control.Arrow, @@ -522,8 +524,11 @@ -- wherever that assumption is exploited. vfyNoEv :: Event a -> b -> b vfyNoEv NoEvent b = b -vfyNoEv _ _ = usrErr "AFRP" "vfyNoEv" "Assertion failed: Functions on events must not map NoEvent to Event." - +vfyNoEv _ _ = + usrErr + "AFRP" + "vfyNoEv" + "Assertion failed: Functions on events must not map NoEvent to Event." ------------------------------------------------------------------------------ @@ -539,7 +544,8 @@ -- | Choice of which SF to run based on the value of a signal. instance ArrowChoice SF where - -- (+++) :: forall b c b' c' . SF b c -> SF d e -> SF (Either b d) (Either c e) + -- (+++) :: forall b c b' c' + -- . SF b c -> SF d e -> SF (Either b d) (Either c e) sfL +++ sfR = SF $ \a -> case a of Left b -> let (sf', c) = sfTF sfL b @@ -751,7 +757,9 @@ (s1', NoEvent, NoEvent) -> ((s1', s2, cne), cne, cne) (s1', Event b, NoEvent) -> let (s2', c, cne') = f2 s2 b in ((s1', s2', cne'), c, cne') - _ -> usrErr "AFRP" "cpXX" "Assertion failed: Functions on events must not map NoEvent to Event." + _ -> usrErr "AFRP" "cpXX" $ + "Assertion failed: Functions on events must not map " + ++ "NoEvent to Event." -- !!! 2005-06-28: Why isn't SFCpAXA (FDC ...) checked for? -- !!! No invariant rules that out, and it would allow to drop the -- !!! event processor ... Does that happen elsewhere? @@ -1121,7 +1129,9 @@ case f1 s a of (s', NoEvent, NoEvent) -> (s', f2ne, f2ne) (s', eb, NoEvent) -> (s', f2 eb, f2ne) - _ -> usrErr "AFRP" "cpXEAux" "Assertion failed: Functions on events must not map NoEvent to Event." + _ -> usrErr "AFRP" "cpXEAux" $ + "Assertion failed: Functions on events must not " + ++ "map NoEvent to Event." cpXEAux fd2 _ _ (SFCpAXA _ fd11 sf12 fd13) = cpAXA fd11 sf12 (fdComp fd13 fd2) cpXEAux fd2 f2 f2ne sf1 = SFCpAXA tf FDI sf1 fd2 diff --git a/src/FRP/Yampa/Loop.hs b/src/FRP/Yampa/Loop.hs --- a/src/FRP/Yampa/Loop.hs +++ b/src/FRP/Yampa/Loop.hs @@ -1,5 +1,7 @@ -{-# LANGUAGE GADTs, Rank2Types, CPP #-} ------------------------------------------------------------------------------------------ +{-# LANGUAGE CPP #-} +{-# LANGUAGE GADTs #-} +{-# LANGUAGE Rank2Types #-} +-------------------------------------------------------------------------------- -- | -- Module : FRP.Yampa.Loop -- Copyright : (c) Antony Courtney and Henrik Nilsson, Yale University, 2003 @@ -11,7 +13,7 @@ -- Portability : non-portable -GHC extensions- -- -- Well-initialised loops ------------------------------------------------------------------------------------------ +-------------------------------------------------------------------------------- module FRP.Yampa.Loop ( -- * Loops with guaranteed well-defined feedback diff --git a/src/FRP/Yampa/Random.hs b/src/FRP/Yampa/Random.hs --- a/src/FRP/Yampa/Random.hs +++ b/src/FRP/Yampa/Random.hs @@ -1,5 +1,7 @@ -{-# LANGUAGE GADTs, Rank2Types, CPP #-} ------------------------------------------------------------------------------------------ +{-# LANGUAGE CPP #-} +{-# LANGUAGE GADTs #-} +{-# LANGUAGE Rank2Types #-} +-------------------------------------------------------------------------------- -- | -- Module : FRP.Yampa.Random -- Copyright : (c) Antony Courtney and Henrik Nilsson, Yale University, 2003 @@ -12,7 +14,7 @@ -- Signals and signal functions with noise and randomness. -- -- The Random number generators are re-exported from "System.Random". ------------------------------------------------------------------------------------------ +-------------------------------------------------------------------------------- module FRP.Yampa.Random ( @@ -103,7 +105,8 @@ occAux [] = undefined occAux (r:rs) = SF' tf -- True where - tf dt _ = let p = 1 - exp (-(dt/t_avg)) -- Probability for at least one event. + tf dt _ = let p = 1 - exp (-(dt/t_avg)) -- Probability for at least one + -- event. in (occAux rs, if r < p then Event x else NoEvent) diff --git a/src/FRP/Yampa/Scan.hs b/src/FRP/Yampa/Scan.hs --- a/src/FRP/Yampa/Scan.hs +++ b/src/FRP/Yampa/Scan.hs @@ -1,4 +1,7 @@ -{-# LANGUAGE GADTs, Rank2Types, CPP #-} +{-# LANGUAGE CPP #-} +{-# LANGUAGE GADTs #-} +{-# LANGUAGE Rank2Types #-} +-- | -- Module : FRP.Yampa.Scan -- Copyright : (c) Antony Courtney and Henrik Nilsson, Yale University, 2003 -- License : BSD-style (see the LICENSE file in the distribution) @@ -6,8 +9,8 @@ -- Maintainer : ivan.perez@keera.co.uk -- Stability : provisional -- Portability : non-portable (GHC extensions) - --- | Simple, stateful signal processing. +-- +-- Simple, stateful signal processing. -- -- Scanning implements elementary, step-based accumulating over signal -- functions by means of an auxiliary function applied to each input and to an diff --git a/src/FRP/Yampa/Simulation.hs b/src/FRP/Yampa/Simulation.hs --- a/src/FRP/Yampa/Simulation.hs +++ b/src/FRP/Yampa/Simulation.hs @@ -1,7 +1,9 @@ -{-# LANGUAGE GADTs, Rank2Types, CPP #-} +{-# LANGUAGE CPP #-} +{-# LANGUAGE GADTs #-} +{-# LANGUAGE MultiWayIf #-} {-# LANGUAGE PatternGuards #-} -{-# LANGUAGE MultiWayIf #-} ------------------------------------------------------------------------------------------ +{-# LANGUAGE Rank2Types #-} +-------------------------------------------------------------------------------- -- | -- Module : FRP.Yampa.Simulation -- Copyright : (c) Antony Courtney and Henrik Nilsson, Yale University, 2003 @@ -34,7 +36,7 @@ -- -- This module also includes debugging aids needed to execute signal functions -- step by step, which are used by Yampa's testing facilities. ------------------------------------------------------------------------------------------ +-------------------------------------------------------------------------------- module FRP.Yampa.Simulation ( -- * Reactimation @@ -43,13 +45,15 @@ -- -> (Bool -> b -> IO Bool) -- -> SF a b -- -> IO () - -- + -- ** Low-level reactimation interface ReactHandle, - reactInit, -- IO a -- init - -- -> (ReactHandle a b -> Bool -> b -> IO Bool) -- actuate - -- -> SF a b - -- -> IO (ReactHandle a b) + reactInit, -- :: IO a -- init + -- -> (ReactHandle a b -> Bool -> b -> IO Bool) + -- -- actuate + -- -> SF a b + -- -> IO (ReactHandle a b) + -- process a single input sample: react, -- ReactHandle a b -- -> (DTime,Maybe a) @@ -113,34 +117,35 @@ -- the reactimation loop and return to its caller. -- sf ......... Signal function to reactimate. --- | Convenience function to run a signal function indefinitely, using --- a IO actions to obtain new input and process the output. +-- | Convenience function to run a signal function indefinitely, using a IO +-- actions to obtain new input and process the output. -- -- This function first runs the initialization action, which provides the -- initial input for the signal transformer at time 0. -- -- Afterwards, an input sensing action is used to obtain new input (if any) and --- the time since the last iteration. The argument to the input sensing function --- indicates if it can block. If no new input is received, it is assumed to be --- the same as in the last iteration. +-- the time since the last iteration. The argument to the input sensing +-- function indicates if it can block. If no new input is received, it is +-- assumed to be the same as in the last iteration. -- --- After applying the signal function to the input, the actuation IO action --- is executed. The first argument indicates if the output has changed, the second +-- After applying the signal function to the input, the actuation IO action is +-- executed. The first argument indicates if the output has changed, the second -- gives the actual output). Actuation functions may choose to ignore the first --- argument altogether. This action should return True if the reactimation --- must stop, and False if it should continue. +-- argument altogether. This action should return True if the reactimation must +-- stop, and False if it should continue. -- -- Note that this becomes the program's /main loop/, which makes using this --- function incompatible with GLUT, Gtk and other graphics libraries. It may also --- impose a sizeable constraint in larger projects in which different subparts run --- at different time steps. If you need to control the main --- loop yourself for these or other reasons, use 'reactInit' and 'react'. +-- function incompatible with GLUT, Gtk and other graphics libraries. It may +-- also impose a sizeable constraint in larger projects in which different +-- subparts run at different time steps. If you need to control the main loop +-- yourself for these or other reasons, use 'reactInit' and 'react'. reactimate :: Monad m - => m a -- ^ Initialization action - -> (Bool -> m (DTime, Maybe a)) -- ^ Input sensing action - -> (Bool -> b -> m Bool) -- ^ Actuation (output processing) action - -> SF a b -- ^ Signal function + => m a -- ^ Initialization action + -> (Bool -> m (DTime, Maybe a)) -- ^ Input sensing action + -> (Bool -> b -> m Bool) -- ^ Actuation (output processing) + -- action + -> SF a b -- ^ Signal function -> m () reactimate init sense actuate (SF {sfTF = tf0}) = do @@ -182,7 +187,10 @@ let (sf,b0) = tf0 a0 -- TODO: really need to fix this interface, since right now we -- just ignore termination at time 0: - r' <- newIORef (ReactState {rsActuate = actuate, rsSF = sf, rsA = a0, rsB = b0 }) + r' <- newIORef (ReactState { rsActuate = actuate, rsSF = sf + , rsA = a0, rsB = b0 + } + ) let r = ReactHandle r' _ <- actuate r True b0 return r @@ -192,7 +200,9 @@ -> (DTime,Maybe a) -> IO Bool react rh (dt,ma') = - do rs@(ReactState {rsActuate = actuate, rsSF = sf, rsA = a, rsB = _b }) <- readIORef (reactHandle rh) + do rs <- readIORef (reactHandle rh) + let ReactState {rsActuate = actuate, rsSF = sf, rsA = a, rsB = _b } = rs + let a' = fromMaybe a ma' (sf',b') = (sfTF' sf) dt a' writeIORef (reactHandle rh) (rs {rsSF = sf',rsA = a',rsB = b'}) @@ -248,8 +258,8 @@ -- | Synchronous embedding. The embedded signal function is run on the supplied --- input and time stream at a given (but variable) ratio >= 0 to the outer --- time flow. When the ratio is 0, the embedded signal function is paused. +-- input and time stream at a given (but variable) ratio >= 0 to the outer time +-- flow. When the ratio is 0, the embedded signal function is paused. -- What about running an embedded signal function at a fixed (guaranteed) -- sampling frequency? E.g. super sampling if the outer sampling is slower, diff --git a/src/FRP/Yampa/Switches.hs b/src/FRP/Yampa/Switches.hs --- a/src/FRP/Yampa/Switches.hs +++ b/src/FRP/Yampa/Switches.hs @@ -1,5 +1,7 @@ -{-# LANGUAGE GADTs, Rank2Types, CPP #-} ------------------------------------------------------------------------------------------ +{-# LANGUAGE CPP #-} +{-# LANGUAGE GADTs #-} +{-# LANGUAGE Rank2Types #-} +-------------------------------------------------------------------------------- -- | -- Module : FRP.Yampa.Switches -- Copyright : (c) Antony Courtney and Henrik Nilsson, Yale University, 2003 @@ -11,8 +13,9 @@ -- -- Switches allow you to change the signal function being applied. -- --- The basic idea of switching is fromed by combining a subordinate signal function --- and a signal function continuation parameterised over some initial data. +-- The basic idea of switching is fromed by combining a subordinate signal +-- function and a signal function continuation parameterised over some initial +-- data. -- -- For example, the most basic switch has the following signature: -- @@ -121,7 +124,8 @@ import Control.Arrow import FRP.Yampa.Diagnostics -import FRP.Yampa.InternalCore (SF(..), SF'(..), sfTF', sfConst, fdFun, FunDesc(..), sfArrG, DTime) +import FRP.Yampa.InternalCore (DTime, FunDesc (..), SF (..), SF' (..), fdFun, + sfArrG, sfConst, sfTF') import FRP.Yampa.Basic import FRP.Yampa.Event @@ -145,7 +149,8 @@ {- -- Basic switch. switch :: SF a (b, Event c) -> (c -> SF a b) -> SF a b -switch (SF {sfTF = tf10} :: SF a (b, Event c)) (k :: c -> SF a b) = SF {sfTF = tf0} +switch (SF {sfTF = tf10} :: SF a (b, Event c)) + (k :: c -> SF a b) = SF {sfTF = tf0} where tf0 a0 = case tf10 a0 of @@ -654,12 +659,13 @@ -- | Spatial parallel composition of a signal function collection parameterized -- on the routing function. -- -par :: Functor col => - (forall sf . (a -> col sf -> col (b, sf))) -- ^ Determines the input to each signal function - -- in the collection. IMPORTANT! The routing function MUST - -- preserve the structure of the signal function collection. - - -> col (SF b c) -- ^ Signal function collection. +par :: Functor col + => (forall sf . (a -> col sf -> col (b, sf))) + -- ^ Determines the input to each signal function + -- in the collection. IMPORTANT! The routing function MUST + -- preserve the structure of the signal function collection. + -> col (SF b c) + -- ^ Signal function collection. -> SF a (col c) par rf sfs0 = SF {sfTF = tf0} where @@ -699,15 +705,18 @@ -- !!! Could be optimized on the event source being SFArr, SFArrE, SFArrEE pSwitch :: Functor col - => (forall sf . (a -> col sf -> col (b, sf))) -- ^ Routing function: determines the input to each signal function - -- in the collection. IMPORTANT! The routing function has an - -- obligation to preserve the structure of the signal function - -- collection. - - -> col (SF b c) -- ^ Signal function collection. - -> SF (a, col c) (Event d) -- ^ Signal function generating the switching event. - -> (col (SF b c) -> d -> SF a (col c)) -- ^ Continuation to be invoked once event occurs. - -> SF a (col c) + => (forall sf . (a -> col sf -> col (b, sf))) + -- ^ Routing function: determines the input to each signal + -- function in the collection. IMPORTANT! The routing function + -- has an obligation to preserve the structure of the signal + -- function collection. + -> col (SF b c) + -- ^ Signal function collection. + -> SF (a, col c) (Event d) + -- ^ Signal function generating the switching event. + -> (col (SF b c) -> d -> SF a (col c)) + -- ^ Continuation to be invoked once event occurs. + -> SF a (col c) pSwitch rf sfs0 sfe0 k = SF {sfTF = tf0} where tf0 a0 = @@ -748,23 +757,27 @@ -- !!! Could be optimized on the event source being SFArr, SFArrE, SFArrEE. -- -dpSwitch :: Functor col => - (forall sf . (a -> col sf -> col (b, sf))) -- ^ Routing function. Its purpose is - -- to pair up each running signal function in the collection - -- maintained by 'dpSwitch' with the input it is going to see - -- at each point in time. All the routing function can do is specify - -- how the input is distributed. - -> col (SF b c) -- ^ Initial collection of signal functions. - -> SF (a, col c) (Event d) -- ^ Signal function that observes the external - -- input signal and the output signals from the collection in order - -- to produce a switching event. - -> (col (SF b c) -> d -> SF a (col c)) -- ^ The fourth argument is a function that is invoked when the - -- switching event occurs, yielding a new signal function to switch - -- into based on the collection of signal functions previously - -- running and the value carried by the switching event. This - -- allows the collection to be updated and then switched back - -- in, typically by employing 'dpSwitch' again. - -> SF a (col c) +dpSwitch :: Functor col + => (forall sf . (a -> col sf -> col (b, sf))) + -- ^ Routing function. Its purpose is to pair up each running + -- signal function in the collection maintained by 'dpSwitch' + -- with the input it is going to see at each point in time. All + -- the routing function can do is specify how the input is + -- distributed. + -> col (SF b c) + -- ^ Initial collection of signal functions. + -> SF (a, col c) (Event d) + -- ^ Signal function that observes the external input signal and + -- the output signals from the collection in order to produce a + -- switching event. + -> (col (SF b c) -> d -> SF a (col c)) + -- ^ The fourth argument is a function that is invoked when the + -- switching event occurs, yielding a new signal function to + -- switch into based on the collection of signal functions + -- previously running and the value carried by the switching + -- event. This allows the collection to be updated and then + -- switched back in, typically by employing 'dpSwitch' again. + -> SF a (col c) dpSwitch rf sfs0 sfe0 k = SF {sfTF = tf0} where tf0 a0 = @@ -806,11 +819,13 @@ -- -- This is the parallel version of 'rSwitch'. rpSwitch :: Functor col - => (forall sf . (a -> col sf -> col (b, sf))) -- ^ Routing function: determines the input to each signal function - -- in the collection. IMPORTANT! The routing function has an - -- obligation to preserve the structure of the signal function - -- collection. - -> col (SF b c) -- ^ Initial signal function collection. + => (forall sf . (a -> col sf -> col (b, sf))) + -- ^ Routing function: determines the input to each signal + -- function in the collection. IMPORTANT! The routing function + -- has an obligation to preserve the structure of the signal + -- function collection. + -> col (SF b c) + -- ^ Initial signal function collection. -> SF (a, Event (col (SF b c) -> col (SF b c))) (col c) rpSwitch rf sfs = pSwitch (rf . fst) sfs (arr (snd . fst)) $ \sfs' f -> @@ -836,11 +851,13 @@ -- -- This is the parallel version of 'drSwitch'. drpSwitch :: Functor col - => (forall sf . (a -> col sf -> col (b, sf))) -- ^ Routing function: determines the input to each signal function - -- in the collection. IMPORTANT! The routing function has an - -- obligation to preserve the structure of the signal function - -- collection. - -> col (SF b c) -- ^ Initial signal function collection. + => (forall sf . (a -> col sf -> col (b, sf))) + -- ^ Routing function: determines the input to each signal + -- function in the collection. IMPORTANT! The routing function + -- has an obligation to preserve the structure of the signal + -- function collection. + -> col (SF b c) + -- ^ Initial signal function collection. -> SF (a, Event (col (SF b c) -> col (SF b c))) (col c) drpSwitch rf sfs = dpSwitch (rf . fst) sfs (arr (snd . fst)) $ \sfs' f -> diff --git a/src/FRP/Yampa/Task.hs b/src/FRP/Yampa/Task.hs --- a/src/FRP/Yampa/Task.hs +++ b/src/FRP/Yampa/Task.hs @@ -1,5 +1,6 @@ -{-# LANGUAGE CPP, Rank2Types #-} ------------------------------------------------------------------------------------------ +{-# LANGUAGE CPP #-} +{-# LANGUAGE Rank2Types #-} +-------------------------------------------------------------------------------- -- | -- Module : FRP.Yampa.Task -- Copyright : (c) Antony Courtney and Henrik Nilsson, Yale University, 2003 @@ -11,7 +12,7 @@ -- -- Task abstraction on top of signal transformers. -- ------------------------------------------------------------------------------------------ +-------------------------------------------------------------------------------- module FRP.Yampa.Task ( Task, diff --git a/src/FRP/Yampa/Time.hs b/src/FRP/Yampa/Time.hs --- a/src/FRP/Yampa/Time.hs +++ b/src/FRP/Yampa/Time.hs @@ -1,4 +1,4 @@ ------------------------------------------------------------------------------------------ +-------------------------------------------------------------------------------- -- | -- Module : FRP.Yampa.Time -- Copyright : (c) Antony Courtney and Henrik Nilsson, Yale University, 2003 @@ -21,7 +21,7 @@ -- produce the value one (@1@). If you really, really, really need to know the -- time delta, and need to abandon the hybrid\/FRP abstraction, see -- 'FRP.Yampa.Integration.iterFrom'. ------------------------------------------------------------------------------------------ +-------------------------------------------------------------------------------- module FRP.Yampa.Time ( localTime, -- :: SF a Time