myxine-client-0.0.0.2: A Haskell client for the Myxine GUI server

Safe HaskellNone
LanguageHaskell2010

Myxine

Contents

Description

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 "model-view-controller" style interface in 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.

Required extensions: This library relies on the OverloadedRecordFields language extension, 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.

Synopsis

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. The beginning of a typical myxine-client app looks something like:

type Model = ...

do page <- runPage location initialModel handlers draw
  ...
  finalModel <- waitPage page
  ...
where
  location :: PageLocation
  location     = pagePort ... <> pagePath ...  -- where to connect to the server

  initialModel :: Model
  initialModel = ...  -- model

  handlers :: Handlers
  handlers     = ...  -- controller

  draw :: Model -> PageContent
  draw         = ...  -- view

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.
  • initialModel: the starting value for the model of the page, which can be any Haskell data type of your choice.
  • handlers: the set of Handlers for page events, which describe how to react to events like mouse clicks, form inputs, and more. A handler can modify the model of the page, and perform arbitrary IO actions (though of course it's better style to be as pure as you can). After each handler is invoked, the page is immediately re-rendered to the browser if the model has changed. See the sections on handling events and manipulating pages.
  • draw: a pure function mapping from the current state of the page's model to a rendered HTML view of the page in its entirety. This function will be called on every update to the model, so it's good to make it reasonably fast. This library takes an agnostic approach to HTML generation: it's up to you to create some PageContent by generating some Text. I recommend the @blaze-html@ package for this purpose, but you can do this however you like. See the section on rendering page views.

data Page model Source #

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.

runPage Source #

Arguments

:: PageLocation

The location of the Page (pagePort and/or pagePath)

-> model

The initial model of the model for the Page

-> Handlers model

The set of event Handlers for events in the page

-> (model -> PageContent)

A function to draw the model as some rendered PageContent (how you do this is up to you)

-> IO (Page model)

A Page handle to permit further interaction with the running page

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 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.

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.

stopPage :: Page model -> IO () Source #

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.

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.

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.

Handling Events

In order to react to user events in the browser, we need to specify what effect each event of interest should have on the model in our Page. To do this, runPage asks that we construct up-front a set of Handlers describing this.

Handlers is a Monoid: the mempty Handlers listens to no events (and therefore the only way for a page initialized this way to change is via modifyPage and similar). Singleton Handlers can be created using the on function, and they can be joined together using their Monoid instance.

data Handlers model Source #

A set of handlers for events, possibly empty. Create new Handlers using on, and combine Handlers together using their Monoid instance.

Instances
Semigroup (Handlers model) Source # 
Instance details

Defined in Myxine.Handlers

Methods

(<>) :: Handlers model -> Handlers model -> Handlers model #

sconcat :: NonEmpty (Handlers model) -> Handlers model #

stimes :: Integral b => b -> Handlers model -> Handlers model #

Monoid (Handlers model) Source # 
Instance details

Defined in Myxine.Handlers

Methods

mempty :: Handlers model #

mappend :: Handlers model -> Handlers model -> Handlers model #

mconcat :: [Handlers model] -> Handlers model #

on :: EventType props -> (props -> [Target] -> model -> IO model) -> Handlers model Source #

Create a handler for a specific event type by specifying the type of event and the monadic callback to be invoked when the event occurs.

The provided callback will be given the EventType props of the event, the properties props of this particular event, a list of Targets on which the event fired, in order from most to least specific, and the current model of a page. It has the option to do arbitrary IO, and to return a possibly-changed model.

Notice that each variant of EventType has a type-level index describing what kind of data is carried by events of that type. This means that, for instance, if you want to handle a Click event, which has the type 'EventType MouseEvent', your event handler as created by on will be given access to a MouseEvent data structure when it is invoked. That is to say:

on Click (properties@MouseEvent{} targets model ->
                do print properties
                   print targets
                   print model)
  :: Show model => Handlers model

A full listing of all available EventTypes and their corresponding property records can be found in the below section on types and properties of events.

data Target Source #

A Target is a description of a single element node in the browser. When an event fires in the browser, Myxine tracks the path of nodes it touches, from the most specific element all the way up to the root. Each event handler is given access to this [Target], ordered from most to least specific.

For any Target, you can query the value of any of an attribute, or you can ask for the tag of that element.

Instances
Eq Target Source # 
Instance details

Defined in Myxine.Target

Methods

(==) :: Target -> Target -> Bool #

(/=) :: Target -> Target -> Bool #

Ord Target Source # 
Instance details

Defined in Myxine.Target

Show Target Source # 
Instance details

Defined in Myxine.Target

Generic Target Source # 
Instance details

Defined in Myxine.Target

Associated Types

type Rep Target :: Type -> Type #

Methods

from :: Target -> Rep Target x #

to :: Rep Target x -> Target #

FromJSON Target Source # 
Instance details

Defined in Myxine.Target

type Rep Target Source # 
Instance details

Defined in Myxine.Target

type Rep Target = D1 (MetaData "Target" "Myxine.Target" "myxine-client-0.0.0.2-434XplW2hgD2IAbva8WCSF" False) (C1 (MetaCons "Target" PrefixI True) (S1 (MetaSel (Just "tagName") NoSourceUnpackedness NoSourceStrictness DecidedLazy) (Rec0 Text) :*: S1 (MetaSel (Just "attributes") NoSourceUnpackedness NoSourceStrictness DecidedLazy) (Rec0 (HashMap Text Text))))

attribute :: Text -> Target -> Maybe Text Source #

Get the value, if any, of some named attribute of a Target.

tag :: Target -> Text Source #

Get the name of the HTML tag for this Target. Note that unlike in the browser itself, Myxine returns tag names in lower case, rather than upper.

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, and 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 is non-blocking: it is not guaranteed that when this call returns, the browser is now showing the new view. However, sequential calls to modifyPage, modifyPageIO, setPage, getPage, evalInPage, and stopPage are guaranteed to be executed in the order they were issued.

modifyPageIO :: Page model -> (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. Special cases include: modifyPage and setPage.

This is non-blocking: it is not guaranteed that when this call returns, the browser is now showing the new view. However, sequential calls to modifyPage, modifyPageIO, setPage, getPage, evalInPage, and stopPage are guaranteed to be executed in the order they were issued.

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 is non-blocking: it is not guaranteed that when this call returns, the browser is now showing the new view. However, sequential calls to modifyPage, modifyPageIO, setPage, getPage, evalInPage, and stopPage are guaranteed to be executed in the order they were issued.

getPage :: Page model -> IO model Source #

Get the current model of the page, blocking until it is retrieved.

Sequential calls to modifyPage, modifyPageIO, setPage, getPage, evalInPage, and stopPage are guaranteed to be executed in the order they were issued.

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.

Rendering Page Views

The Myxine server takes care of minimizing patches and re-draws in the browser. You merely need say how you want your model to be rendered, and let it take care of the rest.

The draw function required as the last argument to runPage has the type (model -> PageContent). As the library user, it's up to you how you want to render your model as Text. Then, just wrap your desired body contents with a call to pageBody (and optionally combine this via Semigroup with a call to pageTitle to set the title), and return the resultant PageContent.

data PageContent Source #

The view of a page, as rendered in the browser. Create page content with pageBody and pageTitle, and combine content using the Semigroup instance.

Note: The Semigroup instance for PageContent takes the last specified pageTitle (if any), and concatenates in order each specified pageBody.

pageBody :: Text -> PageContent Source #

Create a rendered PageContent with an empty title and the specified text as its body.

pageTitle :: Text -> PageContent Source #

Create a rendered PageContent with an empty body and the specified text as its title.

Evaluating Raw JavaScript

It occasionally might become necessary for you to directly evaluate some JavaScript within the context of the browser. The most frequent reason for this is to query the value of some object, such as the current contents of a text-box, or the current window dimensions. The evalInPage function is precisely the escape hatch to enable this. Here's how you might get the current window width of the browser window:

do Right width <- evalInPage (JsExpression "window.innerWidth")
   print (width :: Int)

data JavaScript Source #

A piece of raw JavaScript to evaluate: either an expression or a block of statements. Expressions need not terminate with a return statement but cannot span multiple lines; block need to have an explicit return, but can contain multiple statements and lines.

Constructors

JsExpression Text

A JavaScript expression

JsBlock Text

A block of JavaScript statements

evalInPage Source #

Arguments

:: FromJSON a 
=> Page model

The Page in which to evaluate the JavaScript

-> Maybe Int

An optional override for the default timeout of 1000 milliseconds

-> JavaScript

The JavaScript to evaluate: either a JsExpression or a JsBlock

-> IO (Either String a) 

Evaluate some JavaScript in the context of a running Page, blocking until the result is returned.

Returns either a deserialized Haskell type, or a human-readable string describing any error that occurred. Possible errors include:

  • Any exception in the given JavaScript
  • Absence of any browser window currently viewing the page (since there's no way to evaluate JavaScript without a JavaScript engine)
  • Evaluation timeout (default is 1000 milliseconds, but can be overridden in the timeout parameter to this function
  • 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 to null in the results
  • JsBlock inputs which don't explicitly return a value result in null
  • 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.

Keep in mind that this feature has sharp edges, and is usually unnecessary. In particular:

  • 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.

Sequential calls to modifyPage, modifyPageIO, setPage, getPage, evalInPage, and stopPage are guaranteed to be executed in the order they were issued.

Types and Properties of Events

These types are automatically generated from Myxine's master specification of supported events and interfaces, so they will always match those supported by the version of Myxine corresponding to the version of this library. However, Template Haskell does not allow programmatic generation of Haddock documentation, so we can't put proper inline documentation below.

To aid in your reference, note that the name of each type below exactly matches the browser's name for events of that interface, and the names of each interface's properties exactly match the browser's names for them, except in the cases where those names are reserved keywords in Haskell. In those cases, we prepend the name of the interface (for instance, we use the property name inputData instead of data).

For more details on the meaning of each type below and its fields, refer to Myxine's documentation and/or the MDN web API documentation for events and their interfaces.

data EventType :: Type -> Type where Source #

Instances
GCompare EventType Source # 
Instance details

Defined in Myxine.Event

Methods

gcompare :: EventType a -> EventType b -> GOrdering a b #

GEq EventType Source # 
Instance details

Defined in Myxine.Event

Methods

geq :: EventType a -> EventType b -> Maybe (a :~: b) #

Eq (EventType d) Source # 
Instance details

Defined in Myxine.Event

Methods

(==) :: EventType d -> EventType d -> Bool #

(/=) :: EventType d -> EventType d -> Bool #

Ord (EventType d) Source # 
Instance details

Defined in Myxine.Event

Show (EventType d) Source # 
Instance details

Defined in Myxine.Event

data Event Source #

Constructors

Event 
Instances
Eq Event Source # 
Instance details

Defined in Myxine.Event

Methods

(==) :: Event -> Event -> Bool #

(/=) :: Event -> Event -> Bool #

Ord Event Source # 
Instance details

Defined in Myxine.Event

Methods

compare :: Event -> Event -> Ordering #

(<) :: Event -> Event -> Bool #

(<=) :: Event -> Event -> Bool #

(>) :: Event -> Event -> Bool #

(>=) :: Event -> Event -> Bool #

max :: Event -> Event -> Event #

min :: Event -> Event -> Event #

Show Event Source # 
Instance details

Defined in Myxine.Event

Methods

showsPrec :: Int -> Event -> ShowS #

show :: Event -> String #

showList :: [Event] -> ShowS #

FromJSON Event Source # 
Instance details

Defined in Myxine.Event

data UIEvent Source #

Constructors

UIEvent 

Fields

Instances
Eq UIEvent Source # 
Instance details

Defined in Myxine.Event

Methods

(==) :: UIEvent -> UIEvent -> Bool #

(/=) :: UIEvent -> UIEvent -> Bool #

Ord UIEvent Source # 
Instance details

Defined in Myxine.Event

Show UIEvent Source # 
Instance details

Defined in Myxine.Event

FromJSON UIEvent Source # 
Instance details

Defined in Myxine.Event