Skip to content

Commit f807a7e

Browse files
committed
wip
1 parent fa94bf5 commit f807a7e

File tree

3 files changed

+94
-136
lines changed

3 files changed

+94
-136
lines changed

ghcjs/miso-capa/src/Functora/Miso/Capa/Currency.hs

Lines changed: 85 additions & 129 deletions
Original file line numberDiff line numberDiff line change
@@ -6,17 +6,11 @@ module Functora.Miso.Capa.Currency
66
)
77
where
88

9-
import qualified Data.List.NonEmpty as NonEmpty
9+
import qualified Functora.Miso.Capa.Dialog as Dialog
1010
import qualified Functora.Miso.Capa.Field as Field
11-
import qualified Functora.Miso.Css as Css
1211
import Functora.Miso.Prelude
1312
import Functora.Miso.Types
1413
import Functora.Money hiding (Currency, Money, Text)
15-
import qualified Material.Button as Button
16-
import qualified Material.Dialog as Dialog
17-
import qualified Material.LayoutGrid as LayoutGrid
18-
import qualified Material.List as List
19-
import qualified Material.List.Item as ListItem
2014
import qualified Miso
2115
import qualified Text.Fuzzy as Fuzzy
2216

@@ -42,73 +36,56 @@ defOpts =
4236
optsButtonViewer = inspectCurrencyInfo
4337
}
4438

45-
selectCurrency :: Args model action -> Opts model -> View action
39+
selectCurrency :: Opts model -> Args model action -> View action
4640
selectCurrency
41+
opts@Opts
42+
{ optsExtraOnClick = extraOnClick
43+
}
4744
args@Args
4845
{ argsModel = st,
4946
argsOptic = optic,
5047
argsAction = action,
5148
argsEmitter = emitter
52-
}
53-
opts@Opts {optsExtraOnClick = extraOnClick} =
54-
LayoutGrid.cell
55-
[ LayoutGrid.span6Desktop
56-
]
57-
$ [ Button.raised
58-
( Button.setOnClick opened
59-
. Button.setAttributes
60-
[ Css.fullWidth
61-
]
62-
$ Button.config
63-
)
64-
. ( optsButtonViewer opts
65-
)
49+
} =
50+
div_ mempty
51+
$ [ button_ [onClick open]
52+
. singleton
53+
. text
54+
. (opts ^. #optsButtonViewer)
6655
$ fromMaybe
6756
(CurrencyInfo (CurrencyCode "XXX") mempty)
6857
(st ^? cloneTraversal optic . #currencyOutput)
6958
]
70-
<> if st ^? cloneTraversal optic . #currencyModalState /= Just Opened
71-
then mempty
72-
else
73-
[ Dialog.dialog
74-
( Dialog.config
75-
& Dialog.setOnClose closed
76-
& Dialog.setOpen True
77-
)
78-
( Dialog.dialogContent
79-
Nothing
80-
[ currencyListWidget args opts
81-
]
82-
[ div_
83-
[ Css.fullWidth
84-
]
85-
[ Field.textField
86-
Field.Args
87-
{ Field.argsModel = st,
88-
Field.argsOptic =
89-
cloneTraversal optic
90-
. #currencyInput,
91-
Field.argsAction = action,
92-
Field.argsEmitter = emitter
93-
}
94-
( Field.defOpts
95-
& #optsPlaceholder
96-
.~ "Search"
97-
),
98-
Button.raised
99-
( Button.config
100-
& Button.setOnClick closed
101-
& Button.setAttributes
102-
[ Css.fullWidth
103-
]
104-
)
105-
"Back"
106-
]
107-
]
108-
)
109-
]
59+
<> Dialog.dialog
60+
Dialog.defOpts
61+
{ Dialog.optsExtraOnClose =
62+
cloneTraversal optic
63+
. #currencyInput
64+
. #fieldInput
65+
. #uniqueValue
66+
.~ mempty
67+
}
68+
Dialog.Args
69+
{ Dialog.argsModel = st,
70+
Dialog.argsOptic = cloneTraversal optic . #currencyModalState,
71+
Dialog.argsAction = action,
72+
Dialog.argsContent =
73+
[ currencyListWidget opts args,
74+
Field.textField
75+
Field.Args
76+
{ Field.argsModel = st,
77+
Field.argsOptic = cloneTraversal optic . #currencyInput,
78+
Field.argsAction = action,
79+
Field.argsEmitter = emitter
80+
}
81+
( Field.defOpts
82+
& #optsPlaceholder
83+
.~ "Search"
84+
)
85+
]
86+
}
11087
where
111-
opened =
88+
open =
11289
action . PureUpdate $ \prev ->
11390
prev
11491
& cloneTraversal optic
@@ -120,33 +97,17 @@ selectCurrency
12097
. #uniqueValue
12198
.~ mempty
12299
& extraOnClick
123-
closed =
124-
action . PureUpdate $ \prev ->
125-
prev
126-
& cloneTraversal optic
127-
. #currencyModalState
128-
.~ Closed
129-
& cloneTraversal optic
130-
. #currencyInput
131-
. #fieldInput
132-
. #uniqueValue
133-
.~ mempty
134100

135-
currencyListWidget :: Args model action -> Opts model -> View action
101+
currencyListWidget :: Opts model -> Args model action -> View action
136102
currencyListWidget
103+
opts
137104
args@Args
138105
{ argsModel = st,
139106
argsOptic = optic,
140107
argsCurrencies = currencies
141-
}
142-
opts =
143-
List.list
144-
List.config
145-
( currencyListItemWidget args opts current
146-
$ maybe (newFuzz current) NonEmpty.head matching
147-
)
148-
. fmap (currencyListItemWidget args opts current)
149-
$ maybe mempty NonEmpty.tail matching
108+
} =
109+
ul_ [class_ "tree-view"]
110+
$ fmap (currencyListItemWidget opts args current) matching
150111
where
151112
current =
152113
fromMaybe
@@ -167,65 +128,60 @@ currencyListWidget
167128
. #fieldInput
168129
. #uniqueValue
169130
matching =
131+
--
132+
-- TODO : filter not by exact word order,
133+
-- but by all possible permutations as well,
134+
-- with bigger priority for original query.
135+
--
170136
if search == mempty
171-
then Just . fmap newFuzz $ st ^. currencies
137+
then fmap newFuzz . toList $ st ^. currencies
172138
else
173-
nonEmpty
174-
--
175-
-- TODO : filter not by exact word order,
176-
-- but by all possible permutations as well,
177-
-- with bigger priority for original query.
178-
--
179-
$ Fuzzy.filter
180-
search
181-
( toList $ st ^. currencies
182-
)
183-
"<b>"
184-
"</b>"
185-
inspectCurrencyInfo
186-
False
139+
Fuzzy.filter
140+
search
141+
(toList $ st ^. currencies)
142+
"<b>"
143+
"</b>"
144+
inspectCurrencyInfo
145+
False
187146

188147
currencyListItemWidget ::
189-
Args model action ->
190148
Opts model ->
149+
Args model action ->
191150
CurrencyInfo ->
192151
Fuzzy.Fuzzy CurrencyInfo Unicode ->
193-
ListItem.ListItem action
152+
View action
194153
currencyListItemWidget
154+
Opts
155+
{ optsExtraOnClick = extraOnClick
156+
}
195157
Args
196158
{ argsOptic = optic,
197159
argsAction = action
198160
}
199-
Opts
200-
{ optsExtraOnClick = extraOnClick
201-
}
202161
current
203162
fuzz =
204-
ListItem.listItem
205-
( ListItem.config
206-
& ListItem.setSelected
207-
( if current == item
208-
then Just ListItem.activated
209-
else Nothing
210-
)
211-
& ListItem.setOnClick
212-
( action . PureUpdate $ \st ->
213-
st
214-
& cloneTraversal optic
215-
. #currencyModalState
216-
.~ Closed
217-
& cloneTraversal optic
218-
. #currencyInput
219-
. #fieldInput
220-
. #uniqueValue
221-
.~ mempty
222-
& cloneTraversal optic
223-
. #currencyOutput
224-
.~ item
225-
& extraOnClick
226-
)
227-
)
228-
[ Miso.rawHtml
163+
li_
164+
[ onClick . action . PureUpdate $ \st ->
165+
st
166+
& cloneTraversal optic
167+
. #currencyModalState
168+
.~ Closed
169+
& cloneTraversal optic
170+
. #currencyInput
171+
. #fieldInput
172+
. #uniqueValue
173+
.~ mempty
174+
& cloneTraversal optic
175+
. #currencyOutput
176+
.~ item
177+
& extraOnClick
178+
]
179+
[ ( if current == item
180+
then strong_ mempty
181+
else span_ mempty
182+
)
183+
. singleton
184+
. Miso.rawHtml
229185
$ Fuzzy.rendered fuzz
230186
]
231187
where

ghcjs/miso-capa/src/Functora/Miso/Capa/Dialog.hs

Lines changed: 7 additions & 5 deletions
Original file line numberDiff line numberDiff line change
@@ -17,18 +17,20 @@ data Args model action = Args
1717
}
1818
deriving stock (Generic)
1919

20-
data Opts = Opts
21-
{ optsTitle :: Maybe Unicode
20+
data Opts model = Opts
21+
{ optsTitle :: Maybe Unicode,
22+
optsExtraOnClose :: model -> model
2223
}
2324
deriving stock (Generic)
2425

25-
defOpts :: Opts
26+
defOpts :: Opts model
2627
defOpts =
2728
Opts
28-
{ optsTitle = Nothing
29+
{ optsTitle = Nothing,
30+
optsExtraOnClose = id
2931
}
3032

31-
dialog :: forall model action. Opts -> Args model action -> [View action]
33+
dialog :: forall model action. Opts model -> Args model action -> [View action]
3234
dialog opts args =
3335
if args ^? #argsModel . cloneTraversal optic /= Just Opened
3436
then mempty

ghcjs/miso-capa/src/Functora/Miso/Capa/Switch.hs

Lines changed: 2 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -34,10 +34,10 @@ defOpts =
3434

3535
switch ::
3636
forall model action.
37-
Args model action ->
3837
Opts model action ->
38+
Args model action ->
3939
View action
40-
switch Args {argsModel = st, argsOptic = optic, argsAction = action} opts =
40+
switch opts Args {argsModel = st, argsOptic = optic, argsAction = action} =
4141
Flex.flex mempty
4242
$ maybeToList
4343
( fmap (\icon -> i_ [class_ icon] mempty)

0 commit comments

Comments
 (0)