wip

Author: functora

ghcjs/delivery-calculator/delivery-calculator.cabal

@@ -19,7 +19,6 @@ common pkg
     App.Jsm
     App.Types
     App.Widgets.Asset
-    App.Widgets.Fav
     App.Widgets.Main
     App.Widgets.Menu
     App.Widgets.Templates

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

@@ -63,12 +63,10 @@ import qualified Text.Regex as Re
 import qualified Text.URI as URI
 
 data Model = Model
-  { modelFav :: OpenedOrClosed,
-    modelMenu :: OpenedOrClosed,
+  { modelMenu :: OpenedOrClosed,
     modelLinks :: OpenedOrClosed,
     modelLoading :: Bool,
     modelState :: St Unique,
-    modelFavMap :: Map Unicode Fav,
     modelUriViewer :: [FieldPair DynamicField Unique],
     modelDonateViewer :: [FieldPair DynamicField Unique],
     modelProducerQueue :: TChan (InstantOrDelayed (Update Model)),
@@ -95,7 +93,6 @@ data St f = St
     stMerchantTele :: Field Unicode f,
     stMerchantFeePercent :: Field DynamicField f,
     stOnlineOrOffline :: OnlineOrOffline,
-    stFavName :: Field Unicode f,
     stPreview :: Field Unicode f,
     stScreen :: Screen,
     stEnableTheme :: Bool,
@@ -125,7 +122,6 @@ newSt = do
   merchantCur <- newCurrency rub
   tele <- newTextField "Functora"
   fee <- newDynamicField $ DynamicFieldNumber 2
-  fav <- newTextField mempty
   pre <- newTextField "Delivery Calculator"
   pure
     St
@@ -137,7 +133,6 @@ newSt = do
         stMerchantTele = tele,
         stMerchantFeePercent = fee & #fieldType .~ FieldTypePercent,
         stOnlineOrOffline = Online,
-        stFavName = fav,
         stPreview = pre & #fieldType .~ FieldTypeTitle,
         stScreen = Main,
         stEnableTheme = True,
@@ -216,7 +211,7 @@ verifyAsset asset =
                     (qty ^. #fieldPairValue . #fieldOutput)
           if null failures
             then mempty
-            else [blockquote_ mempty failures]
+            else [keyed "asset-failure" $ blockquote_ mempty failures]
     _ ->
       mempty
 
@@ -499,8 +494,7 @@ baseUri =
 setScreenPure :: Screen -> Update Model
 setScreenPure sc =
   PureUpdate
-    $ (& #modelFav .~ Closed)
-    . (& #modelMenu .~ Closed)
+    $ (& #modelMenu .~ Closed)
     . (& #modelLinks .~ Closed)
     . (& #modelState . #stScreen .~ sc)
 

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

@@ -25,12 +25,10 @@ newModel webOpts mSt uri = do
   market <- maybe Rates.newMarket pure $ mSt ^? _Just . #modelMarket
   pure
     Model
-      { modelFav = Closed,
-        modelMenu = Closed,
+      { modelMenu = Closed,
         modelLinks = Closed,
         modelLoading = True,
         modelState = fromMaybe defSt mApp,
-        modelFavMap = mempty,
         modelUriViewer = mempty,
         modelDonateViewer = donate,
         modelProducerQueue = prod,

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

@@ -131,35 +131,31 @@ updateModel (InitUpdate ext) prevSt = do
                 { modelProducerQueue = prod,
                   modelConsumerQueue = cons
                 }
-        Jsm.selectStorage ("favorite-" <> vsn) $ \mFav -> do
-          let fav = mergeMap (const id) $ fromMaybe mempty mFav
-          if isJust ext
-            then
-              pushActionQueue
-                nextSt
+        if isJust ext
+          then
+            pushActionQueue
+              nextSt
+              . Instant
+              . PureUpdate
+              $ #modelLoading
+              .~ False
+          else Jsm.selectStorage ("current-" <> vsn) $ \case
+            Nothing ->
+              pushActionQueue nextSt
                 . Instant
                 . PureUpdate
-                $ (& #modelFavMap %~ fav)
-                . (& #modelLoading .~ False)
-            else Jsm.selectStorage ("current-" <> vsn) $ \case
-              Nothing ->
-                pushActionQueue nextSt
-                  . Instant
-                  . PureUpdate
-                  $ (& #modelFavMap %~ fav)
-                  . (& #modelLoading .~ False)
-              Just uri -> do
-                finSt <- newModel (nextSt ^. #modelWebOpts) (Just nextSt) uri
-                pushActionQueue nextSt
-                  . Instant
-                  . PureUpdate
-                  $ ( const
-                        $ finSt
-                        & #modelFavMap
-                        %~ fav
-                        & #modelLoading
-                        .~ False
-                    )
+                $ #modelLoading
+                .~ False
+            Just uri -> do
+              finSt <- newModel (nextSt ^. #modelWebOpts) (Just nextSt) uri
+              pushActionQueue nextSt
+                . Instant
+                . PureUpdate
+                $ ( const
+                      $ finSt
+                      & #modelLoading
+                      .~ False
+                  )
         pure
           $ ChanUpdate (const nextSt)
     ]
@@ -201,7 +197,6 @@ updateModel (ChanUpdate update0) st0 = do
             $ evalModel st2
         let st3 = update2 st2
         uri <- stUri st3
-        Jsm.insertStorage ("favorite-" <> vsn) $ st3 ^. #modelFavMap
         Jsm.insertStorage ("current-" <> vsn) uri
         syncUri uri
         nextUri <- stUri $ st3 & #modelState . #stScreen %~ unQrCode

ghcjs/delivery-calculator/src/Main.hs

@@ -148,6 +148,7 @@ field full@Full {fullArgs = args, fullParser = parser, fullViewer = viewer} opts
       id
       ( \x ->
           singleton
+            . keyed (decodeUtf8 . unTagged $ htmlUid uid)
             . label_ mempty
             . (text x :)
             . (br_ mempty :)