diff --git a/README.md b/README.md
--- a/README.md
+++ b/README.md
@@ -22,6 +22,9 @@
+
+ 
+
@@ -79,22 +82,28 @@
data Action
= AddOne
| SubtractOne
+ | NoOp
+ | SayHelloWorld
deriving (Show, Eq)
-- | Entry point for a miso application
main :: IO ()
main = startApp App {..}
where
- model = 0 -- initial model
- update = updateModel -- update function
- view = viewModel -- view function
- events = defaultEvents -- default delegated events
- subs = [] -- empty subscription list
+ initialAction = SayHelloWorld -- initial action to be executed on application load
+ model = 0 -- initial model
+ update = updateModel -- update function
+ view = viewModel -- view function
+ events = defaultEvents -- default delegated events
+ subs = [] -- empty subscription list
-- | Updates model, optionally introduces side effects
updateModel :: Action -> Model -> Effect Model Action
updateModel AddOne m = noEff (m + 1)
updateModel SubtractOne m = noEff (m - 1)
+updateModel NoOp m = noEff m
+updateModel SayHelloWorld m = m <# do
+ putStrLn "Hello World" >> pure NoOp
-- | Constructs a virtual DOM from a model
viewModel :: Model -> View Action
diff --git a/examples/mario/Main.hs b/examples/mario/Main.hs
--- a/examples/mario/Main.hs
+++ b/examples/mario/Main.hs
@@ -15,6 +15,7 @@
= GetArrows !Arrows
| Time !Double
| WindowCoords !(Int,Int)
+ | NoOp
foreign import javascript unsafe "$r = performance.now();"
now :: IO Double
@@ -23,7 +24,7 @@
main = do
time <- now
let m = mario { time = time }
- startApp App { model = m, ..}
+ startApp App { model = m, initialAction = NoOp, ..}
where
update = updateMario
view = display
@@ -63,6 +64,7 @@
}
updateMario :: Action -> Model -> Effect Model Action
+updateMario NoOp m = noEff m
updateMario (GetArrows arrs) m = step newModel
where
newModel = m { arrows = arrs }
diff --git a/examples/router/Main.hs b/examples/router/Main.hs
--- a/examples/router/Main.hs
+++ b/examples/router/Main.hs
@@ -35,7 +35,7 @@
main :: IO ()
main = do
currentURI <- getCurrentURI
- startApp App { model = Model currentURI, ..}
+ startApp App { model = Model currentURI, initialAction = NoOp, ..}
where
update = updateModel
events = defaultEvents
diff --git a/examples/todo-mvc/Main.hs b/examples/todo-mvc/Main.hs
--- a/examples/todo-mvc/Main.hs
+++ b/examples/todo-mvc/Main.hs
@@ -78,7 +78,7 @@
deriving Show
main :: IO ()
-main = startApp App{..}
+main = startApp App { initialAction = NoOp, ..}
where
model = emptyModel
update = updateModel
diff --git a/examples/websocket/Main.hs b/examples/websocket/Main.hs
--- a/examples/websocket/Main.hs
+++ b/examples/websocket/Main.hs
@@ -21,7 +21,7 @@
import qualified Miso.String as S
main :: IO ()
-main = startApp App {..}
+main = startApp App { initialAction = Id, ..}
where
model = Model mempty mempty
events = defaultEvents
diff --git a/exe/Main.hs b/exe/Main.hs
--- a/exe/Main.hs
+++ b/exe/Main.hs
@@ -6,7 +6,7 @@
type Model = Int
main :: IO ()
-main = startApp App {..}
+main = startApp App { initialAction = SayHelloWorld, ..}
where
model = 0
update = updateModel
@@ -17,10 +17,15 @@
updateModel :: Action -> Model -> Effect Model Action
updateModel AddOne m = noEff (m + 1)
updateModel SubtractOne m = noEff (m - 1)
+updateModel NoOp m = noEff m
+updateModel SayHelloWorld m = m <# do
+ putStrLn "Hello World!" >> pure NoOp
data Action
= AddOne
| SubtractOne
+ | NoOp
+ | SayHelloWorld
deriving (Show, Eq)
viewModel :: Int -> View Action
diff --git a/ghc-src/Miso/Html/Internal.hs b/ghc-src/Miso/Html/Internal.hs
--- a/ghc-src/Miso/Html/Internal.hs
+++ b/ghc-src/Miso/Html/Internal.hs
@@ -1,4 +1,5 @@
{-# LANGUAGE KindSignatures #-}
+{-# LANGUAGE DataKinds #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE TypeSynonymInstances #-}
{-# LANGUAGE RankNTypes #-}
@@ -7,6 +8,7 @@
{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE UndecidableInstances #-}
-----------------------------------------------------------------------------
-- |
-- Module : Miso.Html.Internal
@@ -42,35 +44,38 @@
) where
import Data.Aeson
-import qualified Data.Map as M
+import qualified Data.Map as M
import Data.Monoid
-import Data.Text (Text)
-import qualified Data.Text as T
+import Data.Proxy
+import Data.Text (Text)
+import qualified Data.Text as T
import qualified Data.Vector as V
-import qualified Lucid as L
-import qualified Lucid.Base as L
-import Miso.String hiding (map)
+import qualified Lucid as L
+import qualified Lucid.Base as L
+import Servant.API
+
import Miso.Event
+import Miso.String hiding (map)
-- | Virtual DOM implemented as a Rose `Vector`.
-- Used for diffing, patching and event delegation.
-- Not meant to be constructed directly, see `View` instead.
-data VTree model where
+data VTree action where
VNode :: { vType :: Text -- ^ Element type (i.e. "div", "a", "p")
, vNs :: NS -- ^ HTML or SVG
, vProps :: Props -- ^ Fields present on DOM Node
, vCss :: CSS -- ^ Styles
, vKey :: Maybe Key -- ^ Key used for child swap patch
- , vChildren :: V.Vector (VTree model) -- ^ Child nodes
- } -> VTree model
+ , vChildren :: V.Vector (VTree action) -- ^ Child nodes
+ } -> VTree action
VText :: { vText :: Text -- ^ TextNode content
- } -> VTree model
+ } -> VTree action
-instance Show (VTree model) where
+instance Show (VTree action) where
show = show . L.toHtml
-- | Converting `VTree` to Lucid's `L.Html`
-instance L.ToHtml (VTree model) where
+instance L.ToHtml (VTree action) where
toHtmlRaw = L.toHtml
toHtml (VText x) = L.toHtml x
toHtml VNode{..} =
@@ -96,17 +101,22 @@
toHtmlFromJSON (Array a) = pack (show a)
-- | Core type for constructing a `VTree`, use this instead of `VTree` directly.
-newtype View model = View { runView :: VTree model }
+newtype View action = View { runView :: VTree action }
+-- | For constructing type-safe links
+instance HasLink (View a) where
+ type MkLink (View a) = MkLink (Get '[] ())
+ toLink _ = toLink (Proxy :: Proxy (Get '[] ()))
+
-- | Convenience class for using View
-class ToView v where toView :: v -> View model
+class ToView v where toView :: v -> View action
-- | Show `View`
-instance Show (View model) where
+instance Show (View action) where
show (View xs) = show xs
-- | Converting `View` to Lucid's `L.Html`
-instance L.ToHtml (View model) where
+instance L.ToHtml (View action) where
toHtmlRaw = L.toHtml
toHtml (View xs) = L.toHtml xs
@@ -117,7 +127,7 @@
deriving (Show, Eq)
-- | `VNode` creation
-node :: NS -> MisoString -> Maybe Key -> [Attribute model] -> [View model] -> View model
+node :: NS -> MisoString -> Maybe Key -> [Attribute action] -> [View action] -> View action
node vNs vType vKey as xs =
let vProps = Props $ M.fromList [ (k,v) | P k v <- as ]
vCss = CSS $ M.fromList [ (k,v) | C k v <- as ]
@@ -125,7 +135,7 @@
in View VNode {..}
-- | `VText` creation
-text :: ToMisoString str => str -> View model
+text :: ToMisoString str => str -> View action
text x = View $ VText (toMisoString x)
-- | Key for specific children patch
@@ -156,7 +166,7 @@
newtype CSS = CSS (M.Map MisoString MisoString)
-- | `View` Attributes to annotate DOM, converted into Events, Props, Attrs and CSS
-data Attribute model
+data Attribute action
= C MisoString MisoString
| P MisoString Value
| E ()
@@ -167,7 +177,7 @@
deriving (Show, Eq)
-- | Constructs a property on a `VNode`, used to set fields on a DOM Node
-prop :: ToJSON a => MisoString -> a -> Attribute model
+prop :: ToJSON a => MisoString -> a -> Attribute action
prop k v = P k (toJSON v)
-- | For defining delegated events
diff --git a/ghcjs-src/Miso.hs b/ghcjs-src/Miso.hs
--- a/ghcjs-src/Miso.hs
+++ b/ghcjs-src/Miso.hs
@@ -57,9 +57,9 @@
sub (readIORef modelRef) writeEvent
-- init event application thread
void . forkIO . forever $ do
- action <- getEvent
+ newAction <- getEvent
modifyMVar_ actionsMVar $! \actions ->
- pure (actions |> action)
+ pure (actions |> newAction)
-- Hack to get around `BlockedIndefinitelyOnMVar` exception
-- that occurs when no event handlers are present on a template
-- and `notify` is no longer in scope
@@ -70,6 +70,8 @@
viewRef <- newIORef initialVTree
-- Begin listening for events in the virtual dom
delegator viewRef events
+ -- Process initial action of application
+ writeEvent initialAction
-- Program loop, blocking on SkipChan
forever $ wait >> do
-- Apply actions to model
diff --git a/ghcjs-src/Miso/Html/Internal.hs b/ghcjs-src/Miso/Html/Internal.hs
--- a/ghcjs-src/Miso/Html/Internal.hs
+++ b/ghcjs-src/Miso/Html/Internal.hs
@@ -1,19 +1,20 @@
-{-# LANGUAGE OverloadedStrings #-}
-{-# LANGUAGE CPP #-}
-{-# LANGUAGE TypeFamilies #-}
-{-# LANGUAGE TypeOperators #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE CPP #-}
+{-# LANGUAGE TypeFamilies #-}
+{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
-{-# LANGUAGE DataKinds #-}
-{-# LANGUAGE KindSignatures #-}
-{-# LANGUAGE LambdaCase #-}
-{-# LANGUAGE ConstraintKinds #-}
-{-# LANGUAGE FlexibleInstances #-}
-{-# LANGUAGE MultiParamTypeClasses #-}
-{-# LANGUAGE ScopedTypeVariables #-}
-{-# LANGUAGE OverloadedStrings #-}
-{-# LANGUAGE DeriveGeneric #-}
-{-# LANGUAGE RecordWildCards #-}
-{-# OPTIONS_GHC -fno-warn-orphans #-}
+{-# LANGUAGE DataKinds #-}
+{-# LANGUAGE KindSignatures #-}
+{-# LANGUAGE LambdaCase #-}
+{-# LANGUAGE ConstraintKinds #-}
+{-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE MultiParamTypeClasses #-}
+{-# LANGUAGE UndecidableInstances #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE DeriveGeneric #-}
+{-# LANGUAGE RecordWildCards #-}
+{-# OPTIONS_GHC -fno-warn-orphans #-}
-----------------------------------------------------------------------------
-- |
-- Module : Miso.Html.Internal
@@ -51,19 +52,20 @@
) where
import Control.Monad
--- import Data.Aeson hiding (Object)
-import Data.Aeson.Types (parseEither)
-import Data.Monoid
+import Data.Aeson.Types (parseEither)
import Data.JSString
import Data.JSString.Text
-import qualified Data.Map as M
-import qualified Data.Text as T
+import qualified Data.Map as M
+import Data.Monoid
+import Data.Proxy
+import qualified Data.Text as T
import GHCJS.Foreign.Callback
import GHCJS.Marshal
import GHCJS.Types
-import JavaScript.Array.Internal (fromList)
+import JavaScript.Array.Internal (fromList)
import JavaScript.Object
import JavaScript.Object.Internal (Object (Object))
+import Servant.API
import Miso.Event.Decoder
import Miso.Event.Types
@@ -82,6 +84,11 @@
newtype View action = View {
runView :: (action -> IO ()) -> IO VTree
}
+
+-- | For constructing type-safe links
+instance HasLink (View a) where
+ type MkLink (View a) = MkLink (Get '[] ())
+ toLink _ = toLink (Proxy :: Proxy (Get '[] ()))
-- | Convenience class for using View
class ToView v where toView :: v -> View m
diff --git a/ghcjs-src/Miso/Router.hs b/ghcjs-src/Miso/Router.hs
--- a/ghcjs-src/Miso/Router.hs
+++ b/ghcjs-src/Miso/Router.hs
@@ -137,11 +137,6 @@
type RouteT m (View a) x = m -> x
route _ _ a m = RPage (a m)
--- | Link
-instance HasLink (View a) where
- type MkLink (View a) = MkLink (Get '[] ())
- toLink _ = toLink (Proxy :: Proxy (Get '[] ()))
-
-- | Use a handler to route a 'Location'.
-- Normally 'runRoute' should be used instead, unless you want custom
-- handling of string failing to parse as 'URI'.
diff --git a/ghcjs-src/Miso/Types.hs b/ghcjs-src/Miso/Types.hs
--- a/ghcjs-src/Miso/Types.hs
+++ b/ghcjs-src/Miso/Types.hs
@@ -28,5 +28,7 @@
-- ^ List of subscriptions to run during application lifetime
, events :: M.Map MisoString Bool
-- ^ List of delegated events that the body element will listen for
+ , initialAction :: action
+ -- ^ Initial action that is run after the application has loaded
}
diff --git a/miso.cabal b/miso.cabal
--- a/miso.cabal
+++ b/miso.cabal
@@ -1,5 +1,5 @@
name: miso
-version: 0.2.1.0
+version: 0.3.0.0
category: Web, Miso, Data Structures
license: BSD3
license-file: LICENSE
@@ -12,7 +12,7 @@
cabal-version: >=1.22
synopsis: A tasty Haskell front-end framework
description:
- Miso is a small isomorphic Haskell front-end framework featuring a virtual-dom, diffing / patching algorithm, event delegation, event batching, SVG, Server-sent events, Websockets, and an extensible Subscription-based subsystem. Inspired by Elm, Redux and Bobril. `IO` and other effects (like `XHR`) can be introduced into the system via the `Effect` data type. Miso makes heavy use of the GHCJS FFI and therefore has minimal dependencies.
+ Miso is a small "isomorphic" Haskell front-end framework featuring a virtual-dom, diffing / patching algorithm, event delegation, event batching, SVG, Server-sent events, Websockets, type-safe servant-style routing and an extensible Subscription-based subsystem. Inspired by Elm, Redux and Bobril. Miso is pure by default, but side effects (like XHR) can be introduced into the system via the Effect data type. Miso makes heavy use of the GHCJS FFI and therefore has minimal dependencies.
extra-source-files:
README.md
@@ -165,6 +165,7 @@
bytestring,
BoundedChan,
containers,
+ servant,
text
if impl(ghcjs)
hs-source-dirs:
@@ -177,7 +178,6 @@
containers,
scientific,
unordered-containers,
- servant,
transformers,
vector
js-sources: