Safe Haskell | None |
---|---|
Language | Haskell2010 |
This library implements well-typed bindings to the Myxine server for creating local interactive GUIs in the web browser. For more details on Myxine-the-program, see the package description of this library, or its own homepage.
This module defines a higher level interface which abstracts over the direct calls to the Myxine server to allow a more declarative style of programming.
For a one-to-one set of bindings directly to the corresponding calls to the Myxine API see the module Myxine.Direct. This is straightforward for small examples and tests, but can become cumbersome for building full interactive applications.
Synopsis
- data Page model
- runPage :: forall model. PageLocation -> (WithinPage => IO model) -> (WithinPage => model -> (PageContent, Handlers model)) -> IO (Page model)
- waitPage :: Page model -> IO model
- stopPage :: Page model -> IO ()
- data PageLocation
- pagePath :: PagePath -> PageLocation
- pagePort :: PagePort -> PageLocation
- type Reactive model = ReactiveM model ()
- data ReactiveM model a
- reactive :: Reactive model -> model -> (PageContent, Handlers model)
- title :: Text -> Reactive model
- markup :: ToMarkup h => h -> Reactive model
- on' :: EventType props -> (props -> StateT model IO Propagation) -> Reactive model
- on :: EventType props -> (props -> StateT model IO ()) -> Reactive model
- data Propagation
- (@@) :: (Html -> Html) -> ReactiveM model a -> ReactiveM model a
- (##) :: Traversal' model model' -> Reactive model' -> Reactive model
- target :: ReactiveM model a -> ReactiveM model a
- this :: ReactiveM model Text
- class WithinPage
- eval :: (WithinPage, FromJSON a, MonadIO m) => Text -> m a
- evalBlock :: (WithinPage, FromJSON a, MonadIO m) => Text -> m a
- modifyPage :: Page model -> (model -> model) -> IO ()
- modifyPageIO :: Page model -> (WithinPage => model -> IO model) -> IO ()
- setPage :: Page model -> model -> IO ()
- getPage :: Page model -> IO model
- module Myxine.Event
Required Extensions
This library relies on the extension OverloadedRecordFields
, since a
variety of browser event interfaces share field names/types. Without enabling
it, you'll see many bewildering errors about ambiguous names.
You may also find useful for concision the extensions NamedFieldPuns
and
RecordWildCards
.
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
:
runPage
::PageLocation
-> model -> (WithinPage
=> model -> (PageContent
,Handlers
model)) -> IO (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
: thepagePath
andpagePort
to connect to the Myxine server. Usemempty
to use the default port and the root path. See the section on page 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 theReactive
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 and manipulating pages.
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 PageContent
or gathering a set of Handlers
. Instead,
as noted above, runPage
takes as input any function of type
. We
provide the WithinPage
=> model -> (PageContent
, Handlers
model)Reactive
-built pages to runPage
by evaluating them using:
reactive
::Reactive
model -> model -> (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 onEvent
and
<>
, avoiding the Reactive
abstraction altogether if you so choose.
Creating and Waiting For Pages
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.
:: PageLocation | The location of the |
-> (WithinPage => IO model) | An IO action to return the initial |
-> (WithinPage => model -> (PageContent, Handlers model)) | A function to draw the |
-> IO (Page model) | A |
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):
runPage
location (pure initialModel) (reactive
component)
waitPage :: Page model -> IO model Source #
Wait for a Page
to finish executing and return its resultant model
, or
re-throw any exception the page encountered.
This function may throw 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.
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.
data PageLocation Source #
The options for connecting to the Myxine server. This is an opaque
Monoid
: set options by combining pagePort
and/or pagePath
using their
Semigroup
instance.
Instances
pagePath :: PagePath -> PageLocation Source #
Set the path to something other than the default of /
.
pagePort :: PagePort -> PageLocation Source #
Set the port to a non-default port. This is only necessary when Myxine is running on a non-default port also.
Building Reactive Pages
When using the Reactive
DSL for building pages, it's intended that you
import it alongside the Html5
and
Attributes
modules from the
blaze-html, which
provide the HTML combinators required for building markup.
While nothing about this module hard-codes the use of
lenses, it is often useful in
the body of handlers given to on
to manipulate the model state using
lens combinators, in particular the stateful .=
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 _1
,
_2
, ^.
, .=
,
+=
, and *=
.
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^.
_2
then "red" else "green")@@
doon
MouseOver
$ \_ ->_2
.=
Trueon
MouseOut
$ \_ ->_2
.=
False H.button ! A.style "margin: 20pt"@@
doon
Click
$ \MouseEvent
{shiftKey = False} ->_1
+=
1on
Click
$ \MouseEvent
{shiftKey = True} ->_1
*=
2markup
$ do H.span ! A.style "font-size: 20pt" $ H.string (show (model^.
_1
))
type Reactive model = ReactiveM model () Source #
The Reactive
type interleaves the description of page markup with the
specification of event handlers for the page.
It is a Monoid
and its underlying type ReactiveM
is a Monad
, which
means that just like the Blaze templating library, it can be (and is designed
to be!) used in do
-notation. Importantly, it is also a MonadReader
model
, where the current model is returned by ask
.
data ReactiveM model a Source #
The underlying builder monad for the Reactive
type.
This is almost always used with a return type of ()
, hence you will usually
see it aliased as Reactive
model
.
Instances
MonadReader model (ReactiveM model) Source # | |
Monad (ReactiveM model) Source # | |
Functor (ReactiveM model) Source # | |
Applicative (ReactiveM model) Source # | |
Defined in Myxine.Reactive pure :: a -> ReactiveM model a # (<*>) :: ReactiveM model (a -> b) -> ReactiveM model a -> ReactiveM model b # liftA2 :: (a -> b -> c) -> ReactiveM model a -> ReactiveM model b -> ReactiveM model c # (*>) :: ReactiveM model a -> ReactiveM model b -> ReactiveM model b # (<*) :: ReactiveM model a -> ReactiveM model b -> ReactiveM model a # | |
a ~ () => IsString (ReactiveM model a) Source # | A string literal is a |
Defined in Myxine.Reactive fromString :: String -> ReactiveM model a # | |
Semigroup a => Semigroup (ReactiveM model a) Source # |
|
Monoid a => Monoid (ReactiveM model a) Source # | The empty |
Attributable (ReactiveM model a -> ReactiveM model a) Source # | You can apply an HTML attribute to any function between |
Attributable (ReactiveM model a) Source # | You can apply an HTML attribute to any |
reactive :: Reactive model -> model -> (PageContent, Handlers model) Source #
Evaluate a reactive component to produce a pair of PageContent
and
Handlers
. This is the bridge between the runPage
abstraction and
the Reactive
abstraction: use this to run a reactive component in a
Page
.
title :: Text -> Reactive model Source #
Set the title for the page. If this function is called multiple times in one update, the most recent call is used.
markup :: ToMarkup h => h -> Reactive model Source #
Write an atomic piece of HTML (or anything that can be converted to it) to
the page in this location. Event listeners for its enclosing scope can be
added by sequential use of on
. If you need sub-pieces of this HTML to have
their own scoped event listeners, use @@
to build a composite component.
>>>
markup h === const (toMarkup h) @@ pure ()
on' :: EventType props -> (props -> StateT model IO Propagation) -> Reactive model Source #
Listen to a particular event and react to it by modifying the model for the
page. This function's returned Propagation
value specifies whether or not
to propagate the event outwards to other enclosing contexts. The event target
is scoped to the enclosing @@
, or the whole page if at the top level.
When the specified EventType
occurs, the event handler will be called with
that event type's corresponding property record, e.g. a Click
event's
handler will receive a MouseEvent
record. A handler can modify the page's
model via State
ful actions and perform arbitrary IO using liftIO
. In the
context of a running page, a handler also has access to the eval
and
evalBlock
functions to evaluate JavaScript in that page.
Exception behavior: This function catches PatternMatchFail
exceptions
thrown by the passed function. That is, if there is a partial pattern match
in the pure function from event properties to stateful update, the stateful
update will be silently skipped. This is useful as a shorthand to select only
events of a certain sort, for instance:
on'
Click
\MouseEvent
{shiftKey = True} -> do putStrLn "Shift + Click!" pureBubble
data Propagation Source #
Indicator for whether an event should continue to be triggered on parent
elements in the path. An event handler can signal that it wishes the event to
stop propagating by returning Stop
.
Bubble | Continue to trigger the event on parent elements |
Stop | Continue to trigger the event for all handlers of this element, but stop before triggering it on any parent elements |
Instances
(@@) :: (Html -> Html) -> ReactiveM model a -> ReactiveM model a infixr 5 Source #
Wrap an inner reactive component in some enclosing HTML. Any listeners
created via on
in the wrapped component will be scoped to only events that
occur within this chunk of HTML.
In the following example, we install a Click
handler for the whole page,
then build a div
with another Click
handler inside that page, which
returns Stop
from on'
to stop the Click
event from bubbling out to the
outer handler when the inner div
is clicked.
doon
Click
$ \_ -> liftIO $ putStrLn "Clicked outside!" div ! style "background: lightblue;"@@
do "Click here, or elsewhere..."on'
Click
$ \_ -> do liftIO $ putStrLn "Clicked inside!" pureStop
(##) :: Traversal' model model' -> Reactive model' -> Reactive model infixr 5 Source #
Focus a reactive page fragment to manipulate a piece of a larger model,
using a Traversal'
to specify what part(s) of the larger model to
manipulate.
This is especially useful when creating generic components which can be re-used in the context of many different models. For instance, we can define a toggle button and specify separately which part of a model it toggles:
toggle ::Reactive
Bool toggle = button@@
do active <-ask
if active then "ON" else "OFF"on
Click
\_ ->modify
not twoToggles ::Reactive
(Bool, Bool) twoToggles = do _1##
toggle _2##
toggle
This function takes a Traversal'
, which is strictly more general than a
Lens'
. This means you can use traversals with zero or more than one target,
and this many replicas of the given Reactive
fragment will be generated,
each separately controlling its corresponding portion of the model. This
means the above example could also be phrased:
twoToggles ::Reactive
(Bool, Bool) twoToggles =each
##
toggle
target :: ReactiveM model a -> ReactiveM model a Source #
Create a scope for event listeners without wrapping any enclosing HTML. Any
listeners created via on
will apply only to HTML that is written inside
this block, rather than to the enclosing broader scope.
>>>
target === (id @@)
this :: ReactiveM model Text Source #
Return a piece of JavaScript code which looks up the object corresponding
to the current scope's location in the page. This is suitable to be used in
eval
, for instance, to retrieve properties of a particular element.
If there is no enclosing @@
, then this is the window
object; otherwise,
it is the outermost HTML element object created by the first argument to the
enclosing @@
. If there are multiple elements at the root of the enclosing
@@
, then the first of these is selected.
For example, here's an input which reports its own contents:
textbox :: Reactive Text textbox = input @@ do e <- this on Input _ -> do value eval $ this < ".value" put value
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 <- askmarkup
currentWidthon
Resize
$ \_ -> do width <-eval
"window.innerWidth"put
width
Possible errors (which manifest as JsException
s):
- Any exception in the given JavaScript
- Invalid JSON response for the result type inferred (use
Value
if you don't know what shape of data you're waiting to receive).
Further caveats:
- JavaScript
undefined
is translated tonull
in the results - Return types are limited to those which can be serialized via
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.
class WithinPage Source #
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.
withinPageContext
eval :: (WithinPage, FromJSON a, MonadIO m) => Text -> m a Source #
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.
evalBlock :: (WithinPage, FromJSON a, MonadIO m) => Text -> m a Source #
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.
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 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 :: Page model -> (model -> model) -> IO () Source #
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.
modifyPageIO :: Page model -> (WithinPage => model -> IO model) -> IO () Source #
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.
setPage :: Page model -> model -> IO () Source #
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.
getPage :: Page model -> IO model Source #
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.
module Myxine.Event