Skip to content

Commit b6611af

Browse files
functorafunctora
committed
WIP
1 parent 243297e commit b6611af

File tree

4 files changed

+157
-69
lines changed

4 files changed

+157
-69
lines changed

‎ghcjs/delivery-calculator/src/App/Widgets/Assets.hs‎

Lines changed: 25 additions & 6 deletions
Original file line numberDiff line numberDiff line change
@@ -14,9 +14,28 @@ assetsViewer st = do
1414

1515
assetViewer :: Model -> Int -> [View Action]
1616
assetViewer st idx =
17-
FieldPairs.fieldPairsViewer
18-
FieldPairs.Args
19-
{ FieldPairs.argsModel = st,
20-
FieldPairs.argsOptic = #modelState . #stAssets . ix idx . #assetFieldPairs,
21-
FieldPairs.argsAction = PushUpdate . Instant
22-
}
17+
( FieldPairs.fieldPairsViewer args
18+
)
19+
<> ( if st
20+
^? #modelState
21+
. #stAssets
22+
. ix idx
23+
. #assetModalState
24+
== Just Opened
25+
then
26+
FieldPairs.fieldPairsEditor
27+
args
28+
$ FieldPairs.defOpts
29+
& #optsAdvanced
30+
.~ False
31+
else mempty
32+
)
33+
where
34+
args =
35+
FieldPairs.Args
36+
{ FieldPairs.argsModel = st,
37+
FieldPairs.argsOptic =
38+
#modelState . #stAssets . ix idx . #assetFieldPairs,
39+
FieldPairs.argsAction =
40+
PushUpdate . Instant
41+
}

‎ghcjs/miso-widgets/src/Functora/Miso/Widgets/Assets.hs‎

Lines changed: 1 addition & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -156,6 +156,7 @@ assetEditor
156156
. #assetFieldPairs,
157157
FieldPairs.argsAction = action
158158
}
159+
FieldPairs.defOpts
159160
where
160161
idxTxt :: Unicode
161162
idxTxt = "#" <> inspect (idx + 1)

‎ghcjs/miso-widgets/src/Functora/Miso/Widgets/FieldPairs.hs‎

Lines changed: 130 additions & 63 deletions
Original file line numberDiff line numberDiff line change
@@ -1,5 +1,7 @@
11
module Functora.Miso.Widgets.FieldPairs
22
( Args (..),
3+
Opts (..),
4+
defOpts,
35
fieldPairsViewer,
46
fieldPairsEditor,
57
)
@@ -19,6 +21,17 @@ data Args model action f = Args
1921
}
2022
deriving stock (Generic)
2123

24+
newtype Opts = Opts
25+
{ optsAdvanced :: Bool
26+
}
27+
deriving stock (Eq, Ord, Show, Data, Generic)
28+
29+
defOpts :: Opts
30+
defOpts =
31+
Opts
32+
{ optsAdvanced = True
33+
}
34+
2235
fieldPairsViewer :: (Foldable1 f) => Args model action f -> [View action]
2336
fieldPairsViewer args@Args {argsOptic = optic} = do
2437
item <-
@@ -84,73 +97,127 @@ fieldPairViewer args@Args {argsOptic = optic} idx pair =
8497
then Grid.bigCell
8598
else Grid.mediumCell
8699

87-
fieldPairsEditor :: Args model action Unique -> [View action]
88-
fieldPairsEditor args@Args {argsModel = st, argsOptic = optic} = do
100+
fieldPairsEditor :: Args model action Unique -> Opts -> [View action]
101+
fieldPairsEditor args@Args {argsModel = st, argsOptic = optic} opts = do
89102
idx <- fst <$> zip [0 ..] (fromMaybe mempty $ st ^? cloneTraversal optic)
90-
fieldPairEditor args idx
103+
fieldPairEditor args opts idx
91104

92105
fieldPairEditor ::
93106
forall model action.
94107
Args model action Unique ->
108+
Opts ->
95109
Int ->
96110
[View action]
97-
fieldPairEditor Args {argsModel = st, argsOptic = optic, argsAction = action} idx =
98-
[ Field.textField
99-
Field.Args
100-
{ Field.argsModel = st,
101-
Field.argsOptic = cloneTraversal optic . ix idx . #fieldPairKey,
102-
Field.argsAction = action
103-
}
104-
( Field.defOpts @model @action
105-
& #optsPlaceholder
106-
.~ ("Label " <> idxTxt)
107-
& ( #optsLeadingWidget ::
108-
Lens'
109-
(Field.Opts model action)
110-
(Maybe (Field.OptsWidget model action))
111-
)
112-
.~ Just (Field.DownWidget optic idx mempty)
113-
& #optsTrailingWidget
114-
.~ Just (Field.UpWidget optic idx mempty)
115-
),
116-
Field.dynamicField
117-
Field.Args
118-
{ Field.argsModel = st,
119-
Field.argsOptic = cloneTraversal optic . ix idx . #fieldPairValue,
120-
Field.argsAction = action
121-
}
122-
( Field.defOpts
123-
& #optsPlaceholder
124-
.~ ( "Value "
125-
<> idxTxt
126-
<> ( maybe mempty (" - " <>)
127-
$ st
128-
^? cloneTraversal optic
129-
. ix idx
130-
. #fieldPairValue
131-
. #fieldType
132-
. to userFieldType
133-
)
134-
)
135-
& ( #optsLeadingWidget ::
136-
Lens'
137-
(Field.Opts model action)
138-
(Maybe (Field.OptsWidget model action))
139-
)
140-
.~ Just
141-
( Field.ModalWidget
142-
$ Field.ModalFieldWidget
143-
optic
144-
idx
145-
#fieldPairValue
146-
Dynamic
147-
)
148-
& #optsTrailingWidget
149-
.~ Just
150-
( Field.DeleteWidget optic idx mempty
151-
)
152-
)
153-
]
154-
where
155-
idxTxt :: Unicode
156-
idxTxt = "#" <> inspect (idx + 1)
111+
fieldPairEditor
112+
Args
113+
{ argsModel = st,
114+
argsOptic = optic,
115+
argsAction = action
116+
}
117+
Opts
118+
{ optsAdvanced = False
119+
}
120+
idx =
121+
[ Field.dynamicField
122+
Field.Args
123+
{ Field.argsModel = st,
124+
Field.argsOptic = cloneTraversal optic . ix idx . #fieldPairValue,
125+
Field.argsAction = action
126+
}
127+
( Field.defOpts
128+
& #optsPlaceholder
129+
.~ ( fromMaybe ("#" <> inspect (idx + 1))
130+
$ st
131+
^? cloneTraversal optic
132+
. ix idx
133+
. #fieldPairKey
134+
. #fieldOutput
135+
)
136+
& ( #optsLeadingWidget ::
137+
Lens'
138+
(Field.Opts model action)
139+
(Maybe (Field.OptsWidget model action))
140+
)
141+
.~ Just
142+
( Field.ModalWidget
143+
$ Field.ModalFieldWidget
144+
optic
145+
idx
146+
#fieldPairValue
147+
Dynamic
148+
)
149+
& #optsTrailingWidget
150+
.~ Just
151+
( Field.DeleteWidget optic idx mempty
152+
)
153+
)
154+
]
155+
fieldPairEditor
156+
Args
157+
{ argsModel = st,
158+
argsOptic = optic,
159+
argsAction = action
160+
}
161+
Opts
162+
{ optsAdvanced = True
163+
}
164+
idx =
165+
[ Field.textField
166+
Field.Args
167+
{ Field.argsModel = st,
168+
Field.argsOptic = cloneTraversal optic . ix idx . #fieldPairKey,
169+
Field.argsAction = action
170+
}
171+
( Field.defOpts @model @action
172+
& #optsPlaceholder
173+
.~ ("Label " <> idxTxt)
174+
& ( #optsLeadingWidget ::
175+
Lens'
176+
(Field.Opts model action)
177+
(Maybe (Field.OptsWidget model action))
178+
)
179+
.~ Just (Field.DownWidget optic idx mempty)
180+
& #optsTrailingWidget
181+
.~ Just (Field.UpWidget optic idx mempty)
182+
),
183+
Field.dynamicField
184+
Field.Args
185+
{ Field.argsModel = st,
186+
Field.argsOptic = cloneTraversal optic . ix idx . #fieldPairValue,
187+
Field.argsAction = action
188+
}
189+
( Field.defOpts
190+
& #optsPlaceholder
191+
.~ ( "Value "
192+
<> idxTxt
193+
<> ( maybe mempty (" - " <>)
194+
$ st
195+
^? cloneTraversal optic
196+
. ix idx
197+
. #fieldPairValue
198+
. #fieldType
199+
. to userFieldType
200+
)
201+
)
202+
& ( #optsLeadingWidget ::
203+
Lens'
204+
(Field.Opts model action)
205+
(Maybe (Field.OptsWidget model action))
206+
)
207+
.~ Just
208+
( Field.ModalWidget
209+
$ Field.ModalFieldWidget
210+
optic
211+
idx
212+
#fieldPairValue
213+
Dynamic
214+
)
215+
& #optsTrailingWidget
216+
.~ Just
217+
( Field.DeleteWidget optic idx mempty
218+
)
219+
)
220+
]
221+
where
222+
idxTxt :: Unicode
223+
idxTxt = "#" <> inspect (idx + 1)

‎ghcjs/miso-widgets/src/Functora/Miso/Widgets/PaymentMethods.hs‎

Lines changed: 1 addition & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -157,6 +157,7 @@ paymentMethodEditor
157157
. #paymentMethodFieldPairs,
158158
FieldPairs.argsAction = action
159159
}
160+
FieldPairs.defOpts
160161
where
161162
idxTxt :: Unicode
162163
idxTxt = "#" <> inspect (idx + 1)

0 commit comments

Comments
 (0)