Skip to content

Commit dacc56a

Browse files
functorafunctora
committed
UI improvements
1 parent 2bf3418 commit dacc56a

File tree

10 files changed

+277
-81
lines changed

10 files changed

+277
-81
lines changed

‎ghcjs/delivery-calculator/delivery-calculator.cabal‎

Lines changed: 2 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -23,6 +23,8 @@ common pkg
2323
App.Widgets.Main
2424
App.Widgets.MarketLinks
2525
App.Widgets.Menu
26+
App.Widgets.PlaceOrder
27+
App.Widgets.RemoveOrder
2628
App.Widgets.Templates
2729
App.Xlsx
2830

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

Lines changed: 8 additions & 23 deletions
Original file line numberDiff line numberDiff line change
@@ -18,7 +18,6 @@ module App.Types
1818
unQrCode,
1919
unShareUri,
2020
stUri,
21-
stTeleUri,
2221
setScreenAction,
2322
pushActionQueue,
2423
icon,
@@ -65,6 +64,8 @@ import qualified Text.URI as URI
6564
data Model = Model
6665
{ modelMenu :: OpenedOrClosed,
6766
modelLinks :: OpenedOrClosed,
67+
modelPlaceOrder :: OpenedOrClosed,
68+
modelRemoveOrder :: OpenedOrClosed,
6869
modelMarketLinks :: OpenedOrClosed,
6970
modelLoading :: Bool,
7071
modelState :: St Unique,
@@ -92,6 +93,8 @@ data St f = St
9293
stExchangeRateAt :: UTCTime,
9394
stMerchantCurrency :: Currency f,
9495
stMerchantTele :: Field Unicode f,
96+
stMerchantWhats :: Field Unicode f,
97+
stMerchantEmail :: Field Unicode f,
9598
stMerchantFeePercent :: Field DynamicField f,
9699
stOnlineOrOffline :: OnlineOrOffline,
97100
stPreview :: Field Unicode f,
@@ -122,6 +125,8 @@ newSt = do
122125
ct <- getCurrentTime
123126
merchantCur <- newCurrency rub
124127
tele <- newTextField "Functora"
128+
whats <- newTextField "TODO"
129+
email <- newTextField "TODO"
125130
fee <- newDynamicField $ DynamicFieldNumber 2
126131
pre <- newTextField "Delivery Calculator"
127132
pure
@@ -132,6 +137,8 @@ newSt = do
132137
stExchangeRateAt = ct,
133138
stMerchantCurrency = merchantCur,
134139
stMerchantTele = tele,
140+
stMerchantWhats = whats,
141+
stMerchantEmail = email,
135142
stMerchantFeePercent = fee & #fieldType .~ FieldTypePercent,
136143
stOnlineOrOffline = Online,
137144
stPreview = pre & #fieldType .~ FieldTypeTitle,
@@ -446,28 +453,6 @@ stQuery st = do
446453
. B64URL.encode
447454
. from @BL.ByteString @ByteString
448455

449-
stTeleUri :: (MonadThrow m) => Model -> m URI
450-
stTeleUri st = do
451-
base <-
452-
URI.mkURI "https://t.me"
453-
user <-
454-
URI.mkPathPiece
455-
. from @Unicode @Text
456-
$ st
457-
^. #modelState
458-
. #stMerchantTele
459-
. #fieldOutput
460-
key <-
461-
URI.mkQueryKey "text"
462-
val <-
463-
URI.mkQueryValue
464-
$ "Hello, I have a question about delivery. I will share the Excel file in the next message."
465-
pure
466-
$ base
467-
{ URI.uriPath = Just (False, [user]),
468-
URI.uriQuery = [URI.QueryParam key val]
469-
}
470-
471456
unShareUri ::
472457
( MonadIO m,
473458
MonadThrow m

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

Lines changed: 7 additions & 34 deletions
Original file line numberDiff line numberDiff line change
@@ -1,13 +1,11 @@
11
module App.Widgets.Main (mainWidget) where
22

3-
import qualified App.Jsm as Jsm
43
import App.Types
54
import qualified App.Widgets.Asset as Asset
65
import qualified App.Widgets.MarketLinks as MarketLinks
76
import qualified App.Widgets.Menu as Menu
8-
import qualified App.Xlsx as Xlsx
9-
import qualified Data.ByteString.Lazy as BL
10-
import qualified Functora.Miso.Jsm as Jsm
7+
import qualified App.Widgets.PlaceOrder as PlaceOrder
8+
import qualified App.Widgets.RemoveOrder as RemoveOrder
119
import Functora.Miso.Prelude
1210
import qualified Functora.Miso.Widgets.BrowserLink as BrowserLink
1311
import qualified Functora.Miso.Widgets.Field as Field
@@ -118,7 +116,7 @@ screenWidget st@Model {modelState = St {stScreen = Main}} =
118116
buttons :: [View Action]
119117
buttons =
120118
singleton
121-
$ Flex.flexRowCenter
119+
. Flex.flexRowCenter
122120
section_
123121
( mappend
124122
[ style_
@@ -129,9 +127,8 @@ screenWidget st@Model {modelState = St {stScreen = Main}} =
129127
]
130128
]
131129
)
132-
[ button_
133-
[ type_ "submit",
134-
onClick . PushUpdate . Instant . ImpureUpdate $ do
130+
$ ( button_
131+
[ onClick . PushUpdate . Instant . ImpureUpdate $ do
135132
asset <- newAsset
136133
pure
137134
$ #modelState
@@ -140,33 +137,9 @@ screenWidget st@Model {modelState = St {stScreen = Main}} =
140137
]
141138
[ icon Icon.IconAdd,
142139
text " Add item"
143-
],
144-
button_
145-
[ type_ "submit",
146-
onClick
147-
. PushUpdate
148-
. Instant
149-
. EffectUpdate
150-
. either impureThrow Jsm.openBrowserPage
151-
$ stTeleUri st
152140
]
153-
[ icon Icon.IconTelegram,
154-
text " Order via Telegram"
155-
],
156-
button_
157-
[ type_ "submit",
158-
onClick . PushUpdate . Instant . EffectUpdate $ do
159-
let doc = st ^. #modelState
160-
imgs <- Jsm.fetchBlobUris doc
161-
file <- Xlsx.xlsxFile
162-
Jsm.saveFileShare file Xlsx.xlsxMime
163-
. from @BL.ByteString @ByteString
164-
$ Xlsx.newXlsx doc imgs
165-
]
166-
[ icon Icon.IconDownload,
167-
text " Share excel file"
168-
]
169-
]
141+
)
142+
: RemoveOrder.removeOrder st <> PlaceOrder.placeOrder st
170143

171144
totalViewer :: Model -> [View Action]
172145
totalViewer st =

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

Lines changed: 4 additions & 4 deletions
Original file line numberDiff line numberDiff line change
@@ -19,11 +19,11 @@ marketLinks st =
1919
Dialog.argsOptic = #modelMarketLinks,
2020
Dialog.argsAction = PushUpdate . Instant,
2121
Dialog.argsContent =
22-
[ button_ [onClick $ openBrowser taobaoLink] [text "Taobao"],
23-
button_ [onClick $ openBrowser poizonLink] [text "Poizon"],
24-
button_ [onClick $ openBrowser poizonLink] [text "Dewu"],
22+
[ button_ [onClick $ openBrowser alibabaLink] [text "1688"],
2523
button_ [onClick $ openBrowser alibabaLink] [text "Alibaba"],
26-
button_ [onClick $ openBrowser alibabaLink] [text "1688"],
24+
button_ [onClick $ openBrowser poizonLink] [text "Dewu"],
25+
button_ [onClick $ openBrowser poizonLink] [text "Poizon"],
26+
button_ [onClick $ openBrowser taobaoLink] [text "Taobao"],
2727
button_ [onClick $ openBrowser tmallLink] [text "Tmall"]
2828
]
2929
}

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

Lines changed: 24 additions & 16 deletions
Original file line numberDiff line numberDiff line change
@@ -25,21 +25,7 @@ menu st =
2525
[ ("grid-template-columns", "1fr auto")
2626
]
2727
]
28-
[ button_
29-
[ role_ "button",
30-
style_
31-
[ ("min-width", "0"),
32-
("justify-self", "start"),
33-
("word-break", "keep-all"),
34-
("overflow-wrap", "normal")
35-
],
36-
onClick . PushUpdate . Instant . ImpureUpdate $ do
37-
doc <- liftIO newSt
38-
pure $ #modelState .~ doc
39-
]
40-
[ icon Icon.IconDelivery,
41-
text " Delivery Calculator"
42-
],
28+
[ div_ mempty mempty,
4329
button_
4430
[ role_ "button",
4531
style_
@@ -159,7 +145,29 @@ menu st =
159145
}
160146
( Field.defOpts
161147
& #optsLabel
162-
.~ Just ("Merchant telegram" :: Unicode)
148+
.~ Just ("Merchant Telegram" :: Unicode)
149+
)
150+
<> Field.textField
151+
Field.Args
152+
{ Field.argsModel = st,
153+
Field.argsOptic = #modelState . #stMerchantWhats,
154+
Field.argsAction = PushUpdate . Instant,
155+
Field.argsEmitter = pushActionQueue st . Instant
156+
}
157+
( Field.defOpts
158+
& #optsLabel
159+
.~ Just ("Merchant WhatsApp" :: Unicode)
160+
)
161+
<> Field.textField
162+
Field.Args
163+
{ Field.argsModel = st,
164+
Field.argsOptic = #modelState . #stMerchantEmail,
165+
Field.argsAction = PushUpdate . Instant,
166+
Field.argsEmitter = pushActionQueue st . Instant
167+
}
168+
( Field.defOpts
169+
& #optsLabel
170+
.~ Just ("Merchant email" :: Unicode)
163171
)
164172
<> Field.textField
165173
Field.Args

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

Lines changed: 146 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,146 @@
1+
module App.Widgets.PlaceOrder (placeOrder) where
2+
3+
import qualified App.Jsm as Jsm
4+
import App.Types
5+
import qualified App.Xlsx as Xlsx
6+
import qualified Data.ByteString.Lazy as BL
7+
import qualified Functora.Miso.Jsm as Jsm
8+
import Functora.Miso.Prelude
9+
import qualified Functora.Miso.Widgets.Dialog as Dialog
10+
import qualified Functora.Miso.Widgets.Icon as Icon
11+
import qualified Text.URI as URI
12+
13+
placeOrder :: Model -> [View Action]
14+
placeOrder st =
15+
if null $ st ^. #modelState . #stAssets
16+
then mempty
17+
else
18+
button_
19+
[ onClick
20+
. PushUpdate
21+
. Instant
22+
. PureUpdate
23+
$ #modelPlaceOrder
24+
.~ Opened
25+
]
26+
[ icon Icon.IconShopping,
27+
text " Place Order"
28+
]
29+
: Dialog.dialog
30+
Dialog.defOpts
31+
{ Dialog.optsTitle = Just ("Place order" :: Unicode),
32+
Dialog.optsFlexCol = False,
33+
Dialog.optsTitleIcon = Just Icon.IconShopping
34+
}
35+
Dialog.Args
36+
{ Dialog.argsModel = st,
37+
Dialog.argsOptic = #modelPlaceOrder,
38+
Dialog.argsAction = PushUpdate . Instant,
39+
Dialog.argsContent =
40+
[ button_
41+
[ onClick
42+
. either impureThrow openBrowser
43+
$ teleUri st
44+
]
45+
[ icon Icon.IconTelegram,
46+
text " Telegram"
47+
],
48+
button_
49+
[ onClick
50+
. either impureThrow openBrowser
51+
$ whatsUri st
52+
]
53+
[ icon Icon.IconWhatsApp,
54+
text " WhatsApp"
55+
],
56+
button_
57+
[ onClick
58+
. either impureThrow openBrowser
59+
$ emailUri st
60+
]
61+
[ icon Icon.IconEmail,
62+
text " Email"
63+
],
64+
button_
65+
[ onClick . PushUpdate . Instant . EffectUpdate $ do
66+
let doc = st ^. #modelState
67+
imgs <- Jsm.fetchBlobUris doc
68+
file <- Xlsx.xlsxFile
69+
Jsm.saveFileShare file Xlsx.xlsxMime
70+
. from @BL.ByteString @ByteString
71+
$ Xlsx.newXlsx doc imgs
72+
]
73+
[ icon Icon.IconDownload,
74+
text " Share Excel file"
75+
]
76+
]
77+
}
78+
79+
openBrowser :: URI -> Action
80+
openBrowser =
81+
PushUpdate
82+
. Instant
83+
. EffectUpdate
84+
. Jsm.openBrowserPage
85+
86+
teleUri :: (MonadThrow m) => Model -> m URI
87+
teleUri st = do
88+
base <- URI.mkURI "https://t.me"
89+
user <-
90+
URI.mkPathPiece
91+
. from @Unicode @Text
92+
$ st
93+
^. #modelState
94+
. #stMerchantTele
95+
. #fieldOutput
96+
key <- URI.mkQueryKey "text"
97+
val <- URI.mkQueryValue placeOrderMessage
98+
pure
99+
$ base
100+
{ URI.uriPath = Just (False, [user]),
101+
URI.uriQuery = [URI.QueryParam key val]
102+
}
103+
104+
whatsUri :: (MonadThrow m) => Model -> m URI
105+
whatsUri st = do
106+
base <- URI.mkURI "https://wa.me"
107+
user <-
108+
URI.mkPathPiece
109+
. from @Unicode @Text
110+
$ st
111+
^. #modelState
112+
. #stMerchantWhats
113+
. #fieldOutput
114+
key <- URI.mkQueryKey "text"
115+
val <- URI.mkQueryValue placeOrderMessage
116+
pure
117+
$ base
118+
{ URI.uriPath = Just (False, [user]),
119+
URI.uriQuery = [URI.QueryParam key val]
120+
}
121+
122+
emailUri :: (MonadThrow m) => Model -> m URI
123+
emailUri st = do
124+
user <-
125+
URI.mkPathPiece
126+
. from @Unicode @Text
127+
$ st
128+
^. #modelState
129+
. #stMerchantEmail
130+
. #fieldOutput
131+
base <- URI.mkURI $ "mailto:" <> URI.unRText user
132+
subjKey <- URI.mkQueryKey "subject"
133+
subjVal <- URI.mkQueryValue "Delivery Calculator"
134+
bodyKey <- URI.mkQueryKey "body"
135+
bodyVal <- URI.mkQueryValue placeOrderMessage
136+
pure
137+
$ base
138+
{ URI.uriQuery =
139+
[ URI.QueryParam subjKey subjVal,
140+
URI.QueryParam bodyKey bodyVal
141+
]
142+
}
143+
144+
placeOrderMessage :: Text
145+
placeOrderMessage =
146+
"Hello, I have a question about delivery. I will share the Excel file in the next message."

0 commit comments

Comments
 (0)