digestive-functors-0.6.1.0: A practical formlet library

Safe HaskellSafe-Inferred

Text.Digestive.Form

Contents

Description

End-user interface - provides the main functionality for form creation and validation. For an interface for front-end implementation, see View.

Synopsis

Documentation

type Formlet v m a = Maybe a -> Form v m aSource

A Form with a set, optional default value

type Form v m a = FormTree m v m aSource

Base type for a form.

The three type parameters are:

  • v: the type for textual information, displayed to the user. For example, error messages are of this type. v stands for view.
  • m: the monad in which validators operate. The classical example is when validating input requires access to a database, in which case this m should be an instance of MonadIO.
  • a: the type of the value returned by the form, used for its Applicative instance.

data SomeForm v m Source

Value-agnostic Form

Constructors

forall a . SomeForm (FormTree Identity v m a) 

Instances

Show (SomeForm v m) 

(.:) :: Monad m => Text -> Form v m a -> Form v m aSource

Operator to set a name for a subform.

Basic forms

text :: Formlet v m TextSource

Returns a Formlet which may optionally take a default text

string :: Monad m => Formlet v m StringSource

Identical to text but takes a String

stringRead :: (Monad m, Read a, Show a) => v -> Formlet v m aSource

Returns a Formlet for a parseable and serializable value type

choice :: (Eq a, Monad m) => [(a, v)] -> Formlet v m aSource

Returns a Formlet for a value restricted to the provided list of value-message tuples

choice' :: Monad m => [(a, v)] -> Maybe Int -> Form v m aSource

Sometimes there is no good Eq instance for choice. In this case, you can use this function, which takes an index in the list as default.

choiceWith :: (Eq a, Monad m) => [(Text, (a, v))] -> Formlet v m aSource

Allows you to assign your own values: these values will be used in the resulting HTML instead of the default [0 ..]. This fixes some race conditions that might otherwise appear, e.g. if new choice items are added to some database while a user views and submits the form...

choiceWith' :: Monad m => [(Text, (a, v))] -> Maybe Int -> Form v m aSource

A version of choiceWith for when there is no good Eq instance.

groupedChoice :: (Eq a, Monad m) => [(Text, [(a, v)])] -> Formlet v m aSource

Returns a Formlet for named groups of choices.

groupedChoice' :: Monad m => [(Text, [(a, v)])] -> Maybe Int -> Form v m aSource

Sometimes there is no good Eq instance for choice. In this case, you can use this function, which takes an index in the list as default.

groupedChoiceWith :: (Eq a, Monad m) => [(Text, [(Text, (a, v))])] -> Formlet v m aSource

Allows you to assign your own values: these values will be used in the resulting HTML instead of the default [0 ..]. This fixes some race conditions that might otherwise appear, e.g. if new choice items are added to some database while a user views and submits the form...

groupedChoiceWith' :: Monad m => [(Text, [(Text, (a, v))])] -> Maybe Int -> Form v m aSource

Low-level support for grouped choice.

bool :: Formlet v m BoolSource

Returns a Formlet for binary choices

file :: Form v m (Maybe FilePath)Source

Returns a Formlet for file selection

Optional forms

optionalText :: Monad m => Maybe Text -> Form v m (Maybe Text)Source

Create a text form with an optional default text which returns nothing if no optional text was set, and no input was retrieved.

optionalString :: Monad m => Maybe String -> Form v m (Maybe String)Source

Identical to optionalText, but uses Strings

optionalStringRead :: (Monad m, Read a, Show a) => v -> Maybe a -> Form v m (Maybe a)Source

Identical to optionalText for parseable and serializable values.

Validation and transformation

checkSource

Arguments

:: Monad m 
=> v

Error message (if fail)

-> (a -> Bool)

Validating predicate

-> Form v m a

Form to validate

-> Form v m a

Resulting form

Validate the results of a form with a simple predicate

Example:

 check "Can't be empty" (not . null) (string Nothing)

checkM :: Monad m => v -> (a -> m Bool) -> Form v m a -> Form v m aSource

Version of check which allows monadic validations

validate :: Monad m => (a -> Result v b) -> Form v m a -> Form v m bSource

This is an extension of check that can be used to apply transformations that optionally fail

Example: taking the first character of an input string

 head' :: String -> Result String Char
 head' []      = Error "Is empty"
 head' (x : _) = Success x

 char :: Monad m => Form m String Char
 char = validate head' (string Nothing)

validateM :: Monad m => (a -> m (Result v b)) -> Form v m a -> Form v m bSource

Version of validate which allows monadic validations

disable :: Form v m a -> Form v m aSource

Disables a form

Lifting forms

monadic :: m (Form v m a) -> Form v m aSource

Hide a monadic wrapper

Dynamic list forms

listOf :: Monad m => Formlet v m a -> Formlet v m [a]Source

Dynamic lists