Skip to content

Commit 66e001c

Browse files
author
Ryan Trinkle
committed
Merge branch 'develop'
2 parents 4bbe386 + d0ffd2b commit 66e001c

File tree

8 files changed

+287
-12
lines changed

8 files changed

+287
-12
lines changed

Quickref.md

Lines changed: 171 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,171 @@
1+
# Reflex Quick(ish) Reference
2+
3+
## Typeclasses
4+
5+
Many Reflex functions operate in monadic context `m a`, where the monad 'm' supports various additional typeclasses such as MonadWidget, MonadHold, or MonadSample in addition to Monad itself. The actual 'm' in use will be determined by the top-level entry point of the FRP host (such as Reflex-Dom -- see the bottom of the Reflex-Dom quick reference for details).
6+
7+
The function signatures here have been simplified by removing many typeclass constraints and adding simple annotations to each function. Also the ubiquitous 't' type parameter has been removed.
8+
9+
Some of these functions are *pure*: They operate on Events, Behaviors, or Dynamics uniformly without regard to the "current time". Other functions must operate in some monadic context, because they produce a result "as of now" (e.g., any function that takes an "initial" value, or returns a "current" value). Annotations are used to distinguish these cases:
10+
11+
```haskell
12+
[ ] -- Pure function
13+
[S] -- Function runs in any monad supporting MonadSample
14+
[H] -- Function runs in any monad supporting MonadHold
15+
```
16+
17+
Since MonadHold depends on MonadSample, any [S] function also runs in [H] context.
18+
19+
## Functions producing Event
20+
21+
```haskell
22+
-- Trivial Event
23+
[ ] never :: Event a
24+
25+
-- Extract Event from Dynamic
26+
[ ] updated :: Dynamic a -> Event a
27+
28+
-- Transform Event to Event using function
29+
[ ] fmap :: (a -> b) -> Event a -> Event b
30+
[ ] fmapMaybe :: (a -> Maybe b) -> Event a -> Event b
31+
[ ] ffilter :: (a -> Bool) -> Event a -> Event a
32+
[ ] ffor :: Event a -> (a -> b) -> Event b
33+
[ ] fforMaybe :: Event a -> (a -> Maybe b) -> Event b
34+
35+
-- Event to identical Event with debug trace. (Only prints if Event is ultimately used.)
36+
[ ] traceEvent :: Show a => String -> Event a -> Event a
37+
[ ] traceEventWith :: (a -> String) -> Event a -> Event a
38+
39+
-- Transform Event to Event by sampling Behavior or Dynamic
40+
[ ] gate :: Behavior Bool -> Event a -> Event a
41+
[ ] tag :: Behavior a -> Event b -> Event a
42+
[ ] tagDyn :: Dynamic a -> Event b -> Event a
43+
[ ] attach :: Behavior a -> Event b -> Event (a, b)
44+
[ ] attachDyn :: Dynamic a -> Event b -> Event (a, b)
45+
[ ] attachWith :: (a -> b -> c) -> Behavior a -> Event b -> Event c
46+
[ ] attachDynWith :: (a -> b -> c) -> Dynamic a -> Event b -> Event c
47+
[ ] attachWithMaybe :: (a -> b -> Maybe c) -> Behavior a -> Event b -> Event c
48+
[ ] attachDynWithMaybe :: (a -> b -> Maybe c) -> Dynamic a -> Event b -> Event c
49+
50+
-- Combine multiple Events
51+
[ ] <> :: Monoid a => Event a -> Event a -> Event a
52+
[ ] mergeWith :: (a -> a -> a) -> [Event a] -> Event a
53+
[ ] leftmost :: [Event a] -> Event a
54+
[ ] mergeList :: [Event a] -> Event (NonEmpty a)
55+
[ ] merge :: GCompare k => DMap (WrapArg Event k) -> Event (DMap k)
56+
[ ] mergeMap :: Ord k => Map k (Event a) -> Event (Map k a)
57+
58+
-- Efficient one-to-many fanout
59+
[ ] fanMap :: Ord k => Event (Map k a) -> EventSelector (Const2 k a)
60+
[ ] fan :: GCompare k => Event (DMap k) -> EventSelector k
61+
[ ] select :: EventSelector k -> k a -> Event a
62+
63+
-- Event to Event via function that can sample current values
64+
[ ] push :: (a -> m (Maybe b)) -> Event a -> Event b
65+
[ ] pushAlways :: (a -> m b ) -> Event a -> Event b
66+
-- Note supplied function operates in [H] context
67+
68+
-- Split Event into next occurrence and all other future occurrences, as of now.
69+
[H] headE :: Event a -> m (Event a)
70+
[H] tailE :: Event a -> m (Event a)
71+
[H] headTailE :: Event a -> m (Event a, Event a)
72+
```
73+
74+
## Functions producing Behavior
75+
76+
```haskell
77+
-- Trivial Behavior
78+
[ ] constant :: a -> Behavior a
79+
80+
-- Extract Behavior from Dynamic
81+
[ ] current :: Dynamic a -> Behavior a
82+
83+
-- Create Behavior with given initial value, updated when the Event fires.
84+
[H] hold :: a -> Event a -> m (Behavior a)
85+
86+
-- Transform Behavior to Behavior using function
87+
[ ] fmap :: (a -> b) -> Behavior a -> Behavior b
88+
[ ] ffor :: Behavior a -> (a -> b) -> Behavior b
89+
[ ] <*> :: Behavior (a -> b) -> Behavior a -> Behavior b
90+
[ ] >>= :: Behavior a -> (a -> Behavior b) -> Behavior b
91+
[ ] <> :: Monoid a => Behavior a -> Behavior a -> Behavior a
92+
-- ... plus many more due to typeclass membership
93+
94+
-- Behavior to Behavior by sampling current values
95+
[S] sample :: Behavior a -> m a
96+
[ ] pull :: m a -> Behavior a
97+
-- Note supplied value is in [S] context
98+
```
99+
100+
## Functions producing Dynamic
101+
102+
```haskell
103+
-- Trivial Dynamic
104+
[ ] constDyn :: a -> Dynamic a
105+
106+
-- Create Dynamic with given initial value, updated (various ways) when the Event fires.
107+
[H] holdDyn :: a -> Event a -> m (Dynamic a)
108+
[H] foldDyn :: (a -> b -> b ) -> b -> Event a -> m (Dynamic b)
109+
[H] foldDynMaybe :: (a -> b -> Maybe b ) -> b -> Event a -> m (Dynamic b)
110+
[H] foldDynM :: (a -> b -> m' b ) -> b -> Event a -> m (Dynamic b)
111+
[H] foldDynMaybeM :: (a -> b -> m' (Maybe b)) -> b -> Event a -> m (Dynamic b)
112+
-- Note m' supplies [H] context
113+
114+
-- Initial value is 0; counts Event firings from now.
115+
[H] count :: Num b => Event a -> m (Dynamic b)
116+
-- Initial Bool value is supplied; toggles at each Event firing.
117+
[H] toggle :: Bool -> Event a -> m (Dynamic Bool)
118+
119+
-- Transform Dynamic to Dynamic using function
120+
[H] forDyn :: Dynamic a -> (a -> b) -> m (Dynamic b)
121+
[H] mapDyn :: (a -> b) -> Dynamic a -> m (Dynamic b)
122+
[H] mapDynM :: (a -> m' b) -> Dynamic a -> m (Dynamic b)
123+
-- Note m' supplies [S] context
124+
[H] splitDyn :: Dynamic (a, b) -> m (Dynamic a, Dynamic b)
125+
126+
-- Combine multiple Dynamics
127+
[H] mconcatDyn :: Monoid a => [Dynamic a] -> m (Dynamic a)
128+
[H] distributeDMapOverDyn :: GCompare k => DMap (WrapArg Dynamic k) -> m (Dynamic (DMap k))
129+
[H] combineDyn :: (a -> b -> c) -> Dynamic a -> Dynamic b -> m (Dynamic c)
130+
131+
-- Efficient one-to-many fanout
132+
[ ] demux :: Ord k => Dynamic k -> Demux k
133+
[H] getDemuxed :: Eq k => Demux k -> k -> m (Dynamic Bool)
134+
135+
-- Dynamic to Dynamic, removing updates w/o value change
136+
[ ] nubDyn :: Eq a => Dynamic a -> Dynamic a
137+
138+
-- Dynamic to identical Dynamic with debug trace. (Only prints if Dynamic is ultimately used.)
139+
[ ] traceDyn :: Show a => String -> Dynamic a -> Dynamic a
140+
[ ] traceDynWith :: (a -> String) -> Dynamic a -> Dynamic a
141+
```
142+
143+
## Flattening functions
144+
145+
These functions flatten nested types such as Event-of-Event, Behavior-of-Event, Event-of-Behavior etc, removing the outer wrapper.
146+
147+
For Events, the returned Event fires whenever the latest Event supplied by the wrapper fires. There are differences in how the functions handle *coincidences* -- situations where the old or new Event fires at the same instant that we switch from old to new. In some cases, the output Event tracks the old Event at the instant of switchover, while in other cases it tracks the new Event.
148+
149+
```haskell
150+
-- Flatten Behavior-of-Event to Event. Old Event is used during switchover.
151+
[ ] switch :: Behavior (Event a) -> Event a
152+
153+
-- Flatten Dyanmic-of-Event to Event. New Event is used immediately.
154+
[ ] switchPromptlyDyn :: Dynamic (Event a) -> Event a
155+
156+
-- Flatten Event-of-Event to Event that fires when both wrapper AND new Event fire.
157+
[ ] coincidence :: Event (Event a) -> Event a
158+
159+
-- Flatten Dynamic-of-Dynamic to Dynamic. New Dynamic is used immediately.
160+
-- Output updated whenever inner OR outer Dynamic updates.
161+
[ ] joinDyn :: Dynamic (Dynamic a) -> Dynamic a
162+
[ ] joinDynThroughMap :: Ord k => Dynamic (Map k (Dynamic a)) -> Dynamic (Map k a)
163+
164+
-- Analogous to 'hold': Create a Behavior that is initially identical to the
165+
-- supplied Behavior. Updated to track a new Behavior whenever the Event fires.
166+
[H] switcher :: Behavior a -> Event (Behavior a) -> m (Behavior a)
167+
168+
-- Similar to above, for Events. Created Event initially tracks the first argument.
169+
-- At switchover, the output Event immediately tracks the new Event.
170+
[H] switchPromptly :: Event a -> Event (Event a) -> m (Event a)
171+
```

README.md

Lines changed: 2 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -12,4 +12,6 @@ Comprehensive documentation is still a work in progress, but a tutorial for Refl
1212

1313
[reddit/r/reflexfrp](http://www.reddit.com/r/reflexfrp)
1414

15+
[reflex at hackage](https://hackage.haskell.org/package/reflex)
16+
1517
irc.freenode.net #reflex-frp

default.nix

Lines changed: 3 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -1,12 +1,14 @@
11
{ mkDerivation, dependent-map, dependent-sum
22
, mtl, ref-tf, semigroups, these, MemoTrie, exception-transformers
3+
, haskell-src-exts, haskell-src-meta
34
}:
45
mkDerivation {
56
pname = "reflex";
6-
version = "0.3";
7+
version = "0.3.1";
78
src = builtins.filterSource (path: type: baseNameOf path != ".git") ./.;
89
buildDepends = [
910
dependent-map dependent-sum mtl ref-tf semigroups these exception-transformers
11+
haskell-src-exts haskell-src-meta
1012
];
1113
testDepends = [
1214
MemoTrie

reflex.cabal

Lines changed: 5 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -1,5 +1,5 @@
11
Name: reflex
2-
Version: 0.3
2+
Version: 0.3.1
33
Synopsis: Higher-order Functional Reactive Programming
44
Description: Reflex is a high-performance, deterministic, higher-order Functional Reactive Programming system
55
License: BSD3
@@ -28,7 +28,10 @@ library
2828
ref-tf == 0.4.*,
2929
exception-transformers == 0.4.*,
3030
transformers >= 0.2,
31-
transformers-compat >= 0.3
31+
transformers-compat >= 0.3,
32+
haskell-src-exts == 1.16.*,
33+
haskell-src-meta == 0.6.*,
34+
syb == 0.5.*
3235

3336
exposed-modules:
3437
Reflex,

src/Reflex/Dynamic.hs

Lines changed: 2 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -17,6 +17,8 @@ module Reflex.Dynamic ( Dynamic -- Abstract so we can preserve the law that the
1717
, mapDynM
1818
, foldDyn
1919
, foldDynM
20+
, foldDynMaybe
21+
, foldDynMaybeM
2022
, combineDyn
2123
, collectDyn
2224
, mconcatDyn

src/Reflex/Dynamic/TH.hs

Lines changed: 30 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -1,11 +1,17 @@
11
{-# LANGUAGE TemplateHaskell, ScopedTypeVariables, TypeOperators, GADTs, EmptyDataDecls, PatternGuards #-}
2-
module Reflex.Dynamic.TH (qDyn, unqDyn) where
2+
module Reflex.Dynamic.TH (qDyn, unqDyn, mkDyn) where
33

44
import Reflex.Dynamic
55

66
import Language.Haskell.TH
7+
import qualified Language.Haskell.TH.Syntax as TH
8+
import Language.Haskell.TH.Quote
79
import Data.Data
810
import Control.Monad.State
11+
import qualified Language.Haskell.Exts as Hs
12+
import qualified Language.Haskell.Meta.Syntax.Translate as Hs
13+
import Data.Monoid
14+
import Data.Generics
915

1016
-- | Quote a Dynamic expression. Within the quoted expression, you can use '$(unqDyn [| x |])' to refer to any expression 'x' of type 'Dynamic t a'; the unquoted result will be of type 'a'
1117
qDyn :: Q Exp -> Q Exp
@@ -36,3 +42,26 @@ data UnqDyn
3642
--TODO: It would be much nicer if the TH AST was extensible to support this kind of thing without trickery
3743
unqMarker :: a -> UnqDyn
3844
unqMarker = error "An unqDyn expression was used outside of a qDyn expression"
45+
46+
mkDyn :: QuasiQuoter
47+
mkDyn = QuasiQuoter
48+
{ quoteExp = mkDynExp
49+
, quotePat = error "mkDyn: pattern splices are not supported"
50+
, quoteType = error "mkDyn: type splices are not supported"
51+
, quoteDec = error "mkDyn: declaration splices are not supported"
52+
}
53+
54+
mkDynExp :: String -> Q Exp
55+
mkDynExp s = case Hs.parseExpWithMode (Hs.defaultParseMode { Hs.extensions = [ Hs.EnableExtension Hs.TemplateHaskell ] }) s of
56+
Hs.ParseFailed (Hs.SrcLoc _ l c) err -> fail $ "mkDyn:" <> show l <> ":" <> show c <> ": " <> err
57+
Hs.ParseOk e -> qDyn $ return $ everywhere (id `extT` reinstateUnqDyn) $ Hs.toExp $ everywhere (id `extT` antiE) e
58+
where TH.Name (TH.OccName occName) (TH.NameG _ _ (TH.ModName modName)) = 'unqMarker
59+
antiE x = case x of
60+
Hs.SpliceExp se ->
61+
Hs.App (Hs.Var $ Hs.Qual (Hs.ModuleName modName) (Hs.Ident occName)) $ case se of
62+
Hs.IdSplice v -> Hs.Var $ Hs.UnQual $ Hs.Ident v
63+
Hs.ParenSplice ps -> ps
64+
_ -> x
65+
reinstateUnqDyn (TH.Name (TH.OccName occName') (TH.NameQ (TH.ModName modName')))
66+
| modName == modName' && occName == occName' = 'unqMarker
67+
reinstateUnqDyn x = x

src/Reflex/Host/Class.hs

Lines changed: 37 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -4,6 +4,7 @@ module Reflex.Host.Class where
44
import Reflex.Class
55

66
import Control.Applicative
7+
import Control.Monad
78
import Control.Monad.Fix
89
import Control.Monad.Trans
910
import Control.Monad.Trans.Reader (ReaderT())
@@ -12,7 +13,8 @@ import Control.Monad.Trans.Cont (ContT())
1213
import Control.Monad.Trans.Except (ExceptT())
1314
import Control.Monad.Trans.RWS (RWST())
1415
import Control.Monad.Trans.State (StateT())
15-
import Data.Dependent.Sum (DSum)
16+
import qualified Control.Monad.Trans.State.Strict as Strict
17+
import Data.Dependent.Sum (DSum (..))
1618
import Data.Monoid
1719
import Data.GADT.Compare
1820
import Control.Monad.Ref
@@ -113,6 +115,25 @@ newEventWithTriggerRef = do
113115
return (e, rt)
114116
{-# INLINE newEventWithTriggerRef #-}
115117

118+
fireEventRef :: (MonadReflexHost t m, MonadRef m, Ref m ~ Ref IO) => Ref m (Maybe (EventTrigger t a)) -> a -> m ()
119+
fireEventRef mtRef input = do
120+
mt <- readRef mtRef
121+
case mt of
122+
Nothing -> return ()
123+
Just trigger -> fireEvents [trigger :=> input]
124+
125+
fireEventRefAndRead :: (MonadReflexHost t m, MonadRef m, Ref m ~ Ref IO) => Ref m (Maybe (EventTrigger t a)) -> a -> EventHandle t b -> m (Maybe b)
126+
fireEventRefAndRead mtRef input e = do
127+
mt <- readRef mtRef
128+
case mt of
129+
Nothing -> return Nothing -- Since we aren't firing the input, the output can't fire
130+
Just trigger -> fireEventsAndRead [trigger :=> input] $ do
131+
mGetValue <- readEvent e
132+
case mGetValue of
133+
Nothing -> return Nothing
134+
Just getValue -> liftM Just getValue
135+
136+
116137
--------------------------------------------------------------------------------
117138
-- Instances
118139
--------------------------------------------------------------------------------
@@ -152,6 +173,21 @@ instance MonadReflexHost t m => MonadReflexHost t (StateT s m) where
152173
type ReadPhase (StateT s m) = ReadPhase m
153174
fireEventsAndRead dm a = lift $ fireEventsAndRead dm a
154175
runHostFrame = lift . runHostFrame
176+
177+
178+
instance MonadReflexCreateTrigger t m => MonadReflexCreateTrigger t (Strict.StateT s m) where
179+
newEventWithTrigger = lift . newEventWithTrigger
180+
newFanEventWithTrigger initializer = lift $ newFanEventWithTrigger initializer
181+
182+
instance MonadSubscribeEvent t m => MonadSubscribeEvent t (Strict.StateT r m) where
183+
subscribeEvent = lift . subscribeEvent
184+
185+
instance MonadReflexHost t m => MonadReflexHost t (Strict.StateT s m) where
186+
type ReadPhase (Strict.StateT s m) = ReadPhase m
187+
fireEventsAndRead dm a = lift $ fireEventsAndRead dm a
188+
runHostFrame = lift . runHostFrame
189+
190+
155191

156192
instance MonadReflexCreateTrigger t m => MonadReflexCreateTrigger t (ContT r m) where
157193
newEventWithTrigger = lift . newEventWithTrigger

0 commit comments

Comments
 (0)