delivery calculator wip

Author: functora

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

@@ -11,6 +11,7 @@ module App.Types
     unQrCode,
     unShareUri,
     stUri,
+    stTeleUri,
     setScreenPure,
     setScreenAction,
     vsn,
@@ -62,10 +63,10 @@ data Action
 
 data St f = St
   { stAssets :: [Asset f],
-    stPayments :: [Money f],
-    stFeePercent :: Field Rational f,
+    stPayment :: Money f,
+    stMerchantTele :: Field Unicode f,
+    stMerchantFeePercent :: Field Rational f,
     stDefAssetCurrency :: Currency f,
-    stDefPaymentCurrency :: Currency f,
     stFavName :: Field Unicode f,
     stPreview :: Field Unicode f,
     stScreen :: Screen
@@ -89,19 +90,20 @@ deriving via GenericType (St Identity) instance Binary (St Identity)
 newSt :: (MonadIO m) => m (St Unique)
 newSt = do
   fee <- newRatioField 2
-  assetCur <- newCurrency cny
-  paymentCur <- newCurrency rub
+  payment <- newMoney 0 rub
+  defAssetCur <- newCurrency cny
   fav <- newTextField mempty
-  pre <- newTextField mempty
+  pre <- newTextField "Delivery Calculator"
+  tele <- newTextField "Functora"
   pure
     St
       { stAssets = mempty,
-        stPayments = mempty,
-        stFeePercent = fee,
-        stDefAssetCurrency = assetCur,
-        stDefPaymentCurrency = paymentCur,
+        stPayment = payment,
+        stMerchantTele = tele,
+        stMerchantFeePercent = fee,
+        stDefAssetCurrency = defAssetCur,
         stFavName = fav,
-        stPreview = pre,
+        stPreview = pre & #fieldType .~ FieldTypeTitle,
         stScreen = Main
       }
 
@@ -166,6 +168,22 @@ stQuery st = do
         . B64URL.encode
         . from @BL.ByteString @ByteString
 
+stTeleUri :: (MonadThrow m) => Model -> m URI
+stTeleUri st = do
+  base <- URI.mkURI "https://t.me"
+  user <- URI.mkPathPiece $ st ^. #modelState . #stMerchantTele . #fieldOutput
+  link <- stUri st
+  key <- URI.mkQueryKey "text"
+  val <-
+    URI.mkQueryValue
+      $ "Hello, I have a question about the delivery of the following items: "
+      <> URI.render link
+  pure
+    $ base
+      { URI.uriPath = Just (False, [user]),
+        URI.uriQuery = [URI.QueryParam key val]
+      }
+
 unShareUri ::
   ( MonadIO m,
     MonadThrow m

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

@@ -80,15 +80,37 @@ screenWidget st@Model {modelState = St {stScreen = QrCode sc}} =
               "Open"
           ]
        ]
-screenWidget Model {modelState = St {stScreen = Main}} =
-  mempty
 screenWidget st@Model {modelState = St {stScreen = Donate}} =
   FieldPairs.fieldPairsViewer
     FieldPairs.Args
       { FieldPairs.argsModel = st,
         FieldPairs.argsOptic = #modelDonateViewer,
         FieldPairs.argsAction = PushUpdate . Instant
       }
+screenWidget Model {modelState = St {stScreen = Main}} =
+  [ Grid.mediumCell
+      [ Button.raised
+          ( Button.config
+              & Button.setIcon (Just "add_box")
+              & Button.setAttributes [Css.fullWidth]
+              & Button.setOnClick Noop
+          )
+          "Add item"
+      ],
+    Grid.mediumCell
+      [ Button.raised
+          ( Button.config
+              & Button.setIcon (Just "send")
+              & Button.setAttributes [Css.fullWidth]
+              & Button.setOnClick
+                ( PushUpdate
+                    . Instant
+                    $ \next -> flip Jsm.openBrowserPage next =<< stTeleUri next
+                )
+          )
+          "Order via Telegram"
+      ]
+  ]
 
 pasteWidget ::
   Unicode ->

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

@@ -147,22 +147,37 @@ menu st =
                                 }
                               ( Field.defOpts @Model @Action
                                   & #optsPlaceholder
-                                  .~ ( "Preview - "
-                                        <> ( st
-                                              ^. #modelState
-                                              . #stPreview
-                                              . #fieldType
-                                              . to userFieldType
-                                           )
-                                     )
-                                  & #optsLeadingWidget
-                                  .~ Just
-                                    ( Field.ModalWidget
-                                        $ Field.ModalMiniWidget
-                                          ( #modelState
-                                              . #stPreview
-                                          )
-                                    )
+                                  .~ ("QR title" :: Unicode)
+                                  & #optsFilledOrOutlined
+                                  .~ Outlined
+                              )
+                          ],
+                        Grid.mediumCell
+                          [ Field.ratioField
+                              Field.Args
+                                { Field.argsModel = st,
+                                  Field.argsOptic =
+                                    #modelState . #stMerchantFeePercent,
+                                  Field.argsAction =
+                                    PushUpdate . Instant
+                                }
+                              ( Field.defOpts
+                                  & #optsPlaceholder
+                                  .~ ("Merchant fee %" :: Unicode)
+                                  & #optsFilledOrOutlined
+                                  .~ Outlined
+                              )
+                          ],
+                        Grid.mediumCell
+                          [ Field.textField
+                              Field.Args
+                                { Field.argsModel = st,
+                                  Field.argsOptic = #modelState . #stMerchantTele,
+                                  Field.argsAction = PushUpdate . Instant
+                                }
+                              ( Field.defOpts
+                                  & #optsPlaceholder
+                                  .~ ("Merchant telegram" :: Unicode)
                                   & #optsFilledOrOutlined
                                   .~ Outlined
                               )