myxine-client-0.0.1.0: src/Myxine/Page.hs
{-# options_haddock not-home #-}
module Myxine.Page
(
-- * #Top# Creating Interactive Pages
{-|
To create an interactive page, we need to build a 'Page'. A 'Page' is a handle
to a running page in the browser, providing a stateful typed mapping between the
view and interactions in the browser page and the types and actions available
within Haskell. To create a 'Page', we use 'runPage':
@
'Myxine.Page.runPage' ::
'Direct.PageLocation' ->
model ->
('Myxine.WithinPage' => model -> ('Direct.PageContent', 'Handlers' model)) ->
IO ('Myxine.Page.Page' model)
@
The beginning of a typical @myxine-client@ app looks something like:
@
data Model = ... -- the model that defines the page's current state
do page <- 'runPage' location (pure initialModel) ('reactive' . component)
finalModel <- 'waitPage' page
where
location :: 'PageLocation'
location = 'pagePort' 1123 <> 'pagePath' \'/\' -- where to connect to the server
initialModel :: Model
initialModel = ... -- the initial state of the model
component :: 'WithinPage' => 'Reactive' Model
component = ... -- how to render the model and listen for events that would update it
@
To describe the interactive behavior of the page, we need to define:
* __@location@:__ the 'pagePath' and 'pagePort' to connect to the Myxine server.
Use 'mempty' to use the default port and the root path. See the section on [page
locations](#Locations).
* __@initialModel@:__ the starting value for the model of the page, which can be
any Haskell data type of your choice.
* __@component@:__ an interleaved description in the 'Reactive' monad explaining
both how to render the current state of the model as HTML, and how to handle
events that occur within that selfsame HTML by updating the model and performing
IO.
See also the sections on [building reactive pages](#Building) and [manipulating
pages](#Manipulating).
-}
-- ** #NoReactive# Using 'Page' without 'Reactive'
{-|
Although the 'Reactive' abstraction is typically the most convenient way to
build a 'Page', the 'runPage' abstraction is not bound to a specific way of
formatting HTML 'Direct.PageContent' or gathering a set of 'Handlers'. Instead,
as noted above, 'runPage' takes as input any function of type
@'Myxine.WithinPage' => model -> ('Direct.PageContent', 'Handlers' model)@. We
provide the 'Reactive'-built pages to 'runPage' by /evaluating/ them using:
@
'reactive' :: 'Reactive' model -> model -> ('Direct.PageContent', 'Handlers' model)
@
This might not always suit your desires, though, and that's precisely why it's
not baked in. You are free to construct 'PageContent' using 'pageTitle' and
'pageBody', and to construct 'Handlers' using 'Myxine.Handlers.onEvent' and
'<>', avoiding the 'Reactive' abstraction altogether if you so choose.
-}
-- * #Pages# Creating and Waiting For Pages
Page, runPage, waitPage, stopPage
-- * #Locations# Specifying Page Locations
{-| If you are building a single-page application using Myxine, and you don't
intend to share its address space, you don't need to change the default
settings for the 'PageLocation': 'mempty' will do. However, the Myxine
server will gladly host your page at any path you desire; just use
'pagePath' to specify. Similarly, use 'pagePort' to specify if the Myxine
server is running on a different port than its default of 1123.
-}
, PageLocation, pagePath, pagePort
-- * #Building# Building Reactive Pages
{-| When using the 'Reactive' DSL for building pages, it's intended that you
import it alongside the 'Text.Blaze.Html5' and
'Text.Blaze.Html5.Attributes' modules from the
[blaze-html](https://hackage.haskell.org/package/blaze-html), which
provide the HTML combinators required for building markup.
While nothing about this module hard-codes the use of
[lenses](https://hackage.haskell.org/package/lens), it is often useful in
the body of handlers given to 'on' to manipulate the model state using
lens combinators, in particular the stateful 'Control.Lens.Setter..=' and
friends. This library is designed to play well with the following import
structure:
@
import Text.Blaze.Html5 ((!))
import qualified Text.Blaze.Html5 as H
import qualified Text.Blaze.Html5.Attributes as A
import Control.Monad.IO.Class
import Control.Monad.State
import Control.Monad.Reader
import Control.Lens
import Myxine
@
__A small example:__
Here's a simple 'Reactive' page that uses some of the combinators in this
library, as well as the Lens combinators 'Control.Lens._1',
'Control.Lens._2', 'Control.Lens.^.', 'Control.Lens..=',
'Control.Lens.+=', and 'Control.Lens.*='.
In this demonstration, you can see how the '@@' and 'on' functions work
together to allow you to define event handlers scoped to specific regions
of the page: handlers defined via 'on' receive only events from within the
region delineated by the enclosing '@@'. As such, clicking on the
background does not increment the counter, but clicking on the button
does.
@
main :: IO ()
main = do
page <- 'runPage' 'mempty' (0, False) ('reactive' component)
print =<< 'waitPage' page
component :: Reactive (Integer, Bool)
component = do
model <- 'ask'
H.div ! A.style ("background: " '<>' if model 'Control.Lens.^.' 'Control.Lens._2' then "red" else "green") '@@' do
'on' 'MouseOver' $ \\_ -> 'Control.Lens._2' 'Control.Lens..=' True
'on' 'MouseOut' $ \\_ -> 'Control.Lens._2' 'Control.Lens..=' False
H.button ! A.style "margin: 20pt" '@@' do
'on' 'Click' $ \\'MouseEvent'{shiftKey = False} -> 'Control.Lens._1' 'Control.Lens.+=' 1
'on' 'Click' $ \\'MouseEvent'{shiftKey = True} -> 'Control.Lens._1' 'Control.Lens.*=' 2
'markup' $ do
H.span ! A.style "font-size: 20pt" $
H.string (show (model 'Control.Lens.^.' 'Control.Lens._1'))
@
-}
, module Myxine.Reactive
-- * #Evaluating# Evaluating JavaScript
{-| The functions 'eval' and 'evalBlock' evaluate some 'JavaScript' in the
context of the current 'Page' and return a deserialized Haskell type
(inferred from the use site), or throw a 'JsException' containing a
human-readable string describing any error that occurred.
For instance, here's how we would query the width of the browser window on
every 'Resize' event:
@
windowWidth :: 'WithinPage' => 'Reactive' Int
windowWidth = do
currentWidth <- ask
'markup' currentWidth
'on' 'Resize' $ \\_ -> do
width <- 'eval' "window.innerWidth"
'Control.Monad.State.put' width
@
__Possible errors__ (which manifest as 'JsException's):
* Any exception in the given JavaScript
* Invalid JSON response for the result type inferred (use 'JSON.Value' if you
don't know what shape of data you're waiting to receive).
__Further caveats:__
* JavaScript @undefined@ is translated to @null@ in the results
* Return types are limited to those which can be serialized via
[JSON.stringify](https://developer.mozilla.org/docs/Web/JavaScript/Reference/Global_Objects/JSON/stringify),
which does not work for cyclic objects (like @window@, @document@, and all
DOM nodes), and may fail to serialize some properties for other non-scalar
values. If you want to return a non-scalar value like a list or dictionary,
construct it explicitly yourself by copying from the fields of the object
you're interested in.
* You're evaluating an arbitrary string as JavaScript, which means there
are no guarantees about type safety or purity.
* It is possible that you could break the Myxine server code running in
the page that makes it update properly, or hang the page by passing a
non-terminating piece of code.
* Any modifications you make to the DOM will be immediately overwritten on
the next re-draw of the page. Don't do this.
* If there are multiple browser windows pointed at the same page, and the
result of your query differs between them, it's nondeterministic which
result you get back.
-}
, WithinPage, eval, evalBlock
-- * #Manipulating# Manipulating Running Pages
{-| Once a page is running, the only way to interact with its contents is via its
'Page' handle (unless you use the methods in 'Myxine.Direct', but it is
/strongly discouraged/ to mix the two different abstractions: you will
almost certainly confuse yourself a lot).
A 'Page' whose behavior relies solely on user interactions within the
browser doesn't need any of these functions: these are the mechanism by
which external information can be used to modify the model of a page, and
thereby update the GUI to reflect the model.
Keep in mind that Myxine, like most GUIs, is an inherently concurrent
system. This interface reflects that: in between direct modifications
of the model with 'modifyPage' and its friends, the model may change
arbitrarily due to event handlers (or other threads) taking actions upon
it. However, it's guaranteed that any single modification is atomic, and
that sequences of modifications are not re-ordered (although there may be
things that happen in between them).
-}
, modifyPage, modifyPageIO, setPage, getPage
) where
import Control.Monad
import Control.Monad.IO.Class
import Control.Exception (SomeException, finally, throwIO, catch)
import qualified Data.Aeson as JSON
import Control.Concurrent
import Control.Concurrent.Async
import Data.List.NonEmpty (nonEmpty)
import Data.Text (Text)
import Data.Foldable
import qualified Unsafe.Coerce as Unsafe
import Myxine.Direct
import Myxine.Reactive
import Myxine.Handlers
-- | A handle to a running 'Page'. Create this using 'runPage', and wait for its
-- eventual result using 'waitPage'. In between, you can interact with it using
-- the rest of the functions in this module, such as 'modifyPage', 'stopPage',
-- etc.
data Page model
= Page
{ pageActions :: !(Chan (PageAction model))
, pageFinished :: !(MVar (Either SomeException model))
, pageLocation :: !PageLocation }
-- | An action to be performed in the page context. Either a call to stop the
-- page, or an effectful function to be performed on the model of the page.
data PageAction model
= StopPage
| PageAction !(WithinPage => model -> IO model)
-- | Run an interactive page, returning a handle 'Page' through which it can be
-- interacted further, via the functions in this module (e.g. 'waitPage',
-- 'modifyPage', etc.).
--
-- This function takes as input a 'PageLocation', an initial model, and a pure
-- function from the current state of the page's model to a rendered HTML view
-- of the page in its entirety, and the new set of 'Handlers' for page events. A
-- handler can modify the model of the page, and perform arbitrary 'IO' actions,
-- including evaluating JavaScript in the page using 'eval'. After each all
-- pertinent handlers for an event are dispatched, the page is re-rendered to
-- the browser.
--
-- This function itself is non-blocking: it immediately kicks off threads to
-- start running the page. It will not throw exceptions by itself. All
-- exceptions thrown by page threads (such as issues with connecting to the
-- server) are deferred until a call to 'waitPage'.
--
-- __Important:__ Because the GHC runtime does not wait for all threads to
-- finish when ending the main thread, you probably need to use 'waitPage' to
-- make sure your program stays alive to keep processing events.
--
-- Typical use of this function embeds a 'Reactive' page by using the 'reactive'
-- function to adapt it as the last argument (but this is not the only way to
-- use it, see [Using Page without Reactive](#NoReactive)):
--
-- @
-- 'runPage' location (pure initialModel) ('reactive' component)
-- @
runPage :: forall model.
PageLocation
{- ^ The location of the 'Page' (built using 'pagePort' and/or 'pagePath'). -} ->
(WithinPage => IO model)
{- ^ An IO action to return the initial @model@ for the 'Page'.
Note that this is in a 'WithinPage' context and therefore can use
'eval' and 'evalBlock'. -} ->
(WithinPage => model -> (PageContent, Handlers model))
{- ^ A function to draw the @model@ as some rendered 'Direct.PageContent'
and produce the set of 'Handlers' for events on that new view of the
page. Note that this is in a 'WithinPage' context and therefore can use
'eval' and 'evalBlock'.
-} ->
IO (Page model)
{- ^ A 'Page' handle to permit further interaction with the running page -}
runPage pageLocation getInitialModel drawAndHandle =
do pageActions :: Chan (PageAction model) <- newChan
currentUpdate :: Chan (Either PageEvent model) <- newChan
frames :: Chan PageContent <- newChan
eventLists :: Chan (Maybe EventList) <- newChan
pageFinished :: MVar (Either SomeException model) <- newEmptyMVar
let inPage :: (WithinPage => a) -> a
inPage = withPageContext (WithinPageContext pageLocation)
-- The stream of events from the page
nextEvent <- events pageLocation
-- Renders the page:
renderThread <- forkIO $
forever (update pageLocation . Dynamic =<< readChan frames)
-- Polls for the next event:
pollThread <- forkIO $
onLatest (writeChan currentUpdate . Left) $
maybe (forever (threadDelay maxBound)) nextEvent <$>
readChan eventLists
-- Handles events and sends update actions to the model thread:
updateThread <- forkIO $
let loop handlers = do
writeChan eventLists $
SomeEvents <$> nonEmpty (handledEvents handlers)
readChan currentUpdate >>= \case
Left event -> do
writeChan pageActions (PageAction (handle handlers event))
loop handlers
Right model ->
do let (content, handlers') = inPage (drawAndHandle model)
writeChan frames content
loop handlers'
in catch @SomeException (loop mempty)
(putMVar pageFinished . Left)
-- Processes update actions to the model and sends to update thread:
_modelThread <- forkIO $
let loop model =
readChan pageActions >>= \case
StopPage -> putMVar pageFinished (Right model)
PageAction action ->
do model' <- inPage (action model)
writeChan currentUpdate (Right model')
loop model'
in finally
(catch @SomeException
(loop =<< inPage getInitialModel)
(putMVar pageFinished . Left))
(traverse_ killThread [renderThread, pollThread, updateThread])
-- Kick off the cycle by "updating" the intial model
writeChan pageActions (PageAction pure)
pure Page{..}
-- | Race each action in a "stream" of actions against the arrival of the next
-- action, feeding the completed results into a function, but canceling actions
-- that take longer to produce a value than it takes to get the next action. In
-- other words, a sequential pre-emptible work queue.
onLatest :: (a -> IO ()) -> IO (IO a) -> IO ()
onLatest action rest = go =<< rest
where
go first =
race first rest >>= \case
Left a -> do
action a
next <- rest
go next
Right preempt -> do
go preempt
-- | Wait for a 'Page' to finish executing and return its resultant @model@, or
-- re-throw any exception the page encountered.
--
-- This function may throw 'Req.HttpException' if it cannot connect to a running
-- instance of the server. Additionally, it will also re-throw any exception
-- that was raised by user code running within an event handler or
-- model-modifying action.
waitPage :: Page model -> IO model
waitPage Page{pageFinished} =
do result <- readMVar pageFinished
either throwIO pure result
-- | Politely request a 'Page' to shut down. This is non-blocking: to get the
-- final model of the 'Page', follow 'stopPage' with a call to 'waitPage'.
--
-- Before the page is stopped, all events and modifications which were pending
-- at the time of this command will be processed.
stopPage :: Page model -> IO ()
stopPage Page{pageActions, pageFinished} = do
running <- isEmptyMVar pageFinished
when running $ writeChan pageActions StopPage
-- | Modify the model of the page with a pure function, and update the view in
-- the browser to reflect the new model.
--
-- This function is non-blocking; the page view may not yet have been updated by
-- the time it returns.
modifyPage :: Page model -> (model -> model) -> IO ()
modifyPage page f = do
running <- isEmptyMVar (pageFinished page)
when running $ modifyPageIO page (pure . f)
-- | Modify the model of the page, potentially doing arbitrary other effects in
-- the 'IO' monad, then re-draw the page to the browser. The functions 'eval'
-- and 'evalBlock' are available for evaluating JavaScript within the context of
-- the current page.
--
-- This function is non-blocking; the page view may not yet have been updated by
-- the time it returns.
modifyPageIO :: Page model -> (WithinPage => model -> IO model) -> IO ()
modifyPageIO Page{pageActions} action =
writeChan pageActions (PageAction action)
-- | Set the model of the page to a particular value, and update the view in the
-- browser to reflect the new model.
--
-- This function is non-blocking; the page view may not yet have been updated by
-- the time it returns.
setPage :: Page model -> model -> IO ()
setPage page = modifyPage page . const
-- | Get the current model of the page, blocking until it is retrieved.
--
-- __Note:__ it is not guaranteed that the model returned by this function is
-- "fresh" by the time you act upon it. That is:
--
-- @
-- 'getPage' page >>= 'setPage' page
-- @
--
-- __is not the same as__
--
-- @
-- 'modifyPage' id
-- @
--
-- This is because some other thread (notably, an event handler thread) could
-- have changed the page in between the call to 'getPage' and 'setPage'. As a
-- result, you probably don't want to use this function, except perhaps as a way
-- to extract intermediate reports on the value of the page.
getPage :: Page model -> IO model
getPage page = do
v <- newEmptyMVar
modifyPageIO page \model ->
do putMVar v model
pure model
takeMVar v
-- Borrowing a technique from Data.Reflection:
-- | The @WithinPage@ constraint, when it is present, enables the use of the
-- 'eval' and 'evalBlock' functions. Only in the body of a call to 'runPage' or
-- 'modifyPageIO' is there a canonical current page, and it's a type error to
-- use these functions anywhere else.
class WithinPage where
-- Acquire the JavaScript evaluation context from the ambient page. This
-- function cannot be called directly; use 'eval' or 'evalBlock' to evaluate
-- JavaScript within a page.
withinPageContext :: WithinPageContext
-- Specialized version of Data.Reflection.Gift:
newtype WithinPageGift r = WithinPageGift (WithinPage => r)
-- Specialized version of Data.Reflection.give:
withPageContext :: forall r. WithinPageContext -> (WithinPage => r) -> r
withPageContext c k = Unsafe.unsafeCoerce (WithinPageGift k :: WithinPageGift r) c
{-# NOINLINE withPageContext #-}
-- A "handle" that closes over the page location
newtype WithinPageContext =
WithinPageContext PageLocation
eval, evalBlock :: (WithinPage, JSON.FromJSON a, MonadIO m) => Text -> m a
-- | Evaluate a JavaScript __expression__ in the context of the current page.
-- The given text is automatically wrapped in a @return@ statement before being
-- evaluated in the browser.
--
-- If you try to call 'eval' outside of a call to 'runPage' or 'modifyPageIO',
-- you'll get a type error like the following:
--
-- > • No instance for WithinPage arising from a use of ‘eval’
-- > • In a stmt of a 'do' block: x <- eval @Int "1 + 1"
--
-- This means that you called it in some non-'Page' context, like in the
-- main function of your program.
eval expression =
let WithinPageContext location = withinPageContext
in liftIO (evaluateJs location (JsExpression expression))
-- | Evaluate a JavaScript __block__ in the context of the current page. Unlike
-- 'eval', the given text is /not/ automatically wrapped in a @return@
-- statement, which means that you can evaluate multi-line statements, but you
-- must provide your own @return@.
--
-- If you try to call 'evalBlock' outside of a call to 'runPage' or
-- 'modifyPageIO', you'll get a type error like the following:
--
-- > • No instance for WithinPage arising from a use of ‘evalBlock’
-- > • In a stmt of a 'do' block: x <- evalBlock @Int "return 1;"
--
-- This means that you called it in some non-'Page' context, like in the
-- main function of your program.
evalBlock block =
let WithinPageContext location = withinPageContext
in liftIO (evaluateJs location (JsBlock block))