@@ -1,6 +1,10 @@
1+{- | This module provides a pure implementation of Reflex, which is intended
2+to serve as a reference for the semantics of the Reflex class. All implementations
1−{- | This module provides a pure implementation of Reflex, which is intended to serve as a reference for the semantics of the Reflex class. All implementations of Reflex should produce the same results as this implementation, although performance and laziness/strictness may differ.
3+of Reflex should produce the same results as this implementation, although performance
4+and laziness/strictness may differ.
3−{-# LANGUAGE TypeFamilies, MultiParamTypeClasses, EmptyDataDecls #-}
7+{-# LANGUAGE TypeFamilies, MultiParamTypeClasses, EmptyDataDecls, InstanceSigs #-}
4module Reflex.Pure where
8module Reflex.Pure where
6import Reflex.Class
10import Reflex.Class
@@ -8,39 +12,65 @@ import Data.Functor.Misc
9import Control.Monad
13import Control.Monad
10import Data.MemoTrie
14import Data.MemoTrie
15+import Data.Dependent.Map (DMap, GCompare)
11import qualified Data.Dependent.Map as DMap
16import qualified Data.Dependent.Map as DMap
13data Pure t
18data Pure t
15−-- | The Enum instance of t must be dense: for all x :: t, there must not exist any y :: t such that pred x < y < x
20+-- | The Enum instance of t must be dense: for all x :: t, there must not exist
21+-- any y :: t such that pred x < y < x. The HasTrie instance will be used exclusively
16−-- The HasTrie instance will be used exclusively to memoize functions of t, not for any of its other capabilities
22+-- to memoize functions of t, not for any of its other capabilities.
17instance (Enum t, HasTrie t, Ord t) => Reflex (Pure t) where
23instance (Enum t, HasTrie t, Ord t) => Reflex (Pure t) where
18 newtype Behavior (Pure t) a = Behavior { unBehavior :: t -> a }
25 newtype Behavior (Pure t) a = Behavior { unBehavior :: t -> a }
19− newtype Event (Pure t) a = Event { unEvent :: t -> Maybe a }
26+ newtype Event (Pure t) a = Event { unEvent :: t -> Maybe a }
20 type PushM (Pure t) = (->) t
28 type PushM (Pure t) = (->) t
21 type PullM (Pure t) = (->) t
29 type PullM (Pure t) = (->) t
31+ never :: Event (Pure t) a
22 never = Event $ \_ -> Nothing
32 never = Event $ \_ -> Nothing
34+ constant :: a -> Behavior (Pure t) a
23 constant x = Behavior $ \_ -> x
35 constant x = Behavior $ \_ -> x
37+ push :: (a -> PushM (Pure t) (Maybe b)) -> Event (Pure t) a -> Event (Pure t) b
24 push f e = Event $ memo $ \t -> unEvent e t >>= \o -> f o t
38 push f e = Event $ memo $ \t -> unEvent e t >>= \o -> f o t
40+ pull :: PullM (Pure t) a -> Behavior (Pure t) a
25 pull = Behavior . memo
41 pull = Behavior . memo
43+ merge :: GCompare k => DMap (WrapArg (Event (Pure t)) k) -> Event (Pure t) (DMap k)
26 merge events = Event $ memo $ \t ->
44 merge events = Event $ memo $ \t ->
27 let currentOccurrences = unwrapDMapMaybe (($ t) . unEvent) events
45 let currentOccurrences = unwrapDMapMaybe (($ t) . unEvent) events
28 in if DMap.null currentOccurrences
46 in if DMap.null currentOccurrences
29 then Nothing
47 then Nothing
30 else Just currentOccurrences
48 else Just currentOccurrences
50+ fan :: GCompare k => Event (Pure t) (DMap k) -> EventSelector (Pure t) k
31 fan e = EventSelector $ \k -> Event $ \t -> unEvent e t >>= DMap.lookup k
51 fan e = EventSelector $ \k -> Event $ \t -> unEvent e t >>= DMap.lookup k
53+ switch :: Behavior (Pure t) (Event (Pure t) a) -> Event (Pure t) a
32 switch b = Event $ memo $ \t -> unEvent (unBehavior b t) t
54 switch b = Event $ memo $ \t -> unEvent (unBehavior b t) t
56+ coincidence :: Event (Pure t) (Event (Pure t) a) -> Event (Pure t) a
33 coincidence e = Event $ memo $ \t -> unEvent e t >>= \o -> unEvent o t
57 coincidence e = Event $ memo $ \t -> unEvent e t >>= \o -> unEvent o t
35instance Ord t => MonadSample (Pure t) ((->) t) where
59instance Ord t => MonadSample (Pure t) ((->) t) where
61+ sample :: Behavior (Pure t) a -> (t -> a)
36 sample = unBehavior
62 sample = unBehavior
38instance (Enum t, HasTrie t, Ord t) => MonadHold (Pure t) ((->) t) where
64instance (Enum t, HasTrie t, Ord t) => MonadHold (Pure t) ((->) t) where
66+ hold :: a -> Event (Pure t) a -> (t -> (Behavior (Pure t) a))
39 hold initialValue e initialTime = Behavior f
67 hold initialValue e initialTime = Behavior f
40 where f = memo $ \sampleTime ->
68 where f = memo $ \sampleTime ->
69+ -- Really, the sampleTime should never be prior to the initialTime,
41− if sampleTime <= initialTime -- Really, the sampleTime should never be prior to the initialTime, because that would mean the Behavior is being sampled before being created
70+ -- because that would mean the Behavior is being sampled before being created.
71+ if sampleTime <= initialTime
42 then initialValue
72 then initialValue
43 else let lastTime = pred sampleTime
73 else let lastTime = pred sampleTime
44 in case unEvent e lastTime of
74 in case unEvent e lastTime of
45 Nothing -> f lastTime
75 Nothing -> f lastTime
46− Just x -> x
76+ Just x -> x