hplayground-0.1.2.0: a client-side haskell framework that compiles to javascript with the haste compiler

Safe HaskellNone
LanguageHaskell98

Haste.HPlay.View

Contents

Description

The haste-hplayground framework. http://github.com/agocorona/hplayground

Synopsis

Documentation

re-exported

widget combinators and modifiers

static :: Monad m => View v m a -> View v m a Source

To produce updates, each line of html produced by a "do" sequence in the Widget monad is included within a span tag. When the line is reexecuted after a event, the span is updated with the new rendering.

static tell to the rendering that this widget does not change, so the extra span tag for each line in the sequence and the rewriting is not necessary. Thus the size of the HTML and the performance is improved.

dynamic :: Monad m => View v m a -> View v m a Source

wcallback :: Widget a -> (a -> Widget b) -> Widget b Source

It is a callback in the view monad. The rendering of the second parameter substitutes the rendering of the first paramenter when the latter validates without afecting the rendering of other widgets. This allow the simultaneous execution of different dynamic behaviours in different page locations at the same page.

(<+>) :: (Monad m, FormInput view) => View view m a -> View view m b -> View view m (Maybe a, Maybe b) infixr 2 Source

Join two widgets in the same page the resulting widget, when asked with it, return a 2 tuple of their validation results if both return Noting, the widget return Nothing (invalid).

it has a low infix priority: infixr 2

r <- ask  widget1 <+>  widget2
case r of (Just x, Nothing) -> ..

(**>) :: (Functor m, Monad m, FormInput view) => View view m a -> View view m b -> View view m b infixr 1 Source

The first elem result (even if it is not validated) is discarded, and the secod is returned . This contrast with the applicative operator *> which fails the whole validation if the validation of the first elem fails.

The first element is displayed however, as happens in the case of *> .

Here w's are widgets and r's are returned values

(w1 <* w2) will return Just r1 only if w1 and w2 are validated

(w1 <** w2) will return Just r1 even if w2 is not validated

it has a low infix priority: infixr 1

(<**) :: (Functor m, Monad m, FormInput view) => View view m a -> View view m b -> View view m a infixr 1 Source

The second elem result (even if it is not validated) is discarded, and the first is returned . This contrast with the applicative operator *> which fails the whole validation if the validation of the second elem fails. The second element is displayed however, as in the case of <*. see the <** examples

it has a low infix priority: infixr 1

validate :: Widget a -> (a -> WState Perch IO (Maybe Perch)) -> Widget a Source

Validates a form or widget result against a validating procedure

getOdd= getInt Nothing validate (x -> return $ if mod x 2==0 then  Nothing else Just "only odd numbers, please")

firstOf :: (FormInput view, Monad m, Functor m) => [View view m a] -> View view m a Source

Concat a list of widgets of the same type, return a the first validated result

manyOf :: (FormInput view, MonadIO m, Functor m) => [View view m a] -> View view m [a] Source

from a list of widgets, it return the validated ones.

allOf :: [View Perch IO a] -> Widget [a] Source

like manyOf, but does not validate if one or more of the widgets does not validate

(<<<) :: (Monad m, Monoid view) => (view -> view) -> View view m a -> View view m a infixr 5 Source

Enclose Widgets within some formating. view is intended to be instantiated to a particular format

NOTE: It has a infix priority : infixr 5 less than the one of ++> and <++ of the operators, so use parentheses when appropriate, unless the we want to enclose all the widgets in the right side. Most of the type errors in the DSL are due to the low priority of this operator.

(<<) :: (t1 -> t) -> t1 -> t infixr 7 Source

A parameter application with lower priority than ($) and direct function application

(<++) :: (Monad m, Monoid v) => View v m a -> v -> View v m a infixr 6 Source

Append formatting code to a widget

 getString "hi" <++ H1 << "hi there"

It has a infix prority: infixr 6 higuer that <<< and most other operators

(++>) :: (Monad m, Monoid view) => view -> View view m a -> View view m a infixr 6 Source

Prepend formatting code to a widget

bold "enter name" ++ getString Nothing

It has a infix prority: infixr 6 higuer that <<< and most other operators

(<!) :: (FormInput v, Monad m) => View v m a -> Attribs -> View v m a infixl 8 Source

Add attributes to the topmost tag of a widget

it has a fixity infix 8

basic widgets

wprint :: ToElem a => a -> Widget () Source

show something enclosed in the pre tag, so ASCII formatting chars are honored

getString :: (StateType (View view m) ~ MFlowState, FormInput view, Monad (View view m), MonadIO m) => Maybe String -> View view m String Source

Display a text box and return a non empty String

inputString :: (StateType (View view m) ~ MFlowState, FormInput view, Monad (View view m), MonadIO m) => Maybe String -> View view m String Source

getInteger :: (StateType (View view m) ~ MFlowState, FormInput view, MonadIO m) => Maybe Integer -> View view m Integer Source

Display a text box and return an Integer (if the value entered is not an Integer, fails the validation)

inputInteger :: (StateType (View view m) ~ MFlowState, FormInput view, MonadIO m) => Maybe Integer -> View view m Integer Source

getInt :: (StateType (View view m) ~ MFlowState, FormInput view, MonadIO m) => Maybe Int -> View view m Int Source

Display a text box and return a Int (if the value entered is not an Int, fails the validation)

inputInt :: (StateType (View view m) ~ MFlowState, FormInput view, MonadIO m) => Maybe Int -> View view m Int Source

inputFloat :: (StateType (View view m) ~ MFlowState, FormInput view, MonadIO m) => Maybe Float -> View view m Float Source

inputDouble :: (StateType (View view m) ~ MFlowState, FormInput view, MonadIO m) => Maybe Double -> View view m Double Source

getPassword :: (FormInput view, StateType (View view m) ~ MFlowState, MonadIO m) => View view m String Source

Display a password box

inputPassword :: (StateType (View view m) ~ MFlowState, FormInput view, MonadIO m) => View view m String Source

setRadio :: (FormInput view, MonadIO m, Typeable a, Eq a, Show a) => a -> String -> View view m (Radio a) Source

Implement a radio button the parameter is the name of the radio group

setRadioActive :: (Typeable * a, Show a, Eq a) => a -> String -> Widget (Radio a) Source

getRadio :: (Monad (View view m), Monad m, Functor m, FormInput view) => [String -> View view m (Radio a)] -> View view m a Source

encloses a set of Radio boxes. Return the option selected

setCheckBox :: (FormInput view, MonadIO m, Typeable a, Show a) => Bool -> a -> View view m (CheckBoxes a) Source

Display a text box and return the value entered if it is readable( Otherwise, fail the validation)

getCheckBoxes :: (Monad m, FormInput view) => View view m (CheckBoxes a) -> View view m [a] Source

getTextBox :: (FormInput view, StateType (View view m) ~ MFlowState, MonadIO m, Typeable a, Show a, Read a) => Maybe a -> View view m a Source

getMultilineText :: (FormInput view, MonadIO m) => String -> View view m String Source

Display a multiline text box and return its content

textArea :: (FormInput view, MonadIO m) => String -> View view m String Source

A synonim of getMultilineText

getBool :: (FormInput view, MonadIO m, Functor m, Monad (View view m)) => Bool -> String -> String -> View view m Bool Source

getSelect :: (FormInput view, MonadIO m, Typeable a, Read a) => View view m (MFOption a) -> View view m a Source

Display a dropdown box with the options in the first parameter is optionally selected . It returns the selected option.

setOption :: (Monad m, Monad (View view m), Show a, Eq a, Typeable a, FormInput view) => a -> view -> View view m (MFOption a) Source

Set the option for getSelect. Options are concatenated with <|>

setSelectedOption :: (Monad m, Monad (View view m), Show a, Eq a, Typeable a, FormInput view) => a -> view -> View view m (MFOption a) Source

Set the selected option for getSelect. Options are concatenated with <|>

wlabel :: (Monad m, FormInput view) => view -> View view m a -> View view m a Source

resetButton :: (FormInput view, Monad m) => String -> View view m () Source

inputReset :: (FormInput view, Monad m) => String -> View view m () Source

submitButton :: (Monad (View view m), StateType (View view m) ~ MFlowState, FormInput view, MonadIO m) => String -> View view m String Source

inputSubmit :: (Monad (View view m), StateType (View view m) ~ MFlowState, FormInput view, MonadIO m) => String -> View view m String Source

wbutton :: a -> String -> Widget a Source

active button. When clicked, return the label value

wlink :: (Show a, Typeable a) => a -> Perch -> Widget a Source

Present a link. Return the first parameter when clicked

noWidget :: (FormInput view, Monad m, Functor m) => View view m a Source

Empty widget that does not validate. May be used as "empty boxes" inside larger widgets.

It returns a non valid value.

stop :: (FormInput view, Monad m, Functor m) => View view m a Source

a sinonym of noWidget that can be used in a monadic expression in the View monad. it stop the computation in the Widget monad.

wraw :: Perch -> Widget () Source

Render a Show-able value and return it wrender :: (Monad m, Functor m, Show a,Monad (View view m), FormInput view) => a -> View view m a wrender x = (fromStr $ show x) ++> return x

Render raw view formatting. It is useful for displaying information.

isEmpty :: Widget a -> Widget Bool Source

True if the widget has no valid input

out of flow updates

at :: ElemID -> UpdateMethod -> Widget a -> Widget a Source

Run the widget as the content of the element with the given id. The content can be appended, prepended to the previous content or it can be the only content depending on the update method.

data UpdateMethod Source

Constructors

Append 
Prepend 
Insert 

Instances

Session data storage

getSessionData :: (StateType m ~ MFlowState, MonadState m, Typeable a) => m (Maybe a) Source

Get the session data of the desired type if there is any.

getSData :: Typeable a => Widget a Source

getSessionData specialized for the View monad. if Nothing, the monadic computation does not continue. getSData is a widget that does not validate when there is no data of that type in the session.

setSessionData :: (MonadState m, Typeable * a, (~) * (StateType m) MFlowState) => a -> m () Source

setSessionData :: (StateType m ~ MFlowState, Typeable a) => a -> m ()

setSData :: (StateType m ~ MFlowState, MonadState m, Typeable a) => a -> m () Source

a shorter name for setSessionData

delSessionData :: (MonadState m, Typeable * a, (~) * (StateType m) MFlowState) => a -> m () Source

delSData :: (StateType m ~ MFlowState, MonadState m, Typeable a) => a -> m () Source

reactive and events

data EventData Source

Constructors

EventData 

Fields

evName :: String
 
evData :: EvData
 

Instances

data EvData Source

Constructors

NoData 
Click Int (Int, Int) 
Mouse (Int, Int) 
Key Int 

Instances

raiseEvent :: Widget a -> Event IO b -> Widget a Source

triggers the event when it happens in the widget.

What happens then?

1)The event reexecutes all the monadic sentence where the widget is, (with no re-rendering)

2) with the result of this reevaluaution, executes the rest of the monadic computation

3) update the DOM tree with the rendering of the reevaluation in 2).

As usual, If one step of the monadic computation return empty, the reevaluation finish So the effect of an event can be restricted as much as you may need.

Neither the computation nor the tree in the upstream flow is touched. (unless you use out of stream directives, like at)

monadic computations inside monadic computations are executed following recursively the steps mentioned above. So an event in a component deep down could or could not trigger the reexecution of the rest of the whole.

fire :: Widget a -> Event IO b -> Widget a Source

A shorter synonym for raiseEvent

wake :: Widget a -> Event IO b -> Widget a Source

A shorter and smoother synonym for raiseEvent

react :: Widget a -> Event IO b -> Widget a Source

A professional synonym for raiseEvent

pass :: Perch -> Event IO b -> Widget EventData Source

pass trough only if the event is fired in this DOM element. Otherwise, if the code is executing from a previous event, the computation will stop

continueIf :: Bool -> a -> Widget a Source

return empty and the monadic computation stop if the condition is false. If true, return the second parameter.

wtimeout :: Int -> Widget () -> Widget () Source

executes a widget each t milliseconds until it validates and return ()

data Event m a :: (* -> *) -> * -> * where

Constructors

OnLoad :: Event m (m ()) 
OnUnload :: Event m (m ()) 
OnChange :: Event m (m ()) 
OnFocus :: Event m (m ()) 
OnBlur :: Event m (m ()) 
OnMouseMove :: Event m ((Int, Int) -> m ()) 
OnMouseOver :: Event m ((Int, Int) -> m ()) 
OnMouseOut :: Event m (m ()) 
OnClick :: Event m (Int -> (Int, Int) -> m ()) 
OnDblClick :: Event m (Int -> (Int, Int) -> m ()) 
OnMouseDown :: Event m (Int -> (Int, Int) -> m ()) 
OnMouseUp :: Event m (Int -> (Int, Int) -> m ()) 
OnKeyPress :: Event m (Int -> m ()) 
OnKeyUp :: Event m (Int -> m ()) 
OnKeyDown :: Event m (Int -> m ()) 

Instances

Eq (Event m a) 
Ord (Event m a) 

running it

runWidget :: Widget b -> Elem -> IO (Maybe b) Source

run the widget as the content of a DOM element the new rendering is added to the element

runWidgetId :: Widget b -> ElemID -> IO (Maybe b) Source

run the widget as the content of a DOM element, the id is passed as parameter. All the content of the element is erased previously and it is substituted by the new rendering

runBody :: Widget a -> IO (Maybe a) Source

run the widget as the body of the HTML

addHeader :: Perch -> IO () Source

add a header in the header tag

Perch is reexported

low level and internals

getNextId :: (StateType m ~ MFlowState, MonadState m) => m String Source

get the next ideitifier that will be created by genNewId

genNewId :: (StateType m ~ MFlowState, MonadState m) => m String Source

Generate a new string. Useful for creating tag identifiers and other attributes.

if the page is refreshed, the identifiers generated are the same.

getParam :: (FormInput view, StateType (View view m) ~ MFlowState, MonadIO m, Typeable a, Show a, Read a) => Maybe String -> String -> Maybe a -> View view m a Source

class (Monoid view, Typeable view) => FormInput view where Source

Minimal interface for defining the basic form and link elements. The core of MFlow is agnostic about the rendering package used. Every formatting (either HTML or not) used with MFlow must have an instance of this class. See "MFlow.Forms.Blaze.Html for the instance for blaze-html" MFlow.Forms.XHtml for the instance for Text.XHtml and MFlow.Forms.HSP for the instance for Haskell Server Pages.

Methods

fromStr :: String -> view Source

fromStrNoEncode :: String -> view Source

ftag :: String -> view -> view Source

inred :: view -> view Source

flink :: String -> view -> view Source

flink1 :: String -> view Source

finput :: Name -> Type -> Value -> Checked -> OnClick -> view Source

ftextarea :: String -> String -> view Source

fselect :: String -> view -> view Source

foption :: String -> view -> Bool -> view Source

foption1 :: String -> Bool -> view Source

formAction :: String -> String -> view -> view Source

attrs :: view -> Attribs -> view Source

Instances

newtype View v m a Source

Constructors

View 

Fields

runView :: WState v m (FormElm v a)
 

Instances

Attributable (Widget a) 
Monoid view => MonadTrans (View view) 
(Monoid view, Functor m, Monad m) => Alternative (View view m) 
Monad (View Perch IO) 
(Monad m, Functor m) => Functor (View view m) 
(Monoid view, Functor m, Monad m) => Applicative (View view m) 
(FormInput view, Monad (View view m), MonadIO m) => MonadIO (View view m) 
(FormInput view, Monad m, Monad (View view m)) => MonadState (View view m) 
(FormInput v, Monad (View v m), Monad m, Functor m, Monoid a) => Monoid (View v m a) 
type StateType (View view m) 

data FormElm view a Source

Constructors

FormElm view (Maybe a) 

Instances

Functor (FormElm view) 
Monoid view => Monoid (FormElm view a)