-
Notifications
You must be signed in to change notification settings - Fork 0
/
Trans.purs
84 lines (60 loc) · 2.76 KB
/
Trans.purs
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
module Chameleon.Transformers.Accum.Trans where
import Prelude
import Chameleon.Class (class Html, class MapMaybe, Key)
import Chameleon.Class as C
import Chameleon.Transformers.Accum.Class (class Accum, class TellAccum)
import Chameleon.Transformers.OutMsg.Class (class OutMsg, class RunOutMsg, fromOutHtml)
import Chameleon.Transformers.OutMsg.Class as O
import Chameleon.Transformers.FunctorTrans.Class (class FunctorTrans)
import Control.Monad.Writer (runWriter, tell)
import Data.These (These)
import Data.Traversable (for)
import Data.Tuple (Tuple(..))
import Data.Tuple.Nested (type (/\), (/\))
data AccumT :: Type -> (Type -> Type) -> Type -> Type
data AccumT acc html a = AccumT acc (html a)
derive instance (Functor html) => Functor (AccumT acc html)
instance Monoid acc => FunctorTrans (AccumT acc) where
lift :: forall html msg. html msg -> AccumT acc html msg
lift = AccumT mempty
runAccumT :: forall acc html a. AccumT acc html a -> Tuple (html a) acc
runAccumT (AccumT acc html) = Tuple html acc
execAccumT :: forall acc html a. AccumT acc html a -> acc
execAccumT (AccumT acc _) = acc
evalAccumT :: forall acc html a. AccumT acc html a -> html a
evalAccumT (AccumT _ html) = html
-- Accum
instance Semigroup acc => TellAccum acc (AccumT acc html) where
tellAccum acc' html = AccumT (acc <> acc') html'
where
Tuple html' acc = runAccumT html
instance Semigroup acc => Accum acc (AccumT acc html) where
censorAccum f (AccumT acc html) = AccumT (f acc) html
-- Html
instance (Html html, Monoid acc) => Html (AccumT acc html) where
elem elemName props children = AccumT accum (C.elem elemName props children')
where
runChildren :: forall a. Array (AccumT acc html a) -> Array (html a) /\ acc
runChildren xs = runWriter do
for xs \(AccumT acc html) -> do
tell acc
pure html
children' /\ accum = runChildren children
elemKeyed elemName props children = AccumT accum (C.elemKeyed elemName props children')
where
runChildren :: forall a. Array (Key /\ AccumT acc html a) -> Array (Key /\ html a) /\ acc
runChildren xs = runWriter do
for xs \(key /\ AccumT acc html) -> do
tell acc
pure (key /\ html)
children' /\ accum = runChildren children
text str = AccumT mempty (C.text str)
-- MapMaybe
instance (MapMaybe html) => MapMaybe (AccumT acc html) where
mapMaybe f (AccumT acc html) = AccumT acc (C.mapMaybe f html)
-- OutMsg
instance (Monoid acc, OutMsg out html) => OutMsg out (AccumT acc html) where
fromOutHtml :: forall msg. AccumT acc html (These msg out) -> AccumT acc html msg
fromOutHtml (AccumT acc html) = (AccumT acc $ fromOutHtml html)
instance (Monoid acc, RunOutMsg out html) => RunOutMsg out (AccumT acc html) where
runOutMsg (AccumT acc html) = AccumT acc (O.runOutMsg html)