forked from citizennet/purescript-ocelot
/
Expandable.purs
172 lines (148 loc) · 4.08 KB
/
Expandable.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
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
module Ocelot.Block.Expandable where
import Prelude
import DOM.HTML.Indexed (HTMLdiv, HTMLspan, Interactive)
import Data.Array (snoc)
import Data.Bifunctor (lmap, rmap)
import Data.Foldable (foldr)
import Data.Maybe (Maybe(..), fromMaybe)
import Data.String.Read (class Read, read)
import Data.Tuple (Tuple(..))
import Halogen.HTML (PropName(..))
import Halogen.HTML as HH
import Halogen.HTML.Core (class IsProp, Prop(..), PropValue)
import Halogen.HTML.Properties as HP
import Halogen.VDom.DOM.Prop (propFromString)
import Ocelot.Block.Icon as Icon
import Ocelot.HTML.Properties ((<&>))
import Unsafe.Coerce (unsafeCoerce)
data Status
= Collapsed
| Expanded
instance read :: Read Status where
read = case _ of
"collapsed" -> pure Collapsed
"expanded" -> pure Expanded
otherwise -> Nothing
instance isPropStatus :: IsProp Status where
toPropValue = propFromString <<< toProp
toProp :: Status -> String
toProp = case _ of
Collapsed -> "collapsed"
Expanded -> "expanded"
toBoolean :: Status -> Boolean
toBoolean Collapsed = false
toBoolean Expanded = true
fromBoolean :: Boolean -> Status
fromBoolean false = Collapsed
fromBoolean true = Expanded
instance heytingAlgebraStatus :: HeytingAlgebra Status where
ff = Collapsed
tt = Expanded
implies a b = not a || b
conj Expanded Expanded = Expanded
conj _ _ = Collapsed
disj Expanded _ = Expanded
disj _ Expanded = Expanded
disj _ _ = Collapsed
not Expanded = Collapsed
not Collapsed = Expanded
headingClasses :: Array HH.ClassName
headingClasses = HH.ClassName <$>
[ "flex"
, "justify-between"
, "cursor-pointer"
]
headingInnerClasses :: Array HH.ClassName
headingInnerClasses = HH.ClassName <$>
[ "flex-initial"
]
chevronClasses :: Array HH.ClassName
chevronClasses = HH.ClassName <$>
[ "text-grey-70"
, "text-lg"
, "leading-loose"
]
contentSharedClasses :: Array HH.ClassName
contentSharedClasses = HH.ClassName <$>
[]
contentClasses :: Status -> Array HH.ClassName
contentClasses status_ = contentSharedClasses <>
( case status_ of
Collapsed -> HH.ClassName <$>
[ "max-h-0"
, "opacity-0"
, "overflow-hidden"
, "transition-1/4-in"
]
Expanded -> HH.ClassName <$>
[ "max-h-full"
, "opacity-100"
, "transition-1/2-out"
]
)
type HTMLexpandable = Interactive ( expanded :: Status )
status :: ∀ r i. Status -> HP.IProp ( expanded :: Status | r ) i
status = HP.prop (PropName "expanded")
-- Takes a row of `IProps` containing the `expanded` label
-- and returns a `Tuple` containing the extracted value as
-- well as the original row, minus the `expanded` label
extractStatus
:: ∀ r i
. Array (HH.IProp ( expanded :: Status | r) i)
-> Tuple Status (Array (HH.IProp r i))
extractStatus =
foldr f (Tuple Expanded [])
where
f (HP.IProp (Property "expanded" expanded)) =
lmap (const $ coerceExpanded expanded)
f iprop = rmap $ (flip snoc) $ coerceR iprop
coerceExpanded :: PropValue -> Status
coerceExpanded = fromMaybe Expanded <<< read <<< unsafeCoerce
coerceR :: HH.IProp ( expanded :: Status | r ) i -> HH.IProp r i
coerceR = unsafeCoerce
heading
:: ∀ p i
. Array (HH.IProp HTMLexpandable i)
-> Array (HH.HTML p i)
-> HH.HTML p i
heading iprops html =
let (Tuple status_ iprops') = extractStatus iprops in
HH.header
( [ HP.classes headingClasses ] <&> iprops' )
[ HH.div
[ HP.classes headingInnerClasses ]
html
, HH.div_
[ chevron_ status_ ]
]
chevron
:: ∀ p i
. Status
-> Array (HH.IProp HTMLspan i)
-> HH.HTML p i
chevron status_ iprops =
( case status_ of
Collapsed -> Icon.expand
Expanded -> Icon.collapse
)
( [ HP.classes chevronClasses ] <&> iprops )
chevron_
:: ∀ p i
. Status
-> HH.HTML p i
chevron_ status_ = chevron status_ []
content
:: ∀ p i
. Status
-> Array (HH.IProp HTMLdiv i)
-> Array (HH.HTML p i)
-> HH.HTML p i
content status_ iprops =
HH.div
( [ HP.classes $ contentClasses status_ ] <&> iprops )
content_
:: ∀ p i
. Status
-> Array (HH.HTML p i)
-> HH.HTML p i
content_ status_ = content status_ []