uri sync wip

Author: functora

ghcjs/currency-converter/app.cabal

@@ -121,6 +121,7 @@ common pkg
     , miso
     , miso-components
     , modern-uri
+    , network-uri
     , qrcode-core
     , random
     , syb

ghcjs/currency-converter/package-lock.json

@@ -13,7 +13,6 @@ module App.Types
     pureUpdate,
     unShareUri,
     stUri,
-    baseUri,
     setScreenPure,
     setScreenAction,
     shareLink,
@@ -249,7 +248,7 @@ stQuery st = do
 
 stUri :: (MonadThrow m) => Model -> m URI
 stUri st = do
-  uri <- mkURI $ from @MisoString @Prelude.Text baseUri
+  uri <- mkURI $ fromMisoString baseUri
   qxs <- stQuery . uniqueToIdentity $ st ^. #modelState
   pure
     $ uri

ghcjs/currency-converter/src/App/Types.hs

@@ -60,7 +60,7 @@ qr st txt opts
             extraCell
               $ Button.raised
                 ( Button.config
-                    & Button.setIcon (Just "content_copy")
+                    & Button.setIcon (Just "share")
                     & Button.setAttributes [class_ "fill"]
                     & Button.setOnClick (Misc.copyIntoClipboardAction st txt)
                 )

ghcjs/currency-converter/src/App/Widgets/Qr.hs

@@ -122,13 +122,17 @@ newModel webOpts mSt uri = do
 newDonateDoc :: IO (StDoc Unique)
 newDonateDoc = do
   doc <- newStDoc
+  topMoney <- newMoney 5 usd
+  bottomMoney <- newMoney 0 btc
   title <- newFieldPair mempty $ DynamicFieldText "Hello, User!"
   message <- newFieldPair mempty $ DynamicFieldText exampleDonationText
   btcMtd <- newFieldPair "BTC - Bitcoin" $ DynamicFieldText exampleBtcAddress
   xmrMtd <- newFieldPair "XMR - Monero" $ DynamicFieldText exampleXmrAddress
   pure
     doc
-      { stDocFieldPairs =
+      { stDocTopMoney = topMoney,
+        stDocBottomMoney = bottomMoney,
+        stDocFieldPairs =
           [ title
               & #fieldPairValue
               . #fieldType

ghcjs/currency-converter/src/App/Widgets/Templates.hs

@@ -31,6 +31,7 @@ import qualified Functora.Web as Web
 import Language.Javascript.JSaddle ((!), (!!))
 import qualified Language.Javascript.JSaddle as JS
 import qualified Miso
+import qualified Network.URI as URI (parseURI)
 import qualified Text.URI as URI
 
 #ifdef wasi_HOST_OS
@@ -199,10 +200,12 @@ updateModel (ChanUpdate prevSt) _ = do
                 consoleLog e
                 pure $ prevSt & #modelLoading .~ False
             )
-            $ foldlM (\acc updater -> evalModel $ updater acc) prevSt actions
+            . evalModel
+            $ foldl (&) prevSt actions
         uri <- URI.mkURI $ shareLink nextSt
         Storage.insertStorage ("favorite-" <> vsn) (nextSt ^. #modelFavMap)
         Storage.insertStorage ("current-" <> vsn) uri
+        syncUri uri
         if nextSt ^. #modelLoading
           then do
             void
@@ -395,6 +398,19 @@ evalModel raw = do
               & #modelOnlineAt
               .~ ct
 
+syncUri :: URI -> JSM ()
+syncUri uri = do
+  textUri <- fmap Prelude.inspect getCurrentURI
+  prevUri <- URI.mkURI textUri
+  let nextUri = prevUri {URI.uriQuery = URI.uriQuery uri}
+  when (nextUri /= prevUri)
+    $ pushURI
+    =<< ( maybe (throwString $ "Bad URI " <> textUri) pure
+            . URI.parseURI
+            . from @Prelude.Text @Prelude.String
+            $ URI.render nextUri
+        )
+
 getBaseConverterMoneyLens :: TopOrBottom -> ALens' Model (Money Unique)
 getBaseConverterMoneyLens = \case
   Top -> #modelState . #stDoc . #stDocTopMoney

ghcjs/currency-converter/src/Main.hs

@@ -18,7 +18,7 @@ async function insertStorage(key, value) {
 
 async function openBrowserPage(url) {
   try {
-    return await Browser.open({ url: url });
+    return await Browser.open({ url: url, windowName: "_blank" });
   } catch (e) {
     return window.open(url, "_blank").focus();
   }

ghcjs/currency-converter/static/cap.js

@@ -597,7 +597,7 @@ async function insertStorage(key, value) {
 }
 async function openBrowserPage(url) {
   try {
-    return await Browser.open({ url });
+    return await Browser.open({ url, windowName: "_blank" });
   } catch (e) {
     return window.open(url, "_blank").focus();
   }