/
Wizard.purs
211 lines (196 loc) · 7.11 KB
/
Wizard.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
module Lumi.Components.Wizard
( Wizard
, step
, revalidate
, WizardStep
, stepIdentifier
, liftStep
, resumeStep
, previousStep
, gotoStep
, wizard
) where
import Prelude
import Control.Monad.Free (Free, foldFree, liftF, resume)
import Data.Bifunctor (lmap)
import Data.Either (Either(..))
import Data.Maybe (Maybe(..))
import Data.Newtype (class Newtype, un)
import Effect (Effect)
import Lumi.Components.Form (FormBuilder)
import Lumi.Components.Form as F
import React.Basic (JSX)
import Record.Unsafe.Union (unsafeUnion)
import Unsafe.Coerce (unsafeCoerce)
-- | `Form` is the base functor for the `Wizard` language. It represents a
-- | form as a step of the wizard, taking a parametrized identifier for the
-- | current step, and a function to effectively run the form step.
newtype Form step props value a =
Form
{ run ::
props
-> value
-> { form :: { forceTopLabels :: Boolean, inlineTable :: Boolean } -> ((value -> value) -> Effect Unit) -> JSX
, result :: Maybe a
}
, step :: step
}
derive instance functorForm :: Functor (Form step props value)
-- | A `Wizard` is a sequential computation of `FormBuilder`s, representing,
-- | each one, a wizard step that can depend on the result of previous steps to
-- | produce a final result.
-- |
-- | `Wizard` is a monadic DSL that contains only a single instruction: `step`.
newtype Wizard step (props :: Type) value a = Wizard (Free (Form step props value) a)
derive instance newtypeWizard :: Newtype (Wizard step props value a) _
derive newtype instance functorWizard :: Functor (Wizard step props value)
derive newtype instance applyWizard :: Apply (Wizard step props value)
derive newtype instance applicativeWizard :: Applicative (Wizard step props value)
derive newtype instance bindWizard :: Bind (Wizard step props value)
derive newtype instance monadWizard :: Monad (Wizard step props value)
-- | Lift a `FormBuilder` and an associated identifier of type `step` into a
-- | `Wizard step`.
step
:: forall step props value
. step
-> FormBuilder { readonly :: Boolean | props } value
~> Wizard step { readonly :: Boolean | props } value
step s f =
let
form = F.build f
in
Wizard $ liftF $ Form
{ step: s
, run:
\props value ->
{ form: \{ forceTopLabels, inlineTable } onChange ->
form $ unsafeUnion props
{ value
, onChange: \_ -> onChange
, forceTopLabels
, inlineTable
}
, result: F.revalidate f props value
}
}
-- | Revalidate a `Wizard`, returning the final result if, with the given
-- | `value`, all steps produce valid results.
revalidate :: forall step props value a. Wizard step props value a -> props -> value -> Maybe a
revalidate w props value = foldFree go (un Wizard w)
where
go :: Form step props value ~> Maybe
go (Form form) = (form.run props value).result
-- | `WizardStep` is a suspended `Wizard` computation, that is, a `Wizard`
-- | whose execution has been stopped at some step. It can be thought of as a
-- | `Wizard` zipper.
newtype WizardStep step (props :: Type) value a = WizardStep
{ previous :: Maybe (WizardStep step props value a)
, current :: Either (Form step props value (Wizard step props value a)) a
}
derive instance newtypeWizardStep :: Newtype (WizardStep step props value a) _
-- | Retrieve the identifier for the focused step of a `WizardStep`.
-- | Returns `Nothing` if the `WizardStep` represents a finalized `Wizard`.
stepIdentifier :: forall step props value a. WizardStep step props value a -> Maybe step
stepIdentifier (WizardStep { current }) =
case current of
Left (Form form) -> Just form.step
Right _ -> Nothing
-- | Lifts a `Wizard` into a `WizardStep` that focuses on its first step.
liftStep :: forall step props value. Wizard step props value ~> WizardStep step props value
liftStep = WizardStep <<< { previous: Nothing, current: _ } <<< lmap (map Wizard) <<< resume <<< un Wizard
-- | Resume a suspended `WizardStep`, if the current step produces a valid
-- | result, returning either the next `WizardStep` or the final result.
resumeStep
:: forall step props value a
. WizardStep step props value a
-> props
-> value
-> Maybe (Either (WizardStep step props value a) a)
resumeStep s@(WizardStep { current }) props value =
case current of
Right a -> Just (Right a)
Left (Form form) ->
let
{ result } = form.run props value
in
case result of
Nothing -> Nothing
Just next ->
case resume (un Wizard next) of
Right a -> Just (Right a)
Left _ -> Just $ Left $
WizardStep
{ previous: Just s
, current: lmap (map Wizard) (resume (un Wizard next))
}
-- | Return the previous step, if there is one.
previousStep
:: forall step props value a
. WizardStep step props value a
-> Maybe (WizardStep step props value a)
previousStep = _.previous <<< un WizardStep
-- | Given that the `step` identifiers for the supplied `Wizard` are ordered,
-- | go to the first step in a `Wizard` that is assigned to the given
-- | identifier, if found.
gotoStep
:: forall step props value a
. Ord step
=> step
-> Wizard step props value a
-> props
-> value
-> Maybe (WizardStep step props value a)
gotoStep s w props value = go (liftStep w)
where
go :: WizardStep step props value a -> Maybe (WizardStep step props value a)
go wizardStep@(WizardStep { previous, current }) =
case current of
Right a -> Nothing
Left (Form form) ->
if form.step >= s
then Just wizardStep
else
let
{ result } = form.run props value
in
case result of
Nothing -> Nothing
Just next ->
case resume (un Wizard next) of
Right a -> Nothing
Left _ ->
go $ WizardStep
{ previous: Just wizardStep
, current: lmap (map Wizard) (resume (un Wizard next))
}
-- | A component that renders a `WizardStep` (a suspended `Wizard`).
wizard
:: forall step props value a
. { step :: WizardStep step {| props } value a
, value :: value
, onChange :: (value -> value) -> Effect Unit
, forceTopLabels :: Boolean
, inlineTable :: Boolean
| props
}
-> JSX
wizard props@{ value, onChange, forceTopLabels, inlineTable } =
case (un WizardStep props.step).current of
Right a ->
mempty
Left (Form form') ->
let
{ form } = form'.run (contractProps props) value
in
form { forceTopLabels, inlineTable } onChange
where
contractProps
:: { step :: WizardStep step {| props } value a
, value :: value
, onChange :: (value -> value) -> Effect Unit
, forceTopLabels :: Boolean
, inlineTable :: Boolean
| props
}
-> {| props }
contractProps = unsafeCoerce