diff --git a/CHANGELOG b/CHANGELOG --- a/CHANGELOG +++ b/CHANGELOG @@ -1,6 +1,13 @@ +2018-04-05 Ivan Perez + * Yampa.cabal: Version bump (0.11). + * src/: Adds documentation; makes type synonym a newtype. + * tests/: Removes deprecated import. + * .travis.yml: Tests on travis with GHC 7.6 to 8.4. + * Thanks to @ptvirgo, @thalerjonathan, @turion. + 2017-12-17 Ivan Perez - * Yampa.cabal: Version bump (0.10.7), adds flag descriptions, - fixes missing modules. + * Yampa.cabal: Version bump (0.10.7), adds flag to expose core, + adds flag descriptions, fixes missing modules. * README.md: Adds images to descriptions. * doc/: New HCAR including iOS release. * src/: Exposes new function, removes unused extensions, @@ -8,8 +15,8 @@ * stack.yaml: Fixes nix setup. * tests/: Adapts to new API. * examples/: Adapts to new API. - * Thanks to @chriz-keera, @suzumiyasmith, @meimisaki, - @RyanGlScott, @madjestic, @mgttlinger, @eapcochran, + * Thanks to @chriz-keera, @suzumiyasmith, @meimisaki, + @RyanGlScott, @madjestic, @mgttlinger, @eapcochran, @jonmouchou. 2017-08-28 Ivan Perez diff --git a/Yampa.cabal b/Yampa.cabal --- a/Yampa.cabal +++ b/Yampa.cabal @@ -1,5 +1,5 @@ name: Yampa -version: 0.10.7 +version: 0.11 cabal-version: >= 1.8 license: BSD3 license-file: LICENSE @@ -171,7 +171,7 @@ if flag(examples) buildable: True build-depends: base < 5, random, deepseq, SDL, hcwiid, Yampa - else + else buildable: False source-repository head diff --git a/src/FRP/Yampa.hs b/src/FRP/Yampa.hs --- a/src/FRP/Yampa.hs +++ b/src/FRP/Yampa.hs @@ -16,13 +16,15 @@ -- of Functional Reactive Programming (FRP) and is structured using arrow -- combinators. -- --- You can find examples, tutorials and documentation on Yampa here: +-- You can find examples, screenshots, tutorials and documentation here: -- --- +-- -- -- -- +-- -- +-- -- Structuring a hybrid system in Yampa is done based on two main concepts: -- -- * Signal Functions: 'SF'. Yampa is based on the concept of Signal Functions, @@ -42,10 +44,6 @@ -- an input sensing action and an actuation/consumer action and executes -- until explicitly stopped), and 'react' (which executes only one cycle). -- --- This will be the last version of Yampa to include mergeable records, point2 --- and point3, vector2 and vector3, and other auxiliary definitions. The --- internals have now changed. Also, please let us know if you see any problems --- with the new project structure. -- -- Main Yampa modules: -- @@ -118,6 +116,11 @@ -- * "FRP.Yampa.Miscellany" -- -- * "FRP.Yampa.Utilities" +-- +-- This will be the last version of Yampa to include mergeable records, point2 +-- and point3, vector2 and vector3, and other auxiliary definitions. The +-- internals have now changed. Also, please let us know if you see any problems +-- with the new project structure. -- ToDo: -- @@ -275,7 +278,7 @@ edgeJust, -- :: SF (Maybe a) (Event a) edgeBy, -- :: (a -> a -> Maybe b) -> a -> SF a (Event b) maybeToEvent, -- :: Maybe a -> Event a - + -- ** Stateful event suppression notYet, -- :: SF (Event a) (Event a) once, -- :: SF (Event a) (Event a) diff --git a/src/FRP/Yampa/AffineSpace.hs b/src/FRP/Yampa/AffineSpace.hs --- a/src/FRP/Yampa/AffineSpace.hs +++ b/src/FRP/Yampa/AffineSpace.hs @@ -17,10 +17,6 @@ import FRP.Yampa.VectorSpace ------------------------------------------------------------------------------- --- Affine Space type relation ------------------------------------------------------------------------------- - infix 6 .+^, .-^, .-. -- Maybe origin should not be a class method, even though an origin @@ -30,14 +26,26 @@ -- seems closer to the mathematical definition of affine space, provided -- the constraint on the coefficient space for VectorSpace is also Fractional. --- Minimal instance: origin, .+^, .^. +-- | Affine Space type relation. +-- +-- An affine space is a set (type) @p@, and an associated vector space @v@ over +-- a field @a@. class (Floating a, VectorSpace v a) => AffineSpace p v a | p -> v, v -> a where + + -- | Origin of the affine space. origin :: p + + -- | Addition of affine point and vector. (.+^) :: p -> v -> p - (.-^) :: p -> v -> p - (.-.) :: p -> p -> v - distance :: p -> p -> a + -- | Subtraction of affine point and vector. + (.-^) :: p -> v -> p p .-^ v = p .+^ (negateVector v) + -- | Subtraction of two points in the affine space, giving a vector. + (.-.) :: p -> p -> v + + -- | Distance between two points in the affine space, same as the 'norm' of + -- the vector they form (see '(.-.)'. + distance :: p -> p -> a distance p1 p2 = norm (p1 .-. p2) 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 @@ -75,7 +75,7 @@ -- Insert a sample in the output, and from that point on, behave -- like the given sf. (-:>) :: b -> SF a b -> SF a b -b0 -:> (SF {sfTF = tf10}) = SF {sfTF = \a0 -> (ct, b0)} +b0 -:> (SF {sfTF = tf10}) = SF {sfTF = \_a0 -> (ct, b0)} where ct = SF' $ \_dt a0 -> tf10 a0 -- | Input initialization operator. 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,8 +1,7 @@ +-- | Apply SFs only under certain conditions. module FRP.Yampa.Conditional ( - -- Guards and automata-oriented combinators - provided -- :: (a -> Bool) -> SF a b -> SF a b -> SF a b - -- ** Variable delay - , pause -- :: b -> SF a b -> SF a Bool -> SF a b + provided -- :: (a -> Bool) -> SF a b -> SF a b -> SF a b + , pause -- :: b -> SF a b -> SF a Bool -> SF a b ) where @@ -12,12 +11,22 @@ import FRP.Yampa.EventS import FRP.Yampa.Switches ------------------------------------------------------------------------------- --- Guards and automata-oriented combinators ------------------------------------------------------------------------------- +-- * Guards and automata-oriented combinators +-- | Runs a signal function only when a given predicate is satisfied, otherwise +-- runs the other signal function. +-- +-- 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] --- Runs sft only when the predicate p is satisfied, otherwise runs sff. provided :: (a -> Bool) -> SF a b -> SF a b -> SF a b provided p sft sff = switch (constant undefined &&& snap) $ \a0 -> @@ -26,9 +35,7 @@ stt = switch (sft &&& (not . p ^>> edge)) (const stf) stf = switch (sff &&& (p ^>> edge)) (const stt) ------------------------------------------------------------------------------- --- Variable pause in signal ------------------------------------------------------------------------------- +-- * Variable pause -- | Given a value in an accumulator (b), a predicate signal function (sfC), -- and a second signal function (sf), pause will produce the accumulator b diff --git a/src/FRP/Yampa/Core.hs b/src/FRP/Yampa/Core.hs --- a/src/FRP/Yampa/Core.hs +++ b/src/FRP/Yampa/Core.hs @@ -1,3 +1,20 @@ +-- | Minimal FRP core. +-- +-- For documentation purposes only, to serve as a minimal FRP implementation. +-- Based on Antony Courtney's thesis "Modeling User Interfaces in a +-- Functional Language", page 48 +-- (see https://www.antonycourtney.com/pubs/ac-thesis.pdf, page 61). +-- +-- Notes: +-- +-- - While 'time' is defined as "core", it is not a primitive in Yampa, and it +-- is actually defined as the 'integral' of @1@ over time. +-- +-- - This does not include 'derivative'. +-- +-- - This does not include parallel switching combinators (see +-- 'FRP.Yampa.Switches'). +-- module FRP.Yampa.Core ( -- * Signal function @@ -11,13 +28,18 @@ -- * Stateful combinators , loop + -- | Instantly loops an SF, making the second output also the second + -- input, using the fix combinator. This introduces a instant loop; + -- without delays, that may lead to an infinite loop. , integral -- ** Switching upon certain events , Event(..) , switch - -- ** Time (NOTE: integral 1 over time. Not really necessary.) + -- ** Time + -- | Note: The function 'time' is actually the 'integral' of @1@ over time. + -- So, it's not really necessary. , Time , time ) 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 @@ -8,20 +8,21 @@ -- Stability : provisional -- Portability : non-portable (GHC extensions) -- +-- SF primitives and combinators to delay signals, introducing new values in +-- them. +-- ----------------------------------------------------------------------------------------- module FRP.Yampa.Delays ( - -- * Delays - -- ** Basic delays + -- * Basic delays pre, -- :: SF a a iPre, -- :: a -> SF a a + fby, -- :: b -> SF a b -> SF a b, infixr 0 - -- ** Timed delays + -- * Timed delays delay, -- :: Time -> a -> SF a a - -- ** To be completed - fby, -- :: b -> SF a b -> SF a b, infixr 0 ) where import Control.Arrow @@ -39,6 +40,9 @@ ------------------------------------------------------------------------------ -- | Uninitialized delay operator. +-- +-- The output has an infinitesimal delay (1 sample), and the value at time +-- zero is undefined. -- !!! Redefined using SFSScan -- !!! About 20% slower than old_pre on its own. @@ -50,9 +54,23 @@ -- | Initialized delay operator. +-- +-- Creates an SF that delays the input signal, introducing an infinitesimal +-- delay (one sample), using the given argument to fill in the initial output +-- at time zero. + iPre :: a -> SF a a iPre = (--> pre) +-- | Lucid-Synchrone-like initialized delay (read "followed by"). +-- +-- Initialized delay combinator, introducing an infinitesimal delay (one +-- sample) in given 'SF', using the given argument to fill in the initial +-- output at time zero. +-- +-- The difference with 'iPre' is that 'fby' takes an 'SF' as argument. +fby :: b -> SF a b -> SF a b +b0 `fby` sf = b0 --> sf >>> pre ------------------------------------------------------------------------------ -- Timed delays @@ -107,17 +125,6 @@ -- varDelay :: Time -> a -> SF (a, Time) a -- varDelay = undefined - --- if_then_else :: SF a Bool -> SF a b -> SF a b -> SF a b --- if_then_else condSF sfThen sfElse = proc (i) -> do --- cond <- condSF -< i --- ok <- sfThen -< i --- notOk <- sfElse -< i --- returnA -< if cond then ok else notOk - --- | Lucid-Synchrone-like initialized delay (read "followed by"). -fby :: b -> SF a b -> SF a b -b0 `fby` sf = b0 --> sf >>> pre -- Vim modeline 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 @@ -8,14 +8,16 @@ -- Stability : provisional -- Portability : portable -- --- Standardized error-reporting for Yampa +-- Standarized error-reporting for Yampa ----------------------------------------------------------------------------------------- module FRP.Yampa.Diagnostics where +-- | Reports an error due to a violation of Yampa's preconditions/requirements. usrErr :: String -> String -> String -> a usrErr mn fn msg = error (mn ++ "." ++ fn ++ ": " ++ msg) +-- | Reports an error in Yampa's implementation. intErr :: String -> String -> String -> a intErr mn fn msg = error ("[internal error] " ++ mn ++ "." ++ fn ++ ": " ++ msg) 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,3 +1,4 @@ +{-# OPTIONS_GHC -fno-warn-warnings-deprecations #-} ----------------------------------------------------------------------------------------- -- | -- Module : FRP.Yampa.Event @@ -8,20 +9,21 @@ -- Stability : provisional -- Portability : portable -- --- Definition of Yampa Event type. --- --- Yampa Events represent discrete time-signals, meaning those that do not +-- Events in Yampa represent discrete time-signals, meaning those that do not -- change continuously. Examples of event-carrying signals would be mouse -- clicks (in between clicks it is assumed that there is no click), some -- keyboard events, button presses on wiimotes or window-manager events. -- --- 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. No mechanism in Yampa will --- check this or misbehave if this assumption is violated. +-- 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. +-- Nevertheless, no mechanism in Yampa will check this or misbehave if this +-- assumption is violated. -- -- Events are essential for many other Yampa constructs, like switches (see --- @FRP.Yampa.Switches.switch@ for details). +-- 'FRP.Yampa.Switches.switch' for details). -- ---------------------------------------------------------------------------- -- @@ -77,13 +79,6 @@ -- 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. --- --- ToDo: --- - Either: reveal NoEvent and Event --- or: introcuce 'event = Event', call what's now 'event' 'fromEvent', --- and call what's now called 'fromEvent' something else, like --- 'unsafeFromEvent'??? Better, dump it! After all, using current --- names, 'fromEvent = event undefined'! ----------------------------------------------------------------------------------------- module FRP.Yampa.Event where @@ -95,7 +90,6 @@ import Control.Applicative import Control.DeepSeq (NFData(..)) -import Data.Functor import FRP.Yampa.Diagnostics import FRP.Yampa.Forceable 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,14 @@ {-# LANGUAGE GADTs, Rank2Types, CPP #-} ------------------------------------------------------------------------------------------ --- | +-- | 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. +-- +-- For signals that carry events, there should be a limit in the number of +-- 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) @@ -8,10 +16,8 @@ -- Maintainer : ivan.perez@keera.co.uk -- Stability : provisional -- Portability : non-portable (GHC extensions) --- --- ------------------------------------------------------------------------------------------ + module FRP.Yampa.EventS ( -- * Basic event sources @@ -35,38 +41,14 @@ takeEvents, -- :: Int -> SF (Event a) (Event a) dropEvents, -- :: Int -> SF (Event a) (Event a) - -- ** Pointwise functions on events - -- noEvent, -- :: Event a - -- noEventFst, -- :: (Event a, b) -> (Event c, b) - -- noEventSnd, -- :: (a, Event b) -> (a, Event c) - -- event, -- :: a -> (b -> a) -> Event b -> a - -- fromEvent, -- :: Event a -> a - -- isEvent, -- :: Event a -> Bool - -- isNoEvent, -- :: Event a -> Bool - -- tag, -- :: Event a -> b -> Event b, infixl 8 - -- tagWith, -- :: b -> Event a -> Event b, - -- attach, -- :: Event a -> b -> Event (a, b), infixl 8 - -- lMerge, -- :: Event a -> Event a -> Event a, infixl 6 - -- rMerge, -- :: Event a -> Event a -> Event a, infixl 6 - -- merge, -- :: Event a -> Event a -> Event a, infixl 6 - -- mergeBy, -- :: (a -> a -> a) -> Event a -> Event a -> Event a - -- mapMerge, -- :: (a -> c) -> (b -> c) -> (a -> b -> c) - -- -- -> Event a -> Event b -> Event c - -- mergeEvents, -- :: [Event a] -> Event a - -- catEvents, -- :: [Event a] -> Event [a] - -- joinE, -- :: Event a -> Event b -> Event (a,b),infixl 7 - -- splitE, -- :: Event (a,b) -> (Event a, Event b) - -- filterE, -- :: (a -> Bool) -> Event a -> Event a - -- mapFilterE, -- :: (a -> Maybe b) -> Event a -> Event b - -- gate, -- :: Event a -> Bool -> Event a, infixl 8 - -- Event sources - snap, -- :: SF a (Event a) - snapAfter, -- :: Time -> SF a (Event a) - sample, -- :: Time -> SF a (Event a) - recur, -- :: SF a (Event b) -> SF a (Event b) - andThen -- :: SF a (Event b)->SF a (Event b)->SF a (Event b) - + -- * Hybrid SF combinators + snap, -- :: SF a (Event a) + snapAfter, -- :: Time -> SF a (Event a) + sample, -- :: Time -> SF a (Event a) + -- * Repetition and switching + recur, -- :: SF a (Event b) -> SF a (Event b) + andThen -- :: SF a (Event b) -> SF a (Event b) -> SF a (Event b) ) where @@ -81,7 +63,6 @@ import FRP.Yampa.Scan import FRP.Yampa.Switches - infixr 5 `andThen` -- -- The event-processing function *could* accept the present NoEvent @@ -116,30 +97,27 @@ -- (sfEP f c' bne', b) -{- --- !!! Maybe something like this? --- !!! But one problem is that the invarying marking would be lost --- !!! if the signal function is taken apart and re-constructed from --- !!! the function description and subordinate signal function in --- !!! cases like SFCpAXA. -sfMkInv :: SF a b -> SF a b -sfMkInv sf = SF {sfTF = ...} - - sfMkInvAux :: SF' a b -> SF' a b - sfMkInvAux sf@(SFArr _ _) = sf - -- sfMkInvAux sf@(SFAcc _ _ _ _) = sf - sfMkInvAux sf@(SFEP _ _ _ _) = sf - sfMkInvAux sf@(SFCpAXA tf inv fd1 sf2 fd3) - | inv = sf - | otherwise = SFCpAXA tf' True fd1 sf2 fd3 - where - tf' = \dt a -> let (sf', b) = tf dt a in (sfMkInvAux sf', b) - sfMkInvAux sf@(SF' tf inv) - | inv = sf - | otherwise = SF' tf' True - tf' = - --} +-- -- !!! Maybe something like this? +-- -- !!! But one problem is that the invarying marking would be lost +-- -- !!! if the signal function is taken apart and re-constructed from +-- -- !!! the function description and subordinate signal function in +-- -- !!! cases like SFCpAXA. +-- sfMkInv :: SF a b -> SF a b +-- sfMkInv sf = SF {sfTF = ...} +-- +-- sfMkInvAux :: SF' a b -> SF' a b +-- sfMkInvAux sf@(SFArr _ _) = sf +-- -- sfMkInvAux sf@(SFAcc _ _ _ _) = sf +-- sfMkInvAux sf@(SFEP _ _ _ _) = sf +-- sfMkInvAux sf@(SFCpAXA tf inv fd1 sf2 fd3) +-- | inv = sf +-- | otherwise = SFCpAXA tf' True fd1 sf2 fd3 +-- where +-- tf' = \dt a -> let (sf', b) = tf dt a in (sfMkInvAux sf', b) +-- sfMkInvAux sf@(SF' tf inv) +-- | inv = sf +-- | otherwise = SF' tf' True +-- tf' = ------------------------------------------------------------------------------ -- Basic event sources @@ -284,56 +262,54 @@ -- inseparable".) -- The events in the list are ordered temporally to the extent possible. -{- --- This version is too strict! -delayEventCat :: Time -> SF (Event a) (Event [a]) -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) - - 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 - - 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) --} +-- -- This version is too strict! +-- delayEventCat :: Time -> SF (Event a) (Event [a]) +-- 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) +-- +-- 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 +-- +-- 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) -- | Delay an event by a given delta and catenate events that occur so closely -- so as to be /inseparable/. @@ -440,7 +416,6 @@ -- edgeTag a = edgeBy (isBoolRaisingEdge a) True edgeTag a = edge >>> arr (`tag` a) - -- Internal utility. -- isBoolRaisingEdge :: a -> Bool -> Bool -> Maybe a -- isBoolRaisingEdge _ False False = Nothing @@ -448,7 +423,6 @@ -- isBoolRaisingEdge _ True True = Nothing -- isBoolRaisingEdge _ True False = Nothing - -- | Edge detector particularized for detecting transtitions -- on a 'Maybe' signal from 'Nothing' to 'Just'. @@ -463,7 +437,6 @@ isJustEdge (Just _) (Just _) = Nothing isJustEdge (Just _) Nothing = Nothing - -- | Edge detector parameterized on the edge detection function and initial -- state, i.e., the previous input sample. The first argument to the -- edge detection function is the previous sample, the second the current one. @@ -520,16 +493,20 @@ dropEvents n = dSwitch (never &&& identity) (const (NoEvent >-- dropEvents (n - 1))) --- Event source with a single occurrence at time 0. The value of the event --- is obtained by sampling the input at that time. + +-- ** Hybrid continuous-to-discrete SF combinators. + +-- | Event source with a single occurrence at time 0. The value of the event is +-- obtained by sampling the input at that time. + -- (The outer "switch" ensures that the entire signal function will become -- just "constant" once the sample has been taken.) snap :: SF a (Event a) snap = switch (never &&& (identity &&& now () >>^ \(a, e) -> e `tag` a)) now --- 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 +-- | 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. snapAfter :: Time -> SF a (Event a) snapAfter t_ev = switch (never @@ -538,13 +515,15 @@ now --- Sample a signal at regular intervals. +-- | Sample a signal at regular intervals. sample :: Time -> SF a (Event a) sample p_ev = identity &&& repeatedly p_ev () >>^ \(a, e) -> e `tag` a +-- * Repetition and switching --- Makes an event source recurring by restarting it as soon as it has an +-- | Makes an event source recurring by restarting it as soon as it has an -- occurrence. + -- !!! What about event sources that have an instantaneous occurrence? -- !!! E.g. recur (now ()). -- !!! Or worse, what about recur identity? (or substitute identity for @@ -555,6 +534,9 @@ recur :: SF a (Event b) -> SF a (Event b) recur sfe = switch (never &&& sfe) $ \b -> Event b --> (recur (NoEvent-->sfe)) +-- | Apply the first SF until it produces an event, and, afterwards, switch to +-- the second SF. This is just a convenience function, used to write what +-- sometimes is more understandable switch-based code. andThen :: SF a (Event b) -> SF a (Event b) -> SF a (Event b) sfe1 `andThen` sfe2 = dSwitch (sfe1 >>^ dup) (const sfe2) diff --git a/src/FRP/Yampa/Forceable.hs b/src/FRP/Yampa/Forceable.hs --- a/src/FRP/Yampa/Forceable.hs +++ b/src/FRP/Yampa/Forceable.hs @@ -15,63 +15,65 @@ {-# DEPRECATED "Use DeepSeq instead" #-} where +-- | A deep strict evalaution class. class Forceable a where + -- | Evaluate completely. force :: a -> a - +-- | Deep strict evaluation for 'Int'. instance Forceable Int where force = id - +-- | Deep strict evaluation for 'Integer'. instance Forceable Integer where force = id - +-- | Deep strict evaluation for 'Double'. instance Forceable Double where force = id - +-- | Deep strict evaluation for 'Float'. instance Forceable Float where force = id - +-- | Deep strict evaluation for 'Bool'. instance Forceable Bool where force = id - -instance Forceable () where - force = id - - +-- | Deep strict evaluation for 'Char'. instance Forceable Char where force = id +-- | Deep strict evaluation for '()'. +instance Forceable () where + force = id +-- | Deep strict evaluation for pairs. instance (Forceable a, Forceable b) => Forceable (a, b) where force p@(a, b) = force a `seq` force b `seq` p - +-- | Deep strict evaluation for triples. instance (Forceable a, Forceable b, Forceable c) => Forceable (a, b, c) where force p@(a, b, c) = force a `seq` force b `seq` force c `seq` p - +-- | Deep strict evaluation for tuples of four elements. instance (Forceable a, Forceable b, Forceable c, Forceable d) => Forceable (a, b, c, d) where force p@(a, b, c, d) = force a `seq` force b `seq` force c `seq` force d `seq` p - +-- | Deep strict evaluation for tuples of five elements. instance (Forceable a, Forceable b, Forceable c, Forceable d, Forceable e) => Forceable (a, b, c, d, e) where force p@(a, b, c, d, e) = force a `seq` force b `seq` force c `seq` force d `seq` force e `seq` p - +-- | Deep strict evaluation for lists. instance (Forceable a) => Forceable [a] where force nil@[] = nil force xs@(x:xs') = force x `seq` force xs' `seq` xs - +-- | Deep strict evaluation for 'Maybe'. instance (Forceable a) => Forceable (Maybe a) where force mx@Nothing = mx force mx@(Just x) = force x `seq` mx diff --git a/src/FRP/Yampa/Geometry.hs b/src/FRP/Yampa/Geometry.hs --- a/src/FRP/Yampa/Geometry.hs +++ b/src/FRP/Yampa/Geometry.hs @@ -8,7 +8,7 @@ -- Stability : provisional -- Portability : non-portable (GHC extensions) -- --- Basic geometrical abstractions. +-- Basic geometric abstractions. ----------------------------------------------------------------------------------------- module FRP.Yampa.Geometry ( 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 @@ -8,19 +8,18 @@ -- Stability : provisional -- Portability : non-portable (GHC extensions) -- +-- Discrete to continuous-time signal functions. ----------------------------------------------------------------------------------------- module FRP.Yampa.Hybrid ( - --- * Discrete to continuous-time signal functions --- ** Wave-form generation + -- * Wave-form generation hold, -- :: a -> SF (Event a) a dHold, -- :: a -> SF (Event a) a trackAndHold, -- :: a -> SF (Maybe a) a dTrackAndHold, -- :: a -> SF (Maybe a) a --- ** Accumulators + -- * Accumulators accum, -- :: a -> SF (Event (a -> a)) (Event a) accumHold, -- :: a -> SF (Event (a -> a)) a dAccumHold, -- :: a -> SF (Event (a -> a)) a @@ -44,6 +43,14 @@ ------------------------------------------------------------------------------ -- | Zero-order hold. +-- +-- Converts a discrete-time signal into a continuous-time signal, by holding +-- the last value until it changes in the input signal. The given parameter +-- may be used for time zero, and until the first event occurs in the input +-- signal, so hold is always well-initialized. +-- +-- >>> embed (hold 1) (deltaEncode 0.1 [NoEvent, NoEvent, Event 2, NoEvent, Event 3, NoEvent]) +-- [1,1,2,2,3,3] hold :: a -> SF (Event a) a hold a_init = epPrim f () a_init where @@ -66,9 +73,15 @@ -- !!! it might be possible to define dHold simply as hold >>> iPre -- !!! without any performance penalty. --- | Zero-order hold with delay. +-- | Zero-order hold with a delay. -- --- Identity: dHold a0 = hold a0 >>> iPre a0). +-- Converts a discrete-time signal into a continuous-time signal, by holding +-- the last value until it changes in the input signal. The given parameter is +-- used for time zero (until the first event occurs in the input signal), so +-- 'dHold' shifts the discrete input by an infinitesimal delay. +-- +-- >>> embed (dHold 1) (deltaEncode 0.1 [NoEvent, NoEvent, Event 2, NoEvent, Event 3, NoEvent]) +-- [1,1,1,2,2,3] dHold :: a -> SF (Event a) a dHold a0 = hold a0 >>> iPre a0 {- @@ -78,14 +91,30 @@ f a' a = (a, a', a) -} --- | Tracks input signal when available, holds last value when disappears. +-- | Tracks input signal when available, holding the last value when the input +-- is 'Nothing'. -- +-- 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@. +-- +-- >>> embed (trackAndHold 1) (deltaEncode 0.1 [Nothing, Nothing, Just 2, Nothing, Just 3, Nothing]) +-- [1,1,2,2,3,3] + -- !!! DANGER!!! Event used inside arr! Probably OK because arr will not be -- !!! optimized to arrE. But still. Maybe rewrite this using, say, scan? -- !!! or switch? Switching (in hold) for every input sample does not -- !!! seem like such a great idea anyway. 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. +-- +-- 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@. +-- +-- >>> embed (dTrackAndHold 1) (deltaEncode 0.1 [Nothing, Nothing, Just 2, Nothing, Just 3, Nothing]) +-- [1,1,1,2,2,3] dTrackAndHold :: a -> SF (Maybe a) a dTrackAndHold a_init = trackAndHold a_init >>> iPre a_init 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 @@ -8,6 +8,16 @@ -- Stability : provisional -- Portability : non-portable (GHC extensions) -- +-- Integration and derivation of input signals. +-- +-- In continuous time, these primitives define SFs that integrate/derive the +-- input signal. Since this is subject to the sampling resolution, simple +-- versions are implemented (like the rectangle rule for the integral). +-- +-- In discrete time, all we do is count the number of events. +-- +-- The combinator 'iterFrom' gives enough flexibility to program your own +-- leak-free integration and derivation SFs. ----------------------------------------------------------------------------------------- module FRP.Yampa.Integration ( @@ -20,8 +30,6 @@ -- * Differentiation derivative, -- :: VectorSpace a s => SF a a -- Crude! - - -- Temporarily hidden, but will eventually be made public. iterFrom -- :: (a -> a -> DTime -> b -> b) -> b -> SF a b ) where @@ -56,6 +64,9 @@ imIntegral :: VectorSpace a s => a -> SF a a imIntegral = ((\ _ a' dt v -> v ^+^ realToFrac dt *^ a') `iterFrom`) +-- | Integrate using an auxiliary function that takes the current and the last +-- input, the time between those samples, and the last output, and returns a +-- new output. iterFrom :: (a -> a -> DTime -> b -> b) -> b -> SF a b f `iterFrom` b = SF (iterAux b) where @@ -72,9 +83,15 @@ where tf dt a = (derivativeAux a, (a ^-^ a_prev) ^/ realToFrac dt) +-- | Integrate the first input signal and add the /discrete/ accumulation (sum) +-- of the second, discrete, input signal. impulseIntegral :: VectorSpace a k => SF (a, Event a) a impulseIntegral = (integral *** accumHoldBy (^+^) zeroVector) >>^ uncurry (^+^) +-- | Count the occurrences of input events. +-- +-- >>> embed count (deltaEncode 1 [Event 'a', NoEvent, Event 'b']) +-- [Event 1,NoEvent,Event 2] count :: Integral b => SF (Event a) (Event b) count = accumBy (\n _ -> n + 1) 0 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 @@ -163,6 +163,7 @@ -- ** Future Signal Function SF'(..), -- Signal Function. + Transition, sfTF', sfId, sfConst, @@ -171,8 +172,6 @@ -- *** Scanning sfSScan, - Transition, - -- ** Function descriptions FunDesc(..), fdFun, @@ -232,8 +231,12 @@ data SF a b = SF {sfTF :: a -> Transition a b} --- Representation of signal function in "running" state. +-- | Signal function in "running" state. -- +-- It can also be seen as a Future Signal Function, meaning, +-- an SF that, given a time delta or a time in the future, it will +-- be an SF. + -- Possibly better design for Inv. -- Problem: tension between on the one hand making use of the -- invariant property, and on the other keeping track of how something @@ -285,11 +288,12 @@ -- SFPair :: ... SF' :: !(DTime -> a -> Transition a b) -> SF' a b --- A transition is a pair of the next state (in the form of a signal +-- | A transition is a pair of the next state (in the form of a future signal -- function) and the output at the present time step. type Transition a b = (SF' a b, b) +-- | Obtain the function that defines a running SF. sfTF' :: SF' a b -> (DTime -> a -> Transition a b) sfTF' (SFArr tf _) = tf sfTF' (SFSScan tf _ _ _) = tf @@ -316,19 +320,20 @@ -- "Smart" constructors. The corresponding "raw" constructors should not -- be used directly for construction. +-- | Constructor for a lifted structured function. sfArr :: FunDesc a b -> SF' a b sfArr FDI = sfId sfArr (FDC b) = sfConst b sfArr (FDE f fne) = sfArrE f fne sfArr (FDG f) = sfArrG f - +-- | SF constructor for the identity function. sfId :: SF' a a sfId = sf where sf = SFArr (\_ a -> (sf, a)) FDI - +-- | SF constructor for the constant function. sfConst :: b -> SF' a b sfConst b = sf where @@ -344,12 +349,23 @@ sf = SFArr (\_ ea -> (sf, case ea of NoEvent -> fne ; _ -> f ea)) (FDE f fne) +-- | SF constructor for a general function. sfArrG :: (a -> b) -> SF' a b sfArrG f = sf where sf = SFArr (\_ a -> (sf, f a)) (FDG f) +-- | Versatile zero-order hold SF' with folding. +-- +-- This function returns an SF that, if there is an input, runs it +-- through the given function and returns part of its output and, if not, +-- returns the last known output. +-- +-- The auxiliary function returns the value of the current output and +-- the future held output, thus making it possible to have to distinct +-- outputs for the present and the future. + -- epPrim is used to define hold, accum, and other event-processing -- functions. epPrim :: (c -> a -> (c, b, b)) -> c -> b -> SF (Event a) b @@ -367,6 +383,16 @@ -- extra cost for the more common and simple case of non-composed event -- processors. -- + +-- | Constructor for a zero-order hold SF' with folding. +-- +-- This function returns a running SF that, if there is an input, runs it +-- through the given function and returns part of its output and, if not, +-- returns the last known output. +-- +-- The auxiliary function returns the value of the current output and +-- the future held output, thus making it possible to have to distinct +-- outputs for the present and the future. sfEP :: (c -> a -> (c, b, b)) -> c -> b -> SF' (Event a) b sfEP f c bne = sf where @@ -414,23 +440,31 @@ -- 2005-02-30: OK, for FDE, invarant is that the field of type b = -- f NoEvent. +-- | Structured function definition. +-- +-- This type represents functions with a bit more structure, providing +-- specific constructors for the identity, constant and event-based +-- functions, helping optimise arrow combinators for special cases. data FunDesc a b where FDI :: FunDesc a a -- Identity function FDC :: b -> FunDesc a b -- Constant function FDE :: (Event a -> b) -> b -> FunDesc (Event a) b -- Event-processing fun FDG :: (a -> b) -> FunDesc a b -- General function +-- | Turns a function into a structured function. fdFun :: FunDesc a b -> (a -> b) fdFun FDI = id fdFun (FDC b) = const b fdFun (FDE f _) = f fdFun (FDG f) = f +-- | Composition for structured functions. fdComp :: FunDesc a b -> FunDesc b c -> FunDesc a c fdComp FDI fd2 = fd2 fdComp fd1 FDI = fd1 fdComp (FDC b) fd2 = FDC ((fdFun fd2) b) fdComp _ (FDC c) = FDC c + -- Hardly worth the effort? -- 2005-03-30: No, not only not worth the effort as the only thing saved -- would be an application of f2. Also wrong since current invariant does @@ -449,7 +483,7 @@ f1a -> f2 f1a fdComp (FDG f1) fd2 = FDG (fdFun fd2 . f1) - +-- | Parallel application of structured functions. fdPar :: FunDesc a b -> FunDesc c d -> FunDesc (a,c) (b,d) fdPar FDI FDI = FDI fdPar FDI (FDC d) = FDG (\(~(a, _)) -> (a, d)) @@ -459,7 +493,7 @@ fdPar (FDC b) fd2 = FDG (\(~(_, c)) -> (b, (fdFun fd2) c)) fdPar fd1 fd2 = FDG (\(~(a, c)) -> ((fdFun fd1) a, (fdFun fd2) c)) - +-- | Parallel application with broadcasting for structured functions. fdFanOut :: FunDesc a b -> FunDesc a c -> FunDesc a (b,c) fdFanOut FDI FDI = FDG (\a -> (a, a)) fdFanOut FDI (FDC c) = FDG (\a -> (a, c)) @@ -490,12 +524,15 @@ ------------------------------------------------------------------------------ -- Arrow instance and implementation ------------------------------------------------------------------------------ + #if __GLASGOW_HASKELL__ >= 610 +-- | Composition and identity for SFs. instance Control.Category.Category SF where (.) = flip compPrim id = SF $ \x -> (sfId,x) #endif +-- | Choice of which SF to run based on the value of a signal. instance ArrowChoice SF where left sf = SF $ \a -> -- NOTE: there might be a problem with choice here. @@ -515,6 +552,8 @@ Right x -> (futureArrowLeft fSF, Right x) +-- | Signal Functions as Arrows. See "The Yampa Arcade", by Courtney, Nilsson +-- and Peterson. instance Arrow SF where arr = arrPrim first = firstPrim @@ -1485,10 +1524,10 @@ -- * ArrowLoop instance and implementation +-- | Creates a feedback loop without delay. instance ArrowLoop SF where loop = loopPrim - loopPrim :: SF (a,c) (b,c) -> SF a b loopPrim (SF {sfTF = tf10}) = SF {sfTF = tf0} where @@ -1523,7 +1562,13 @@ -} -- * Scanning + +-- | Constructor for a zero-order hold with folding. -- +-- This function returns a running SF that takes an input, runs it through a +-- function and, if there is an output, returns it, otherwise, returns the +-- previous value. Additionally, an accumulator or folded value is kept +-- internally. sfSScan :: (c -> a -> Maybe (c, b)) -> c -> b -> SF' a b sfSScan f c b = sf where diff --git a/src/FRP/Yampa/Internals.hs b/src/FRP/Yampa/Internals.hs --- a/src/FRP/Yampa/Internals.hs +++ b/src/FRP/Yampa/Internals.hs @@ -8,18 +8,17 @@ -- Stability : provisional -- Portability : portable -- --- An interface giving access to some of the internal --- details of the Yampa implementation. +-- An interface giving access to some of the internal details of the Yampa +-- implementation. -- --- This interface is indended to be used when the need arises to break --- abstraction barriers, e.g. for interfacing Yampa to the real world, for --- debugging purposes, or the like. Be aware that the internal details --- may change. Relying on this interface means that your code is not --- insulated against such changes. +-- Legacy, deprecated module. ----------------------------------------------------------------------------------------- -module FRP.Yampa.Internals ( +module FRP.Yampa.Internals +{-# DEPRECATED "Use FRP.Yampa instead" #-} + ( Event(..) -) where + ) + where import FRP.Yampa.Event diff --git a/src/FRP/Yampa/MergeableRecord.hs b/src/FRP/Yampa/MergeableRecord.hs --- a/src/FRP/Yampa/MergeableRecord.hs +++ b/src/FRP/Yampa/MergeableRecord.hs @@ -10,8 +10,6 @@ -- -- Framework for record merging. -- --- Idea: --- -- MergeableRecord is intended to be a super class for classes providing -- update operations on records. The ADT induced by such a set of operations -- can be considered a "mergeable record", which can be merged into larger @@ -60,27 +58,29 @@ mrFinalize ) where +-- | Superclass providing operations on records. Record operations can be +-- merged (composed). To obtain a record from a sequence of merging operations +-- (see 'mrFinalize'), one needs only to provide an initial value, or +-- 'mrDefault'. class MergeableRecord a where mrDefault :: a - --- Type constructor for mergeable records. +-- | Type constructor for mergeable records. newtype MR a = MR (a -> a) - --- Construction of a mergeable record. +-- | Construction of a mergeable record. mrMake :: MergeableRecord a => (a -> a) -> MR a mrMake f = (MR f) - --- Merge two mergeable records. Left "overrides" in case of conflict. +-- | Merge two mergeable records. Left "overrides" in case of conflict. (~+~) :: MergeableRecord a => MR a -> MR a -> MR a (MR f1) ~+~ (MR f2) = MR (f1 . f2) +-- | Merge two mergeable records. Left "overrides" in case of conflict. +-- Synonym for '~+~'. mrMerge :: MergeableRecord a => MR a -> MR a -> MR a mrMerge = (~+~) - --- Finalization: turn a mergeable record into a record. +-- | Finalization: turn a mergeable record into a record. mrFinalize :: MergeableRecord a => MR a -> a mrFinalize (MR f) = f mrDefault diff --git a/src/FRP/Yampa/Miscellany.hs b/src/FRP/Yampa/Miscellany.hs --- a/src/FRP/Yampa/Miscellany.hs +++ b/src/FRP/Yampa/Miscellany.hs @@ -8,34 +8,33 @@ -- Stability : provisional -- Portability : portable -- --- Collection of entities that really should be part --- of the Haskell 98 prelude or simply have no better --- home. +-- Collection of entities that really should be part of Haskell base, other packages, +-- or simply have no better home. -- ----------------------------------------------------------------------------------------- module FRP.Yampa.Miscellany ( --- Reverse function composition + -- * Reverse function composition ( # ), -- :: (a -> b) -> (b -> c) -> (a -> c), infixl 9 --- Arrow plumbing aids + -- * Arrow plumbing aids dup, -- :: a -> (a,a) --- Maps over lists of pairs + -- * Maps over lists of pairs mapFst, -- :: (a -> b) -> [(a,c)] -> [(b,c)] mapSnd, -- :: (a -> b) -> [(c,a)] -> [(c,b)] --- Generalized tuple selectors + -- * Generalized tuple selectors sel3_1, sel3_2, sel3_3, sel4_1, sel4_2, sel4_3, sel4_4, sel5_1, sel5_2, sel5_3, sel5_4, sel5_5, --- Floating point utilities + -- * Floating point utilities fDiv, -- :: (RealFrac a, Integral b) => a -> a -> b fMod, -- :: RealFrac a => a -> a -> a fDivMod, -- :: (RealFrac a, Integral b) => a -> a -> (b, a) --- Liftings + -- * Liftings arr2, -- :: Arrow a => (b->c->d) -> a (b,c) d arr3, -- :: Arrow a => (b->c->d->e) -> a (b,c,d) e arr4, -- :: Arrow a => (b->c->d->e->f) -> a (b,c,d,e) f @@ -53,10 +52,7 @@ infixl 9 # infixl 7 `fDiv`, `fMod` - ------------------------------------------------------------------------------- --- Reverse function composition ------------------------------------------------------------------------------- +-- | Reverse function composition -- !!! Reverse function composition should go. -- !!! Better to use <<< and >>> for, respectively, @@ -69,8 +65,8 @@ ------------------------------------------------------------------------------ -- Arrow plumbing aids ------------------------------------------------------------------------------- +-- | Duplicate an input. dup :: a -> (a,a) dup x = (x,x) @@ -78,10 +74,12 @@ -- Maps over lists of pairs ------------------------------------------------------------------------------ +-- | Map a function over the first component of pairs in a list. {-# DEPRECATED mapFst "mapFst is not used by Yampa and will be removed from the next release" #-} mapFst :: (a -> b) -> [(a,c)] -> [(b,c)] mapFst f = map (\(x,y) -> (f x, y)) +-- | Map a function over the second component of pairs in a list. {-# DEPRECATED mapSnd "mapSnd is not used by Yampa and will be removed from the next release" #-} mapSnd :: (a -> b) -> [(c,a)] -> [(c,b)] mapSnd f = map (\(x,y) -> (x, f y)) @@ -93,22 +91,32 @@ {-# DEPRECATED sel3_1, sel3_2, sel3_3 "Use the tuple package instead." #-} -- Triples + +-- | Select the first component of a triple. sel3_1 :: (a, b, c) -> a sel3_1 (x,_,_) = x + +-- | Select the second component of a triple. sel3_2 :: (a, b, c) -> b sel3_2 (_,x,_) = x + +-- | Select the third component of a triple. sel3_3 :: (a, b, c) -> c sel3_3 (_,_,x) = x {-# DEPRECATED sel4_1, sel4_2, sel4_3, sel4_4 "Use the tuple package instead." #-} -- 4-tuples +-- | Select the first component of a 4-element tuple. sel4_1 :: (a, b, c, d) -> a sel4_1 (x,_,_,_) = x +-- | Select the second component of a 4-element tuple. sel4_2 :: (a, b, c, d) -> b sel4_2 (_,x,_,_) = x +-- | Select the third component of a 4-element tuple. sel4_3 :: (a, b, c, d) -> c sel4_3 (_,_,x,_) = x +-- | Select the fourth component of a 4-element tuple. sel4_4 :: (a, b, c, d) -> d sel4_4 (_,_,_,x) = x @@ -116,14 +124,19 @@ -- 5-tuples {-# DEPRECATED sel5_1, sel5_2, sel5_3, sel5_4, sel5_5 "Use the tuple package instead." #-} +-- | Select the first component of a 5-element tuple. sel5_1 :: (a, b, c, d, e) -> a sel5_1 (x,_,_,_,_) = x +-- | Select the second component of a 5-element tuple. sel5_2 :: (a, b, c, d, e) -> b sel5_2 (_,x,_,_,_) = x +-- | Select the third component of a 5-element tuple. sel5_3 :: (a, b, c, d, e) -> c sel5_3 (_,_,x,_,_) = x +-- | Select the fourth component of a 5-element tuple. sel5_4 :: (a, b, c, d, e) -> d sel5_4 (_,_,_,x,_) = x +-- | Select the fifth component of a 5-element tuple. sel5_5 :: (a, b, c, d, e) -> e sel5_5 (_,_,_,_,x) = x @@ -135,14 +148,15 @@ -- Floating-point div and modulo operators. {-# DEPRECATED fDiv, fMod, fDivMod "These are not used by Yampa and will be removed." #-} +-- | Floating-point integer division. fDiv :: (RealFrac a) => a -> a -> Integer fDiv x y = fst (fDivMod x y) - +-- | Floating-point modulo. fMod :: (RealFrac a) => a -> a -> a fMod x y = snd (fDivMod x y) - +-- | Floating-point integer division and modulo. fDivMod :: (RealFrac a) => a -> a -> (Integer, a) fDivMod x y = (q, r) where @@ -150,46 +164,48 @@ r = x - fromIntegral q * y -- * Arrows ------------------------------------------------------------------------------- --- Liftings ------------------------------------------------------------------------------- +-- ** Liftings + +-- | Lift a binary function onto an arrow arr2 :: Arrow a => (b -> c -> d) -> a (b, c) d arr2 = arr . uncurry - +-- | Lift a 3-ary function onto an arrow arr3 :: Arrow a => (b -> c -> d -> e) -> a (b, c, d) e arr3 = arr . \h (b, c, d) -> h b c d - +-- | Lift a 4-ary function onto an arrow arr4 :: Arrow a => (b -> c -> d -> e -> f) -> a (b, c, d, e) f arr4 = arr . \h (b, c, d, e) -> h b c d e - +-- | Lift a 5-ary function onto an arrow arr5 :: Arrow a => (b -> c -> d -> e -> f -> g) -> a (b, c, d, e, f) g arr5 = arr . \h (b, c, d, e, f) -> h b c d e f - +-- | Lift an 0-ary function onto an arrow +-- +-- If there was an @arr0@ function, this would be a synonym. lift0 :: Arrow a => c -> a b c -lift0 c = arr (const c) - +lift0 c = arr (const c) +-- | Lift a function into a function between arrows. lift1 :: Arrow a => (c -> d) -> (a b c -> a b d) lift1 f = \a -> a >>> arr f - +-- | Lift a binary function into a function between arrows. lift2 :: Arrow a => (c -> d -> e) -> (a b c -> a b d -> a b e) lift2 f = \a1 a2 -> a1 &&& a2 >>> arr2 f - +-- | Lift a 3-ary function into a function between arrows. lift3 :: Arrow a => (c -> d -> e -> f) -> (a b c -> a b d -> a b e -> a b f) lift3 f = \a1 a2 a3 -> (lift2 f) a1 a2 &&& a3 >>> arr2 ($) - +-- | Lift a 4-ary function into a function between arrows. lift4 :: Arrow a => (c->d->e->f->g) -> (a b c->a b d->a b e->a b f->a b g) lift4 f = \a1 a2 a3 a4 -> (lift3 f) a1 a2 a3 &&& a4 >>> arr2 ($) - +-- | Lift a 5-ary function into a function between arrows. lift5 :: Arrow a => (c->d->e->f->g->h) -> (a b c->a b d->a b e->a b f->a b g->a b h) lift5 f = \a1 a2 a3 a4 a5 ->(lift4 f) a1 a2 a3 a4 &&& a5 >>> arr2 ($) diff --git a/src/FRP/Yampa/Point2.hs b/src/FRP/Yampa/Point2.hs --- a/src/FRP/Yampa/Point2.hs +++ b/src/FRP/Yampa/Point2.hs @@ -1,3 +1,4 @@ +{-# OPTIONS_GHC -fno-warn-warnings-deprecations #-} {-# LANGUAGE ExistentialQuantification, MultiParamTypeClasses, FlexibleInstances, StandaloneDeriving #-} ----------------------------------------------------------------------------------------- -- | @@ -14,9 +15,6 @@ ----------------------------------------------------------------------------------------- module FRP.Yampa.Point2 ( - -- module AFRPVectorSpace, - -- module AFRPAffineSpace, - -- module AFRPVector2, Point2(..), -- Non-abstract, instance of AffineSpace point2X, -- :: RealFloat a => Point2 a -> a point2Y -- :: RealFloat a => Point2 a -> a @@ -27,26 +25,24 @@ import FRP.Yampa.Vector2 import FRP.Yampa.Forceable ------------------------------------------------------------------------------- --- 2D point, constructors and selectors. ------------------------------------------------------------------------------- +-- * 2D point, constructors and selectors +-- | 2D point. data Point2 a = RealFloat a => Point2 !a !a deriving instance Eq a => Eq (Point2 a) deriving instance Show a => Show (Point2 a) +-- | X coordinate of a 2D point. point2X :: RealFloat a => Point2 a -> a point2X (Point2 x _) = x +-- | Y coordinate of a 2D point. point2Y :: RealFloat a => Point2 a -> a point2Y (Point2 _ y) = y - ------------------------------------------------------------------------------- --- Affine space instance ------------------------------------------------------------------------------- +-- * Affine space instance instance RealFloat a => AffineSpace (Point2 a) (Vector2 a) a where origin = Point2 0 0 @@ -57,10 +53,7 @@ (Point2 x1 y1) .-. (Point2 x2 y2) = vector2 (x1 - x2) (y1 - y2) - ------------------------------------------------------------------------------- --- Forceable instance ------------------------------------------------------------------------------- +-- * Forceable instance instance RealFloat a => Forceable (Point2 a) where force = id diff --git a/src/FRP/Yampa/Point3.hs b/src/FRP/Yampa/Point3.hs --- a/src/FRP/Yampa/Point3.hs +++ b/src/FRP/Yampa/Point3.hs @@ -1,3 +1,4 @@ +{-# OPTIONS_GHC -fno-warn-warnings-deprecations #-} {-# LANGUAGE ExistentialQuantification, MultiParamTypeClasses, FlexibleInstances, StandaloneDeriving #-} ----------------------------------------------------------------------------------------- -- | @@ -14,9 +15,6 @@ ----------------------------------------------------------------------------------------- module FRP.Yampa.Point3 ( - -- module AFRPVectorSpace, - -- module AFRPAffineSpace, - -- module AFRPVector3, Point3(..), -- Non-abstract, instance of AffineSpace point3X, -- :: RealFloat a => Point3 a -> a point3Y, -- :: RealFloat a => Point3 a -> a @@ -28,29 +26,28 @@ import FRP.Yampa.Vector3 import FRP.Yampa.Forceable ------------------------------------------------------------------------------- --- 3D point, constructors and selectors. ------------------------------------------------------------------------------- +-- * 3D point, constructors and selectors +-- | 3D point. data Point3 a = RealFloat a => Point3 !a !a !a deriving instance Eq a => Eq (Point3 a) deriving instance Show a => Show (Point3 a) +-- | X coodinate of a 3D point. point3X :: RealFloat a => Point3 a -> a point3X (Point3 x _ _) = x +-- | Y coodinate of a 3D point. point3Y :: RealFloat a => Point3 a -> a point3Y (Point3 _ y _) = y +-- | Z coodinate of a 3D point. point3Z :: RealFloat a => Point3 a -> a point3Z (Point3 _ _ z) = z - ------------------------------------------------------------------------------- --- Affine space instance ------------------------------------------------------------------------------- +-- * Affine space instance instance RealFloat a => AffineSpace (Point3 a) (Vector3 a) a where origin = Point3 0 0 0 @@ -64,10 +61,7 @@ (Point3 x1 y1 z1) .-. (Point3 x2 y2 z2) = vector3 (x1 - x2) (y1 - y2) (z1 - z2) - ------------------------------------------------------------------------------- --- Forceable instance ------------------------------------------------------------------------------- +-- * Forceable instance instance RealFloat a => Forceable (Point3 a) where force = id 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 @@ -9,13 +9,18 @@ -- Stability : provisional -- Portability : non-portable (GHC extensions) -- +-- Signals and signal functions with noise and randomness. +-- +-- The Random number generators are re-exported from "System.Random". ----------------------------------------------------------------------------------------- module FRP.Yampa.Random ( + + -- * Random number generators RandomGen(..), Random(..), --- * Noise (random signal) sources and stochastic event sources + -- * Noise, random signals, and stochastic event sources noise, -- :: noise :: (RandomGen g, Random b) => -- g -> SF a b noiseR, -- :: noise :: (RandomGen g, Random b) => 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,6 +1,4 @@ {-# LANGUAGE GADTs, Rank2Types, CPP #-} ------------------------------------------------------------------------------------------ --- | -- Module : FRP.Yampa.Scan -- Copyright : (c) Antony Courtney and Henrik Nilsson, Yale University, 2003 -- License : BSD-style (see the LICENSE file in the distribution) @@ -8,29 +6,41 @@ -- Maintainer : ivan.perez@keera.co.uk -- Stability : provisional -- Portability : non-portable (GHC extensions) ------------------------------------------------------------------------------------------ +-- | 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 +-- accumulator. For comparison with other FRP libraries and with stream +-- processing abstractions, think of fold. + module FRP.Yampa.Scan ( --- ** Simple, stateful signal processing sscan, -- :: (b -> a -> b) -> b -> SF a b sscanPrim, -- :: (c -> a -> Maybe (c, b)) -> c -> b -> SF a b ) where import FRP.Yampa.InternalCore (SF(..), sfSScan) ------------------------------------------------------------------------------- --- Simple, stateful signal processing ------------------------------------------------------------------------------- +-- ** Simple, stateful signal processing +-- | Applies a function point-wise, using the last output as next input. This +-- creates a well-formed loop based on a pure, auxiliary function. + -- New sscan primitive. It should be possible to define lots of functions -- in terms of this one. Eventually a new constructor will be introduced if -- this works out. - sscan :: (b -> a -> b) -> b -> SF a b sscan f b_init = sscanPrim f' b_init b_init where f' b a = let b' = f b a in Just (b', b') +-- | Generic version of 'sscan', in which the auxiliary function produces +-- an internal accumulator and an "held" output. +-- +-- Applies a function point-wise, using the last known 'Just' output to form +-- the output, and next input accumulator. If the output is 'Nothing', the last +-- known accumulators are used. This creates a well-formed loop based on a +-- pure, auxiliary function. sscanPrim :: (c -> a -> Maybe (c, b)) -> c -> b -> SF a b sscanPrim f c_init b_init = SF {sfTF = tf0} where 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 @@ -9,16 +9,36 @@ -- Stability : provisional -- Portability : non-portable (GHC extensions) -- +-- Execution/simulation of signal functions. +-- +-- SFs can be executed in two ways: by running them, feeding input samples one +-- by one, obtained from a monadic environment (presumably, |IO|), or by +-- passing an input stream and calculating an output stream. The former is +-- called /reactimation/, and the latter is called /embedding/. +-- +-- Normally, to run an SF, you would use 'reactimate', providing input samples, +-- and consuming the putput samples in the 'IO' monad. This function takes over +-- the program, implementing a "main loop". If you want more control over the +-- evaluation loop (for instance, if you are using Yampa in combination with a +-- backend that also implements some main loop), you may want to use the +-- lower-level API for reactimation ('ReactHandle', 'reactInit', 'react'). +-- +-- You can use 'embed' for testing, to evaluate SFs in a terminal, and to embed +-- an SF inside a larger system. The helper functions 'deltaEncode' and +-- 'deltaEncodeBy' facilitate producing input /signals/ from plain lists of +-- input samples. +-- ----------------------------------------------------------------------------------------- module FRP.Yampa.Simulation ( --- * Execution/simulation --- ** Reactimation + -- * Reactimation reactimate, -- :: IO a -- -> (Bool -> IO (DTime, Maybe a)) -- -> (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 @@ -29,8 +49,7 @@ -- -> (DTime,Maybe a) -- -> IO Bool --- ** Embedding - -- (tentative: will be revisited) + -- * Embedding embed, -- :: SF a b -> (a, [(DTime, Maybe a)]) -> [b] embedSynch, -- :: SF a b -> (a, [(DTime, Maybe a)]) -> SF Double b deltaEncode, -- :: Eq a => DTime -> [a] -> (a, [(DTime, Maybe a)]) @@ -136,7 +155,8 @@ } -- | A reference to reactimate's state, maintained across samples. -type ReactHandle a b = IORef (ReactState a b) +newtype ReactHandle a b = ReactHandle + { reactHandle :: IORef (ReactState a b) } -- | Initialize a top-level reaction handle. reactInit :: IO a -- init @@ -148,7 +168,8 @@ 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 @@ -157,10 +178,10 @@ -> (DTime,Maybe a) -> IO Bool react rh (dt,ma') = - do rs@(ReactState {rsActuate = actuate, rsSF = sf, rsA = a, rsB = _b }) <- readIORef rh + do rs@(ReactState {rsActuate = actuate, rsSF = sf, rsA = a, rsB = _b }) <- readIORef (reactHandle rh) let a' = fromMaybe a ma' (sf',b') = (sfTF' sf) dt a' - writeIORef rh (rs {rsSF = sf',rsA = a',rsB = b'}) + writeIORef (reactHandle rh) (rs {rsSF = sf',rsA = a',rsB = b'}) done <- actuate rh True b' return done 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 @@ -23,17 +23,48 @@ -- switch, and a signal function that starts with the residual data left by the -- first SF in the event and continues onwards. -- --- Note that switching occurs, at most, once. If you want something to switch --- repeatedly, you need to loop. However, some switches are immediate (meaning --- that the second SF is started at the time of switching). If you use the same --- SF that originally provoked the switch, you are very likely to fall into an --- infinite loop. +-- Switching occurs, at most, once. If you want something to switch repeatedly, +-- in general, you need to loop, or to switch onto the same signal function +-- again. However, some switches, explained below, are immediate (meaning that +-- the second SF is started at the time of switching). If you use the same SF +-- that originally provoked the switch, you are very likely to fall into an +-- infinite loop. In those cases, the use of 'dSwitch' or '-->' may help. +-- +-- Switches vary depending on a number of criterions: +-- +-- - /Decoupled/ vs normal switching /(d)/: when an SF is being applied and a +-- different SF needs to be applied next, one question is which one is used +-- for the time in which the switching takes place. In decoupled switching, the +-- old SF is used for the time of switching, and the one SF is only used after +-- that. In normal or instantaneous or coupled switching, the old SF is +-- discarded immediately and a new SF is used for the output already from that +-- point in time. +-- +-- - How the switching event is provided /( \/r\/k)/: normally, an 'Event' is +-- used to indicate that a switching must take place. This event can be part of +-- the argument SF (e.g., 'switch'), it can be part of the input (e.g., +-- 'rSwitch'), or it can be determined by a second argument SF (e.g, +-- 'kSwitch'). +-- +-- - How many SFs are being handled /( \/p\/par)/: some combinators deal with +-- only one SF, others handle collections, either in the form of a +--'Functor' or a list ('[]'). +-- +-- - How the input is router /(B\/Z\/ )/: when multiple SFs are being combined, +-- a decision needs to be made about how the input is passed ot the internal +-- SFs. In some cases, broadcasting is used to pass the same input to all +-- internal SFs. In others, the input is itself a collection, and each element +-- is passed to one internal SF (i.e., /zipping/). In others, an auxiliary +-- function is used to decide how to route specific inputs to specific SFs in +-- the collection. +-- +-- These gives a number of different combinations, some of which make no sense, +-- and also helps determine the expected behaviour of a combinator by looking +-- at its name. For example, 'drpSwitchB' is the decoupled (/d/), recurrent +-- (/r/), parallel (/p/) switch with broadcasting (/B/). module FRP.Yampa.Switches ( - -- Re-exported module, classes, and types - - -- * Switching - -- ** Basic switchers + -- * Basic switching switch, dSwitch, -- :: SF a (b, Event c) -> (c -> SF a b) -> SF a b rSwitch, drSwitch, -- :: SF a b -> SF (a,Event (SF a b)) b kSwitch, dkSwitch, -- :: SF a b @@ -41,8 +72,8 @@ -- -> (SF a b -> c -> SF a b) -- -> SF a b - -- ** Parallel composition and switching - -- *** Parallel composition and switching over collections with broadcasting + -- * Parallel composition\/switching (collections) + -- ** With broadcasting parB, -- :: Functor col => col (SF a b) -> SF a (col b) pSwitchB,dpSwitchB, -- :: Functor col => -- col (SF a b) @@ -54,7 +85,7 @@ -- -> SF (a, Event (col (SF a b)->col (SF a b))) -- (col b) - -- *** Parallel composition and switching over collections with general routing + -- ** With helper routing function par, -- Functor col => -- (forall sf . (a -> col sf -> col (b, sf))) -- -> col (SF b c) @@ -71,7 +102,9 @@ -- -> SF (a, Event (col (SF b c) -> col (SF b c))) -- (col c) -- - -- Parallel composition/switchers with "zip" routing + -- * Parallel composition\/switching (lists) + -- + -- ** With "zip" routing parZ, -- [SF a b] -> SF [a] [b] pSwitchZ, -- [SF a b] -> SF ([a],[b]) (Event c) -- -> ([SF a b] -> c -> SF [a] [b]) -> SF [a] [b] @@ -80,7 +113,7 @@ rpSwitchZ, -- [SF a b] -> SF ([a], Event ([SF a b]->[SF a b])) [b] drpSwitchZ, -- [SF a b] -> SF ([a], Event ([SF a b]->[SF a b])) [b] - -- Application of an SF to a collections + -- ** With replication parC, -- SF a b -> SF [a] [b] ) where @@ -94,7 +127,7 @@ import FRP.Yampa.Event ------------------------------------------------------------------------------ --- Basic switchers +-- Basic switches ------------------------------------------------------------------------------ -- !!! Interesting case. It seems we need scoped type variables @@ -149,21 +182,17 @@ -- | Basic switch. -- --- By default, the first signal function is applied. --- --- Whenever the second value in the pair actually is an event, --- the value carried by the event is used to obtain a new signal --- function to be applied *at that time and at future times*. --- --- Until that happens, the first value in the pair is produced --- in the output signal. +-- By default, the first signal function is applied. Whenever the second value +-- in the pair actually is an event, the value carried by the event is used to +-- obtain a new signal function to be applied *at that time and at future +-- times*. Until that happens, the first value in the pair is produced in the +-- output signal. -- --- Important note: at the time of switching, the second --- signal function is applied immediately. If that second --- SF can also switch at time zero, then a double (nested) --- switch might take place. If the second SF refers to the --- first one, the switch might take place infinitely many --- times and never be resolved. +-- Important note: at the time of switching, the second signal function is +-- applied immediately. If that second SF can also switch at time zero, then a +-- double (nested) switch might take place. If the second SF refers to the +-- first one, the switch might take place infinitely many times and never be +-- resolved. -- -- Remember: The continuation is evaluated strictly at the time -- of switching! @@ -314,6 +343,9 @@ -- | Recurring switch. -- +-- Uses the given SF until an event comes in the input, in which case the SF in +-- the event is turned on, until the next event comes in the input, and so on. +-- -- See for more -- information on how this switch works. @@ -338,6 +370,11 @@ -- | Recurring switch with delayed observation. -- +-- Uses the given SF until an event comes in the input, in which case the SF in +-- the event is turned on, until the next event comes in the input, and so on. +-- +-- Uses decoupled switch ('dSwitch'). +-- -- See for more -- information on how this switch works. drSwitch :: SF a b -> SF (a, Event (SF a b)) b @@ -352,8 +389,12 @@ -} --- | "Call-with-current-continuation" switch. +-- | Call-with-current-continuation switch. -- +-- Applies the first SF until the input signal and the output signal, when +-- passed to the second SF, produce an event, in which case the original SF and +-- the event are used to build an new SF to switch into. +-- -- See for more -- information on how this switch works. @@ -473,6 +514,12 @@ -- | 'kSwitch' with delayed observation. -- +-- Applies the first SF until the input signal and the output signal, when +-- passed to the second SF, produce an event, in which case the original SF and +-- the event are used to build an new SF to switch into. +-- +-- The switch is decoupled ('dSwitch'). +-- -- See for more -- information on how this switch works. @@ -535,7 +582,7 @@ -- | Spatial parallel composition of a signal function collection. -- Given a collection of signal functions, it returns a signal --- function that 'broadcast's its input signal to every element +-- function that broadcasts its input signal to every element -- of the collection, to return a signal carrying a collection -- of outputs. See 'par'. -- @@ -545,7 +592,7 @@ parB = par broadcast -- | Parallel switch (dynamic collection of signal functions spatially composed --- in parallel). See 'pSwitch'. +-- in parallel) with broadcasting. See 'pSwitch'. -- -- For more information on how parallel composition works, check -- @@ -554,7 +601,7 @@ -> SF a (col b) pSwitchB = pSwitch broadcast --- | Delayed parallel switch with broadcasting (dynamic collection of +-- | Decoupled parallel switch with broadcasting (dynamic collection of -- signal functions spatially composed in parallel). See 'dpSwitch'. -- -- For more information on how parallel composition works, check @@ -564,19 +611,42 @@ -> SF a (col b) dpSwitchB = dpSwitch broadcast +-- | Recurring parallel switch with broadcasting. +-- +-- Uses the given collection of SFs, until an event comes in the input, in +-- which case the function in the 'Event' is used to transform the collections +-- of SF to be used with 'rpSwitch' again, until the next event comes in the +-- input, and so on. +-- +-- Broadcasting is used to decide which subpart of the input goes to each SF in +-- the collection. +-- +-- See 'rpSwitch'. +-- -- For more information on how parallel composition works, check -- rpSwitchB :: Functor col => col (SF a b) -> SF (a, Event (col (SF a b) -> col (SF a b))) (col b) rpSwitchB = rpSwitch broadcast +-- | Decoupled recurring parallel switch with broadcasting. +-- +-- Uses the given collection of SFs, until an event comes in the input, in +-- which case the function in the 'Event' is used to transform the collections +-- of SF to be used with 'rpSwitch' again, until the next event comes in the +-- input, and so on. +-- +-- Broadcasting is used to decide which subpart of the input goes to each SF in +-- the collection. +-- +-- This is the decoupled version of 'rpSwitchB'. +-- -- For more information on how parallel composition works, check -- drpSwitchB :: Functor col => col (SF a b) -> SF (a, Event (col (SF a b) -> col (SF a b))) (col b) drpSwitchB = drpSwitch broadcast - ------------------------------------------------------------------------------ -- Parallel composition and switching over collections with general routing ------------------------------------------------------------------------------ @@ -627,15 +697,6 @@ -- event value. -- --- rf ......... 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. --- sfs0 ....... Signal function collection. --- sfe0 ....... Signal function generating the switching event. --- k .......... Continuation to be invoked once event occurs. --- Returns the resulting signal function. --- -- !!! 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 @@ -733,22 +794,28 @@ cs) --- Recurring parallel switch parameterized on the routing function. --- rf ......... 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. --- sfs ........ Initial signal function collection. --- Returns the resulting signal function. - -rpSwitch :: Functor col => - (forall sf . (a -> col sf -> col (b, sf))) - -> col (SF b c) -> SF (a, Event (col (SF b c) -> col (SF b c))) (col c) +-- | Recurring parallel switch parameterized on the routing function. +-- +-- Uses the given collection of SFs, until an event comes in the input, in +-- which case the function in the 'Event' is used to transform the collections +-- of SF to be used with 'rpSwitch' again, until the next event comes in the +-- input, and so on. +-- +-- The routing function is used to decide which subpart of the input +-- goes to each SF in the collection. +-- +-- 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. + -> 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 -> noEventSnd >=- rpSwitch rf (f sfs') - {- rpSwitch rf sfs = pSwitch (rf . fst) sfs (arr (snd . fst)) k where @@ -756,11 +823,25 @@ rpSwitch' sfs = pSwitch (rf . fst) sfs (NoEvent --> arr (snd . fst)) k -} --- Recurring parallel switch with delayed observation parameterized on the +-- | Recurring parallel switch with delayed observation parameterized on the -- routing function. -drpSwitch :: Functor col => - (forall sf . (a -> col sf -> col (b, sf))) - -> col (SF b c) -> SF (a, Event (col (SF b c) -> col (SF b c))) (col c) +-- +-- Uses the given collection of SFs, until an event comes in the input, in +-- which case the function in the 'Event' is used to transform the collections +-- of SF to be used with 'rpSwitch' again, until the next event comes in the +-- input, and so on. +-- +-- The routing function is used to decide which subpart of the input +-- goes to each SF in the collection. +-- +-- 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. + -> 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 -> noEventSnd >=- drpSwitch rf (f sfs') @@ -776,25 +857,74 @@ -- * Parallel composition/switchers with "zip" routing ------------------------------------------------------------------------------ +-- | Parallel composition of a list of SFs. +-- +-- Given a list of SFs, returns an SF that takes a list of inputs, applies +-- each SF to each input in order, and returns the SFs' outputs. +-- +-- >>> embed (parZ [arr (+1), arr (+2)]) (deltaEncode 0.1 [[0, 0], [1, 1]]) +-- [[1,2],[2,3]] +-- +-- If there are more SFs than inputs, an exception is thrown. +-- +-- >>> embed (parZ [arr (+1), arr (+1), arr (+2)]) (deltaEncode 0.1 [[0, 0], [1, 1]]) +-- [[1,1,*** Exception: FRP.Yampa.Switches.parZ: Input list too short. +-- +-- If there are more inputs than SFs, the unused inputs are ignored. +-- +-- >>> embed (parZ [arr (+1)]) (deltaEncode 0.1 [[0, 0], [1, 1]]) +-- [[1],[2]] parZ :: [SF a b] -> SF [a] [b] parZ = par (safeZip "parZ") - +-- | Parallel switch (dynamic collection of signal functions spatially composed +-- in parallel). See 'pSwitch'. +-- +-- For more information on how parallel composition works, check +-- pSwitchZ :: [SF a b] -> SF ([a],[b]) (Event c) -> ([SF a b] -> c -> SF [a] [b]) -> SF [a] [b] pSwitchZ = pSwitch (safeZip "pSwitchZ") - +-- | Decoupled parallel switch with broadcasting (dynamic collection of +-- signal functions spatially composed in parallel). See 'dpSwitch'. +-- +-- For more information on how parallel composition works, check +-- dpSwitchZ :: [SF a b] -> SF ([a],[b]) (Event c) -> ([SF a b] -> c ->SF [a] [b]) -> SF [a] [b] dpSwitchZ = dpSwitch (safeZip "dpSwitchZ") - +-- | Recurring parallel switch with "zip" routing. +-- +-- Uses the given list of SFs, until an event comes in the input, in which case +-- the function in the 'Event' is used to transform the list of SF to be used +-- with 'rpSwitchZ' again, until the next event comes in the input, and so on. +-- +-- Zip routing is used to decide which subpart of the input goes to each SF in +-- the list. +-- +-- See 'rpSwitch'. +-- +-- For more information on how parallel composition works, check +-- rpSwitchZ :: [SF a b] -> SF ([a], Event ([SF a b] -> [SF a b])) [b] rpSwitchZ = rpSwitch (safeZip "rpSwitchZ") - +-- | Decoupled recurring parallel switch with "zip" routing. +-- +-- Uses the given list of SFs, until an event comes in the input, in which case +-- the function in the 'Event' is used to transform the list of SF to be used +-- with 'rpSwitchZ' again, until the next event comes in the input, and so on. +-- +-- Zip routing is used to decide which subpart of the input goes to each SF in +-- the list. +-- +-- See 'rpSwitchZ' and 'drpSwitch'. +-- +-- For more information on how parallel composition works, check +-- drpSwitchZ :: [SF a b] -> SF ([a], Event ([SF a b] -> [SF a b])) [b] drpSwitchZ = drpSwitch (safeZip "drpSwitchZ") @@ -828,7 +958,26 @@ freezeCol :: Functor col => col (SF' a b) -> DTime -> col (SF a b) freezeCol sfs dt = fmap (`freeze` dt) sfs --- Apply an SF to every element of a list. +-- | Apply an SF to every element of a list. +-- +-- Example: +-- +-- >>> embed (parC integral) (deltaEncode 0.1 [[1, 2], [2, 4], [3, 6], [4.0, 8.0 :: Float]]) +-- [[0.0,0.0],[0.1,0.2],[0.3,0.6],[0.6,1.2]] +-- +-- The number of SFs or expected inputs is determined by the first input +-- list, and not expected to vary over time. +-- +-- If more inputs come in a subsequent list, they are ignored. +-- +-- >>> embed (parC (arr (+1))) (deltaEncode 0.1 [[0], [1, 1], [3, 4], [6, 7, 8], [1, 1], [0, 0], [1, 9, 8]]) +-- [[1],[2],[4],[7],[2],[1],[2]] +-- +-- If less inputs come in a subsequent list, an exception is thrown. +-- +-- >>> embed (parC (arr (+1))) (deltaEncode 0.1 [[0, 0], [1, 1], [3, 4], [6, 7, 8], [1, 1], [0, 0], [1, 9, 8]]) +-- [[1,1],[2,2],[4,5],[7,8],[2,2],[1,1],[2,10]] + parC :: SF a b -> SF [a] [b] parC sf = SF $ \as -> let os = map (sfTF sf) as bs = map snd os @@ -852,7 +1001,6 @@ listSeq' :: [a] -> [a] listSeq' [] = [] listSeq' rs@(a:as) = a `seq` listSeq' as `seq` rs - -- Vim modeline -- vim:set tabstop=8 expandtab: 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 @@ -42,10 +42,11 @@ infixl 0 `timeOut`, `abortWhen`, `repeatUntil` ------------------------------------------------------------------------------- --- The Task type ------------------------------------------------------------------------------- +-- * The Task type + +-- | A task is a partially SF that may terminate with a result. + -- CPS-based representation allowing a termination to be detected. -- (Note the rank 2 polymorphic type!) -- The representation can be changed if necessary, but the Monad laws @@ -53,31 +54,41 @@ newtype Task a b c = Task (forall d . (c -> SF a (Either b d)) -> SF a (Either b d)) - unTask :: Task a b c -> ((c -> SF a (Either b d)) -> SF a (Either b d)) unTask (Task f) = f - +-- | Creates a 'Task' from an SF that returns, as a second output, an 'Event' +-- when the SF terminates. See 'switch'. mkTask :: SF a (b, Event c) -> Task a b c mkTask st = Task (switch (st >>> first (arr Left))) --- "Runs" a task (unusually bad name?). The output from the resulting --- signal transformer is tagged with Left while the underlying task is --- running. Once the task has terminated, the output goes constant with --- the value Right x, where x is the value of the terminating event. +-- | Runs a task. +-- +-- The output from the resulting signal transformer is tagged with Left while +-- the underlying task is running. Once the task has terminated, the output +-- goes constant with the value Right x, where x is the value of the +-- terminating event. + +-- Check name. runTask :: Task a b c -> SF a (Either b c) runTask tk = (unTask tk) (constant . Right) --- Runs a task. The output becomes undefined once the underlying task has --- terminated. Convenient e.g. for tasks which are known not to terminate. +-- | Runs a task that never terminates. +-- +-- The output becomes undefined once the underlying task has terminated. +-- +-- Convenience function for tasks which are known not to terminate. runTask_ :: Task a b c -> SF a b runTask_ tk = runTask tk >>> arr (either id (usrErr "AFRPTask" "runTask_" "Task terminated!")) +-- | Creates an SF that represents an SF and produces an event +-- when the task terminates, and otherwise produces just an output. + -- Seems as if the following is convenient after all. Suitable name??? -- Maybe that implies a representation change for Tasks? -- Law: mkTask (taskToSF task) = task (but not (quite) vice versa.) @@ -93,9 +104,7 @@ isEdge (Right _) (Left _) = Nothing ------------------------------------------------------------------------------- --- Functor, Applicative and Monad instance ------------------------------------------------------------------------------- +-- * Functor, Applicative and Monad instance instance Functor (Task a b) where fmap f tk = Task (\k -> unTask tk (k . f)) @@ -141,49 +150,50 @@ No surprises (obviously, since this is essentially just the CPS monad). -} - ------------------------------------------------------------------------------- --- Basic tasks ------------------------------------------------------------------------------- +-- * Basic tasks --- Non-terminating task with constant output b. +-- | Non-terminating task with constant output b. constT :: b -> Task a b c constT b = mkTask (constant b &&& never) --- "Sleeps" for t seconds with constant output b. +-- | "Sleeps" for t seconds with constant output b. sleepT :: Time -> b -> Task a b () sleepT t b = mkTask (constant b &&& after t ()) --- Takes a "snapshot" of the input and terminates immediately with the input --- value as the result. No time passes; law: +-- | Takes a "snapshot" of the input and terminates immediately with the input +-- value as the result. -- --- snapT >> snapT = snapT +-- No time passes; therefore, the following must hold: -- +-- @snapT >> snapT = snapT@ + snapT :: Task a b a snapT = mkTask (constant (intErr "AFRPTask" "snapT" "Bad switch?") &&& snap) ------------------------------------------------------------------------------- --- Basic tasks combinators ------------------------------------------------------------------------------- +-- * Basic tasks combinators --- Impose a time out on a task. +-- | Impose a time out on a task. timeOut :: Task a b c -> Time -> Task a b (Maybe c) tk `timeOut` t = mkTask ((taskToSF tk &&& after t ()) >>> arr aux) where aux ((b, ec), et) = (b, (lMerge (fmap Just ec) (fmap (const Nothing) et))) --- Run a "guarding" event source (SF a (Event b)) in parallel with a --- (possibly non-terminating) task. The task will be aborted at the --- first occurrence of the event source (if it has not terminated itself --- before that). Useful for separating sequencing and termination concerns. --- E.g. we can do something "useful", but in parallel watch for a (exceptional) --- condition which should terminate that activity, whithout having to check --- for that condition explicitly during each and every phase of the activity. --- Example: tsk `abortWhen` lbp +-- | Run a "guarding" event source (SF a (Event b)) in parallel with a +-- (possibly non-terminating) task. +-- +-- The task will be aborted at the first occurrence of the event source (if it +-- has not terminated itself before that). +-- +-- Useful for separating sequencing and termination concerns. E.g. we can do +-- something "useful", but in parallel watch for a (exceptional) condition +-- which should terminate that activity, without having to check for that +-- condition explicitly during each and every phase of the activity. +-- +-- Example: @tsk `abortWhen` lbp@ abortWhen :: Task a b c -> SF a (Event d) -> Task a b (Either c d) tk `abortWhen` est = mkTask ((taskToSF tk &&& est) >>> arr aux) where @@ -191,42 +201,30 @@ ------------------------------------------------------------------------------ --- Loops +-- * Loops ------------------------------------------------------------------------------ -- These are general monadic combinators. Maybe they don't really belong here. --- Repeat m until result satisfies the predicate p +-- | Repeat m until result satisfies the predicate p repeatUntil :: Monad m => m a -> (a -> Bool) -> m a m `repeatUntil` p = m >>= \x -> if not (p x) then repeatUntil m p else return x --- C-style for-loop. --- Example: for 0 (+1) (>=10) ... +-- | C-style for-loop. +-- +-- Example: +-- +-- >>> for 0 (+1) (>=10) ... for :: Monad m => a -> (a -> a) -> (a -> Bool) -> m b -> m () for i f p m = when (p i) $ m >> for (f i) f p m --- Perform the monadic operation for each element in the list. +-- | Perform the monadic operation for each element in the list. forAll :: Monad m => [a] -> (a -> m b) -> m () forAll = forM_ --- Repeat m for ever. +-- | Repeat m for ever. forEver :: Monad m => m a -> m b forEver m = m >> forEver m - - --- Alternatives/other potentially useful signatures: --- until :: a -> (a -> M a) -> (a -> Bool) -> M a --- for: a -> b -> (a -> b -> a) -> (a -> b -> Bool) -> (a -> b -> M b) -> M b --- while??? It could be: --- while :: a -> (a -> Bool) -> (a -> M a) -> M a - - ------------------------------------------------------------------------------- --- Monad transformers? ------------------------------------------------------------------------------- - --- What about monad transformers if we want to compose this monad with --- other capabilities??? 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 @@ -8,6 +8,19 @@ -- Stability : provisional -- Portability : non-portable (GHC extensions) -- +-- SF primitives that producing the current running time. +-- +-- Time is global for an 'SF', so, every constituent 'SF' will use the +-- same global clock. However, when used in combination with +-- 'FRP.Yampa.Switches.switch'ing, the SF switched into will be started at the +-- time of switching, so any reference to 'localTime' or 'time' from that 'SF' +-- will count using the time of switching as the start time. +-- +-- Take also into account that, because 'FRP.Yampa.Integration.derivative' is +-- the derivative of a signal /over time/, derivating 'localTime' will always +-- 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 ( diff --git a/src/FRP/Yampa/Utilities.hs b/src/FRP/Yampa/Utilities.hs --- a/src/FRP/Yampa/Utilities.hs +++ b/src/FRP/Yampa/Utilities.hs @@ -10,16 +10,17 @@ -- -- Derived utility definitions. -- + -- ToDo: -- --- * Possibly add +-- - Possibly add -- impulse :: VectorSpace a k => a -> Event a -- But to do that, we need access to Event, which we currently do not have. -- --- * The general arrow utilities should be moved to a module +-- - The general arrow utilities should be moved to a module -- FRP.Yampa.Utilities. -- --- * I'm not sure structuring the Yampa \"core\" according to what is +-- - I'm not sure structuring the Yampa \"core\" according to what is -- core functionality and what's not is all that useful. There are -- many cases where we want to implement combinators that fairly -- easily could be implemented in terms of others as primitives simply @@ -28,7 +29,7 @@ -- warrant doing this. E.g. 'switch' should be a primitive, even though -- it could be derived from 'pSwitch'. -- --- * Reconsider 'recur'. If an event source has an immediate occurrence, +-- - Reconsider 'recur'. If an event source has an immediate occurrence, -- we'll get into a loop. For example: recur now. Maybe suppress -- initial occurrences? Initial occurrences are rather pointless in this -- case anyway. diff --git a/src/FRP/Yampa/Vector2.hs b/src/FRP/Yampa/Vector2.hs --- a/src/FRP/Yampa/Vector2.hs +++ b/src/FRP/Yampa/Vector2.hs @@ -1,3 +1,4 @@ +{-# OPTIONS_GHC -fno-warn-warnings-deprecations #-} {-# LANGUAGE ExistentialQuantification, MultiParamTypeClasses, FlexibleInstances, StandaloneDeriving #-} ----------------------------------------------------------------------------------------- -- | @@ -29,10 +30,9 @@ import FRP.Yampa.VectorSpace import FRP.Yampa.Forceable +-- * 2D vector, constructors and selectors ------------------------------------------------------------------------------- --- 2D vector, constructors and selectors. ------------------------------------------------------------------------------- +-- | 2D Vector. -- Restrict coefficient space to RealFloat (rather than Floating) for now. -- While unclear if a complex coefficient space would be useful (and if the @@ -45,33 +45,39 @@ deriving instance Show a => Show (Vector2 a) +-- | Creates a 2D vector from the cartesian coordinates. vector2 :: RealFloat a => a -> a -> Vector2 a vector2 = Vector2 +-- | X cartesian coordinate. vector2X :: RealFloat a => Vector2 a -> a vector2X (Vector2 x _) = x +-- | Y cartesian coordinate. vector2Y :: RealFloat a => Vector2 a -> a vector2Y (Vector2 _ y) = y +-- | Returns a vector's cartesian coordinates. vector2XY :: RealFloat a => Vector2 a -> (a, a) vector2XY (Vector2 x y) = (x, y) +-- | Creates a 2D vector from the polar coordinates. vector2Polar :: RealFloat a => a -> a -> Vector2 a vector2Polar rho theta = Vector2 (rho * cos theta) (rho * sin theta) +-- | Calculates the vector's radial distance (magnitude). vector2Rho :: RealFloat a => Vector2 a -> a vector2Rho (Vector2 x y) = sqrt (x * x + y * y) +-- | Calculates the vector's azimuth (angle). vector2Theta :: RealFloat a => Vector2 a -> a vector2Theta (Vector2 x y) = atan2 y x +-- | Polar coordinate representation of a 2D vector. vector2RhoTheta :: RealFloat a => Vector2 a -> (a, a) vector2RhoTheta v = (vector2Rho v, vector2Theta v) ------------------------------------------------------------------------------- --- Vector space instance ------------------------------------------------------------------------------- +-- * Vector space instance instance RealFloat a => VectorSpace (Vector2 a) a where zeroVector = Vector2 0 0 @@ -89,17 +95,14 @@ (Vector2 x1 y1) `dot` (Vector2 x2 y2) = x1 * x2 + y1 * y2 ------------------------------------------------------------------------------- --- Additional operations ------------------------------------------------------------------------------- +-- * Additional operations +-- | Rotates a vector with a given angle. vector2Rotate :: RealFloat a => a -> Vector2 a -> Vector2 a vector2Rotate theta' v = vector2Polar (vector2Rho v) (vector2Theta v + theta') ------------------------------------------------------------------------------- --- Forceable instance ------------------------------------------------------------------------------- +-- * Forceable instance instance RealFloat a => Forceable (Vector2 a) where force = id diff --git a/src/FRP/Yampa/Vector3.hs b/src/FRP/Yampa/Vector3.hs --- a/src/FRP/Yampa/Vector3.hs +++ b/src/FRP/Yampa/Vector3.hs @@ -1,3 +1,4 @@ +{-# OPTIONS_GHC -fno-warn-warnings-deprecations #-} {-# LANGUAGE ExistentialQuantification, MultiParamTypeClasses, FlexibleInstances, StandaloneDeriving #-} ----------------------------------------------------------------------------------------- -- | @@ -31,10 +32,11 @@ import FRP.Yampa.VectorSpace import FRP.Yampa.Forceable ------------------------------------------------------------------------------- --- 3D vector, constructors and selectors. ------------------------------------------------------------------------------- +-- * 3D vector, constructors and selectors + +-- | 3D Vector. + -- Restrict coefficient space to RealFloat (rather than Floating) for now. -- While unclear if a complex coefficient space would be useful (and if the -- result really would be a 3d vector), the only thing causing trouble is the @@ -46,36 +48,46 @@ deriving instance Show a => Show (Vector3 a) +-- | Creates a 3D vector from the cartesian coordinates. vector3 :: RealFloat a => a -> a -> a -> Vector3 a vector3 = Vector3 +-- | X cartesian coordinate. vector3X :: RealFloat a => Vector3 a -> a vector3X (Vector3 x _ _) = x +-- | Y cartesian coordinate. vector3Y :: RealFloat a => Vector3 a -> a vector3Y (Vector3 _ y _) = y +-- | Z cartesian coordinate. vector3Z :: RealFloat a => Vector3 a -> a vector3Z (Vector3 _ _ z) = z +-- | Returns a vector's cartesian coordinates. vector3XYZ :: RealFloat a => Vector3 a -> (a, a, a) vector3XYZ (Vector3 x y z) = (x, y, z) +-- | Creates a 3D vector from the spherical coordinates. vector3Spherical :: RealFloat a => a -> a -> a -> Vector3 a vector3Spherical rho theta phi = Vector3 (rhoSinPhi * cos theta) (rhoSinPhi * sin theta) (rho * cos phi) where rhoSinPhi = rho * sin phi +-- | Calculates the vector's radial distance. vector3Rho :: RealFloat a => Vector3 a -> a vector3Rho (Vector3 x y z) = sqrt (x * x + y * y + z * z) +-- | Calculates the vector's azimuth. vector3Theta :: RealFloat a => Vector3 a -> a vector3Theta (Vector3 x y _) = atan2 y x +-- | Calculates the vector's inclination. vector3Phi :: RealFloat a => Vector3 a -> a vector3Phi v@(Vector3 _ _ z) = acos (z / vector3Rho v) +-- | Spherical coordinate representation of a 3D vector. vector3RhoThetaPhi :: RealFloat a => Vector3 a -> (a, a, a) vector3RhoThetaPhi (Vector3 x y z) = (rho, theta, phi) where @@ -83,10 +95,7 @@ theta = atan2 y x phi = acos (z / rho) - ------------------------------------------------------------------------------- --- Vector space instance ------------------------------------------------------------------------------- +-- * Vector space instance instance RealFloat a => VectorSpace (Vector3 a) a where zeroVector = Vector3 0 0 0 @@ -103,21 +112,16 @@ (Vector3 x1 y1 z1) `dot` (Vector3 x2 y2 z2) = x1 * x2 + y1 * y2 + z1 * z2 - ------------------------------------------------------------------------------- --- Additional operations ------------------------------------------------------------------------------- +-- * Additional operations +-- | Rotates a vector with a given polar and azimuthal angles. vector3Rotate :: RealFloat a => a -> a -> Vector3 a -> Vector3 a vector3Rotate theta' phi' v = vector3Spherical (vector3Rho v) (vector3Theta v + theta') (vector3Phi v + phi') - ------------------------------------------------------------------------------- --- Forceable instance ------------------------------------------------------------------------------- +-- * Forceable instance instance RealFloat a => Forceable (Vector3 a) where force = id diff --git a/src/FRP/Yampa/VectorSpace.hs b/src/FRP/Yampa/VectorSpace.hs --- a/src/FRP/Yampa/VectorSpace.hs +++ b/src/FRP/Yampa/VectorSpace.hs @@ -10,15 +10,10 @@ -- Portability : non-portable (GHC extensions) -- -- Vector space type relation and basic instances. --- ----------------------------------------------------------------------------------------- module FRP.Yampa.VectorSpace where ------------------------------------------------------------------------------- --- Vector space type relation ------------------------------------------------------------------------------- - infixr *^ infixl ^/ infix 7 `dot` @@ -28,33 +23,63 @@ -- the constraint on the coefficient space (a) should (or, at least, could) -- be Fractional (roughly a Field) rather than Floating. --- Minimal instance: zeroVector, (*^), (^+^), dot +-- | Vector space type relation. +-- +-- A vector space is a set (type) closed under addition and multiplication by +-- a scalar. The type of the scalar is the /field/ of the vector space, and +-- it is said that @v@ is a vector space over @a@. +-- +-- The encoding uses a type class |VectorSpace| @v a@, where @v@ represents +-- the type of the vectors and @a@ represents the types of the scalars. + class (Eq a, Floating a) => VectorSpace v a | v -> a where - zeroVector :: v - (*^) :: a -> v -> v - (^/) :: v -> a -> v - negateVector :: v -> v - (^+^) :: v -> v -> v - (^-^) :: v -> v -> v - dot :: v -> v -> a - norm :: v -> a - normalize :: v -> v + -- | Vector with no magnitude (unit for addition). + zeroVector :: v + -- | Multiplication by a scalar. + (*^) :: a -> v -> v + + -- | Division by a scalar. + (^/) :: v -> a -> v v ^/ a = (1/a) *^ v - negateVector v = (-1) *^ v + -- | Vector addition + (^+^) :: v -> v -> v + -- | Vector subtraction + (^-^) :: v -> v -> v v1 ^-^ v2 = v1 ^+^ negateVector v2 + -- | Vector negation. Addition with a negated vector should be + -- same as subtraction. + negateVector :: v -> v + negateVector v = (-1) *^ v + + -- | Dot product (also known as scalar or inner product). + -- + -- For two vectors, mathematically represented as @a = a1,a2,...,an@ and @b + -- = b1,b2,...,bn@, the dot product is @a . b = a1*b1 + a2*b2 + ... + + -- an*bn@. + -- + -- Some properties are derived from this. The dot product of a vector with + -- itself is the square of its magnitude ('norm'), and the dot product of + -- two orthogonal vectors is zero. + dot :: v -> v -> a + + -- | Vector's norm (also known as magnitude). + -- + -- For a vector represented mathematically as @a = a1,a2,...,an@, the norm + -- is the square root of @a1^2 + a2^2 + ... + an^2@. + norm :: v -> a norm v = sqrt (v `dot` v) + -- | Return a vector with the same origin and orientation (angle), but such + -- that the norm is one (the unit for multiplication by a scalar). + normalize :: v -> v normalize v = if nv /= 0 then v ^/ nv else error "normalize: zero vector" where nv = norm v ------------------------------------------------------------------------------- --- Vector space instances for Float and Double ------------------------------------------------------------------------------- - +-- | Vector space instance for 'Float's, with 'Float' scalars. instance VectorSpace Float Float where zeroVector = 0 @@ -70,7 +95,7 @@ x1 `dot` x2 = x1 * x2 - +-- | Vector space instance for 'Double's, with 'Double' scalars. instance VectorSpace Double Double where zeroVector = 0 @@ -87,10 +112,7 @@ x1 `dot` x2 = x1 * x2 ------------------------------------------------------------------------------- --- Vector space instances for small tuples of Floating ------------------------------------------------------------------------------- - +-- | Vector space instance for pairs of 'Floating' point numbers. instance (Eq a, Floating a) => VectorSpace (a,a) a where zeroVector = (0,0) @@ -106,7 +128,7 @@ (x1,y1) `dot` (x2,y2) = x1 * x2 + y1 * y2 - +-- | Vector space instance for triplets of 'Floating' point numbers. instance (Eq a, Floating a) => VectorSpace (a,a,a) a where zeroVector = (0,0,0) @@ -122,7 +144,7 @@ (x1,y1,z1) `dot` (x2,y2,z2) = x1 * x2 + y1 * y2 + z1 * z2 - +-- | Vector space instance for tuples with four 'Floating' point numbers. instance (Eq a, Floating a) => VectorSpace (a,a,a,a) a where zeroVector = (0,0,0,0) @@ -138,7 +160,7 @@ (x1,y1,z1,u1) `dot` (x2,y2,z2,u2) = x1 * x2 + y1 * y2 + z1 * z2 + u1 * u2 - +-- | Vector space instance for tuples with five 'Floating' point numbers. instance (Eq a, Floating a) => VectorSpace (a,a,a,a,a) a where zeroVector = (0,0,0,0,0) diff --git a/tests/AFRPTestsAccum.hs b/tests/AFRPTestsAccum.hs --- a/tests/AFRPTestsAccum.hs +++ b/tests/AFRPTestsAccum.hs @@ -25,7 +25,6 @@ import Data.Maybe (fromJust) import FRP.Yampa -import FRP.Yampa.Internals (Event(NoEvent, Event)) import AFRPTestsCommon @@ -288,8 +287,8 @@ accum_t15r :: [Int] accum_t15r = accum_t14 -- Should agree! - + accum_t16 :: [Int] accum_t16 = take 40 $ embed (repeatedly 1.0 1 >>> accumFilter accum_accFiltFun3 0 @@ -312,7 +311,7 @@ accum_t17r :: [Int] accum_t17r = accum_t16 -- Should agree! - + accum_trs = diff --git a/tests/AFRPTestsEvSrc.hs b/tests/AFRPTestsEvSrc.hs --- a/tests/AFRPTestsEvSrc.hs +++ b/tests/AFRPTestsEvSrc.hs @@ -15,7 +15,6 @@ module AFRPTestsEvSrc (evsrc_trs, evsrc_tr) where import FRP.Yampa -import FRP.Yampa.Internals (Event(NoEvent, Event)) import AFRPTestsCommon @@ -201,7 +200,7 @@ evsrc_t12 :: [Event ()] evsrc_t12 = testSF1 (localTime >>> arr (>=0) >>> edge) -evsrc_t12r = +evsrc_t12r = [NoEvent, NoEvent, NoEvent, NoEvent, -- 0.0 s NoEvent, NoEvent, NoEvent, NoEvent, -- 1.0 s NoEvent, NoEvent, NoEvent, NoEvent, -- 2.0 s @@ -234,7 +233,7 @@ evsrc_t14 :: [Event ()] evsrc_t14 = testSF1 (localTime >>> arr (>=0) >>> edgeBy evsrc_isEdge False) -evsrc_t14r = +evsrc_t14r = [Event (), NoEvent, NoEvent, NoEvent, -- 0.0 s NoEvent, NoEvent, NoEvent, NoEvent, -- 1.0 s NoEvent, NoEvent, NoEvent, NoEvent, -- 2.0 s @@ -405,7 +404,7 @@ evsrc_t26 :: [Event Int] -- Drop 5 events to get rid of the event at 4.0 s which may or may not happen --- exactly there. +-- exactly there. evsrc_t26 = testSF1 (repeatedly 0.8 42 >>> dropEvents 5) evsrc_t26r :: [Event Int] @@ -475,26 +474,26 @@ input where dts = replicate 40 0.1 ++ [2.0] ++ replicate 40 0.1 - input = ((), [(dt, Just ()) | dt <- dts]) + input = ((), [(dt, Just ()) | dt <- dts]) {- Resulting input to the delay for reference: -[ NoEvent, NoEvent, NoEvent, NoEvent, NoEvent, -- 0.0 s - NoEvent, Event 0.6, NoEvent, NoEvent, NoEvent, -- 0.5 s - NoEvent, Event 1.1, NoEvent, NoEvent, NoEvent, -- 1.0 s - NoEvent, Event 1.6, NoEvent, NoEvent, NoEvent, -- 1.5 s - NoEvent, Event 2.1, NoEvent, NoEvent, NoEvent, -- 2.0 s - NoEvent, Event 2.6, NoEvent, NoEvent, NoEvent, -- 2.5 s - NoEvent, Event 3.1, NoEvent, NoEvent, NoEvent, -- 3.0 s - NoEvent, Event 3.6, NoEvent, NoEvent, NoEvent, -- 3.5 s - NoEvent, -- 4.0 s - Event 6.0, Event 6.1, NoEvent, NoEvent, NoEvent, -- 6.0 s - NoEvent, Event 6.6, NoEvent, NoEvent, NoEvent, -- 6.5 s - NoEvent, Event 7.1, NoEvent, NoEvent, NoEvent, -- 7.0 s - NoEvent, Event 7.6, NoEvent, NoEvent, NoEvent, -- 7.5 s - NoEvent, Event 8.1, NoEvent, NoEvent, NoEvent, -- 8.0 s - NoEvent, Event 8.6, NoEvent, NoEvent, NoEvent, -- 8.5 s - NoEvent, Event 9.1, NoEvent, NoEvent, NoEvent, -- 9.0 s - NoEvent, Event 9.6, NoEvent, NoEvent, NoEvent, -- 9.5 s +[ NoEvent, NoEvent, NoEvent, NoEvent, NoEvent, -- 0.0 s + NoEvent, Event 0.6, NoEvent, NoEvent, NoEvent, -- 0.5 s + NoEvent, Event 1.1, NoEvent, NoEvent, NoEvent, -- 1.0 s + NoEvent, Event 1.6, NoEvent, NoEvent, NoEvent, -- 1.5 s + NoEvent, Event 2.1, NoEvent, NoEvent, NoEvent, -- 2.0 s + NoEvent, Event 2.6, NoEvent, NoEvent, NoEvent, -- 2.5 s + NoEvent, Event 3.1, NoEvent, NoEvent, NoEvent, -- 3.0 s + NoEvent, Event 3.6, NoEvent, NoEvent, NoEvent, -- 3.5 s + NoEvent, -- 4.0 s + Event 6.0, Event 6.1, NoEvent, NoEvent, NoEvent, -- 6.0 s + NoEvent, Event 6.6, NoEvent, NoEvent, NoEvent, -- 6.5 s + NoEvent, Event 7.1, NoEvent, NoEvent, NoEvent, -- 7.0 s + NoEvent, Event 7.6, NoEvent, NoEvent, NoEvent, -- 7.5 s + NoEvent, Event 8.1, NoEvent, NoEvent, NoEvent, -- 8.0 s + NoEvent, Event 8.6, NoEvent, NoEvent, NoEvent, -- 8.5 s + NoEvent, Event 9.1, NoEvent, NoEvent, NoEvent, -- 9.0 s + NoEvent, Event 9.6, NoEvent, NoEvent, NoEvent, -- 9.5 s NoEvent ] -- 10.0 s -} diff --git a/tests/AFRPTestsPSwitch.hs b/tests/AFRPTestsPSwitch.hs --- a/tests/AFRPTestsPSwitch.hs +++ b/tests/AFRPTestsPSwitch.hs @@ -24,7 +24,6 @@ import Data.List (findIndex) import FRP.Yampa -import FRP.Yampa.Internals (Event(NoEvent, Event)) import AFRPTestsCommon @@ -191,7 +190,7 @@ (pswitch_limit 2.99) pswitch_t4rec >>> arr dup - + pswitch_t4rec :: [SF (a, [Double]) Double] -> Int -> SF (a, [Double]) [Double] @@ -249,7 +248,7 @@ pswitch_t5rec) &&& (arr snd >>> arr sum)) >>> arr (\(xs, y) -> ((xs, y), xs)) - + pswitch_t5rec :: [SF (a, [Double]) Double] -> Int -> SF (a, [Double]) [Double] diff --git a/tests/AFRPTestsRPSwitch.hs b/tests/AFRPTestsRPSwitch.hs --- a/tests/AFRPTestsRPSwitch.hs +++ b/tests/AFRPTestsRPSwitch.hs @@ -23,7 +23,6 @@ import Data.List (findIndex) import FRP.Yampa -import FRP.Yampa.Internals (Event(NoEvent, Event)) import AFRPTestsCommon @@ -93,16 +92,16 @@ rpswitch_t1 = take 20 $ embed (drpSwitchB []) rpswitch_inp1 rpswitch_t1r = - [[], -- 0 s - [], -- 1 s - [], -- 2 s - [], -- 3 s - [2.0], -- 4 s - [5.0], -- 5 s - [8.0], -- 6 s - [12.0], -- 7 s - [16.0], -- 8 s - [20.0] , -- 9 s + [[], -- 0 s + [], -- 1 s + [], -- 2 s + [], -- 3 s + [2.0], -- 4 s + [5.0], -- 5 s + [8.0], -- 6 s + [12.0], -- 7 s + [16.0], -- 8 s + [20.0] , -- 9 s [105.0, 25.0], -- 10 s [111.0, 31.0], -- 11 s [117.0, 37.0], -- 12 s @@ -119,16 +118,16 @@ rpswitch_t2 = take 20 $ embed (rpSwitchB []) rpswitch_inp2 rpswitch_t2r = - [[0.0], -- 0 s - [1.0], -- 1 s - [2.0], -- 2 s - [100.0, 3.0], -- 3 s - [100.0, 102.0, 5.0], -- 4 s - [100.0, 102.0, 104.0, 7.0], -- 5 s - [200.0, 102.0, 104.0, 106.0, 9.0], -- 6 s - [200.0, 203.0, 105.0, 107.0, 109.0, 12.0], -- 7 s - [200.0, 203.0, 206.0, 108.0, 110.0, 112.0, 15.0], -- 8 s - [203.0, 206.0, 209.0, 111.0, 113.0, 115.0, 18.0], -- 9 s + [[0.0], -- 0 s + [1.0], -- 1 s + [2.0], -- 2 s + [100.0, 3.0], -- 3 s + [100.0, 102.0, 5.0], -- 4 s + [100.0, 102.0, 104.0, 7.0], -- 5 s + [200.0, 102.0, 104.0, 106.0, 9.0], -- 6 s + [200.0, 203.0, 105.0, 107.0, 109.0, 12.0], -- 7 s + [200.0, 203.0, 206.0, 108.0, 110.0, 112.0, 15.0], -- 8 s + [203.0, 206.0, 209.0, 111.0, 113.0, 115.0, 18.0], -- 9 s [207.0, 210.0, 213.0, 115.0, 117.0, 119.0, 22.0], -- 10 s [211.0, 214.0, 217.0, 119.0, 121.0, 123.0, 26.0], -- 11 s [15.0, 215.0, 218.0, 221.0, 123.0, 125.0, 127.0, 30.0], -- 12 s @@ -145,16 +144,16 @@ rpswitch_t3 = take 20 $ embed (drpSwitchB []) rpswitch_inp2 rpswitch_t3r = - [[], -- 0 s - [1.0], -- 1 s - [2.0], -- 2 s - [3.0], -- 3 s - [102.0, 5.0], -- 4 s - [102.0, 104.0, 7.0], -- 5 s - [102.0, 104.0, 106.0, 9.0], -- 6 s - [203.0, 105.0, 107.0, 109.0, 12.0], -- 7 s - [203.0, 206.0, 108.0, 110.0, 112.0, 15.0], -- 8 s - [203.0, 206.0, 209.0, 111.0, 113.0, 115.0, 18.0], -- 9 s + [[], -- 0 s + [1.0], -- 1 s + [2.0], -- 2 s + [3.0], -- 3 s + [102.0, 5.0], -- 4 s + [102.0, 104.0, 7.0], -- 5 s + [102.0, 104.0, 106.0, 9.0], -- 6 s + [203.0, 105.0, 107.0, 109.0, 12.0], -- 7 s + [203.0, 206.0, 108.0, 110.0, 112.0, 15.0], -- 8 s + [203.0, 206.0, 209.0, 111.0, 113.0, 115.0, 18.0], -- 9 s [207.0, 210.0, 213.0, 115.0, 117.0, 119.0, 22.0], -- 10 s [211.0, 214.0, 217.0, 119.0, 121.0, 123.0, 26.0], -- 11 s [215.0, 218.0, 221.0, 123.0, 125.0, 127.0, 30.0], -- 12 s diff --git a/tests/AFRPTestsRSwitch.hs b/tests/AFRPTestsRSwitch.hs --- a/tests/AFRPTestsRSwitch.hs +++ b/tests/AFRPTestsRSwitch.hs @@ -22,7 +22,6 @@ import Data.Maybe (fromJust) import FRP.Yampa -import FRP.Yampa.Internals (Event(NoEvent, Event)) import AFRPTestsCommon diff --git a/tests/AFRPTestsSscan.hs b/tests/AFRPTestsSscan.hs --- a/tests/AFRPTestsSscan.hs +++ b/tests/AFRPTestsSscan.hs @@ -16,7 +16,6 @@ module AFRPTestsSscan (sscan_tr, sscan_trs) where import FRP.Yampa -import FRP.Yampa.Internals import AFRPTestsCommon @@ -50,11 +49,11 @@ sscan_t2, sscan_t2r :: [Double] -sscan_t2 = testSF1 (time +sscan_t2 = testSF1 (time >>> arr (\t -> sin (0.5 * t * pi + pi)) - >>> loop (arr (\(x1,x2) -> let x' = max x1 x2 in (x',x')) + >>> loop (arr (\(x1,x2) -> let x' = max x1 x2 in (x',x')) >>> second (iPre_sscan 0.0))) -sscan_t2r = +sscan_t2r = take 25 (let xs = [ sin (0.5 * t * pi + pi) | t <- [0.0, 0.25 ..] ] in tail (scanl max 0 xs)) @@ -62,11 +61,11 @@ sscan_t3, sscan_t3r :: [Double] -sscan_t3 = testSF1 (time +sscan_t3 = testSF1 (time >>> arr (\t -> sin (0.5 * t * pi + pi)) >>> sscan max 0.0) -sscan_t3r = +sscan_t3r = take 25 (let xs = [ sin (0.5 * t * pi + pi) | t <- [0.0, 0.25 ..] ] in tail (scanl max 0 xs)) @@ -75,7 +74,7 @@ hold_sscan :: a -> SF (Event a) a hold_sscan a = sscanPrim f () a where - f _ NoEvent = Nothing + f _ NoEvent = Nothing f _ (Event a) = Just ((), a) @@ -120,16 +119,16 @@ arr (\(e,c) -> (e `tag` (c + 1)) `gate` (c < 10)) >>> dHold_sscan 0 >>> arr dup) -sscan_t5r = [0,1,1,1, -- 0s - 1,2,2,2, -- 1s - 2,3,3,3, -- 2s - 3,4,4,4, -- 3s - 4,5,5,5, -- 4s - 5,6,6,6, -- 5s - 6,7,7,7, -- 6s - 7,8,8,8, -- 7s - 8,9,9,9, -- 8s - 9,10,10,10, -- 9s +sscan_t5r = [0,1,1,1, -- 0s + 1,2,2,2, -- 1s + 2,3,3,3, -- 2s + 3,4,4,4, -- 3s + 4,5,5,5, -- 4s + 5,6,6,6, -- 5s + 6,7,7,7, -- 6s + 7,8,8,8, -- 7s + 8,9,9,9, -- 8s + 9,10,10,10, -- 9s 10,10,10,10, -- 10s 10,10,10,10, -- 11s 10,10] -- 12s @@ -174,18 +173,18 @@ | otherwise = Nothing where c' = c + 1 - -sscan_t7r = [1,1,1,1, -- 0s - 2,2,2,2, -- 1s - 3,3,3,3, -- 2s - 4,4,4,4, -- 3s - 5,5,5,5, -- 4s - 6,6,6,6, -- 5s - 7,7,7,7, -- 6s - 8,8,8,8, -- 7s - 9,9,9,9, -- 8s - 10,10,10,10, -- 9s + +sscan_t7r = [1,1,1,1, -- 0s + 2,2,2,2, -- 1s + 3,3,3,3, -- 2s + 4,4,4,4, -- 3s + 5,5,5,5, -- 4s + 6,6,6,6, -- 5s + 7,7,7,7, -- 6s + 8,8,8,8, -- 7s + 9,9,9,9, -- 8s + 10,10,10,10, -- 9s 10,10,10,10, -- 10s 10,10,10,10, -- 11s 10,10] -- 12s @@ -205,7 +204,7 @@ sscan_t8 :: [Event ()] sscan_t8 = testSF1 (localTime >>> arr (>=0) >>> edge_sscan) -sscan_t8r = +sscan_t8r = [NoEvent, NoEvent, NoEvent, NoEvent, -- 0.0 s NoEvent, NoEvent, NoEvent, NoEvent, -- 1.0 s NoEvent, NoEvent, NoEvent, NoEvent, -- 2.0 s @@ -246,7 +245,7 @@ >>> arr (>=0) >>> edgeBy_sscan sscan_isEdge False) -sscan_t10r = +sscan_t10r = [Event (), NoEvent, NoEvent, NoEvent, -- 0.0 s NoEvent, NoEvent, NoEvent, NoEvent, -- 1.0 s NoEvent, NoEvent, NoEvent, NoEvent, -- 2.0 s @@ -256,7 +255,7 @@ NoEvent] sscan_t11 :: [Event ()] -sscan_t11 = testSF1 (localTime +sscan_t11 = testSF1 (localTime >>> arr (>=4.26) >>> edgeBy_sscan sscan_isEdge False) @@ -437,7 +436,7 @@ >>> arr (`tag` (+1)) >>> accumHold 0 -sscan_t18r = +sscan_t18r = [0,0,1,1,1,1,1,1,1,1, 1,1,1,1,1,1,1,1,1,1, 1,1,1,1,1,1,1,1,1,1, diff --git a/tests/AFRPTestsSwitch.hs b/tests/AFRPTestsSwitch.hs --- a/tests/AFRPTestsSwitch.hs +++ b/tests/AFRPTestsSwitch.hs @@ -15,7 +15,6 @@ import FRP.Yampa import FRP.Yampa.EventS -import FRP.Yampa.Internals (Event(NoEvent, Event)) import AFRPTestsCommon @@ -30,7 +29,7 @@ 4.0, 4.0, 4.0, 5.0, 6.0, 6.0, - 7.0, 7.0, 7.0, + 7.0, 7.0, 7.0, 8.0] ++ repeat 9.0 diff --git a/tests/AFRPTestsUtils.hs b/tests/AFRPTestsUtils.hs --- a/tests/AFRPTestsUtils.hs +++ b/tests/AFRPTestsUtils.hs @@ -17,9 +17,7 @@ module AFRPTestsUtils (utils_tr, utils_trs) where import FRP.Yampa -import FRP.Yampa.Internals (Event(NoEvent, Event)) import FRP.Yampa.Conditional -import FRP.Yampa.Integration import FRP.Yampa.EventS import FRP.Yampa.Hybrid import FRP.Yampa.Utilities @@ -109,7 +107,7 @@ utils_t4 = take 16 $ embed count utils_inp1 utils_t4r :: [Event Int] -utils_t4r = +utils_t4r = [NoEvent, NoEvent, Event 1, NoEvent, Event 2, NoEvent, NoEvent, NoEvent, Event 3, Event 4, Event 5, NoEvent, @@ -120,7 +118,7 @@ utils_t5 = take 16 $ embed count utils_inp2 utils_t5r :: [Event Int] -utils_t5r = +utils_t5r = [Event 1, NoEvent, NoEvent, NoEvent, Event 2, NoEvent, NoEvent, NoEvent, Event 3, Event 4, Event 5, NoEvent, diff --git a/tests/AFRPTestsWFG.hs b/tests/AFRPTestsWFG.hs --- a/tests/AFRPTestsWFG.hs +++ b/tests/AFRPTestsWFG.hs @@ -15,7 +15,6 @@ module AFRPTestsWFG (wfg_tr, wfg_trs) where import FRP.Yampa -import FRP.Yampa.Internals (Event(NoEvent, Event)) import AFRPTestsCommon