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/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 e7cde8e5f..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,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,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 @@ -138,7 +147,7 @@ start = , 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 ] ] ] diff --git a/primer-miso/src/Primer/Miso/Util.hs b/primer-miso/src/Primer/Miso/Util.hs index 69bfb9718..1412d8082 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), @@ -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