-
Notifications
You must be signed in to change notification settings - Fork 0
/
Variant.purs
228 lines (201 loc) · 5.69 KB
/
Variant.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
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
module InteractiveData.DataUIs.Variant
( CfgVariant
, mkSurface
, module Export
, variant
, variant_
, view
) where
import InteractiveData.Core.Prelude
import Chameleon as C
import Data.Array as Array
import Data.Newtype as NT
import Data.Variant (Variant)
import DataMVC.Variant.DataUI (class DataUiVariant)
import DataMVC.Variant.DataUI as V
import InteractiveData.App.UI.DataLabel as UIDataLabel
import InteractiveData.Core.Types.IDSurface (runIdSurface)
import MVC.Variant (CaseKey(..), VariantMsg, VariantState, ViewArgs)
import MVC.Variant (VariantMsg, VariantState) as Export
import Partial.Unsafe (unsafePartial)
import Type.Proxy (Proxy(..))
view :: forall html msg. IDHtml html => ViewArgs html msg -> html msg
view { mkMsg, caseKey, caseKeys } =
withCtx \ctx ->
let
newSeg :: DataPathSegment
newSeg = SegCase $ NT.un CaseKey caseKey
newPath :: DataPath
newPath = ctx.path <> [ newSeg ]
countCases :: Int
countCases = Array.length caseKeys
singleCase :: Boolean
singleCase = countCases == 1
el =
{ caseLabels: styleNode C.div
[ "display: flex"
, "flex-direction: column"
, case ctx.viewMode of
Inline -> "flex-direction: column"
Standalone -> "flex-direction: row"
, "gap: 5px"
, "margin-bottom: 15px"
]
, caseLabel: C.div
}
in
putCtx ctx { path = newPath } $
C.div_
[ C.noHtml -- This is needed due to a very weird rendering issue in Halogen
, el.caseLabels []
( caseKeys # map \possibleCaseKey ->
el.caseLabel []
[ UIDataLabel.view
{ dataPath:
{ before: []
, path: ctx.path <> [ SegCase $ NT.un CaseKey possibleCaseKey ]
}
, mkTitle: UIDataLabel.mkTitleSelect
}
{ isSelected: possibleCaseKey == caseKey
, onHit: if singleCase then Nothing else Just $ mkMsg $ possibleCaseKey
}
]
)
, case ctx.viewMode of
Inline -> C.noHtml
Standalone | not ctx.fastForward -> C.noHtml
Standalone -> C.noHtml
]
mkSurface
:: forall html msg
. IDHtml html
=> { text :: Maybe String
}
-> ViewArgs (IDSurface html) msg
-> IDSurface html msg
mkSurface { text } opts =
IDSurface \(ctx :: IDSurfaceCtx) ->
let
opts' :: ViewArgs html _
opts' = opts
{ viewCase = opts.viewCase
# runIdSurface ctx
# un DataTree
# _.view
}
children :: DataTreeChildren html _
children = Case
(un CaseKey opts.caseKey /\ runIdSurface ctx opts.viewCase)
in
DataTree
{ view: view opts'
, children
, actions: dataActions
{ caseKey: opts.caseKey
, caseKeys: opts.caseKeys
, mkMsg: opts.mkMsg
}
, meta: Nothing
, text
}
type CfgVariant =
{ text :: Maybe String
}
defaultCfgVariant :: CfgVariant
defaultCfgVariant = { text: Nothing }
variant
:: forall opt datauis html fm fs @initsym rcase rmsg rsta r
. OptArgs CfgVariant opt
=> DataUiVariant datauis fm fs (IDSurface html) initsym rcase rmsg rsta r
=> IDHtml html
=> opt
-> Record datauis
-> DataUI
(IDSurface html)
fm
fs
(VariantMsg rcase rmsg)
(VariantState rsta)
(Variant r)
variant opt dataUis =
let
cfg :: CfgVariant
cfg = getAllArgs defaultCfgVariant opt
in
V.dataUiVariant
dataUis
(Proxy :: Proxy initsym)
{ view: mkSurface { text: cfg.text }
}
variant_
:: forall datauis html fm fs @initsym rcase rmsg rsta r
. DataUiVariant datauis fm fs (IDSurface html) initsym rcase rmsg rsta r
=> IDHtml html
=> Record datauis
-> DataUI
(IDSurface html)
fm
fs
(VariantMsg rcase rmsg)
(VariantState rsta)
(Variant r)
variant_ = variant {}
indexMod :: forall a. Int -> Array a -> a
indexMod idx items =
let
length :: Int
length = Array.length items
indexSafe :: Int
indexSafe = idx `mod` length
in
unsafePartial $ Array.unsafeIndex items indexSafe
dataActions
:: forall msg
. { caseKey :: CaseKey
, caseKeys :: Array CaseKey
, mkMsg :: CaseKey -> msg
}
-> Array (DataAction msg)
dataActions { caseKey, caseKeys, mkMsg } =
let
caseCount = Array.length caseKeys :: Int
index :: Maybe Int
index = Array.findIndex (_ == caseKey) caseKeys
indexOr0 :: Int
indexOr0 = fromMaybe 0 index
nextIndex :: Int
nextIndex = indexOr0 + 1
prevIndex :: Int
prevIndex = indexOr0 - 1
nextCaseKey :: CaseKey
nextCaseKey = indexMod nextIndex caseKeys
prevCaseKey :: CaseKey
prevCaseKey = indexMod prevIndex caseKeys
nextMsg :: msg
nextMsg = mkMsg $ indexMod nextIndex caseKeys
prevMsg :: msg
prevMsg = mkMsg $ indexMod prevIndex caseKeys
in
case caseCount of
0 -> []
1 -> []
2 ->
[ DataAction
{ label: "Toggle"
, description: "Switch to " <> un CaseKey nextCaseKey
, msg: This nextMsg
}
]
_ ->
[ DataAction
{ label: "Prev"
, description: "Switch to " <> un CaseKey prevCaseKey
, msg: This prevMsg
}
, DataAction
{ label: "Next"
, description: "Switch to " <> un CaseKey nextCaseKey
, msg: This nextMsg
}
]