Skip to content

Commit 8e8df88

Browse files
functorafunctora
committed
wip
1 parent 2da583b commit 8e8df88

File tree

8 files changed

+144
-134
lines changed

8 files changed

+144
-134
lines changed

‎cabal.project‎

Lines changed: 2 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -67,8 +67,8 @@ else
6767
ghcjs/*/*.cabal
6868
optional-packages:
6969
prv/*/*.cabal
70-
-- package postgresql-libpq
71-
-- flags: +use-pkg-config
70+
package postgresql-libpq
71+
flags: +use-pkg-config
7272
source-repository-package
7373
type: git
7474
location: https://github.com/reanimate/reanimate.git

‎ghcjs/delivery-calculator/flake.nix‎

Lines changed: 1 addition & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -120,6 +120,7 @@
120120
pkgs.libwebp
121121
pkgs.secp256k1
122122
pkgs.pkg-config
123+
pkgs.postgresql
123124
inputs.ghc-wasm-meta.packages.${system}.all_9_10
124125
app-ghcid
125126
app-serve-latest

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

Lines changed: 16 additions & 37 deletions
Original file line numberDiff line numberDiff line change
@@ -14,12 +14,11 @@ import qualified Functora.Miso.Widgets.BrowserLink as BrowserLink
1414
import qualified Functora.Miso.Widgets.Currency as Currency
1515
import qualified Functora.Miso.Widgets.Field as Field
1616
import qualified Functora.Miso.Widgets.Grid as Grid
17+
import qualified Functora.Miso.Widgets.Select as Select
1718
import qualified Functora.Money as Money
1819
import qualified Material.Button as Button
1920
import qualified Material.Dialog as Dialog
2021
import qualified Material.IconButton as IconButton
21-
import qualified Material.Select as Select
22-
import qualified Material.Select.Item as SelectItem
2322
import qualified Material.Theme as Theme
2423
import qualified Material.TopAppBar as TopAppBar
2524
import qualified Text.URI as URI
@@ -177,41 +176,21 @@ menu st =
177176
Currency.argsCurrencies =
178177
#modelCurrencies
179178
},
180-
let item :| items = enumerateNE @OnlineOrOffline
181-
in Grid.mediumCell
182-
[ Select.outlined
183-
( Select.config
184-
& Select.setLabel
185-
( Just "Exchange rate"
186-
)
187-
& Select.setSelected
188-
( Just
189-
$ st
190-
^. #modelState
191-
. #stOnlineOrOffline
192-
)
193-
& Select.setOnChange
194-
( \x ->
195-
PushUpdate
196-
. Instant
197-
. PureUpdate
198-
$ #modelState
199-
. #stOnlineOrOffline
200-
.~ x
201-
)
202-
)
203-
( SelectItem.selectItem
204-
(SelectItem.config item)
205-
[text $ inspect item]
206-
)
207-
$ fmap
208-
( \x ->
209-
SelectItem.selectItem
210-
(SelectItem.config x)
211-
[text $ inspect x]
212-
)
213-
items
214-
],
179+
Grid.mediumCell
180+
[ span_ mempty [text "Exchange rate"],
181+
Select.select
182+
Select.defOpts
183+
Select.Args
184+
{ Select.argsModel =
185+
st,
186+
Select.argsOptic =
187+
#modelState . #stOnlineOrOffline,
188+
Select.argsAction =
189+
PushUpdate . Instant,
190+
Select.argsOptions =
191+
constTraversal $ enumerate @OnlineOrOffline
192+
}
193+
],
215194
Grid.mediumCell
216195
[ Field.ratioField
217196
Field.Args

‎ghcjs/miso-functora/miso-capa.cabal‎ renamed to ‎ghcjs/miso-functora/miso-functora.cabal‎

Lines changed: 16 additions & 14 deletions
Original file line numberDiff line numberDiff line change
@@ -99,6 +99,13 @@ library
9999
ghc-options: -Wno-unused-packages
100100

101101
exposed-modules:
102+
Functora.Miso.Css
103+
Functora.Miso.Jsm
104+
Functora.Miso.Jsm.Generic
105+
Functora.Miso.Jsm.Specific
106+
Functora.Miso.Orphan
107+
Functora.Miso.Prelude
108+
Functora.Miso.Types
102109
Functora.Miso.Widgets.BrowserLink
103110
Functora.Miso.Widgets.Currency
104111
Functora.Miso.Widgets.Dialog
@@ -108,14 +115,8 @@ library
108115
Functora.Miso.Widgets.Grid
109116
Functora.Miso.Widgets.Money
110117
Functora.Miso.Widgets.Qr
118+
Functora.Miso.Widgets.Select
111119
Functora.Miso.Widgets.Switch
112-
Functora.Miso.Css
113-
Functora.Miso.Jsm
114-
Functora.Miso.Jsm.Generic
115-
Functora.Miso.Jsm.Specific
116-
Functora.Miso.Orphan
117-
Functora.Miso.Prelude
118-
Functora.Miso.Types
119120

120121
test-suite miso-functora-test
121122
import: pkg
@@ -132,6 +133,13 @@ test-suite miso-functora-test
132133
if flag(ghcid)
133134
hs-source-dirs: src
134135
other-modules:
136+
Functora.Miso.Css
137+
Functora.Miso.Jsm
138+
Functora.Miso.Jsm.Generic
139+
Functora.Miso.Jsm.Specific
140+
Functora.Miso.Orphan
141+
Functora.Miso.Prelude
142+
Functora.Miso.Types
135143
Functora.Miso.Widgets.BrowserLink
136144
Functora.Miso.Widgets.Currency
137145
Functora.Miso.Widgets.Dialog
@@ -141,14 +149,8 @@ test-suite miso-functora-test
141149
Functora.Miso.Widgets.Grid
142150
Functora.Miso.Widgets.Money
143151
Functora.Miso.Widgets.Qr
152+
Functora.Miso.Widgets.Select
144153
Functora.Miso.Widgets.Switch
145-
Functora.Miso.Css
146-
Functora.Miso.Jsm
147-
Functora.Miso.Jsm.Generic
148-
Functora.Miso.Jsm.Specific
149-
Functora.Miso.Orphan
150-
Functora.Miso.Prelude
151-
Functora.Miso.Types
152154

153155
else
154156
build-depends: miso-functora

‎ghcjs/miso-functora/src/Functora/Miso/Types.hs‎

Lines changed: 10 additions & 10 deletions
Original file line numberDiff line numberDiff line change
@@ -49,7 +49,7 @@ module Functora.Miso.Types
4949
LeadingOrTrailing (..),
5050
OpenedOrClosed (..),
5151
Update (..),
52-
evalUpdate
52+
evalUpdate,
5353
)
5454
where
5555

@@ -268,7 +268,7 @@ data FieldType
268268
| FieldTypeQrCode
269269
| FieldTypeHtml
270270
| FieldTypePassword
271-
deriving stock (Eq, Ord, Show, Enum, Bounded, Data, Generic)
271+
deriving stock (Eq, Ord, Show, Read, Enum, Bounded, Data, Generic)
272272
deriving (Binary) via GenericType FieldType
273273

274274
htmlFieldType :: FieldType -> Unicode
@@ -501,31 +501,31 @@ keyed uid = \case
501501
data TopOrBottom
502502
= Top
503503
| Bottom
504-
deriving stock (Eq, Ord, Show, Enum, Bounded, Data, Generic)
504+
deriving stock (Eq, Ord, Show, Read, Enum, Bounded, Data, Generic)
505505
deriving (Binary) via GenericType TopOrBottom
506506

507507
data OnlineOrOffline
508508
= Online
509509
| Offline
510-
deriving stock (Eq, Ord, Show, Enum, Bounded, Data, Generic)
510+
deriving stock (Eq, Ord, Show, Read, Enum, Bounded, Data, Generic)
511511
deriving (Binary) via GenericType OnlineOrOffline
512512

513513
data StaticOrDynamic
514514
= Static
515515
| Dynamic
516-
deriving stock (Eq, Ord, Show, Enum, Bounded, Data, Generic)
516+
deriving stock (Eq, Ord, Show, Read, Enum, Bounded, Data, Generic)
517517
deriving (Binary) via GenericType StaticOrDynamic
518518

519519
data LeadingOrTrailing
520520
= Leading
521521
| Trailing
522-
deriving stock (Eq, Ord, Show, Enum, Bounded, Data, Generic)
522+
deriving stock (Eq, Ord, Show, Read, Enum, Bounded, Data, Generic)
523523
deriving (Binary) via GenericType LeadingOrTrailing
524524

525525
data OpenedOrClosed
526526
= Opened
527527
| Closed
528-
deriving stock (Eq, Ord, Show, Enum, Bounded, Data, Generic)
528+
deriving stock (Eq, Ord, Show, Read, Enum, Bounded, Data, Generic)
529529
deriving (Binary) via GenericType OpenedOrClosed
530530

531531
data Update model
@@ -536,6 +536,6 @@ data Update model
536536

537537
evalUpdate :: model -> Update model -> JSM model
538538
evalUpdate x = \case
539-
PureUpdate f -> pure $ f x
540-
ImpureUpdate g -> g >>= pure . ($ x)
541-
PureAndImpureUpdate f g -> g >>= pure . ($ f x)
539+
PureUpdate f -> pure $ f x
540+
ImpureUpdate g -> g >>= pure . ($ x)
541+
PureAndImpureUpdate f g -> g >>= pure . ($ f x)

‎ghcjs/miso-functora/src/Functora/Miso/Widgets/Field.hs‎

Lines changed: 20 additions & 71 deletions
Original file line numberDiff line numberDiff line change
@@ -25,12 +25,10 @@ import Functora.Miso.Types
2525
import qualified Functora.Miso.Widgets.Dialog as Dialog
2626
import qualified Functora.Miso.Widgets.Grid as Grid
2727
import qualified Functora.Miso.Widgets.Qr as Qr
28+
import qualified Functora.Miso.Widgets.Select as Select
2829
import qualified Language.Javascript.JSaddle as JS
2930
import qualified Material.IconButton as IconButton
30-
import qualified Material.Select as Select
31-
import qualified Material.Select.Item as SelectItem
3231
import qualified Material.TextField as TextField
33-
import qualified Material.Theme as Theme
3432
import qualified Miso.String as MS
3533

3634
data Args model action t f = Args
@@ -352,7 +350,7 @@ fieldIcon lot full opts = \case
352350
. action
353351
$ Jsm.removeAt opt idx
354352
ModalWidget (ModalItemWidget opt idx _ _ ooc) ->
355-
fieldIconSimple lot "settings" [Theme.primary]
353+
fieldIconSimple lot "settings" mempty
356354
. action
357355
. PureUpdate
358356
$ cloneTraversal opt
@@ -464,6 +462,7 @@ fieldModal args@Args {argsAction = action} (ModalItemWidget opt idx fps lbl ooc)
464462
]
465463
}
466464
fieldModal args (ModalFieldWidget opt idx access sod) = do
465+
let st = args ^. #argsModel
467466
let optic =
468467
cloneTraversal opt
469468
. ix idx
@@ -480,41 +479,15 @@ fieldModal args (ModalFieldWidget opt idx access sod) = do
480479
( case sod of
481480
Static -> mempty
482481
Dynamic ->
483-
[ let typ :| typs = enumerateNE @FieldType
484-
in Grid.bigCell
485-
[ Select.outlined
486-
( Select.config
487-
& Select.setLabel
488-
( Just "Type"
489-
)
490-
& Select.setSelected
491-
( args
492-
^? #argsModel
493-
. cloneTraversal optic
494-
. #fieldType
495-
)
496-
& Select.setOnChange
497-
( \x ->
498-
action
499-
. PureUpdate
500-
$ cloneTraversal optic
501-
. #fieldType
502-
.~ x
503-
)
504-
)
505-
( SelectItem.selectItem
506-
(SelectItem.config typ)
507-
[text $ userFieldType typ]
508-
)
509-
$ fmap
510-
( \t ->
511-
SelectItem.selectItem
512-
(SelectItem.config t)
513-
[text $ userFieldType t]
514-
)
515-
typs
516-
]
517-
]
482+
singleton
483+
$ Select.select
484+
Select.defOpts
485+
Select.Args
486+
{ Select.argsModel = st,
487+
Select.argsOptic = cloneTraversal optic . #fieldType,
488+
Select.argsAction = action,
489+
Select.argsOptions = constTraversal $ enumerate @FieldType
490+
}
518491
)
519492
<> [ -- Grid.mediumCell
520493
-- $ Switch.switch
@@ -569,38 +542,14 @@ selectTypeWidget ::
569542
ATraversal' model (Field a Unique) ->
570543
View action
571544
selectTypeWidget args@Args {argsAction = action} optic =
572-
let typ :| typs = enumerateNE @FieldType
573-
in Select.outlined
574-
( Select.config
575-
& Select.setLabel
576-
( Just "Type"
577-
)
578-
& Select.setSelected
579-
( args
580-
^? #argsModel
581-
. cloneTraversal optic
582-
. #fieldType
583-
)
584-
& Select.setOnChange
585-
( \x ->
586-
action
587-
. PureUpdate
588-
$ cloneTraversal optic
589-
. #fieldType
590-
.~ x
591-
)
592-
)
593-
( SelectItem.selectItem
594-
(SelectItem.config typ)
595-
[text $ userFieldType typ]
596-
)
597-
$ fmap
598-
( \t ->
599-
SelectItem.selectItem
600-
(SelectItem.config t)
601-
[text $ userFieldType t]
602-
)
603-
typs
545+
Select.select
546+
Select.defOpts
547+
Select.Args
548+
{ Select.argsModel = args ^. #argsModel,
549+
Select.argsOptic = cloneTraversal optic . #fieldType,
550+
Select.argsAction = action,
551+
Select.argsOptions = constTraversal $ enumerate @FieldType
552+
}
604553

605554
--
606555
-- TODO : support optional copying widgets

0 commit comments

Comments
 (0)