Skip to content

Commit d1c830f

Browse files
functorafunctora
committed
market links
1 parent 2fae7b6 commit d1c830f

File tree

10 files changed

+114
-21
lines changed

10 files changed

+114
-21
lines changed

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

Lines changed: 1 addition & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -21,6 +21,7 @@ common pkg
2121
App.Types
2222
App.Widgets.Asset
2323
App.Widgets.Main
24+
App.Widgets.MarketLinks
2425
App.Widgets.Menu
2526
App.Widgets.Templates
2627
App.Xlsx

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

Lines changed: 1 addition & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -65,6 +65,7 @@ import qualified Text.URI as URI
6565
data Model = Model
6666
{ modelMenu :: OpenedOrClosed,
6767
modelLinks :: OpenedOrClosed,
68+
modelMarketLinks :: OpenedOrClosed,
6869
modelLoading :: Bool,
6970
modelState :: St Unique,
7071
modelUriViewer :: [FieldPair DynamicField Unique],

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

Lines changed: 30 additions & 12 deletions
Original file line numberDiff line numberDiff line change
@@ -68,11 +68,7 @@ assetViewer st idx =
6868
Dialog.argsAction = PushUpdate . Instant,
6969
Dialog.argsContent =
7070
failures False
71-
<> FieldPairs.fieldPairsEditor
72-
args
73-
fieldPairsOpts
74-
{ FieldPairs.optsAdvanced = False
75-
}
71+
<> FieldPairs.fieldPairsEditor args fieldPairsOpts
7672
}
7773
)
7874
where
@@ -125,13 +121,35 @@ assetViewer st idx =
125121
. #stAssets
126122
. ix idx
127123

128-
fieldPairsOpts :: FieldPairs.Opts model action
124+
fieldPairsOpts :: FieldPairs.Opts Model Action
129125
fieldPairsOpts =
130126
FieldPairs.defOpts
131-
{ FieldPairs.optsField =
132-
Field.defOpts
133-
{ Field.optsExtraAttributesImage =
134-
[ style_ [("max-height", "10vh")]
135-
]
136-
}
127+
{ FieldPairs.optsField = \case
128+
0 -> opts {Field.optsTrailingWidgets = trws}
129+
_ -> opts,
130+
FieldPairs.optsAdvanced = False
137131
}
132+
where
133+
opts =
134+
Field.defOpts
135+
{ Field.optsExtraAttributesImage =
136+
[ style_ [("max-height", "10vh")]
137+
]
138+
}
139+
trws input fob eod =
140+
if eod == Disabled
141+
then Field.defTrailingWidgets input fob eod
142+
else case fob of
143+
Focused | null input -> [Field.PasteWidget mempty, modal]
144+
Focused -> Field.defTrailingWidgets input fob eod
145+
Blurred -> [Field.PasteWidget hide, modal]
146+
modal =
147+
Field.ActionWidget Icon.IconShopping mempty
148+
. PushUpdate
149+
. Instant
150+
. PureUpdate
151+
$ #modelMarketLinks
152+
.~ Opened
153+
154+
hide :: [Attribute action]
155+
hide = [style_ [("display", "none")]]

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

Lines changed: 2 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -3,6 +3,7 @@ module App.Widgets.Main (mainWidget) where
33
import qualified App.Jsm as Jsm
44
import App.Types
55
import qualified App.Widgets.Asset as Asset
6+
import qualified App.Widgets.MarketLinks as MarketLinks
67
import qualified App.Widgets.Menu as Menu
78
import qualified App.Xlsx as Xlsx
89
import qualified Data.ByteString.Lazy as BL
@@ -53,6 +54,7 @@ mainWidget st =
5354
: br_ mempty
5455
: Menu.qrButton st
5556
: Menu.linksWidget st
57+
<> MarketLinks.marketLinks st
5658
]
5759
<> ( if not $ st ^. #modelLoading
5860
then mempty

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

Lines changed: 56 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,56 @@
1+
module App.Widgets.MarketLinks (marketLinks) where
2+
3+
import App.Types
4+
import qualified Functora.Miso.Jsm as Jsm
5+
import Functora.Miso.Prelude
6+
import qualified Functora.Miso.Widgets.Dialog as Dialog
7+
import qualified Functora.Miso.Widgets.Icon as Icon
8+
9+
marketLinks :: Model -> [View Action]
10+
marketLinks st =
11+
Dialog.dialog
12+
Dialog.defOpts
13+
{ Dialog.optsTitle = Just ("Marketplace" :: Unicode),
14+
Dialog.optsFlexCol = False,
15+
Dialog.optsTitleIcon = Just Icon.IconShopping
16+
}
17+
Dialog.Args
18+
{ Dialog.argsModel = st,
19+
Dialog.argsOptic = #modelMarketLinks,
20+
Dialog.argsAction = PushUpdate . Instant,
21+
Dialog.argsContent =
22+
[ button_ [onClick $ openBrowser taobaoLink] [text "Taobao"],
23+
button_ [onClick $ openBrowser poizonLink] [text "Poizon"],
24+
button_ [onClick $ openBrowser poizonLink] [text "Dewu"],
25+
button_ [onClick $ openBrowser alibabaLink] [text "Alibaba"],
26+
button_ [onClick $ openBrowser alibabaLink] [text "1688"],
27+
button_ [onClick $ openBrowser tmallLink] [text "Tmall"]
28+
]
29+
}
30+
where
31+
openBrowser link =
32+
PushUpdate
33+
. Instant
34+
$ PureAndEffectUpdate
35+
(#modelMarketLinks .~ Closed)
36+
(Jsm.openBrowserPage link)
37+
38+
taobaoLink :: URI
39+
taobaoLink =
40+
either impureThrow id
41+
$ mkURI "https://www.taobao.com/"
42+
43+
poizonLink :: URI
44+
poizonLink =
45+
either impureThrow id
46+
$ mkURI "https://dewu.com/"
47+
48+
alibabaLink :: URI
49+
alibabaLink =
50+
either impureThrow id
51+
$ mkURI "https://www.1688.com/"
52+
53+
tmallLink :: URI
54+
tmallLink =
55+
either impureThrow id
56+
$ mkURI "https://www.tmall.com/"

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

Lines changed: 1 addition & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -27,6 +27,7 @@ newModel webOpts mSt uri = do
2727
Model
2828
{ modelMenu = Closed,
2929
modelLinks = Closed,
30+
modelMarketLinks = Closed,
3031
modelLoading = True,
3132
modelState = fromMaybe defSt mApp,
3233
modelUriViewer = mempty,

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

Lines changed: 13 additions & 3 deletions
Original file line numberDiff line numberDiff line change
@@ -28,6 +28,7 @@ data Opts model action = Opts
2828
optsFooterLeft :: [View action] -> [View action],
2929
optsFooterRight :: [View action] -> [View action],
3030
optsExtraOnClose :: model -> model,
31+
optsExtraAttributes :: [Attribute action],
3132
optsFlexCol :: Bool,
3233
optsKeyed :: Maybe Unicode,
3334
optsIcon :: Icon.Icon -> View action
@@ -44,6 +45,7 @@ defOpts =
4445
optsFooterLeft = id,
4546
optsFooterRight = id,
4647
optsExtraOnClose = id,
48+
optsExtraAttributes = mempty,
4749
optsFlexCol = True,
4850
optsKeyed = Nothing,
4951
optsIcon = Icon.icon @Icon.Fa
@@ -70,15 +72,23 @@ dialog opts args =
7072
id
7173
(keyed . (<> "-content"))
7274
(optsKeyed opts)
73-
. nodeHtml "dialog" [boolProp "open" True]
75+
. nodeHtml
76+
"dialog"
77+
( boolProp "open" True
78+
: optsExtraAttributes opts
79+
)
7480
$ Flex.flexLeftRight
7581
header_
7682
id
7783
(optsHeaderLeft opts defHeaderLeft)
7884
(optsHeaderRight opts defHeaderRight)
7985
<> ( if optsFlexCol opts
80-
then [Flex.flexCol form_ id $ argsContent args]
81-
else [Flex.flexRow form_ id $ argsContent args]
86+
then
87+
[ Flex.flexCol form_ (novalidate_ True :) $ argsContent args
88+
]
89+
else
90+
[ Flex.flexRow form_ (novalidate_ True :) $ argsContent args
91+
]
8292
)
8393
<> Flex.flexLeftRight
8494
footer_

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

Lines changed: 1 addition & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -3,6 +3,7 @@ module Functora.Miso.Widgets.Field
33
Full (..),
44
Opts (..),
55
defOpts,
6+
defTrailingWidgets,
67
OptsWidget (..),
78
ModalWidget' (..),
89
truncateUnicode,

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

Lines changed: 6 additions & 6 deletions
Original file line numberDiff line numberDiff line change
@@ -23,7 +23,7 @@ data Args model action f = Args
2323

2424
data Opts model action = Opts
2525
{ optsIcon :: Icon.Icon -> View action,
26-
optsField :: Field.Opts model action,
26+
optsField :: Int -> Field.Opts model action,
2727
optsAdvanced :: Bool
2828
}
2929
deriving stock (Generic)
@@ -32,7 +32,7 @@ defOpts :: Opts model action
3232
defOpts =
3333
Opts
3434
{ optsIcon = Icon.icon @Icon.Fa,
35-
optsField = Field.defOpts,
35+
optsField = const Field.defOpts,
3636
optsAdvanced = True
3737
}
3838

@@ -78,7 +78,7 @@ fieldPairViewer opts args@Args {argsOptic = optic} idx pair =
7878
then mempty
7979
else
8080
Field.fieldViewer
81-
( optsField opts
81+
( optsField opts idx
8282
& #optsIcon
8383
.~ optsIcon opts
8484
& #optsLeftRightViewer
@@ -131,7 +131,7 @@ fieldPairEditor
131131
Field.argsAction = action,
132132
Field.argsEmitter = emitter
133133
}
134-
( optsField opts
134+
( optsField opts idx
135135
& #optsLabel
136136
.~ Just
137137
( fromMaybe ("#" <> inspect (idx + 1))
@@ -160,7 +160,7 @@ fieldPairEditor
160160
Field.argsAction = action,
161161
Field.argsEmitter = emitter
162162
}
163-
( optsField opts
163+
( optsField opts idx
164164
& #optsPlaceholder
165165
.~ ("Label " <> idxTxt)
166166
& #optsTrailingWidgets
@@ -177,7 +177,7 @@ fieldPairEditor
177177
Field.argsAction = action,
178178
Field.argsEmitter = emitter
179179
}
180-
( optsField opts
180+
( optsField opts idx
181181
& #optsPlaceholder
182182
.~ ( "Value "
183183
<> idxTxt

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

Lines changed: 3 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -41,6 +41,7 @@ data Icon
4141
| IconDollar
4242
| IconCoins
4343
| IconExcel
44+
| IconShopping
4445
deriving stock (Eq, Ord, Show, Read, Data, Generic, Enum, Bounded)
4546

4647
class (From Icon a) => IsIcon a where
@@ -79,6 +80,7 @@ data Fa
7980
| FaDollarSign
8081
| FaCoins
8182
| FaFileExcel
83+
| FaCartShopping
8284
deriving stock (Eq, Ord, Show, Read, Data, Generic, Enum, Bounded)
8385

8486
instance From Icon Fa where
@@ -115,6 +117,7 @@ instance From Icon Fa where
115117
IconDollar -> FaDollarSign
116118
IconCoins -> FaCoins
117119
IconExcel -> FaFileExcel
120+
IconShopping -> FaCartShopping
118121

119122
instance IsIcon Fa where
120123
icon x =

0 commit comments

Comments
 (0)