{-# LANGUAGE CPP #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE TemplateHaskell #-}
{-# OPTIONS_GHC -Wno-duplicate-exports #-}
module Miso
(
miso
, (🍜)
, startApp
, withSink
, Sink
, sample
, notify
, start
, start_
, stop
, 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.Mathml
, 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.Mathml
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 -> App model action) -> JSM ()
miso :: forall model action.
Eq model =>
(URI -> App model action) -> JSM ()
miso URI -> App 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@App {..} <- URI -> App model action
f (URI -> App model action) -> JSM URI -> JSM (App 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
-> Map MisoString Capture
-> JSM VTree
forall action.
Prerender
-> View action
-> Sink action
-> LogLevel
-> Map MisoString Capture
-> JSM VTree
runView Prerender
Prerender (model -> View action
view model
model) Sink action
snk LogLevel
logLevel Map MisoString Capture
events
let name = Maybe MisoString -> MisoString
getMountPoint Maybe MisoString
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 -> App model action) -> JSM ()
🍜 :: forall model action.
Eq model =>
(URI -> App model action) -> JSM ()
(🍜) = (URI -> App model action) -> JSM ()
forall model action.
Eq model =>
(URI -> App model action) -> JSM ()
miso
startApp :: Eq model => App model action -> JSM ()
startApp :: forall model action. Eq model => App model action -> JSM ()
startApp app :: App model action
app@App {model
[CSS]
[Sub action]
Maybe action
Maybe MisoString
Map MisoString Capture
LogLevel
model -> View action
action -> Effect model action
mountPoint :: forall model action. App model action -> Maybe MisoString
logLevel :: forall model action. App model action -> LogLevel
initialAction :: forall model action. App model action -> Maybe action
styles :: forall model action. App model action -> [CSS]
events :: forall model action. App model action -> Map MisoString Capture
subs :: forall model action. App model action -> [Sub action]
view :: forall model action. App model action -> model -> View action
update :: forall model action.
App model action -> action -> Effect model action
model :: forall model action. App model action -> model
model :: model
update :: action -> Effect model action
view :: model -> View action
subs :: [Sub action]
events :: Map MisoString Capture
styles :: [CSS]
initialAction :: Maybe action
mountPoint :: Maybe MisoString
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
$
App model action
-> (Sink action -> JSM (MisoString, JSVal, IORef VTree))
-> JSM (IORef VTree)
forall model action.
Eq model =>
App model action
-> (Sink action -> JSM (MisoString, JSVal, IORef VTree))
-> JSM (IORef VTree)
initialize App model action
app ((Sink action -> JSM (MisoString, JSVal, IORef VTree))
-> JSM (IORef VTree))
-> (Sink action -> JSM (MisoString, 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
-> Map MisoString Capture
-> JSM VTree
forall action.
Prerender
-> View action
-> Sink action
-> LogLevel
-> Map MisoString Capture
-> JSM VTree
runView Prerender
DontPrerender (model -> View action
view model
model) Sink action
snk LogLevel
logLevel Map MisoString Capture
events
let name = Maybe MisoString -> MisoString
getMountPoint Maybe MisoString
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
_ <- MisoString -> JSM JSVal
forall script. ToJSString script => script -> JSM JSVal
eval ($(embedStringFile "js/miso.js") :: MisoString)
#endif
#endif
action