├── .gitignore ├── README.md ├── psc-package.json └── src └── Halogen └── Form.purs /.gitignore: -------------------------------------------------------------------------------- 1 | .psc-package 2 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | # halogen-form 2 | 3 | This implements formlets as in Cooper, Lindley, Wadler and Yallop's paper 4 | [_The Essence of Form Abstraction_](http://homepages.inf.ed.ac.uk/slindley/papers/formlets-essence.pdf) 5 | for the halogen package. 6 | 7 | # Introduction 8 | 9 | ## The component 10 | 11 | `Halogen.Form.component` provides a Halogen component to put a form 12 | into your HTML. Its type is: 13 | 14 | ```haskell 15 | component :: 16 | forall error value m. 17 | H.Component 18 | HH.HTML 19 | Query 20 | (FormBuilder error (Array (H.ComponentHTML Query)) value) -- Input 21 | (Either (Array error) value) -- Output 22 | m 23 | ``` 24 | 25 | ## Form builders 26 | 27 | The input to the component is a `FormBuilder`, which looks like this: 28 | 29 | ``` haskell 30 | newtype FormBuilder error html value 31 | ``` 32 | 33 | * The error type is user-defined. We'll see how below. 34 | * The html type is user-defined. 35 | * The value that the form produces in the end. 36 | 37 | Underneath the `FormBuilder` API there is an internal type, which is 38 | produced by a `FormBuilder`, which is the `Form` type: 39 | 40 | ``` haskell 41 | data Form error html value = Form 42 | { value :: Submitted -> Map Int String -> Either (Array error) value 43 | , html :: Submitted -> Map Int String -> html 44 | } 45 | ``` 46 | 47 | A form simply has a value and a way to render it. The `Map Int String` 48 | associates form inputs with their values, if any. A given `Form` knows 49 | what `Int` key (provided by the `FormBuilder`) to use to pull a value 50 | or many values from the input. 51 | 52 | ## The simplest form builders 53 | 54 | The most basic form builder would be `Form.text` which has this type: 55 | 56 | ```haskell 57 | text :: 58 | forall a e. 59 | -> Maybe String 60 | -> FormBuilder e (Array (HH.HTML a (Query Unit))) (Maybe String) 61 | ``` 62 | 63 | The `Maybe String` is the default input, if any. 64 | 65 | Another is `number`, which is the HTML5 `number` input: 66 | 67 | ```haskell 68 | number :: 69 | forall e a. 70 | Maybe Number 71 | -> FormBuilder e (Array (HH.HTML a (Query Unit))) (Maybe Number) 72 | ``` 73 | 74 | ## Defining errors for your form 75 | 76 | A text input's value may be missing, we might want to make them 77 | required to turn that `Maybe String` into a `String`; so we provide a 78 | record telling the builder which error constructor from our error type 79 | `e` to use. It looks like this: 80 | 81 | ``` haskell 82 | data FormError 83 | = MissingInput 84 | -- Etc. 85 | 86 | errors :: { missing :: FormError} 87 | errors = {missing: MissingInput} 88 | ``` 89 | 90 | And then you can use `required`: 91 | 92 | ``` haskell 93 | required :: 94 | forall e r a html. 95 | {missing :: e | r} 96 | -> FormBuilder e html (Maybe a) 97 | -> FormBuilder e html a 98 | ``` 99 | 100 | As `Form.required errors (Form.text Nothing)`. 101 | 102 | Elsewhere in the app, you'll have a printing function: 103 | 104 | ``` haskell 105 | printFormError msg = 106 | HH.strong_ 107 | [ HH.text 108 | (case msg of 109 | MissingInput -> "Please fill everything in." 110 | ] 111 | ``` 112 | 113 | Which lets you use your own way of talking to explain error messages. 114 | 115 | ## Using the form component in a slot 116 | 117 | With our error type defined, we can use the component and build a 118 | form: 119 | 120 | ``` haskell 121 | data Slot = FormSlot 122 | derive instance eqButtonSlot :: Eq Slot 123 | derive instance ordButtonSlot :: Ord Slot 124 | 125 | HH.slot FormSlot Form.component (Form.required errors (Form.text Nothing)) (\value -> Nothing) 126 | ``` 127 | 128 | (`Halogen.Form` is imported as `Form`.) 129 | 130 | This form will produce a `String` in the `value` given to the output 131 | handler. In that output handler you can send the form value to your 132 | `eval` function as usual. 133 | 134 | ## Combining form builders 135 | 136 | We can combine form builders together with `Applicative`: 137 | 138 | ```haskell 139 | HH.slot 140 | FormSlot 141 | Form.component 142 | (Tuple <$> Form.required (Form.text errors Nothing) 143 | <*> Form.required (Form.number errors Nothing) 144 | <* Form.submitInput "Submit!") 145 | (\value -> Nothing) 146 | ``` 147 | 148 | ## Building records 149 | 150 | With the `(<|*>)` combinator that sits in place of `<*>`, you can 151 | build a record instead: 152 | 153 | ```haskell 154 | HH.slot 155 | FormSlot 156 | Form.component 157 | ( map {name: _} (Form.required (Form.text errors Nothing)) 158 | <|*> map {age: _} (Form.required (Form.number errors Nothing)) 159 | <* Form.submitInput "Submit!") 160 | (\value -> Nothing) 161 | ``` 162 | 163 | And now your `value` will be a record of type 164 | 165 | ``` haskell 166 | {name :: String, age :: Number} 167 | ``` 168 | 169 | E.g. 170 | 171 | ```haskell 172 | person :: 173 | forall h. 174 | FormBuilder 175 | FormError 176 | (Array (HH.HTML h (Query Unit))) 177 | { name :: String, age :: Number} 178 | person = 179 | map {name: _} (Form.required (Form.text errors Nothing)) <|*> 180 | map {age: _} (Form.required (Form.number errors Nothing)) <* 181 | submitInput "Submit!" 182 | ``` 183 | 184 | ## Validation 185 | 186 | We can add validation to this form using the `parse` combinator: 187 | 188 | ``` haskell 189 | parse :: 190 | forall a b h e. 191 | (a -> Either (Array e) b) 192 | -> FormBuilder e h a 193 | -> FormBuilder e h b 194 | ``` 195 | 196 | For example: 197 | 198 | ``` haskell 199 | person :: 200 | forall h. 201 | FormBuilder 202 | FormError 203 | (Array (HH.HTML h (Query Unit))) 204 | { approved :: String } 205 | person = 206 | parse 207 | (\them -> 208 | if them . name == "Crocodile Hunter" || them . age > 70 209 | then Left [InsuranceApplicationFailed] 210 | else Right {approved: them . name}) 211 | (map {name: _} (Form.text errors Nothing) <|*> 212 | map {age: _} 213 | (parse 214 | (\age -> 215 | if age > 18 && age < 100 216 | then Right age 217 | else Left [InvalidAge]) 218 | (Form.number errors Nothing)) <* 219 | submitInput "Submit!") 220 | ``` 221 | 222 | Here I've demonstrated two things: 223 | 224 | 1. Using `parse` on an individual form input to validate age. 225 | 2. Using `parse` to apply a life insurance policy on multiple 226 | fields. 227 | 228 | ## Composability 229 | 230 | The fact that validation, input and rendering are all coupled means I 231 | can separate `age` into a re-usable component throughout my app: 232 | 233 | ```haskell 234 | ageInput :: 235 | forall h. 236 | Maybe Number 237 | -> FormBuilder FormError (Array (HH.HTML h (Query Unit))) Number 238 | ageInput def = 239 | parse 240 | (\age -> 241 | if age > 18.0 && age < 100.0 242 | then Right age 243 | else Left [InvalidAge]) 244 | (Form.number errors def) 245 | ``` 246 | 247 | Or make it even more generic to be used across different types of 248 | errors: 249 | 250 | ``` haskell 251 | ageInput :: 252 | forall h e errors. 253 | {invalidAge :: e, missing :: e | errors} 254 | -> Maybe Number 255 | -> FormBuilder e (Array (HH.HTML h (Query Unit))) Number 256 | ageInput es def = 257 | parse 258 | (\age -> 259 | if age > 18.0 && age < 100.0 260 | then Right age 261 | else Left [es.invalidAge]) 262 | (Form.number es def) 263 | ``` 264 | 265 | ## Wrapping up 266 | 267 | You can wrap your own custom HTML around other form builders using 268 | `wrap`: 269 | 270 | 271 | ``` haskell 272 | wrap :: 273 | forall e a html. 274 | (Maybe (Array e) -> html -> html) 275 | -> FormBuilder e html a 276 | -> FormBuilder e html a 277 | ``` 278 | 279 | You can choose to print the error messages around an input, if you 280 | like. Otherwise you can display them in e.g. a list above. 281 | -------------------------------------------------------------------------------- /psc-package.json: -------------------------------------------------------------------------------- 1 | { 2 | "name": "halogen-form", 3 | "set": "psc-0.12.0-20180628", 4 | "source": "https://github.com/purescript/package-sets.git", 5 | "depends": [ 6 | "prelude", 7 | "halogen", 8 | "numbers" 9 | ] 10 | } 11 | -------------------------------------------------------------------------------- /src/Halogen/Form.purs: -------------------------------------------------------------------------------- 1 | -- | Form API. 2 | 3 | module Halogen.Form 4 | (FormBuilder 5 | ,Query 6 | -- * Inputs 7 | ,text 8 | ,number 9 | ,submit 10 | -- * Combinators 11 | ,required 12 | ,wrap 13 | ,parse 14 | ,(<|*>) 15 | ,applyFields 16 | -- * Halogen component 17 | ,component) 18 | where 19 | 20 | import Control.Alternative ((<|>)) 21 | import Control.Monad.State (class MonadState, State, evalState, gets, modify) 22 | import Data.Either (Either(..), either) 23 | import Data.Map (Map) 24 | import Data.Map as M 25 | import Data.Maybe (Maybe(..), fromMaybe, maybe) 26 | import Data.Number (fromString) 27 | import Halogen as H 28 | import Halogen.HTML as HH 29 | import Halogen.HTML.Events as E 30 | import Halogen.HTML.Properties as HP 31 | import Prelude (class Applicative, class Apply, class Bind, class Functor, type (~>), Unit, bind, const, discard, mempty, pure, show, unit, (+), (<$>), (<*>), (<>), (==), (>>=)) 32 | import Prim.Row (class Nub, class Union) 33 | import Record (disjointUnion) 34 | 35 | -------------------------------------------------------------------------------- 36 | -- Component 37 | 38 | -- | Halogen component for materializing a form. 39 | component :: 40 | forall error value m. 41 | H.Component 42 | HH.HTML 43 | Query 44 | (FormBuilder error (Array (H.ComponentHTML Query)) value) 45 | (Either (Array error) value) 46 | m 47 | component = H.component {initialState, render, eval, receiver: const Nothing} 48 | where 49 | initialState (FormBuilder builder) = 50 | FormState 51 | { form: evalState builder (BuilderState {counter: 0}) 52 | , inputs: mempty 53 | , submitted: NotSubmitted 54 | } 55 | render (FormState {form: Form {html}, inputs, submitted}) = 56 | HH.div_ (html submitted inputs) 57 | eval :: 58 | Query 59 | ~> H.ComponentDSL 60 | (FormState error (Array (H.ComponentHTML Query)) value) 61 | Query 62 | (Either (Array error) value) 63 | m 64 | eval (Pure a) = pure a 65 | eval (SubmitInput a) = do 66 | FormState {form: Form {value}, inputs} <- 67 | H.modify 68 | (\(FormState state) -> FormState (state {submitted = Submitted})) 69 | H.raise (value Submitted inputs) 70 | pure a 71 | eval (SetInput i str a) = do 72 | FormState {form: Form {value}, inputs} <- 73 | H.modify 74 | (\(FormState {form, inputs, submitted}) -> 75 | FormState 76 | { form 77 | , inputs: M.insert i str inputs 78 | , submitted 79 | }) 80 | pure a 81 | 82 | -------------------------------------------------------------------------------- 83 | -- Inputs 84 | 85 | -- | A text input. 86 | text :: 87 | forall e a. 88 | Maybe String 89 | -> FormBuilder e (Array (HH.HTML a (Query Unit))) (Maybe String) 90 | text def = 91 | FormBuilder 92 | (do i <- formIdent 93 | pure (Form {value: value i, html: html i})) 94 | where 95 | value i submitted inputs = 96 | pure 97 | (case M.lookup i inputs of 98 | Nothing -> def 99 | Just x -> 100 | if x == "" 101 | then Nothing 102 | else Just x) 103 | html i submitted inputs = 104 | [ HH.input 105 | [ HP.value 106 | (fromMaybe "" (joinEmptyString (M.lookup i inputs) <|> def)) 107 | , HP.type_ HP.InputText 108 | , E.onValueChange (E.input (SetInput i)) 109 | ] 110 | ] 111 | 112 | -- | A number input. 113 | number :: 114 | forall e a. 115 | Maybe Number 116 | -> FormBuilder e (Array (HH.HTML a (Query Unit))) (Maybe Number) 117 | number def = 118 | FormBuilder 119 | (do i <- formIdent 120 | pure (Form {value: value i, html: html i})) 121 | where 122 | value i submitted inputs = 123 | pure (case M.lookup i inputs of 124 | Nothing -> def 125 | Just x -> 126 | if x == "" 127 | then Nothing 128 | else fromString x) 129 | html i submitted inputs = 130 | [ HH.input 131 | [ HP.value 132 | (maybe 133 | "" 134 | show 135 | ((joinEmptyString (M.lookup i inputs) >>= fromString) <|> def)) 136 | , HP.type_ HP.InputNumber 137 | , E.onValueChange (E.input (SetInput i)) 138 | ] 139 | ] 140 | 141 | -------------------------------------------------------------------------------- 142 | -- Buttons 143 | 144 | submit :: forall h e. String -> FormBuilder e (Array (HH.HTML h (Query Unit))) Unit 145 | submit label = 146 | FormBuilder 147 | (do i <- formIdent 148 | pure (Form {value, html})) 149 | where 150 | value _s _i = Right unit 151 | html _s _i = 152 | [ HH.input 153 | [ HP.value label 154 | , HP.type_ HP.InputSubmit 155 | , E.onClick (E.input_ SubmitInput) 156 | ] 157 | ] 158 | 159 | -------------------------------------------------------------------------------- 160 | -- Combinators 161 | 162 | -- | Parse the input from a form. 163 | parse :: 164 | forall a b h e. 165 | (a -> Either (Array e) b) 166 | -> FormBuilder e h a 167 | -> FormBuilder e h b 168 | parse parser (FormBuilder formBuilder) = 169 | FormBuilder 170 | (do Form {html, value} <- formBuilder 171 | pure 172 | (Form 173 | { html 174 | , value: 175 | \submitted inputs -> 176 | case value submitted inputs of 177 | Right a -> parser a 178 | Left e -> Left e 179 | })) 180 | 181 | -- | Wrap around a form. 182 | wrap :: 183 | forall e a html. 184 | (Maybe (Array e) -> html -> html) 185 | -> FormBuilder e html a 186 | -> FormBuilder e html a 187 | wrap f (FormBuilder formBuilder) = 188 | FormBuilder 189 | (do Form {html: origHtml, value} <- formBuilder 190 | let html submitted i = 191 | f 192 | (case submitted of 193 | Submitted -> either Just (const Nothing) (value submitted i) 194 | NotSubmitted -> Nothing) 195 | (origHtml submitted i) 196 | pure (Form {html, value})) 197 | 198 | -- | Make a normally optional field required. 199 | required :: 200 | forall e r a html. 201 | {missing :: e | r} 202 | -> FormBuilder e html (Maybe a) 203 | -> FormBuilder e html a 204 | required es = 205 | parse 206 | (\mi -> 207 | case mi of 208 | Nothing -> Left [es . missing] 209 | Just r -> Right r) 210 | 211 | -- | Applicative-like combinator for combining fields. 212 | applyFields 213 | :: forall f inner outer combined. 214 | Union inner outer combined 215 | => Nub combined combined 216 | => Apply f 217 | => f { | inner } 218 | -> f { | outer } 219 | -> f { | combined } 220 | applyFields getInner getOuter = 221 | disjointUnion <$> getInner <*> getOuter 222 | 223 | infixl 5 applyFields as <|*> 224 | 225 | -------------------------------------------------------------------------------- 226 | -- Internal API 227 | 228 | -- | Generator an identifier for a form input. 229 | formIdent :: forall m. Bind m => MonadState BuilderState m => m Int 230 | formIdent = do 231 | _ <- modify (\(BuilderState s) -> BuilderState (s {counter = s . counter + 1})) 232 | gets (\(BuilderState s) -> s . counter) 233 | 234 | -- | Build a unique form. 235 | newtype FormBuilder error html value = 236 | FormBuilder (State BuilderState (Form error html value)) 237 | derive instance functorBuilder :: Functor (FormBuilder error html) 238 | 239 | instance pureForm :: Applicative (FormBuilder e (Array h)) where 240 | pure a = 241 | FormBuilder 242 | (pure (Form {value: const (const (Right a)), html: const (const [])})) 243 | 244 | instance applyForm :: Apply (FormBuilder e (Array h)) where 245 | apply (FormBuilder getF) (FormBuilder getX) = 246 | FormBuilder 247 | (do Form {value: fValue, html: yHtml} <- getF 248 | Form {value: xValue, html: xHtml} <- getX 249 | let html i = yHtml i <> xHtml i 250 | value submitted i = do 251 | case fValue submitted i of 252 | Right f -> 253 | case xValue submitted i of 254 | Right x -> pure (f x) 255 | Left e -> Left e 256 | Left e -> 257 | case xValue submitted i of 258 | Left e' -> Left (e <> e') 259 | Right _ -> Left e 260 | pure (Form {html, value})) 261 | 262 | -- | State for building forms. 263 | data BuilderState = BuilderState 264 | { counter :: Int 265 | } 266 | 267 | -- | Form was submitted. 268 | data Submitted 269 | = Submitted 270 | | NotSubmitted 271 | 272 | -- | A form itself. 273 | data Form error html value = Form 274 | { value :: Submitted -> Map Int String -> Either (Array error) value 275 | , html :: Submitted -> Map Int String -> html 276 | } 277 | derive instance functorForm :: Functor (Form error html) 278 | 279 | -- | Internal query type. 280 | data Query a 281 | = Pure a 282 | | SubmitInput a 283 | | SetInput Int 284 | String 285 | a 286 | 287 | -- | State for the component. 288 | data FormState error html value = FormState 289 | { form :: Form error html value 290 | , inputs :: Map Int String 291 | , submitted :: Submitted 292 | } 293 | 294 | -- | Empty string results in a Nothing. 295 | joinEmptyString :: Maybe String -> Maybe String 296 | joinEmptyString mstr = do 297 | i <- mstr 298 | if i == "" 299 | then Nothing 300 | else Just i 301 | --------------------------------------------------------------------------------