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