git.iko.soy/reflex
on multi-demux help sign in
reflex/test/Reflex/Pure.hs
76 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
13import Control.Monad
14import Data.MemoTrie
15import Data.Dependent.Map (DMap, GCompare)
16import qualified Data.Dependent.Map as DMap
18data Pure t
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
22-- to memoize functions of t, not for any of its other capabilities.
23instance (Enum t, HasTrie t, Ord t) => Reflex (Pure t) where
25 newtype Behavior (Pure t) a = Behavior { unBehavior :: t -> a }
26 newtype Event (Pure t) a = Event { unEvent :: t -> Maybe a }
28 type PushM (Pure t) = (->) t
29 type PullM (Pure t) = (->) t
31 never :: Event (Pure t) a
32 never = Event $ \_ -> Nothing
34 constant :: a -> Behavior (Pure t) a
35 constant x = Behavior $ \_ -> x
37 push :: (a -> PushM (Pure t) (Maybe b)) -> Event (Pure t) a -> Event (Pure t) b
38 push f e = Event $ memo $ \t -> unEvent e t >>= \o -> f o t
40 pull :: PullM (Pure t) a -> Behavior (Pure t) a
41 pull = Behavior . memo
43 merge :: GCompare k => DMap (WrapArg (Event (Pure t)) k) -> Event (Pure t) (DMap k)
44 merge events = Event $ memo $ \t ->
45 let currentOccurrences = unwrapDMapMaybe (($ t) . unEvent) events
46 in if DMap.null currentOccurrences
47 then Nothing
48 else Just currentOccurrences
50 fan :: GCompare k => Event (Pure t) (DMap k) -> EventSelector (Pure t) 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
54 switch b = Event $ memo $ \t -> unEvent (unBehavior b t) t
56 coincidence :: Event (Pure t) (Event (Pure t) a) -> Event (Pure t) a
57 coincidence e = Event $ memo $ \t -> unEvent e t >>= \o -> unEvent o t
59instance Ord t => MonadSample (Pure t) ((->) t) where
61 sample :: Behavior (Pure t) a -> (t -> a)
62 sample = unBehavior
64instance (Enum t, HasTrie t, Ord t) => MonadHold (Pure t) ((->) t) where
66 hold :: a -> Event (Pure t) a -> (t -> (Behavior (Pure t) a))
67 hold initialValue e initialTime = Behavior f
68 where f = memo $ \sampleTime ->
69 -- Really, the sampleTime should never be prior to the initialTime,
70 -- because that would mean the Behavior is being sampled before being created.
71 if sampleTime <= initialTime
72 then initialValue
73 else let lastTime = pred sampleTime
74 in case unEvent e lastTime of
75 Nothing -> f lastTime
76 Just x -> x