From 890eaa8a66dd6cfecf267f5f90d2f9d86920ca51 Mon Sep 17 00:00:00 2001 From: George Thomas Date: Mon, 24 Feb 2025 22:44:42 +0000 Subject: [PATCH 1/3] chore: Use `MisoString` instead of `Text` where possible This is generally a good idea for performance reasons, since it means that `JSString` is used when compiling for JS or Wasm. And Miso's upcoming components support is stricter about requiring it. Signed-off-by: George Thomas --- primer-miso/src/Primer/Miso.hs | 15 ++++++++------- primer-miso/src/Primer/Miso/Util.hs | 8 +++++--- 2 files changed, 13 insertions(+), 10 deletions(-) diff --git a/primer-miso/src/Primer/Miso.hs b/primer-miso/src/Primer/Miso.hs index e7cde8e5f..62c48ddcf 100644 --- a/primer-miso/src/Primer/Miso.hs +++ b/primer-miso/src/Primer/Miso.hs @@ -52,6 +52,7 @@ import Miso ( style_, text, ) +import Miso.String (MisoString, ms) import Optics (lensVL, to, (%), (.~), (^.), (^..), _Just) import Optics.State.Operators ((?=)) import Primer.App ( @@ -160,7 +161,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 +184,7 @@ viewModel Model{..} = [ class_ $ mwhen (Just def == ((.def) <$> selection)) "selected" , onClick $ SelectDef def ] - [text $ globalNamePretty def] + [text $ ms $ globalNamePretty def] ] <> case selection of Nothing -> [text "no selection"] @@ -228,7 +229,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 +245,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 +303,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 ] ] ] diff --git a/primer-miso/src/Primer/Miso/Util.hs b/primer-miso/src/Primer/Miso/Util.hs index 69bfb9718..b57e18c84 100644 --- a/primer-miso/src/Primer/Miso/Util.hs +++ b/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), @@ -114,15 +116,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 From 38cc992bb9100f3a5b5d221b69001b5504c99686 Mon Sep 17 00:00:00 2001 From: George Thomas Date: Tue, 25 Feb 2025 11:56:21 +0000 Subject: [PATCH 2/3] chore: Use Miso components branch This does not, or at least should not, yet cause any changes in functionality. Signed-off-by: George Thomas --- cabal.project | 8 ++++---- primer-miso/src/Primer/Miso.hs | 2 +- 2 files changed, 5 insertions(+), 5 deletions(-) diff --git a/cabal.project b/cabal.project index 04e0e0546..33c8c758c 100644 --- a/cabal.project +++ b/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. -- diff --git a/primer-miso/src/Primer/Miso.hs b/primer-miso/src/Primer/Miso.hs index 62c48ddcf..30601aa37 100644 --- a/primer-miso/src/Primer/Miso.hs +++ b/primer-miso/src/Primer/Miso.hs @@ -139,7 +139,7 @@ start = , subs = [] , events = defaultEvents , initialAction = NoOp "start" - , mountPoint = Nothing + , mountPoint = "body" , logLevel = Off } where From 5424a8ec1e2d2e87aadee594c391d40668c0b3ca Mon Sep 17 00:00:00 2001 From: George Thomas Date: Tue, 25 Feb 2025 13:14:06 +0000 Subject: [PATCH 3/3] (WIP) add a dummy Miso component Signed-off-by: George Thomas --- primer-miso/frontend/style.css | 7 ++++- primer-miso/src/Primer/Miso.hs | 42 +++++++++++++++++++++++++++-- primer-miso/src/Primer/Miso/Util.hs | 4 +++ 3 files changed, 50 insertions(+), 3 deletions(-) diff --git a/primer-miso/frontend/style.css b/primer-miso/frontend/style.css index 3cba0fc66..7b352d9ae 100644 --- a/primer-miso/frontend/style.css +++ b/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 { diff --git a/primer-miso/src/Primer/Miso.hs b/primer-miso/src/Primer/Miso.hs index 30601aa37..ecd1e3a86 100644 --- a/primer-miso/src/Primer/Miso.hs +++ b/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,15 +43,19 @@ 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) @@ -130,8 +135,11 @@ 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 @@ -153,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 @@ -185,6 +222,7 @@ viewModel Model{..} = , onClick $ SelectDef def ] [text $ ms $ globalNamePretty def] + , component subApp ] <> case selection of Nothing -> [text "no selection"] diff --git a/primer-miso/src/Primer/Miso/Util.hs b/primer-miso/src/Primer/Miso/Util.hs index b57e18c84..1412d8082 100644 --- a/primer-miso/src/Primer/Miso/Util.hs +++ b/primer-miso/src/Primer/Miso/Util.hs @@ -88,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 <-