purview-0.1.0.0: Build server rendered, interactive websites
Safe HaskellSafe-Inferred
LanguageHaskell2010

Purview

Description

Purview aims to be pretty straightforward to work with. As an example, here's a counter that we'll then go through.

module Main where

import Purview

incrementButton = onClick "increment" $ button [ text "+" ]
decrementButton = onClick "decrement" $ button [ text "-" ]

view count = div
  [ p [ text ("count: " <> show count) ]
  , incrementButton
  , decrementButton
  ]

handler :: (Integer -> Purview String any IO) -> Purview () any IO
handler = simpleHandler (0 :: Integer) reducer

reducer action state = case action of
  "increment" -> state + 1
  "decrement" -> state - 1

top = handler view

main = run defaultConfiguration { component=top, devMode=True }

First we define two buttons, each which have action producers (onClick).

When rendered, this tells Purview that when either is clicked it'd like to receive a message (increment or decrement).

Then we define a handler, which takes an initial state ("0"), and a reducer.

The reducer defines how we're supposed to handle the events received, and it passes down the new state to components.

Then we put it together ("handler view"), and run it.

Note the "devMode=True": this tells Purview to send the whole tree over again when the websocket reconnects. This is really handy if you're re-running the server in ghci, although I really recommend using ghcid so you can do:

ghcid --command 'stack ghci yourProject/Main.hs' --test :main

Which will automatically restart the server on code changes. It's fast!

For more in depth reading check out the readme and the examples folder.

Synopsis

Server

run :: Monad m => Configuration () any m -> IO () Source #

This starts up the Scotty server. As a tiny example, to display some text saying "hello":

import Purview

view = p [ text "hello" ]

main = run defaultConfiguration { component=view }

data Configuration parentAction action m Source #

Constructors

Configuration 

Fields

  • component :: Purview parentAction action m

    The top level component to put on the page.

  • interpreter :: m [Event] -> IO [Event]

    How to run your algebraic effects or other. This will apply to all effectHandlers.

  • logger :: String -> IO ()

    Specify what to do with logs

  • htmlEventHandlers :: [HtmlEventHandler]

    For extending the handled events. Have a look at defaultConfiguration to see how to make your own.

  • htmlHead :: Text

    This is placed directly into the <head>, so that you can link to external CSS etc

  • devMode :: Bool

    When enabled, Purview will send the whole tree on websocket reconnection. This enables you to use "ghcid --command 'stack ghci examples/Main.hs' --test :main`" to restart the server on file change, and get a kind of live reloading

Handlers

These are how you can catch events sent from things like onClick and change state, or in the case of effectHandler, make API requests or call functions from your project.

simpleHandler Source #

Arguments

:: (FromJSON action, FromJSON state, ToJSON action, ToJSON parentAction, ToJSON state, Typeable state, Eq state, Applicative m) 
=> state

The initial state

-> (action -> state -> state)

The reducer, or how the state should change for an action

-> (state -> Purview action any1 m)

The continuation / component to connect to

-> Purview parentAction any2 m 

This is most straightforward effect handler. It can't send messages to itself or to its parent.

For example, let's say you want to make a button that switches between saying "up" or "down":

view direction = onClick "toggle" $ button [ text direction ]

handler = simpleHandler "up" reduce
  where reduce "toggle" state = if state == "up" then "down" else "up"

component = handler view

messageHandler Source #

Arguments

:: (FromJSON action, FromJSON state, ToJSON action, ToJSON parentAction, ToJSON state, Typeable state, Eq state, Applicative m) 
=> state

initial state

-> (action -> state -> (state -> state, [DirectedEvent parentAction action]))

reducer

-> (state -> Purview action any1 m)

continuation

-> Purview parentAction any2 m 

More powerful than the simpleHandler, it can send messages to itself or its parent. You will also note that instead of just returning the new state, it returns a function to transform the state. This is because handlers run in their own threads.

effectHandler Source #

Arguments

:: (FromJSON action, FromJSON state, ToJSON action, ToJSON parentAction, ToJSON state, Typeable state, Eq state) 
=> state

initial state

-> (action -> state -> m (state -> state, [DirectedEvent parentAction action]))

reducer (note the m!)

-> (state -> Purview action any1 m)

continuation

-> Purview parentAction any2 m 

This handler gives you access to whichever monad you're running Purview with.

If you wanted to print something on the server every time someone clicked a button:

view direction = onClick "sayHello" $ button [ text "Say hello on the server" ]

handler = effectHandler Nothing reduce
  where reduce "sayHello" state = do
          print "someone on the browser says hello!"
          pure (const Nothing, [])

component = handler view

HTML helpers

div :: [Purview parentAction action m] -> Purview parentAction action m Source #

span :: [Purview parentAction action m] -> Purview parentAction action m Source #

p :: [Purview parentAction action m] -> Purview parentAction action m Source #

h1 :: [Purview parentAction action m] -> Purview parentAction action m Source #

h2 :: [Purview parentAction action m] -> Purview parentAction action m Source #

h3 :: [Purview parentAction action m] -> Purview parentAction action m Source #

h4 :: [Purview parentAction action m] -> Purview parentAction action m Source #

text :: String -> Purview parentAction action m Source #

button :: [Purview parentAction action m] -> Purview parentAction action m Source #

form :: [Purview parentAction action m] -> Purview parentAction action m Source #

input :: [Purview parentAction action m] -> Purview parentAction action m Source #

style :: String -> Purview parentAction action m -> Purview parentAction action m Source #

For adding styles

blue = style "color: \"blue\";"
blueButton = blue $ button [ text "I'm blue" ]

Action producers

onClick :: ToJSON action => action -> Purview parentAction action m -> Purview parentAction action m Source #

This will send the action to the handler above it whenever "click" is triggered on the frontend. It will be bound to whichever HTML is beneath it.

onSubmit :: ToJSON action => action -> Purview parentAction action m -> Purview parentAction action m Source #

This will send the action to the handler above it whenever "submit" is triggered on the frontend.

For Testing

render :: Purview parentAction action m -> String Source #

Takes the tree and turns it into HTML. Attributes are passed down to children until they reach a real HTML tag.

AST

data Attributes action where Source #

Attributes are collected until an HTML constructor is hit, where they are applied during rendering.

Constructors

On 

Fields

  • :: ToJSON action
     
  • => String
     
  • -> action
     
  • -> Attributes action

    part of creating handlers for different events, e.g. On "click"

Style 

Fields

Generic 

Fields

  • :: String
     
  • -> String
     
  • -> Attributes action

    for creating new Attributes to put on HTML, e.g. Generic "type" "radio" for type="radio".

Instances

Instances details
Eq (Attributes action) Source # 
Instance details

Defined in Component

Methods

(==) :: Attributes action -> Attributes action -> Bool #

(/=) :: Attributes action -> Attributes action -> Bool #

data DirectedEvent a b Source #

This is for creating events that should go to a parent handler, or sent back in to the same handler.

Constructors

Parent a 
Self b 

Instances

Instances details
(ToJSON a, ToJSON b) => ToJSON (DirectedEvent a b) Source # 
Instance details

Defined in Events

Generic (DirectedEvent a b) Source # 
Instance details

Defined in Events

Associated Types

type Rep (DirectedEvent a b) :: Type -> Type #

Methods

from :: DirectedEvent a b -> Rep (DirectedEvent a b) x #

to :: Rep (DirectedEvent a b) x -> DirectedEvent a b #

(Show a, Show b) => Show (DirectedEvent a b) Source # 
Instance details

Defined in Events

(Eq a, Eq b) => Eq (DirectedEvent a b) Source # 
Instance details

Defined in Events

Methods

(==) :: DirectedEvent a b -> DirectedEvent a b -> Bool #

(/=) :: DirectedEvent a b -> DirectedEvent a b -> Bool #

type Rep (DirectedEvent a b) Source # 
Instance details

Defined in Events

type Rep (DirectedEvent a b) = D1 ('MetaData "DirectedEvent" "Events" "purview-0.1.0.0-inplace" 'False) (C1 ('MetaCons "Parent" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 a)) :+: C1 ('MetaCons "Self" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 b)))

data Purview parentAction action m where Source #

This is what you end up building using the various helpers. It's hopefully rare that you have to use these directly, but it may be useful to better understand what's happening behind the scenes.

Constructors

Attribute :: Attributes action -> Purview parentAction action m -> Purview parentAction action m 
Text :: String -> Purview parentAction action m 
Html :: String -> [Purview parentAction action m] -> Purview parentAction action m 
Value :: Show a => a -> Purview parentAction action m 
EffectHandler

All the handlers boil down to this one.

Fields

  • :: (FromJSON newAction, ToJSON newAction, ToJSON parentAction, FromJSON state, ToJSON state, Typeable state, Eq state)
     
  • => ParentIdentifier

    The location of the parent effect handler (provided by prepareTree)

  • -> Identifier

    The location of this effect handler (provided by prepareTree)

  • -> state

    The initial state

  • -> (newAction -> state -> m (state -> state, [DirectedEvent parentAction newAction]))

    Receive an action, change the state, and send messages

  • -> (state -> Purview newAction any m)

    Continuation

  • -> Purview parentAction newAction m
     
Once :: ToJSON action => ((action -> Event) -> Event) -> Bool -> Purview parentAction action m -> Purview parentAction action m 
Hide :: Purview parentAction newAction m -> Purview parentAction any m 

Instances

Instances details
Show (Purview parentAction action m) Source # 
Instance details

Defined in Component

Methods

showsPrec :: Int -> Purview parentAction action m -> ShowS #

show :: Purview parentAction action m -> String #

showList :: [Purview parentAction action m] -> ShowS #

Eq (Purview parentAction action m) Source # 
Instance details

Defined in Component

Methods

(==) :: Purview parentAction action m -> Purview parentAction action m -> Bool #

(/=) :: Purview parentAction action m -> Purview parentAction action m -> Bool #