wip

Author: functora

ghcjs/currency-converter/default.nix

@@ -1,8 +1,8 @@
 let
   # functora = ../..;
   functora = fetchTarball {
-    url = "https://github.com/functora/functora.github.io/archive/2b478d8e18769b245a2bc488d7136718e81c0ac1.tar.gz";
-    sha256 = "0xxc2g2hiylk6hhbq6a0qk8a9cq7r0y5l0szm1rwcqlywdb8kg0l";
+    url = "https://github.com/functora/functora.github.io/archive/03df5e6d39d0fdc31a53cc350e1125118b4a12ca.tar.gz";
+    sha256 = "0pad1981bpnl1szvlhgl00ai9ikz9nsl4yv6mxxv0q46j10bdchz";
   };
   legacy = fetchTarball {
     url = "https://github.com/functora/functora.github.io/archive/7a06c850a579058f495ca2d7e5e2f8682ea0998f.tar.gz";

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

@@ -386,6 +386,7 @@ data Fav = Fav
     favCreatedAt :: UTCTime
   }
   deriving stock (Eq, Ord, Show, Data, Generic)
+  deriving (ToJSON, FromJSON) via GenericType Fav
 
 newRatioField :: (MonadIO m) => Rational -> m (Field Rational Unique)
 newRatioField output =

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

@@ -40,7 +40,7 @@ fav st =
                           )
                           ( Field.defOpts
                               & #optsPlaceholder
-                              .~ ("Name - " <> fullFavName)
+                              .~ ("Name - " <> makeFavName st)
                           ),
                        Cell.smallCell
                         $ Button.raised
@@ -56,7 +56,7 @@ fav st =
                        Cell.smallCell
                         $ Button.raised
                           ( Button.config
-                              & Button.setOnClick Noop
+                              & Button.setOnClick deleteAction
                               & Button.setIcon (Just "delete_forever")
                               & Button.setAttributes
                                 [ Theme.secondaryBg,
@@ -78,28 +78,43 @@ fav st =
           )
       ]
   where
-    fullFavName = makeFavName st
     closeAction = pureUpdate 0 (& #modelFav .~ Closed)
     saveAction = PushUpdate $ do
       ct <- getCurrentTime
-      uri <- URI.mkURI $ shareLink (st ^. #modelState . #stScreen) st
-      let nextFav =
-            Fav
-              { favUri = uri,
-                favCreatedAt = ct
-              }
-      pure
-        . ChanItem 0
-        $ ( Misc.textPopupPure
-              $ "Saved "
-              <> fullFavName
-              <> "!"
-          )
-        . ( &
-              #modelFavMap
-                . at fullFavName
-                %~ (Just . maybe nextFav (& #favUri .~ uri))
-          )
+      pure . ChanItem 0 $ \nextSt ->
+        let uri =
+              either impureThrow id
+                . URI.mkURI
+                $ shareLink (nextSt ^. #modelState . #stScreen) nextSt
+            nextFav = do
+              Fav
+                { favUri = uri,
+                  favCreatedAt = ct
+                }
+            nextFavName =
+              makeFavName nextSt
+         in nextSt
+              & ( Misc.textPopupPure
+                    $ "Saved "
+                    <> nextFavName
+                    <> "!"
+                )
+              & #modelFavMap
+              . at nextFavName
+              %~ ( Just
+                    . maybe nextFav (& #favUri .~ uri)
+                 )
+    deleteAction = pureUpdate 0 $ \nextSt ->
+      let nextFavName = makeFavName nextSt
+       in nextSt
+            & ( Misc.textPopupPure
+                  $ "Removed "
+                  <> nextFavName
+                  <> "!"
+              )
+            & #modelFavMap
+            . at nextFavName
+            .~ Nothing
 
 makeFavName :: Model -> Text
 makeFavName st =
@@ -144,12 +159,15 @@ favItem st label Fav {favUri = uri} =
   Cell.bigCell
     $ Button.raised
       ( Button.config
-          & Button.setOnClick opened
+          & Button.setOnClick openAction
           & Button.setAttributes [class_ "fill"]
       )
       label
   where
-    opened = PushUpdate $ do
+    openAction = PushUpdate $ do
+      --
+      -- TODO : Implement here pure, less costly equivalent of newModel.
+      --
       next <- newModel (st ^. #modelWebOpts) (Just st) uri
       pure
         . ChanItem 0