WashNGo-2.12.0.1: WASH is a family of EDSLs for programming Web applications in Haskell.

WASH.CGI.CGI

Contents

Description

One stop shop for the WASH/CGI library. All high-level scripts should get along with importing just this module. Low-level scripts may have to import RawCGI.

Synopsis

Basics

data CGI a Source

Instances

class Monad cgi => CGIMonad cgi Source

Instances

ask :: CGIMonad cgi => WithHTML x cgi a -> cgi ()Source

Takes a monadic value that constructs a HTML page and delivers this page to the browser. This page may contain forms and input widgets.

tell :: (CGIMonad cgi, CGIOutput a) => a -> cgi ()Source

Terminates script by sending its argument to the browser.

io :: (Read a, Show a) => IO a -> CGI aSource

Safe embedding of an IO action into the CGI monad. Intentionally not parameterized ver its monad to avoid its use inside of transactions.

run :: CGI () -> IO ()Source

Turns a CGI action into an IO action. Used to turn the main CGI action into the main function of the program. Typical use:

 main = run mainCGI

runWithOptions :: CGIOptions -> CGI () -> IO ()Source

Turns a CGI action into an IO action. Used to turn the main CGI action into the main function of the program. Takes additional low-level options. Typical use:

 main = runWithOptions [] mainCGI

once :: (CGIMonad cgi, Read a, Show a) => cgi a -> cgi aSource

Brackets a CGI action so that only its result is visible. Improves efficiency by not executing the bracketed action after it has been performed once. Use this for avoiding the inefficient buildup of long interaction logs.

forever :: CGIMonad cgi => cgi () -> cgi ()Source

Repeats a CGI action without saving its state so that the size of the interaction log remains constant.

callWithCurrentHistory :: (CGIMonad cgi, Read a, Show a) => ((a -> cgi ()) -> a -> cgi ()) -> a -> cgi ()Source

Control operator for the CGI monad. Its specification is

 callWithCurrentHistory (\backto x -> action x >>= backto) x
 ==
 action x >>= callWithCurrentHistory (\backto x -> action x >>= backto)

However, callWithCurrentHistory is more efficient because it avoids the buildup of long interaction logs by cutting back every time just before action gets executed.

htell :: CGIMonad cgi => WithHTML x IO () -> cgi aSource

Terminate script by sending a HTML page constructed by monadic argument.

askOffline :: CGIMonad cgi => WithHTML x cgi a -> (Element -> IO ()) -> cgi ()Source

Like ask, but passes the constructed HTML page to the elementAction parameter. This function may send the page via Email or store it into a file. Anyone loading this page in a browser can resume the interaction.

Links and Images

internalImageSource

Arguments

:: CGIMonad cgi 
=> FreeForm

the raw image

-> String

alternative text

-> WithHTML x cgi Image 

Reference to internal image.

externalImageSource

Arguments

:: CGIMonad cgi 
=> URL

URL of image

-> String

alternative text

-> WithHTML x cgi Image 

Reference to image by URL.

makeImg :: Monad cgi => Image -> HTMLField cgi x y ()Source

Create an inline image.

makeRefSource

Arguments

:: (CGIMonad cgi, Monad m) 
=> String

internal name of entity

-> WithHTML x m ()

body of the reference

-> cgi (WithHTML y m ()) 

Create a hyperlink to internal entity.

makePopupRefSource

Arguments

:: CGIMonad cgi 
=> String

name of popup window

-> String

internal name of entity

-> HTMLCons x y cgi () 

Create a popup hyperlink to internal entity.

makeA :: CGIMonad cgi => String -> String -> HTMLField cgi x y ()Source

Create hyperlink to internal entity /path?name.

backLink :: Monad m => HTMLCons x y m ()Source

Link to previous page in browser's history. Uses JavaScript.

hlink :: Monad m => URL -> HTMLCons x y m ()Source

Plain Hyperlink from an URL string.

popuplink :: Monad m => String -> URL -> HTMLCons x y m ()Source

Hyperlink that creates a named popup window from an URL string.

restart :: CGIMonad cgi => cgi ()Source

restart application.

Page Templates

standardPage :: Monad m => String -> WithHTML x m a -> WithHTML y m ()Source

create a standard XHTML page from a title string and body elements

htmlHeader :: Monad m => String -> WithHTML x m a -> WithHTML y m ()Source

create a standard XHTML page without heading from a title string and body elements

html :: Monad m => WithHTML x m a -> WithHTML y m ()Source

create a bare XHTML root tag with proper namespace attribute

cssPage :: Monad m => String -> String -> WithHTML x m a -> WithHTML y m ()Source

create a standard XHTML page from a title string, a stylesheet URL and body elements

cssHeader :: Monad m => String -> String -> WithHTML x m a -> WithHTML y m ()Source

create an XHTML page with CSS reference but without heading from a title string, the URL of the stylesheet and body elements

Forms and Widgets

type HTMLField cgi x y a = WithHTML x cgi () -> WithHTML y cgi aSource

Every input widget maps the content generator for the widget (which may produce HTML elements or attributes) to the content generator of the widget.

Form Creation

makeForm :: CGIMonad cgi => WithHTML x cgi a -> WithHTML y cgi ()Source

Wraps an HTML form around its arguments. All standard attributes are computed and need not be supplied explicitly.

standardQuery :: CGIMonad cgi => String -> WithHTML x cgi a -> cgi ()Source

Convenient workhorse. Takes the title of a page and a monadic HTML value for the contents of the page. Wraps the contents in a form so that input fields and buttons may be used inside.

Form Submission

submitSource

Arguments

:: (CGIMonad cgi, InputHandle h) 
=> h INVALID

input field handles to be validated and passed to callback action

-> (h VALID -> cgi ())

callback maps valid input handles to a CGI action

-> HTMLField cgi x y ()

returns a field so that attributes can be attached

Create a submission button with attached action.

submit0 :: CGIMonad cgi => cgi () -> HTMLField cgi x y ()Source

Create a continuation button that takes no parameters.

defaultSubmit :: (CGIMonad cgi, InputHandle h) => h INVALID -> (h VALID -> cgi ()) -> HTMLField cgi x y ()Source

Create a submission button whose attached action is fired whenever the form is submitted without explicitly clicking any submit button. This can happen if an input field has an attached onclick=submit() action.

resetField :: CGIMonad cgi => HTMLField cgi x y (InputField () INVALID)Source

Creates a reset button that clears all fields of a form.

activeInputFieldSource

Arguments

:: (CGIMonad cgi, Reason a, Read a) 
=> (a -> cgi ())

Function that maps input data to a CGI action.

-> HTMLField cgi x y () 

Creates an input field that submits the field to the browser when data is entered into this field.

activate :: (CGIMonad cgi, InputHandle (i a), HasValue i) => (a -> cgi ()) -> HTMLField cgi x y (i a INVALID) -> HTMLField cgi x y (i a INVALID)Source

Attach a CGI action to the value returned by the input field. Activation means that data is submitted as soon as it is entered.

submitLink :: (CGIMonad cgi, InputHandle h) => h INVALID -> (h VALID -> cgi ()) -> HTMLCons x y cgi ()Source

Create an ordinary link serving as a submission button.

submitLink0 :: CGIMonad cgi => cgi () -> HTMLCons x y cgi ()Source

Create a continuation link.

defaultSubmitLink :: (CGIMonad cgi, InputHandle h) => h INVALID -> (h VALID -> cgi ()) -> HTMLCons x y cgi ()Source

submitx :: DTree cgi x y -> HTMLField cgi x y ()Source

Create a submission button whose validation proceeds according to a decision tree. Trees are built using dtleaf and dtnode.

data DTree cgi x y Source

Abstract type of decisions trees. These trees provide structured validation.

dtleaf :: CGIMonad cgi => cgi () -> DTree cgi x ySource

Create a leaf in a decision tree from a CGI action.

dtnode :: (CGIMonad cgi, InputHandle h) => h INVALID -> (h VALID -> DTree cgi x y) -> DTree cgi x ySource

Create a node in a decision tree. Takes an invalid input field and a continuation. Validates the input field and passes it to the continuation if the validation was successful. The continuation can dispatch on the value of the input field and produces a new decision tree.

Textual Input

inputField :: (CGIMonad cgi, Reason a, Read a) => HTMLField cgi x y (InputField a INVALID)Source

Create a textual input field. Return type can be *anything* in class Reason and Read.

textInputField :: CGIMonad cgi => HTMLField cgi x y (InputField String INVALID)Source

Create a textual input field that returns the string entered. (Avoids having to put quotes around a string.)

checkedTextInputField :: CGIMonad cgi => (Maybe String -> Maybe String) -> HTMLField cgi x y (InputField String INVALID)Source

Creates a textual input field that takes a custom validation function.

passwordInputField :: (CGIMonad cgi, Reason a, Read a) => HTMLField cgi x y (InputField a INVALID)Source

Like inputField but the characters are not echoed on the screen.

makeTextarea :: CGIMonad cgi => String -> HTMLField cgi x y (InputField String INVALID)Source

Create a text area with a preset string.

Checkbox

checkboxInputField :: CGIMonad cgi => HTMLField cgi x y (InputField Bool INVALID)Source

Creates a checkbox. Returns True if box was checked.

Button

makeButton :: CGIMonad cgi => HTMLField cgi x y (InputField Bool INVALID)Source

Create a single button.

radioGroup :: (CGIMonad cgi, Read a) => WithHTML x cgi (RadioGroup a INVALID)Source

Create a handle for a new radio group. This handle is invisible on the screen!

radioButton :: (Show a, Monad cgi) => RadioGroup a INVALID -> a -> HTMLField cgi x y ()Source

Create a new radio button and attach it to an existing RadioGroup.

radioError :: CGIMonad cgi => RadioGroup a INVALID -> WithHTML x cgi ()Source

Create and place the error indicator for an existing RadioGroup. Becomes visible only if no button of a radio group is pressed.

Image

imageField :: CGIMonad cgi => Image -> HTMLField cgi x y (InputField (Int, Int) INVALID)Source

Create an input field from an image. Returns (x,y) position clicked in the image.

Selection Box

selectMultipleSource

Arguments

:: (CGIMonad cgi, Eq a) 
=> (a -> String)

function to display values of type a

-> [a]

list of preselected entries

-> [a]

list of all possible entries

-> (Int, Int)

(min, max) number of fields that must be selected

-> HTMLField cgi x y (InputField [a] INVALID) 

Create a selection box where multiple entries can be selected.

selectSingleSource

Arguments

:: (CGIMonad cgi, Eq a) 
=> (a -> String)

function to display values of type a

-> Maybe a

optional preselected value

-> [a]

list of all possible values

-> HTMLField cgi x y (InputField a INVALID) 

Create a selection box where exactly one entry can be selected.

selectBounded :: (CGIMonad cgi, Enum a, Bounded a, Read a, Show a, Eq a) => Maybe a -> HTMLField cgi x y (InputField a INVALID)Source

Selection box for elements of a Bounded type. Argument is the optional preselected value.

File

fileInputField :: CGIMonad cgi => HTMLField cgi x y (InputField FileReference INVALID)Source

Creates a file input field. Returns a temporary FileReference. The fileReferenceName of the result is *not* guaranteed to be persistent. The application is responsible for filing it away at a safe place.

checkedFileInputField :: CGIMonad cgi => (Maybe FileReference -> Maybe FileReference) -> HTMLField cgi x y (InputField FileReference INVALID)Source

Creates a file input field. Like fileInputField but has an additional parameter for additional validation of the input.

Abstract Selection

table_io :: IO [[String]] -> CGI ATSource

Transform an IO action that produces a table in list form into a CGI action that returns an abstract table.

getText :: Monad m => AT -> Int -> Int -> WithHTML x m ()Source

Access abstract table by row and column. Produces a test node in the document monad.

selectionGroup :: CGIMonad cgi => WithHTML y cgi (SelectionGroup AR INVALID)Source

Create a selection group for a table. Selects one row.

selectionButton :: CGIMonad cgi => SelectionGroup AR INVALID -> AT -> Int -> HTMLField cgi x y ()Source

Create a selection button for an abstract table

selectionDisplay :: CGIMonad cgi => SelectionGroup AR INVALID -> AT -> Int -> (WithHTML x cgi () -> [WithHTML x cgi ()] -> WithHTML x cgi a) -> WithHTML x cgi aSource

Create a labelled selection display for an abstract table. The display function takes the button element and a list of text nodes corresponding to the selected row and is expected to perform the layout.

choiceGroup :: CGIMonad cgi => WithHTML x cgi (SelectionGroup [AR] INVALID)Source

Create a choice group for a table (0-*).

choiceButton :: CGIMonad cgi => SelectionGroup [AR] INVALID -> AT -> Int -> HTMLField cgi x y ()Source

Create one choice button for an abstract table

choiceDisplay :: CGIMonad cgi => SelectionGroup [AR] INVALID -> AT -> Int -> (WithHTML x cgi () -> [WithHTML x cgi ()] -> WithHTML x cgi a) -> WithHTML x cgi aSource

Create a labelled choice display for an abstract table. The display function takes the button element and a list of text nodes corresponding to the selected row and is expected to perform the layout.

Handle Manipulation

class HasValue i whereSource

Methods

value :: i a VALID -> aSource

extract a value from various kinds of input handles

data F0 x Source

Constructors

F0 

Instances

data F1 a x Source

Constructors

F1 (a x) 

Instances

data F2 a b x Source

Constructors

F2 (a x) (b x) 

Instances

data F3 a b c x Source

Constructors

F3 (a x) (b x) (c x) 

Instances

data F4 a b c d x Source

Constructors

F4 (a x) (b x) (c x) (d x) 

Instances

data F5 a b c d e x Source

Constructors

F5 (a x) (b x) (c x) (d x) (e x) 

Instances

data F6 a b c d e f x Source

Constructors

F6 (a x) (b x) (c x) (d x) (e x) (f x) 

Instances

data F7 a b c d e f g x Source

Constructors

F7 (a x) (b x) (c x) (d x) (e x) (f x) (g x) 

Instances

data F8 a b c d e f g h x Source

Constructors

F8 (a x) (b x) (c x) (d x) (e x) (f x) (g x) (h x) 

data FL a x Source

FL is required to pass an unknown number of handles of the same type need to the callback function in a form submission. The handles need to be collected in a list and then wrapped in the FL data constructor

Constructors

FL [a x] 

Instances

data FA a b x Source

FA comes handy when you want to tag an input handle with some extra information, which is not itsefl an input handle and which is not validated by a form submission. The tag is the first argument and the handle is the second argument of the data constructor.

Constructors

FA a (b x) 

Instances

Handle Concatenation

concatFields :: (Reason c, Read c) => InputField c INVALID -> InputField Text INVALID -> InputField c INVALIDSource

create a virtual input field from the concatenation of two input fields

concatFieldsWith :: (Reason c, Read c) => (String -> [String] -> String) -> InputField c INVALID -> [InputField Text INVALID] -> InputField c INVALIDSource

Create a virtual input field from the result of applying a function to two input fields. Parsing is applied to the result of the function call.

Attribute Shortcuts

fieldSIZE :: Monad m => Int -> WithHTML x m ()Source

Create a SIZE attribute from an Int.

fieldMAXLENGTH :: Monad m => Int -> WithHTML x m ()Source

Create a MAXLENGTH attribute from an Int.

fieldVALUE :: (Monad m, Show a) => a -> WithHTML x m ()Source

Create a VALUE attribute from any Showable.

Advanced

Installing Translators

runWithHook :: CGIOptions -> ([String] -> CGI ()) -> CGI () -> IO ()Source

Variant of run where an additional argument cgigen specifies an action taken when the script is invoked with a non-empty query string as in script-name?query-string

docTranslator :: [FreeForm] -> ([String] -> CGI ()) -> [String] -> CGI ()Source

A translator is a function [String] -> CGI (). It takes the query string of the URL (of type [String]) and translates it into a CGI action. docTranslator docs next takes a list of FreeForm documents and a next translator. It tries to select a document by its ffName and falls through to the next translator if no document matches.

lastTranslator :: [String] -> CGI ()Source

Terminates a sequence of translators.

Outputable Stuff

data Status Source

Constructors

Status 

Fields

statusCode :: Int

status code

statusReason :: String

reason phrase

statusContent :: Maybe (WithHTML () IO ())

more explanation

Instances

newtype Location Source

Constructors

Location URL

redirection

Instances

data FreeForm Source

Constructors

FreeForm 

Fields

ffName :: String

internal name

ffContentType :: String

MIME type

ffRawContents :: String

contents as octet stream

Instances

Predefined Types for Input Fields

newtype Text Source

Arbitrary string data. No quotes required.

Constructors

Text 

Fields

unText :: String
 

Instances

newtype NonEmpty Source

Non-empty strings.

Constructors

NonEmpty 

Fields

unNonEmpty :: String
 

newtype AllDigits Source

Non-empty strings of digits.

Constructors

AllDigits 

Fields

unAllDigits :: String
 

newtype Phone Source

Phone numbers.

Constructors

Phone 

Fields

unPhone :: String
 

newtype EmailAddress Source

Reads an email address according to RFC 2822

Constructors

EmailAddress 

newtype CreditCardNumber Source

Reads a credit card number and performs Luhn check on it.

data CreditCardExp Source

Reads credit card expiration dates in format /.

Constructors

CreditCardExp 

Fields

cceMonth :: Int
 
cceYear :: Int
 

newtype Password Source

A Password is a string of length >= 8 with characters taken from at least three of the four sets: lower case characters, upper case characters, digits, and special characters.

Constructors

Password 

Fields

unPassword :: String
 

data Optional a Source

Data type for transforming a field into an optional one. The Read syntax of Absent is the empty string, whereas the Read syntax of Present a is just the Read syntax of a. Analogously for Show.

Constructors

Absent 
Present a 

Instances

Read a => Read (Optional a)

Optional items are either empty or just the item

Show a => Show (Optional a) 
Reason a => Reason (Optional a) 

Lowlevel Stuff

data CGIOption Source

Constructors

NoPort

do not include port number in generated URLs

AutoPort

include automatically generated port number in generated URLs (default)

Port Int

use this port number in generated URLs

NoHttps

do not attempt to detect Https

AutoHttps

autodetect Https by checking for port number 443 and env var HTTPS (default)

FullURL

generate full URL including scheme, host, and port

PartialURL

generate absolute path URL, only (default)

SessionMode 

newtype URL Source

Constructors

URL 

Fields

unURL :: String
 

Instances

Read URL

String in URL format

Show URL 
Reason URL 

Servlets

makeServlet :: CGI () -> CGIProgramSource

Transform a CGI action into a servlet suitable for running from Marlow's web server.

makeServletWithHook :: ([String] -> CGI ()) -> CGI () -> CGIProgramSource

Like makeServlet with additional CGI generator as in runWithHook.

HTML and Style

Experimental Stuff

data FrameSet Source

Abstract data type of frame set generators.

data FrameLayout Source

Overall layout of a frame set: row-wise or column-wise.

Constructors

ROWS 
COLS 

Instances

data FrameSpacing Source

Division of space between elements of a frameset. See http://wp.netscape.com/assist/net_sites/frame_syntax.html

Constructors

FrameAbsolute Int

in pixels

FrameRelative Int

the * format

FramePercent Int

the % format

Instances

makeFrameSource

Arguments

:: CGIMonad cgi 
=> WithHTML x IO ()

additional attributes to frame

-> cgi ()

contents of the frame

-> cgi FrameSet

returns HTML generator for the frame

Create a single frame. Returns the assigned name of the frame.

makeFrameset :: CGIMonad cgi => FrameLayout -> [(FrameSpacing, cgi FrameSet)] -> cgi FrameSetSource

Create a frameset, given a layout, its spacing, and its subframe(set)s.

framesetPage :: CGIMonad cgi => String -> cgi FrameSet -> cgi ()Source

Required wrapper for pages with frames. Takes a title and a FrameSet generator and displays the page.