This module will help generating good looking forms using the twitter bootstrap framework. It also provides automatic conversion of textual input to more useful types
The input string of the user and the parsed value
The input string of the user, the parsed value and internal state of the component
An action to be applied to a form value
An action to be applied to a form value for components with internal state
Apply an action to a form value
Return all side effects of an action to a form value
Return all side effects of an action to a form value and apply a function to wrap them
An effect free form action
Read the current form value if available
Read the current form value or fallback to a default
Check if the given FormValueSt contains a valid value
Generate a FormValueSt for textual input boxes w/o validation
Generate a FormValueSt for textual input boxes w/o validation
An empty form value
All inputs will be defined by this basic structure
An element with a decoder
A simple text input
A simple password input
A simple int input
A simple float input
A simple date input
Time of day
A simple time input
A simple checkbox input
Spec for selectBox
A simple dropdown
A textarea
Spec for an input with a type
A simple input
A simple input not grouped yet
A simple input not grouped yet emitting an effect
Build your own input element
module Html.Form.Input
( FormValue, FormValueSt, FormValueAction, FormValueActionSt(..)
, Element, FormElement, formGroup
, textInput, passwordInput, intInput, floatInput
, dateInput, TimeOfDay, timeInput
, checkBox
, textArea
, SelectElement, selectBox
, InputElement, basicInput, basicInputRaw, basicInputRawEff
, stringFormVal, mayStringFormVal, emptyFormVal
, getFormValue, getFormValueDef, validFormValue
, noFx, apply, effect, mappedEffect
) where
{-| This module will help generating good looking forms using the twitter bootstrap framework.
It also provides automatic conversion of textual input to more useful types
# Form input
@docs FormValue, FormValueSt, FormValueAction, FormValueActionSt, apply, effect, mappedEffect, noFx, getFormValue, getFormValueDef, validFormValue, stringFormVal, mayStringFormVal, emptyFormVal
# Default input element structure
@docs Element, FormElement
# Popular form groups
@docs textInput, passwordInput, intInput, floatInput, dateInput, TimeOfDay, timeInput, checkBox, SelectElement, selectBox, textArea
# Custom input elements
@docs InputElement, basicInput, basicInputRaw, basicInputRawEff
# Custom form groups
@docs formGroup
-}
import Date
import Effects
import Html as H
import Html exposing (text)
import Html.Attributes as A
import Html.Events as E
import Json.Decode as Json
import String
import Time
{-| An action to be applied to a form value -}
type alias FormValueAction e v = FormValueActionSt e v ()
{-| An action to be applied to a form value for components with internal state -}
type FormValueActionSt e v st =
FormValueActionSt
{ action : FormValueSt e v st -> FormValueSt e v st
, effect : Effects.Effects (FormValueActionSt e v st)
}
{-| Apply an action to a form value -}
apply : FormValueActionSt e v st -> FormValueSt e v st -> FormValueSt e v st
apply (FormValueActionSt st) = st.action
{-| Return all side effects of an action to a form value -}
effect : FormValueActionSt e v st -> Effects.Effects (FormValueActionSt e v st)
effect (FormValueActionSt st) = st.effect
{-| Return all side effects of an action to a form value and apply a function to wrap them -}
mappedEffect : (FormValueActionSt e v st -> a) -> FormValueActionSt e v st -> Effects.Effects a
mappedEffect f = Effects.map f << effect
{-| An effect free form action -}
noFx : (FormValueSt e v st -> FormValueSt e v st) -> FormValueActionSt e v st
noFx f = FormValueActionSt { action = f, effect = Effects.none }
{-| The input string of the user and the parsed value -}
type alias FormValue e v = FormValueSt e v ()
{-| The input string of the user, the parsed value and internal state of the component -}
type alias FormValueSt e v st =
{ userInput : String
, value : Result e v
, focused : Bool
, internalState : st
}
{-| An empty form value -}
emptyFormVal : FormValueSt String v ()
emptyFormVal = { userInput = "", value = Err "No input", focused = False, internalState = () }
{-| Generate a FormValueSt for textual input boxes w/o validation -}
stringFormVal : String -> FormValueSt e String ()
stringFormVal str =
{ userInput = str
, value = Ok str
, focused = False
, internalState = ()
}
{-| Generate a FormValueSt for textual input boxes w/o validation -}
mayStringFormVal : Maybe String -> FormValueSt e String ()
mayStringFormVal = stringFormVal << Maybe.withDefault ""
{-| All inputs will be defined by this basic structure -}
type alias Element v e st =
{ id: String
, label: String
, helpBlock: Maybe String
, value: FormValueSt e v st
, onValue: FormValueActionSt e v st -> Signal.Message
}
{-| An element with a decoder -}
type alias FormElement v e st a =
{ element: Element v e st
, props: a
, decoder: String -> Result e v
, autoBlur: Bool
}
isError : Result a b -> Bool
isError r =
case r of
Err _ -> True
Ok _ -> False
{-| Build your own input element -}
formGroup : Element v e st -> H.Html -> H.Html
formGroup el view =
H.div [ A.class ("form-group" ++ if isError el.value.value then " has-error" else "") ]
[ H.label [ A.for el.id ] [ text el.label ]
, view
, case el.helpBlock of
Just val -> H.span [ A.class "help-block" ] [ text val ]
Nothing -> H.span [] []
]
{-| Spec for an input with a type -}
type alias InputElement v e st =
FormElement v e st
{ type' : String
, extraClasses : List String
}
focusHandlers : Bool -> (FormValueActionSt e v st -> Signal.Message) -> List H.Attribute
focusHandlers autoBlur onValue =
[ E.on "focus" Json.value <| \_ ->
onValue <| noFx <| \val -> { val | focused = True }
, E.on "blur" Json.value <| \_ ->
onValue <| noFx <| \val -> { val | focused = not autoBlur }
]
{-| A simple input not grouped yet emitting an effect -}
basicInputRawEff :
(FormValueSt e v st -> Effects.Effects (FormValueActionSt e v st))
-> InputElement v e st
-> H.Html
basicInputRawEff effs iel =
let el = iel.element
val = el.value
in flip H.input [] <|
[ A.type' iel.props.type'
, A.id el.id
, A.class ("form-control " ++ String.join " " iel.props.extraClasses)
, A.placeholder el.label
, A.value val.userInput
, E.on "input" E.targetValue <| \str ->
el.onValue <|
let action curVal =
{ curVal
| userInput = str
, value = iel.decoder str
}
in FormValueActionSt
{ action = action
, effect = effs <| action val
}
] ++ (focusHandlers iel.autoBlur el.onValue)
{-| A simple input not grouped yet -}
basicInputRaw : InputElement v e st -> H.Html
basicInputRaw = basicInputRawEff (\_ -> Effects.none)
{-| A simple input -}
basicInput : InputElement v e st -> H.Html
basicInput iel =
formGroup iel.element (basicInputRaw iel)
{-| A textarea -}
textArea : Element String e () -> H.Html
textArea el =
let val = el.value
handle =
flip H.textarea [ text val.userInput ] <|
[ A.id el.id
, A.class "form-control"
, A.placeholder el.label
, E.on "input" E.targetValue <| \str ->
el.onValue <| noFx <| \curVal ->
{ curVal
| userInput = str
, value = Ok str
}
] ++ (focusHandlers True el.onValue)
in formGroup el handle
{-| A simple text input -}
textInput : Element String e () -> H.Html
textInput el =
basicInput
{ element = el
, props = { type' = "text", extraClasses = [] }
, decoder = Ok
, autoBlur = True
}
{-| A simple password input -}
passwordInput : Element String e () -> H.Html
passwordInput el =
basicInput
{ element = el
, props = { type' = "password", extraClasses = [] }
, decoder = Ok
, autoBlur = True
}
{-| A simple int input -}
intInput : Element Int String () -> H.Html
intInput el =
basicInput
{ element = el
, props = { type' = "number", extraClasses = ["bootforms-int"] }
, decoder = String.toInt
, autoBlur = True
}
{-| A simple float input -}
floatInput : Element Float String () -> H.Html
floatInput el =
basicInput
{ element = el
, props = { type' = "number", extraClasses = ["bootforms-float"] }
, decoder = String.toFloat
, autoBlur = True
}
{-| A simple date input -}
dateInput : Element Date.Date String () -> H.Html
dateInput el =
basicInput
{ element = el
, props = { type' = "text", extraClasses = ["bootforms-date"] }
, decoder = Date.fromString
, autoBlur = True
}
{-| Time of day -}
type alias TimeOfDay =
{ hour: Int
, minute: Int
}
{-| A simple time input -}
timeInput : Element TimeOfDay String () -> H.Html
timeInput el =
basicInput <|
let decode str =
case String.split ":" str of
[hourStr, minStr] ->
String.toInt hourStr `Result.andThen` \hour ->
String.toInt minStr `Result.andThen` \min ->
if hour < 0 || hour > 23 || min < 0 || min > 59
then Err <| "Invalid time: " ++ str
else Ok { hour = hour, minute = min }
_ -> Err <| "Ill formatted time: " ++ str
in { element = el
, props = { type' = "text", extraClasses = ["bootforms-time"] }
, decoder = decode
, autoBlur = True
}
{-| A simple checkbox input -}
checkBox : Element Bool e st -> H.Html
checkBox el =
H.div [ A.class ("checkbox" ++ if isError el.value.value then " has-error" else "") ]
[ H.label []
[ flip H.input [] <|
[ A.type' "checkbox"
, A.id el.id
, A.checked (Result.withDefault False el.value.value)
, E.on "change" E.targetChecked <| \cb ->
el.onValue <| noFx <| \curVal -> { curVal | userInput = if cb then "True" else "False", value = Ok cb }
] ++ (focusHandlers True el.onValue)
, text (" " ++ el.label)
]
, case el.helpBlock of
Just val -> H.span [ A.class "help-block" ] [ text val ]
Nothing -> H.span [] []
]
{-| Spec for selectBox -}
type alias SelectElement v e =
FormElement v e ()
{ choices: List v
, displayChoice: v -> String
, choiceValue: v -> String
}
{-| A simple dropdown -}
selectBox : SelectElement v e -> H.Html
selectBox sel =
formGroup sel.element <|
let el = sel.element
val = el.value
opts =
flip List.map sel.props.choices <| \ch ->
let valAttr =
A.value (sel.props.choiceValue ch)
rest =
if Ok ch == val.value
then [A.selected True]
else []
in H.option (valAttr :: rest) [ text <| sel.props.displayChoice ch ]
in flip H.select opts <|
[ A.id el.id
, A.class "form-control"
, E.on "change" E.targetValue <| \str ->
el.onValue <| noFx <| \curVal ->
{ curVal
| userInput = str
, value = sel.decoder str
}
] ++ (focusHandlers sel.autoBlur el.onValue)
{-| Check if the given FormValueSt contains a valid value -}
validFormValue : FormValueSt e t st -> Bool
validFormValue fv =
case fv.value of
Ok _ -> True
Err _ -> False
{-| Read the current form value if available -}
getFormValue : FormValueSt e t st -> Maybe t
getFormValue fv =
case fv.value of
Ok val -> Just val
Err _ -> Nothing
{-| Read the current form value or fallback to a default -}
getFormValueDef : t -> FormValueSt e t st -> t
getFormValueDef def = Maybe.withDefault def << getFormValue