Skip to content

Commit 535928c

Browse files
committed
wip
1 parent 410566b commit 535928c

File tree

10 files changed

+72
-54
lines changed

10 files changed

+72
-54
lines changed

ghcjs/delivery-calculator/delivery-calculator.cabal

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -1,6 +1,6 @@
11
cabal-version: 2.2
22
name: delivery-calculator
3-
version: 0.1.0.13
3+
version: 0.1.0.14
44
synopsis: Delivery Calculator
55
category: Web
66
build-type: Simple

ghcjs/delivery-calculator/src/App/Jsm.hs

Lines changed: 0 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -1,5 +1,3 @@
1-
{-# OPTIONS_GHC -Wno-deprecations #-}
2-
31
module App.Jsm (fetchBlobUris) where
42

53
import App.Types

ghcjs/delivery-calculator/src/App/Types.hs

Lines changed: 1 addition & 3 deletions
Original file line numberDiff line numberDiff line change
@@ -82,6 +82,7 @@ data Action
8282
= Noop
8383
| InitUpdate (Maybe (St Unique))
8484
| SyncInputs
85+
| LinkUpdate (Model -> Model)
8586
| EvalUpdate (Model -> Model)
8687
| PushUpdate (Update Model)
8788

@@ -96,7 +97,6 @@ data St f = St
9697
stMerchantEmail :: Field Unicode f,
9798
stMerchantFeePercent :: Field DynamicField f,
9899
stOnlineOrOffline :: OnlineOrOffline,
99-
stPreview :: Field Unicode f,
100100
stScreen :: Screen,
101101
stEnableTheme :: Bool,
102102
stTheme :: Theme
@@ -127,7 +127,6 @@ newSt = do
127127
whats <- newTextField "TODO"
128128
email <- newTextField "TODO"
129129
fee <- newDynamicField $ DynamicFieldNumber 2
130-
pre <- newTextField "Delivery Calculator"
131130
pure
132131
St
133132
{ stAssets = mempty,
@@ -140,7 +139,6 @@ newSt = do
140139
stMerchantEmail = email,
141140
stMerchantFeePercent = fee & #fieldType .~ FieldTypePercent,
142141
stOnlineOrOffline = Online,
143-
stPreview = pre & #fieldType .~ FieldTypeTitle,
144142
stScreen = Main,
145143
stEnableTheme = True,
146144
stTheme = Theme.Matcha

ghcjs/delivery-calculator/src/App/Widgets/Main.hs

Lines changed: 31 additions & 26 deletions
Original file line numberDiff line numberDiff line change
@@ -8,7 +8,6 @@ import qualified App.Widgets.PlaceOrder as PlaceOrder
88
import qualified App.Widgets.RemoveOrder as RemoveOrder
99
import Functora.Miso.Prelude
1010
import qualified Functora.Miso.Widgets.BrowserLink as BrowserLink
11-
import qualified Functora.Miso.Widgets.Field as Field
1211
import qualified Functora.Miso.Widgets.FieldPairs as FieldPairs
1312
import qualified Functora.Miso.Widgets.Flex as Flex
1413
import qualified Functora.Miso.Widgets.Icon as Icon
@@ -61,32 +60,38 @@ mainWidget st =
6160

6261
screenWidget :: Model -> [View Action]
6362
screenWidget st@Model {modelState = St {stScreen = QrCode sc}} =
64-
( if unQrCode sc == Donate
65-
then mempty
66-
else
67-
Field.fieldViewer
68-
Field.defOpts
69-
Field.Args
70-
{ Field.argsModel = st,
71-
Field.argsOptic = #modelState . #stPreview,
72-
Field.argsAction = PushUpdate,
73-
Field.argsEmitter = emitter st
74-
}
75-
)
76-
<> FieldPairs.fieldPairsViewer
77-
FieldPairs.defOpts
78-
FieldPairs.Args
79-
{ FieldPairs.argsModel = st,
80-
FieldPairs.argsOptic = #modelUriViewer,
81-
FieldPairs.argsAction = PushUpdate,
82-
FieldPairs.argsEmitter = emitter st
83-
}
84-
<> [ button_
85-
[ onClick . setScreenAction $ unQrCode sc
63+
[ Flex.flexCol
64+
main_
65+
( <>
66+
[ style_ [("align-items", "center")]
8667
]
87-
[ text "Open"
88-
]
89-
]
68+
)
69+
$ fmap
70+
( appendAttrs
71+
[ style_
72+
[ ("display", "flex"),
73+
("align-items", "center"),
74+
("flex-direction", "column")
75+
]
76+
]
77+
)
78+
( FieldPairs.fieldPairsViewer
79+
FieldPairs.defOpts
80+
FieldPairs.Args
81+
{ FieldPairs.argsModel = st,
82+
FieldPairs.argsOptic = #modelUriViewer,
83+
FieldPairs.argsAction = PushUpdate,
84+
FieldPairs.argsEmitter = emitter st
85+
}
86+
)
87+
<> [ button_
88+
[ onClick . setScreenAction $ unQrCode sc
89+
]
90+
[ icon Icon.IconOpen,
91+
text " Delivery Calculator"
92+
]
93+
]
94+
]
9095
screenWidget st@Model {modelState = St {stScreen = Donate}} =
9196
FieldPairs.fieldPairsViewer
9297
FieldPairs.defOpts

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

Lines changed: 0 additions & 11 deletions
Original file line numberDiff line numberDiff line change
@@ -165,17 +165,6 @@ menu st =
165165
& #optsLabel
166166
.~ Just ("Merchant email" :: Unicode)
167167
)
168-
<> Field.textField
169-
Field.Args
170-
{ Field.argsModel = st,
171-
Field.argsOptic = #modelState . #stPreview,
172-
Field.argsAction = PushUpdate,
173-
Field.argsEmitter = emitter st
174-
}
175-
( Field.defOpts @Model @Action
176-
& #optsLabel
177-
.~ Just ("QR title" :: Unicode)
178-
)
179168
<> [ Switch.switch
180169
( Switch.defOpts
181170
& #optsLabel

ghcjs/delivery-calculator/src/Main.hs

Lines changed: 25 additions & 3 deletions
Original file line numberDiff line numberDiff line change
@@ -164,9 +164,12 @@ updateModel SyncInputs st = do
164164
syncInputs st
165165
pure Noop
166166
]
167+
updateModel (LinkUpdate f) st =
168+
noEff $ f st
167169
updateModel (EvalUpdate f) st = do
168170
let prev = f st
169171
let unload = #modelLoading .~ False :: Model -> Model
172+
let next = unload prev
170173
batchEff
171174
prev
172175
[ do
@@ -175,15 +178,34 @@ updateModel (EvalUpdate f) st = do
175178
liftIO
176179
. void
177180
. spawnLink
178-
. deepseq (viewModel $ unload prev)
181+
. deepseq (viewModel next)
179182
. sink
180183
. PushUpdate
181184
. PureUpdate
182185
$ unload
183-
uri <- stUri prev
186+
uri <- stUri next
184187
Jsm.insertStorage ("current-" <> vsn) uri
185188
syncUri uri
186-
pure Noop,
189+
nextUri <- stUri $ next & #modelState . #stScreen %~ unQrCode
190+
uriViewer <-
191+
newFieldPair mempty
192+
. DynamicFieldText
193+
. from @String @Unicode
194+
$ URI.renderStr nextUri
195+
pure
196+
. LinkUpdate
197+
$ #modelUriViewer
198+
%~ mergeFieldPairs
199+
[ uriViewer
200+
& #fieldPairValue
201+
. #fieldOpts
202+
. #fieldOptsQrState
203+
.~ Just Opened
204+
& #fieldPairValue
205+
. #fieldOpts
206+
. #fieldOptsAllowCopy
207+
.~ True
208+
],
187209
do
188210
--
189211
-- NOTE : Workaround to fix slow rendering after screen switch.

ghcjs/delivery-calculator/trapeze.yaml

Lines changed: 2 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -1,8 +1,8 @@
11
platforms:
22
android:
33
appName: Delivery Calculator
4-
versionCode: 13
5-
versionName: 0.1.0.13
4+
versionCode: 14
5+
versionName: 0.1.0.14
66
packageName: com.functora.delivery_calculator
77
manifest:
88
- file: AndroidManifest.xml

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

Lines changed: 2 additions & 5 deletions
Original file line numberDiff line numberDiff line change
@@ -808,12 +808,9 @@ genericFieldViewer opts0 args widget =
808808
)
809809
<> ( if isNothing $ opts ^. #fieldOptsQrState
810810
then mempty
811-
else do
812-
let icon = case stateQr of
813-
Closed -> Icon.IconQrCode
814-
Opened -> Icon.IconFile
811+
else
815812
pure
816-
. fieldViewerIcon opts0 icon
813+
. fieldViewerIcon opts0 Icon.IconQrCode
817814
. action
818815
. PureUpdate
819816
$ cloneTraversal optic

ghcjs/miso-functora/src/Functora/Miso/Widgets/Icon.hs

Lines changed: 3 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -44,6 +44,7 @@ data Icon
4444
| IconShopping
4545
| IconWhatsApp
4646
| IconEmail
47+
| IconOpen
4748
deriving stock (Eq, Ord, Show, Read, Data, Generic, Enum, Bounded)
4849

4950
class (From Icon a) => IsIcon a where
@@ -85,6 +86,7 @@ data Fa
8586
| FaCartShopping
8687
| FaWhatsapp
8788
| FaEnvelope
89+
| FaRightToBracket
8890
deriving stock (Eq, Ord, Show, Read, Data, Generic, Enum, Bounded)
8991

9092
instance From Icon Fa where
@@ -124,6 +126,7 @@ instance From Icon Fa where
124126
IconShopping -> FaCartShopping
125127
IconWhatsApp -> FaWhatsapp
126128
IconEmail -> FaEnvelope
129+
IconOpen -> FaRightToBracket
127130

128131
instance IsIcon Fa where
129132
icon x =

ghcjs/miso-functora/src/Functora/Miso/Widgets/Qr.hs

Lines changed: 7 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -14,7 +14,13 @@ qr txt
1414
| txt == mempty = mempty
1515
| otherwise =
1616
catMaybes
17-
[ fmap (img_ . singleton . src_)
17+
[ fmap
18+
( \src ->
19+
img_
20+
[ loading_ "lazy",
21+
src_ src
22+
]
23+
)
1824
--
1925
-- TODO : Research how this works!
2026
-- It might be leaking memory or something..

0 commit comments

Comments
 (0)