Use experimental Miso components support

cabal.project

@@ -71,13 +71,13 @@ source-repository-package
   subdir: selda selda-sqlite
   --sha256: 0fw336sb03sc54pzmkz6jn989zvbnwnzypb9n0ackprymnvh8mym
 
--- Until a new Hackage release is made which includes
--- https://github.com/dmjio/miso/pull/752
+-- Experimental component support
+-- https://github.com/dmjio/miso/pull/766
 source-repository-package
   type: git
   location: https://github.com/dmjio/miso
-  tag: 2b548d48bffb0e8ae28a6cfb886e4afb0d8be37a
-  --sha256: sha256-fzDEa8vKXgxPPB+8NDLmhn2Jw1UDZso7e/klwidCfhM=
+  tag: bd4fa5c86f7f0a772352c2ff4fa9eeb74f12fef3
+  --sha256: GDJKrP9Xu7N4vxlbp/4n6sPJD0AXQbSd9Rc8tsmBZUw=
 
 -- Wasm workarounds.
 --

primer-miso/frontend/style.css

@@ -105,7 +105,12 @@ body {
 
 #selection-type {
   grid-column-start: 2;
-  grid-column-end: 4;
+  grid-column-end: 3;
+}
+
+#sub-app {
+  grid-column-start: 3;
+  grid-row-start: 2;
 }
 
 .tree {

primer-miso/src/Primer/Miso.hs

@@ -6,6 +6,7 @@
 {-# LANGUAGE RecordWildCards #-}
 {-# LANGUAGE ViewPatterns #-}
 {-# LANGUAGE NoFieldSelectors #-}
+{-# OPTIONS_GHC -Wno-unused-imports #-}
 
 module Primer.Miso (start) where
 
@@ -42,16 +43,21 @@ import Miso (
   View,
   button_,
   class_,
+  component,
+  consoleLog,
   defaultEvents,
   div_,
   fromTransition,
   id_,
   img_,
+  notify,
   onClick,
   src_,
   style_,
   text,
+  (<#),
  )
+import Miso.String (MisoString, ms)
 import Optics (lensVL, to, (%), (.~), (^.), (^..), _Just)
 import Optics.State.Operators ((?=))
 import Primer.App (
@@ -129,16 +135,19 @@ import Primer.Module (Module (moduleName))
 import Primer.Name (Name, unName)
 
 start :: JSM ()
-start =
-  startAppWithSavedState
+start = startAppWithSavedState topApp
+
+topApp :: App Model Action
+topApp =
+  identity
     App
       { model = Model{module_, selection = Nothing}
       , update = updateModel
       , view = viewModel
       , subs = []
       , events = defaultEvents
       , initialAction = NoOp "start"
-      , mountPoint = Nothing
+      , mountPoint = "body"
       , logLevel = Off
       }
   where
@@ -152,6 +161,35 @@ start =
       where
         (p, _, _) = newProg
 
+subApp :: App Int ()
+subApp =
+  App
+    { model = 0 :: Int
+    , update = \() n -> do
+        -- TODO huh, interestingly any effect somehow creates a self-perpuating chain of subcomponent updates
+        -- () <# pure ()
+        -- TODO taking a whole `App` as target seems a weird API - only `mountPoint` is actually used
+        -- it does ensure the correct type of model and action though...
+        -- TODO we
+        -- n' <- notify n topApp $ NoOp "sent from sub"
+        -- () <# consoleLog (ms n')
+        -- TODO what does this return value do/mean?
+        pure $ n + 1
+    , view = \n ->
+        div_
+          [ id_ "sub-app-inner"
+          ]
+          [ text "This is a working Miso component!"
+          , button_ [onClick ()] [text "click"]
+          , text $ ms n
+          ]
+    , subs = []
+    , events = defaultEvents
+    , initialAction = ()
+    , mountPoint = "sub-app"
+    , logLevel = Off
+    }
+
 data Model = Model
   { module_ :: ModuleT -- We typecheck everything up front so that we can use `ExprT`, guaranteeing existence of metadata.
   , selection :: Maybe DefSelectionT
@@ -160,7 +198,7 @@ data Model = Model
   deriving (ToJSON, FromJSON) via PrimerJSON Model
 
 data Action
-  = NoOp Text -- For situations where Miso requires an action, but we don't actually want to do anything.
+  = NoOp MisoString -- For situations where Miso requires an action, but we don't actually want to do anything.
   | SelectDef GVarName
   | SelectNode NodeSelectionT
   deriving stock (Eq, Show)
@@ -183,7 +221,8 @@ viewModel Model{..} =
               [ class_ $ mwhen (Just def == ((.def) <$> selection)) "selected"
               , onClick $ SelectDef def
               ]
-              [text $ globalNamePretty def]
+              [text $ ms $ globalNamePretty def]
+      , component subApp
       ]
       <> case selection of
         Nothing -> [text "no selection"]
@@ -228,7 +267,7 @@ data NodeViewData action = NodeViewData
   }
 
 data NodeViewOpts action
-  = SyntaxNode {wide :: Bool, flavor :: Text, text :: Text}
+  = SyntaxNode {wide :: Bool, flavor :: MisoString, text :: MisoString}
   | HoleNode {empty :: Bool}
   | PrimNode PrimCon
   | ConNode {name :: Name, scope :: ModuleName}
@@ -244,7 +283,7 @@ viewNodeData :: P2 Double -> V2 Double -> [View action] -> NodeViewData action -
 viewNodeData position dimensions edges node = case node.opts of
   PrimNode (PrimAnimation animation) ->
     img_
-      [ src_ ("data:img/gif;base64," <> animation)
+      [ src_ ("data:img/gif;base64," <> ms animation)
       , style_ $ clayToMiso do
           Clay.width $ Clay.px $ realToClay dimensions.x
           Clay.height $ Clay.px $ realToClay dimensions.y
@@ -302,11 +341,11 @@ viewNodeData position dimensions edges node = case node.opts of
                       [ text case node.opts of
                           SyntaxNode{text = t} -> t
                           HoleNode{empty = e} -> if e then "?" else "⚠️"
-                          PrimNode pc -> case pc of
+                          PrimNode pc -> ms @Text case pc of
                             PrimChar c' -> show c'
                             PrimInt n -> show n
-                          ConNode{name} -> unName name
-                          VarNode{name} -> unName name
+                          ConNode{name} -> ms $ unName name
+                          VarNode{name} -> ms $ unName name
                       ]
                   ]
            ]

primer-miso/src/Primer/Miso/Util.hs

@@ -41,6 +41,7 @@ import Control.Monad.Extra (eitherM)
 import Control.Monad.Fresh (MonadFresh (..))
 import Data.Aeson (FromJSON, ToJSON)
 import Data.Map qualified as Map
+import Data.Tuple.Extra (both)
 import Linear (Additive, R1 (_x), R2 (_y), V2, zero)
 import Linear.Affine (Point (..), unP)
 import Miso (
@@ -52,6 +53,7 @@ import Miso (
   startApp,
   (<#),
  )
+import Miso.String (MisoString, ms)
 import Optics (
   AffineTraversal',
   Field1 (_1),
@@ -86,6 +88,10 @@ import Primer.Typecheck (ExprT, TypeError, check, checkKind)
 {- Miso -}
 
 -- https://github.com/dmjio/miso/issues/749
+-- TODO how to also save state for subcomponents?
+-- maybe save them all as separate localStorage entries, keyed by ID?
+-- would it be possible to set this once at root and have it propogate down?
+-- actually, some configurability would be good
 startAppWithSavedState :: forall model action. (Eq model, FromJSON model, ToJSON model) => Miso.App model action -> JSM ()
 startAppWithSavedState app = do
   savedModel <-
@@ -114,15 +120,15 @@ startAppWithSavedState app = do
 -- note that we silently ignore non-properties, and modifiers on properties
 -- what we really want is for Clay property functions to return something much more precise than `Css`
 -- but this would be a big breaking change, and Clay is really designed primarily for generating stylesheets
-clayToMiso :: Clay.Css -> Map Text Text
+clayToMiso :: Clay.Css -> Map MisoString MisoString
 clayToMiso =
   Map.fromList
     . concatMap \case
       Clay.Property _modifiers (Clay.Key k) (Clay.Value v) -> (,) <$> allPrefixes k <*> allPrefixes v
         where
           allPrefixes = \case
-            Clay.Prefixed ts -> map (uncurry (<>)) ts
-            Clay.Plain t -> pure t
+            Clay.Prefixed ts -> map (uncurry (<>) . both ms) ts
+            Clay.Plain t -> pure $ ms t
       _ -> []
     . Clay.runS