{-# LANGUAGE CPP #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE TemplateHaskell #-}
{-# OPTIONS_GHC -Wno-duplicate-exports #-}
module Miso
(
miso
, (🍜)
, startComponent
, withSink
, Sink
, sample
, sample'
, notify
, notify'
, startSub
, stopSub
, Sub
, SubName
, issue
, batch
, io
, io_
, for
, module Miso.Types
, module Miso.Effect
, module Miso.Event
, module Miso.Property
, module Miso.Html
, module Miso.Render
, module Miso.Router
, module Miso.Run
, module Miso.Exception
, module Miso.Subscription
, module Miso.Storage
, module Miso.Fetch
, module Miso.Util
, module Miso.FFI
, ask
, modify
, modify'
, get
, gets
, put
, tell
) where
import Control.Monad (void)
import Control.Monad.IO.Class (liftIO)
import Control.Monad.RWS (get, gets, modify, modify', tell, put, ask)
import Data.IORef (newIORef)
import Language.Javascript.JSaddle (Object(Object), JSM)
#ifndef GHCJS_BOTH
import Data.FileEmbed (embedStringFile)
import Language.Javascript.JSaddle (eval)
import Miso.String (MisoString)
#endif
import Miso.Diff
import Miso.Effect
import Miso.Event
import Miso.Exception
import Miso.Fetch
import Miso.FFI
import qualified Miso.FFI.Internal as FFI
import Miso.Html
import Miso.Internal
import Miso.Property
import Miso.Render
import Miso.Router
import Miso.Run
import Miso.Storage
import Miso.Subscription
import Miso.Types
import Miso.Util
miso :: Eq model => (URI -> Component name model action) -> JSM ()
miso :: forall model (name :: Symbol) action.
Eq model =>
(URI -> Component name model action) -> JSM ()
miso URI -> Component name model action
f = JSM (IORef VTree) -> JSM ()
forall a. JSM a -> JSM ()
withJS (JSM (IORef VTree) -> JSM ()) -> JSM (IORef VTree) -> JSM ()
forall a b. (a -> b) -> a -> b
$ do
app@Component {..} <- URI -> Component name model action
f (URI -> Component name model action)
-> JSM URI -> JSM (Component name model action)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> JSM URI
getURI
initialize app $ \Sink action
snk -> do
[CSS] -> JSM ()
renderStyles [CSS]
styles
VTree (Object vtree) <- Prerender
-> View action -> Sink action -> LogLevel -> Events -> JSM VTree
forall action.
Prerender
-> View action -> Sink action -> LogLevel -> Events -> JSM VTree
runView Prerender
Prerender (model -> View action
view model
model) Sink action
snk LogLevel
logLevel Events
events
let name = Maybe MountPoint -> MountPoint
getMountPoint Maybe MountPoint
mountPoint
FFI.setBodyComponent name
mount <- FFI.getBody
FFI.hydrate (logLevel `elem` [DebugPrerender, DebugAll]) mount vtree
viewRef <- liftIO $ newIORef $ VTree (Object vtree)
pure (name, mount, viewRef)
(🍜) :: Eq model => (URI -> Component name model action) -> JSM ()
🍜 :: forall model (name :: Symbol) action.
Eq model =>
(URI -> Component name model action) -> JSM ()
(🍜) = (URI -> Component name model action) -> JSM ()
forall model (name :: Symbol) action.
Eq model =>
(URI -> Component name model action) -> JSM ()
miso
startComponent :: Eq model => Component name model action -> JSM ()
startComponent :: forall model (name :: Symbol) action.
Eq model =>
Component name model action -> JSM ()
startComponent app :: Component name model action
app@Component {model
[CSS]
[Sub action]
Maybe action
Maybe MountPoint
Events
LogLevel
model -> View action
action -> Effect model action
mountPoint :: forall (name :: Symbol) model action.
Component name model action -> Maybe MountPoint
logLevel :: forall (name :: Symbol) model action.
Component name model action -> LogLevel
initialAction :: forall (name :: Symbol) model action.
Component name model action -> Maybe action
styles :: forall (name :: Symbol) model action.
Component name model action -> [CSS]
events :: forall (name :: Symbol) model action.
Component name model action -> Events
subs :: forall (name :: Symbol) model action.
Component name model action -> [Sub action]
view :: forall (name :: Symbol) model action.
Component name model action -> model -> View action
update :: forall (name :: Symbol) model action.
Component name model action -> action -> Effect model action
model :: forall (name :: Symbol) model action.
Component name model action -> model
model :: model
update :: action -> Effect model action
view :: model -> View action
subs :: [Sub action]
events :: Events
styles :: [CSS]
initialAction :: Maybe action
mountPoint :: Maybe MountPoint
logLevel :: LogLevel
..} = JSM (IORef VTree) -> JSM ()
forall a. JSM a -> JSM ()
withJS (JSM (IORef VTree) -> JSM ()) -> JSM (IORef VTree) -> JSM ()
forall a b. (a -> b) -> a -> b
$
Component name model action
-> (Sink action -> JSM (MountPoint, JSVal, IORef VTree))
-> JSM (IORef VTree)
forall model (name :: Symbol) action.
Eq model =>
Component name model action
-> (Sink action -> JSM (MountPoint, JSVal, IORef VTree))
-> JSM (IORef VTree)
initialize Component name model action
app ((Sink action -> JSM (MountPoint, JSVal, IORef VTree))
-> JSM (IORef VTree))
-> (Sink action -> JSM (MountPoint, JSVal, IORef VTree))
-> JSM (IORef VTree)
forall a b. (a -> b) -> a -> b
$ \Sink action
snk -> do
[CSS] -> JSM ()
renderStyles [CSS]
styles
vtree <- Prerender
-> View action -> Sink action -> LogLevel -> Events -> JSM VTree
forall action.
Prerender
-> View action -> Sink action -> LogLevel -> Events -> JSM VTree
runView Prerender
DontPrerender (model -> View action
view model
model) Sink action
snk LogLevel
logLevel Events
events
let name = Maybe MountPoint -> MountPoint
getMountPoint Maybe MountPoint
mountPoint
FFI.setBodyComponent name
mount <- mountElement name
diff Nothing (Just vtree) mount
viewRef <- liftIO (newIORef vtree)
pure (name, mount, viewRef)
withJS :: JSM a -> JSM ()
withJS :: forall a. JSM a -> JSM ()
withJS JSM a
action = JSM a -> JSM ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (JSM a -> JSM ()) -> JSM a -> JSM ()
forall a b. (a -> b) -> a -> b
$ do
#ifndef GHCJS_BOTH
#ifdef PRODUCTION
_ <- eval ($(embedStringFile "js/miso.prod.js") :: MisoString)
#else
_ <- MountPoint -> JSM JSVal
forall script. ToJSString script => script -> JSM JSVal
eval ($(embedStringFile "js/miso.js") :: MisoString)
#endif
#endif
action