ditto-lucid 0.1.1.2 → 0.1.2.0

raw patch · 3 files changed

+203/−238 lines, 3 filesdep ~dittoPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependency ranges changed: ditto

API changes (from Hackage documentation)

Files

• ditto-lucid.cabal +2/−2
• src/Ditto/Lucid/Named.hs +108/−127
• src/Ditto/Lucid/Unnamed.hs +93/−109

@@ -1,5 +1,5 @@ Name:                ditto-lucid-Version:             0.1.1.2+Version:             0.1.2.0 Synopsis:            Add support for using lucid with Ditto Description:         Ditto is a library for building and validating forms using applicative functors. This package add support for using ditto with lucid. License:             BSD3@@ -24,7 +24,7 @@   build-depends:       base >4.5 && <5     , lucid < 3.0.0-    , ditto >= 0.1.1.0 && <= 0.2+    , ditto >= 0.1.2.0 && <= 0.2     , text >= 0.11 && < 1.3     , path-pieces   hs-source-dirs: src

@@ -4,7 +4,7 @@  module Ditto.Lucid.Named where -import Data.Foldable (traverse_)+import Data.Foldable (traverse_, fold) import Data.Monoid ((<>), mconcat, mempty) import Data.Text (Text) import Ditto.Backend@@ -17,15 +17,18 @@ import qualified Data.Text as T import qualified Text.Read +foldTraverse_ :: (Foldable t, Applicative f, Monoid (f b)) => (a -> t (f b)) -> t a -> f ()+foldTraverse_ f = traverse_ (fold . f)+ inputText   :: (Monad m, FormError err, PathPiece text, Applicative f)   => (input -> Either err text)   -> String   -> text   -> Form m input err (HtmlT f ()) text-inputText getInput name initialValue = G.input getInput inputField initialValue name+inputText getInput name initialValue = G.input name getInput inputField initialValue   where-    inputField i a = input_ [type_ "text", id_ (toPathPiece i), name_ (toPathPiece i), value_ (toPathPiece a)]+  inputField i a = input_ [type_ "text", id_ (toPathPiece i), name_ (toPathPiece i), value_ (toPathPiece a)]  inputPassword   :: (Monad m, FormError err, PathPiece text, Applicative f)@@ -33,9 +36,9 @@   -> String   -> text   -> Form m input err (HtmlT f ()) text-inputPassword getInput name initialValue = G.input getInput inputField initialValue name+inputPassword getInput name initialValue = G.input name getInput inputField initialValue   where-    inputField i a = input_ [type_ "password", id_ (toPathPiece i), name_ (toPathPiece i), value_ (toPathPiece a)]+  inputField i a = input_ [type_ "password", id_ (toPathPiece i), name_ (toPathPiece i), value_ (toPathPiece a)]  inputSubmit   :: (Monad m, FormError err, PathPiece text, Applicative f)@@ -43,18 +46,18 @@   -> String   -> text   -> Form m input err (HtmlT f ()) (Maybe text)-inputSubmit getInput name initialValue = G.inputMaybe getInput inputField initialValue name+inputSubmit getInput name initialValue = G.inputMaybe name getInput inputField initialValue   where-    inputField i a = input_ [type_ "submit", id_ (toPathPiece i), name_ (toPathPiece i), value_ (toPathPiece a)]+  inputField i a = input_ [type_ "submit", id_ (toPathPiece i), name_ (toPathPiece i), value_ (toPathPiece a)]  inputReset   :: (Monad m, FormError err, PathPiece text, Applicative f)   => String   -> text   -> Form m input err (HtmlT f ()) ()-inputReset name lbl = G.inputNoData inputField lbl name+inputReset name lbl = G.inputNoData name inputField lbl   where-    inputField i a = input_ [type_ "submit", id_ (toPathPiece i), name_ (toPathPiece i), value_ (toPathPiece a)]+  inputField i a = input_ [type_ "submit", id_ (toPathPiece i), name_ (toPathPiece i), value_ (toPathPiece a)]  inputHidden   :: (Monad m, FormError err, PathPiece text, Applicative f)@@ -62,18 +65,18 @@   -> String   -> text   -> Form m input err (HtmlT f ()) text-inputHidden getInput name initialValue = G.input getInput inputField initialValue name+inputHidden getInput name initialValue = G.input name getInput inputField initialValue   where-    inputField i a = input_ [type_ "hidden", id_ (toPathPiece i), name_ (toPathPiece i), value_ (toPathPiece a)]+  inputField i a = input_ [type_ "hidden", id_ (toPathPiece i), name_ (toPathPiece i), value_ (toPathPiece a)]  inputButton   :: (Monad m, FormError err, PathPiece text, Applicative f)   => String   -> text   -> Form m input err (HtmlT f ()) ()-inputButton name label = G.inputNoData inputField label name+inputButton name label = G.inputNoData name inputField label   where-    inputField i a = input_ [type_ "button", id_ (toPathPiece i), name_ (toPathPiece i), value_ (toPathPiece a)]+  inputField i a = input_ [type_ "button", id_ (toPathPiece i), name_ (toPathPiece i), value_ (toPathPiece a)]  textarea   :: (Monad m, FormError err, ToHtml text, Monad f)@@ -83,16 +86,16 @@   -> String   -> text -- ^ initial text   -> Form m input err (HtmlT f ()) text-textarea getInput cols rows name initialValue = G.input getInput textareaView initialValue name+textarea getInput cols rows name initialValue = G.input name getInput textareaView initialValue   where-    textareaView i txt =-      textarea_-        [ rows_ (toPathPiece rows)-        , cols_ (toPathPiece cols)-        , id_ (toPathPiece i)-        , name_ (toPathPiece i)-        ] $-        toHtml txt+  textareaView i txt =+    textarea_+      [ rows_ (toPathPiece rows)+      , cols_ (toPathPiece cols)+      , id_ (toPathPiece i)+      , name_ (toPathPiece i)+      ] $+      toHtml txt  -- | Create an @\<input type=\"file\"\>@ element --@@ -101,9 +104,9 @@   :: (Monad m, FormError err, FormInput input, ErrorInputType err ~ input, Applicative f)   => String   -> Form m input err (HtmlT f ()) (FileType input)-inputFile name = G.inputFile fileView name+inputFile name = G.inputFile name fileView   where-    fileView i = input_ [type_ "file", id_ (toPathPiece i), name_ (toPathPiece i)]+  fileView i = input_ [type_ "file", id_ (toPathPiece i), name_ (toPathPiece i)]  -- | Create a @\<button type=\"submit\"\>@ element buttonSubmit@@ -113,9 +116,9 @@   -> text   -> children   -> Form m input err (HtmlT f ()) (Maybe text)-buttonSubmit getInput name text c = G.inputMaybe getInput inputField text name+buttonSubmit getInput name text c = G.inputMaybe name getInput inputField text   where-    inputField i a = button_ [type_ "submit", id_ (toPathPiece i), name_ (toPathPiece i), value_ (toPathPiece a)] $ toHtml c+  inputField i a = button_ [type_ "submit", id_ (toPathPiece i), name_ (toPathPiece i), value_ (toPathPiece a)] $ toHtml c  -- | create a  @\<button type=\"reset\"\>\<\/button\>@ element --@@ -125,9 +128,9 @@   => String   -> HtmlT f ()   -> Form m input err (HtmlT f ()) ()-buttonReset name c = G.inputNoData inputField Nothing name+buttonReset name c = G.inputNoData name inputField Nothing   where-    inputField i a = button_ [type_ "reset", id_ (toPathPiece i), name_ (toPathPiece i)] c+  inputField i a = button_ [type_ "reset", id_ (toPathPiece i), name_ (toPathPiece i)] c  -- | create a  @\<button type=\"button\"\>\<\/button\>@ element --@@ -137,9 +140,9 @@   => String   -> HtmlT f ()   -> Form m input err (HtmlT f ()) ()-button name c = G.inputNoData inputField Nothing name+button name c = G.inputNoData name inputField Nothing   where-    inputField i a = button_ [type_ "button", id_ (toPathPiece i), name_ (toPathPiece i)] c+  inputField i a = button_ [type_ "button", id_ (toPathPiece i), name_ (toPathPiece i)] c  -- | create a @\<label\>@ element. --@@ -151,7 +154,7 @@   => HtmlT f ()   -> String   -> Form m input err (HtmlT f ()) ()-label c name = G.label mkLabel name+label c name = G.label name mkLabel   where     mkLabel i = label_ [for_ (toPathPiece i)] c @@ -164,15 +167,15 @@   -> String   -> Int   -> Form m input err (HtmlT f ()) Int-inputInt getInput name initialValue = G.input getInput inputField initialValue name+inputInt getInput name initialValue = G.input name getInput inputField initialValue   where-    inputField i a =-      input_-        [ type_ "number"-        , id_ (toPathPiece i)-        , name_ (toPathPiece i)-        , value_ (toPathPiece a)-        ]+  inputField i a =+    input_+      [ type_ "number"+      , id_ (toPathPiece i)+      , name_ (toPathPiece i)+      , value_ (toPathPiece a)+      ]  inputDouble   :: (Monad m, FormError err, Applicative f)@@ -180,9 +183,9 @@   -> String   -> Double   -> Form m input err (HtmlT f ()) Double-inputDouble getInput name initialValue = G.input getInput inputField initialValue name+inputDouble getInput name initialValue = G.input name getInput inputField initialValue   where-    inputField i a = input_ [type_ "number", step_ "any", id_ (toPathPiece i), name_ (toPathPiece i), value_ (T.pack $ show a)]+  inputField i a = input_ [type_ "number", step_ "any", id_ (toPathPiece i), name_ (toPathPiece i), value_ (T.pack $ show a)]  -- | Create a single @\<input type=\"checkbox\"\>@ element --@@ -192,7 +195,7 @@ inputCheckbox   :: forall x err input m f. (Monad m, FormError err, ErrorInputType err ~ input, Applicative f)   => Bool -- ^ initially checked-  -> String -- ^ name+  -> String -- ^   -> Form m input err (HtmlT f ()) Bool inputCheckbox initiallyChecked name =   Form $ do@@ -203,21 +206,21 @@       Missing -> mkCheckbox i False -- checkboxes only appear in the submitted data when checked       Found _ -> mkCheckbox i True   where-    mkCheckbox i checked =-      let checkbox =-            input_ $-              (if checked then (:) checked_ else id)-                [type_ "checkbox", id_ (toPathPiece i), name_ (toPathPiece i), value_ (toPathPiece i)]-       in pure-            ( View $ const $ checkbox-            , pure $-              Ok-                ( Proved-                  { pos = unitRange i-                  , unProved = if checked then True else False-                  }-                )-            )+  mkCheckbox i checked =+    let checkbox =+          input_ $+            (if checked then (:) checked_ else id)+              [type_ "checkbox", id_ (toPathPiece i), name_ (toPathPiece i), value_ (toPathPiece i)]+     in pure+          ( View $ const $ checkbox+          , pure $+            Ok+              ( Proved+                { pos = unitRange i+                , unProved = if checked then True else False+                }+              )+          )  -- | Create a group of @\<input type=\"checkbox\"\>@ elements --@@ -227,101 +230,79 @@   -> [(a, lbl)] -- ^ value, label, initially checked   -> (a -> Bool) -- ^ function which indicates if a value should be checked initially   -> Form m input err (HtmlT f ()) [a]-inputCheckboxes name choices isChecked = G.inputMulti choices mkCheckboxes isChecked name+inputCheckboxes name choices isChecked = G.inputMulti name choices mkCheckboxes isChecked   where-    mkCheckboxes nm choices' = mconcat $ concatMap (mkCheckbox nm) choices'-    mkCheckbox nm (i, val, lbl, checked) =-      [ input_ $-          ( (if checked then (checked_ :) else id)-            [type_ "checkbox", id_ (toPathPiece i), name_ (toPathPiece nm), value_ (toPathPiece val)]-          )-      , label_ [for_ (toPathPiece i)] $ toHtml lbl-      ]+  mkCheckboxes nm choices' = foldTraverse_ (mkCheckbox nm) choices'+  mkCheckbox nm (i, val, lbl, checked) =+    [ input_ $+        ( (if checked then (checked_ :) else id)+          [type_ "checkbox", id_ (toPathPiece i), name_ (toPathPiece nm), value_ (toPathPiece val)]+        )+    , label_ [for_ (toPathPiece i)] $ toHtml lbl+    ]  -- | Create a group of @\<input type=\"radio\"\>@ elements inputRadio-  :: (Functor m, Monad m, FormError err, ErrorInputType err ~ input, FormInput input, ToHtml lbl, Monad f)+  :: (Functor m, Monad m, FormError err, ErrorInputType err ~ input, FormInput input, Monad f)   => String-  -> [(a, lbl)] -- ^ value, label, initially checked+  -> [(a, Html ())] -- ^ value, label, initially checked   -> (a -> Bool) -- ^ isDefault   -> Form m input err (HtmlT f ()) a inputRadio name choices isDefault =-  G.inputChoice isDefault choices mkRadios name+  G.inputChoice name isDefault choices mkRadios   where-    mkRadios nm choices' = mconcat $ concatMap (mkRadio nm) choices'-    mkRadio nm (i, val, lbl, checked) =-      [ input_ $-          (if checked then (checked_ :) else id)-            [type_ "radio", id_ (toPathPiece i), name_ (toPathPiece nm), value_ (toPathPiece val)]-      , label_ [for_ (toPathPiece i)] $ toHtml lbl-      , br_ []-      ]+  mkRadios nm choices' = foldTraverse_ (mkRadio nm) choices'+  mkRadio nm (i, val, lbl, checked) =+    [ input_ $+        (if checked then (checked_ :) else id)+          [type_ "radio", id_ (toPathPiece i), name_ (toPathPiece nm), value_ (toPathPiece val)]+    , label_ [for_ (toPathPiece i)] $ toHtml lbl+    , br_ []+    ]  -- | create @\<select\>\<\/select\>@ element plus its @\<option\>\<\/option\>@ children. -- -- see also: 'selectMultiple' select-  :: (Functor m, Monad m, FormError err, ErrorInputType err ~ input, FormInput input, ToHtml lbl, Monad f)+  :: (Functor m, Monad m, FormError err, ErrorInputType err ~ input, FormInput input, Monad f)   => String-  -> [(a, lbl)] -- ^ value, label+  -> [(a, Html ())] -- ^ value, label   -> (a -> Bool) -- ^ isDefault, must match *exactly one* element in the list of choices   -> Form m input err (HtmlT f ()) a-select name choices isDefault = G.inputChoice isDefault choices mkSelect name+select name choices isDefault = G.inputChoice name isDefault choices mkSelect   where-    mkSelect :: (ToHtml lbl, Monad f) => FormId -> [(a, Int, lbl, Bool)] -> HtmlT f ()-    mkSelect nm choices' =-      select_ [name_ (toPathPiece nm)] $-        traverse_ mkOption choices'-    mkOption :: (ToHtml lbl, Monad f) => (a, Int, lbl, Bool) -> HtmlT f ()-    mkOption (_, val, lbl, selected) =-      option_-        ( (if selected then ((:) (selected_ "selected")) else id)-          [value_ (toPathPiece val)]-        )-        (toHtml lbl)+  mkSelect :: (ToHtml lbl, Monad f) => FormId -> [(a, Int, lbl, Bool)] -> HtmlT f ()+  mkSelect nm choices' =+    select_ [name_ (toPathPiece nm)] $+      traverse_ mkOption choices'+  mkOption :: (ToHtml lbl, Monad f) => (a, Int, lbl, Bool) -> HtmlT f ()+  mkOption (_, val, lbl, selected) =+    option_+      ( (if selected then ((:) (selected_ "selected")) else id)+        [value_ (toPathPiece val)]+      )+      (toHtml lbl)  -- | create @\<select multiple=\"multiple\"\>\<\/select\>@ element plus its @\<option\>\<\/option\>@ children. -- -- This creates a @\<select\>@ element which allows more than one item to be selected. selectMultiple-  :: (Functor m, Monad m, FormError err, ErrorInputType err ~ input, FormInput input, ToHtml lbl, Monad f)+  :: (Functor m, Monad m, FormError err, ErrorInputType err ~ input, FormInput input, Monad f)   => String-  -> [(a, lbl)] -- ^ value, label, initially checked+  -> [(a, Html ())] -- ^ value, label, initially checked   -> (a -> Bool) -- ^ isSelected initially   -> Form m input err (HtmlT f ()) [a]-selectMultiple name choices isSelected = G.inputMulti choices mkSelect isSelected name+selectMultiple name choices isSelected = G.inputMulti name choices mkSelect isSelected   where-    mkSelect :: (ToHtml lbl, Monad f) => FormId -> [(a, Int, lbl, Bool)] -> HtmlT f ()-    mkSelect nm choices' =-      select_ [name_ (toPathPiece nm), multiple_ "multiple"] $-        traverse_ mkOption choices'-    mkOption :: (ToHtml lbl, Monad f) => (a, Int, lbl, Bool) -> HtmlT f ()-    mkOption (_, val, lbl, selected) =-      option_-        ( (if selected then ((:) (selected_ "selected")) else id)-          [value_ (toPathPiece val)]-        )-        (toHtml lbl)--{--inputMultiSelectOptGroup :: (Functor m, XMLGenerator x, EmbedAsChild x groupLbl, EmbedAsChild x lbl, EmbedAsAttr x (Attr String FormId), FormError err, ErrorInputType err ~ input, FormInput input, Monad m, Applicative f) =>-                   [(groupLbl, [(a, lbl, Bool)])]  -- ^ value, label, initially checked-                -> Form m input err (HtmlT f ()) [a]-inputMultiSelectOptGroup choices =-    G.inputMulti choices mkSelect-    where-      mkSelect nm choices' =-          [<select name=nm multiple="multiple">-            <% mapM mkOptGroup choices' %>-           </select>-          ]-      mkOptGroup (grpLabel, options) =-          <optgroup label=grpLabel>-           <% mapM mkOption options %>-          </optgroup>-      mkOption (_, val, lbl, selected) =-          <option value=val (if selected then ["selected" := "selected"] else [])>-           <% lbl %>-          </option>--}+  mkSelect :: (ToHtml lbl, Monad f) => FormId -> [(a, Int, lbl, Bool)] -> HtmlT f ()+  mkSelect nm choices' =+    select_ [name_ (toPathPiece nm), multiple_ "multiple"] $+      traverse_ mkOption choices'+  mkOption :: (ToHtml lbl, Monad f) => (a, Int, lbl, Bool) -> HtmlT f ()+  mkOption (_, val, lbl, selected) =+    option_+      ( (if selected then ((:) (selected_ "selected")) else id)+        [value_ (toPathPiece val)]+      )+      (toHtml lbl) 

@@ -4,7 +4,7 @@  module Ditto.Lucid.Unnamed where -import Data.Foldable (traverse_)+import Data.Foldable (traverse_, fold) import Data.Monoid ((<>), mconcat, mempty) import Data.Text (Text) import Ditto.Backend@@ -17,6 +17,9 @@ import qualified Data.Text as T import qualified Text.Read +foldTraverse_ :: (Foldable t, Applicative f, Monoid (f b)) => (a -> t (f b)) -> t a -> f ()+foldTraverse_ f = traverse_ (fold . f)+ inputText   :: (Monad m, FormError error, PathPiece text, Applicative f)   => (input -> Either error text)@@ -33,7 +36,7 @@   -> Form m input error (HtmlT f ()) text inputPassword getInput initialValue = G.input getInput inputField initialValue   where-    inputField i a = input_ [type_ "password", id_ (toPathPiece i), name_ (toPathPiece i), value_ (toPathPiece a)]+  inputField i a = input_ [type_ "password", id_ (toPathPiece i), name_ (toPathPiece i), value_ (toPathPiece a)]  inputSubmit   :: (Monad m, FormError error, PathPiece text, Applicative f)@@ -42,7 +45,7 @@   -> Form m input error (HtmlT f ()) (Maybe text) inputSubmit getInput initialValue = G.inputMaybe getInput inputField initialValue   where-    inputField i a = input_ [type_ "submit", id_ (toPathPiece i), name_ (toPathPiece i), value_ (toPathPiece a)]+  inputField i a = input_ [type_ "submit", id_ (toPathPiece i), name_ (toPathPiece i), value_ (toPathPiece a)]  inputReset   :: (Monad m, FormError error, PathPiece text, Applicative f)@@ -50,7 +53,7 @@   -> Form m input error (HtmlT f ()) () inputReset lbl = G.inputNoData inputField lbl   where-    inputField i a = input_ [type_ "submit", id_ (toPathPiece i), name_ (toPathPiece i), value_ (toPathPiece a)]+  inputField i a = input_ [type_ "submit", id_ (toPathPiece i), name_ (toPathPiece i), value_ (toPathPiece a)]  inputHidden   :: (Monad m, FormError error, PathPiece text, Applicative f)@@ -59,7 +62,7 @@   -> Form m input error (HtmlT f ()) text inputHidden getInput initialValue = G.input getInput inputField initialValue   where-    inputField i a = input_ [type_ "hidden", id_ (toPathPiece i), name_ (toPathPiece i), value_ (toPathPiece a)]+  inputField i a = input_ [type_ "hidden", id_ (toPathPiece i), name_ (toPathPiece i), value_ (toPathPiece a)]  inputButton   :: (Monad m, FormError error, PathPiece text, Applicative f)@@ -67,7 +70,7 @@   -> Form m input error (HtmlT f ()) () inputButton label = G.inputNoData inputField label   where-    inputField i a = input_ [type_ "button", id_ (toPathPiece i), name_ (toPathPiece i), value_ (toPathPiece a)]+  inputField i a = input_ [type_ "button", id_ (toPathPiece i), name_ (toPathPiece i), value_ (toPathPiece a)]  textarea   :: (Monad m, FormError error, ToHtml text, Monad f)@@ -78,14 +81,14 @@   -> Form m input error (HtmlT f ()) text textarea getInput cols rows initialValue = G.input getInput textareaView initialValue   where-    textareaView i txt =-      textarea_-        [ rows_ (toPathPiece rows)-        , cols_ (toPathPiece cols)-        , id_ (toPathPiece i)-        , name_ (toPathPiece i)-        ] $-        toHtml txt+  textareaView i txt =+    textarea_+      [ rows_ (toPathPiece rows)+      , cols_ (toPathPiece cols)+      , id_ (toPathPiece i)+      , name_ (toPathPiece i)+      ] $+      toHtml txt  -- | Create an @\<input type=\"file\"\>@ element --@@ -95,7 +98,7 @@   => Form m input error (HtmlT f ()) (FileType input) inputFile = G.inputFile fileView   where-    fileView i = input_ [type_ "file", id_ (toPathPiece i), name_ (toPathPiece i)]+  fileView i = input_ [type_ "file", id_ (toPathPiece i), name_ (toPathPiece i)]  -- | Create a @\<button type=\"submit\"\>@ element buttonSubmit@@ -106,7 +109,7 @@   -> Form m input error (HtmlT f ()) (Maybe text) buttonSubmit getInput text c = G.inputMaybe getInput inputField text   where-    inputField i a = button_ [type_ "submit", id_ (toPathPiece i), name_ (toPathPiece i), value_ (toPathPiece a)] $ toHtml c+  inputField i a = button_ [type_ "submit", id_ (toPathPiece i), name_ (toPathPiece i), value_ (toPathPiece a)] $ toHtml c  -- | create a  @\<button type=\"reset\"\>\<\/button\>@ element --@@ -117,7 +120,7 @@   -> Form m input error (HtmlT f ()) () buttonReset c = G.inputNoData inputField Nothing   where-    inputField i a = button_ [type_ "reset", id_ (toPathPiece i), name_ (toPathPiece i)] $ toHtml c+  inputField i a = button_ [type_ "reset", id_ (toPathPiece i), name_ (toPathPiece i)] $ toHtml c  -- | create a  @\<button type=\"button\"\>\<\/button\>@ element --@@ -128,7 +131,7 @@   -> Form m input error (HtmlT f ()) () button c = G.inputNoData inputField Nothing   where-    inputField i a = button_ [type_ "button", id_ (toPathPiece i), name_ (toPathPiece i)] $ toHtml c+  inputField i a = button_ [type_ "button", id_ (toPathPiece i), name_ (toPathPiece i)] $ toHtml c  -- | create a @\<label\>@ element. --@@ -141,7 +144,7 @@   -> Form m input error (HtmlT f ()) () label c = G.label mkLabel   where-    mkLabel i = label_ [for_ (toPathPiece i)] c+  mkLabel i = label_ [for_ (toPathPiece i)] c  arbitraryHtml :: Monad m => view -> Form m input error view () arbitraryHtml wrap =@@ -164,13 +167,13 @@   -> Form m input err (HtmlT f ()) Int inputInt getInput initialValue = G.input getInput inputField initialValue   where-    inputField i a =-      input_-        [ type_ "number"-        , id_ (toPathPiece i)-        , name_ (toPathPiece i)-        , value_ (toPathPiece a)-        ]+  inputField i a =+    input_+      [ type_ "number"+      , id_ (toPathPiece i)+      , name_ (toPathPiece i)+      , value_ (toPathPiece a)+      ]  inputDouble   :: (Monad m, FormError err, Applicative f)@@ -179,7 +182,7 @@   -> Form m input err (HtmlT f ()) Double inputDouble getInput initialValue = G.input getInput inputField initialValue   where-    inputField i a = input_ [type_ "number", step_ "any", id_ (toPathPiece i), name_ (toPathPiece i), value_ (T.pack $ show a)]+  inputField i a = input_ [type_ "number", step_ "any", id_ (toPathPiece i), name_ (toPathPiece i), value_ (T.pack $ show a)]  -- | Create a single @\<input type=\"checkbox\"\>@ element --@@ -199,123 +202,104 @@       Missing -> mkCheckbox i False -- checkboxes only appear in the submitted data when checked       Found input -> mkCheckbox i True   where-    mkCheckbox i checked =-      let checkbox =-            input_ $-              (if checked then (:) checked_ else id)-                [type_ "checkbox", id_ (toPathPiece i), name_ (toPathPiece i), value_ (toPathPiece i)]-       in pure-            ( View $ const $ checkbox-            , pure $-              Ok-                ( Proved-                  { pos = unitRange i-                  , unProved = if checked then True else False-                  }-                )-            )+  mkCheckbox i checked =+    let checkbox =+          input_ $+            (if checked then (:) checked_ else id)+              [type_ "checkbox", id_ (toPathPiece i), name_ (toPathPiece i), value_ (toPathPiece i)]+     in pure+          ( View $ const $ checkbox+          , pure $+            Ok+              ( Proved+                { pos = unitRange i+                , unProved = if checked then True else False+                }+              )+          )  -- | Create a group of @\<input type=\"checkbox\"\>@ elements -- inputCheckboxes-  :: (Functor m, Monad m, FormError error, ErrorInputType error ~ input, FormInput input, ToHtml lbl, Monad f)-  => [(a, lbl)] -- ^ value, label, initially checked+  :: (Functor m, Monad m, FormError error, ErrorInputType error ~ input, FormInput input, Monad f)+  => [(a, Html ())] -- ^ value, label, initially checked   -> (a -> Bool) -- ^ function which indicates if a value should be checked initially   -> Form m input error (HtmlT f ()) [a] inputCheckboxes choices isChecked =   G.inputMulti choices mkCheckboxes isChecked   where-    mkCheckboxes nm choices' = mconcat $ concatMap (mkCheckbox nm) choices'-    mkCheckbox nm (i, val, lbl, checked) =-      [ input_ $-          ( (if checked then (checked_ :) else id)-            [type_ "checkbox", id_ (toPathPiece i), name_ (toPathPiece nm), value_ (toPathPiece val)]-          )-      , label_ [for_ (toPathPiece i)] $ toHtml lbl-      ]+  mkCheckboxes :: Monad f => FormId -> [(FormId, Int, Html (), Bool)] -> HtmlT f ()+  mkCheckboxes nm choices' = foldTraverse_ (mkCheckbox nm) choices'+  mkCheckbox nm (i, val, lbl, checked) =+    [ input_ $+        ( (if checked then (checked_ :) else id)+          [type_ "checkbox", id_ (toPathPiece i), name_ (toPathPiece nm), value_ (toPathPiece val)]+        )+    , label_ [for_ (toPathPiece i)] $ toHtml lbl+    ]  -- | Create a group of @\<input type=\"radio\"\>@ elements inputRadio-  :: (Functor m, Monad m, FormError error, ErrorInputType error ~ input, FormInput input, ToHtml lbl, Monad f)-  => [(a, lbl)] -- ^ value, label, initially checked+  :: (Functor m, Monad m, FormError error, ErrorInputType error ~ input, FormInput input, Monad f)+  => [(a, Html ())] -- ^ value, label, initially checked   -> (a -> Bool) -- ^ isDefault   -> Form m input error (HtmlT f ()) a inputRadio choices isDefault =   G.inputChoice isDefault choices mkRadios   where-    mkRadios nm choices' = mconcat $ concatMap (mkRadio nm) choices'-    mkRadio nm (i, val, lbl, checked) =-      [ input_ $-          (if checked then (checked_ :) else id)-            [type_ "radio", id_ (toPathPiece i), name_ (toPathPiece nm), value_ (toPathPiece val)]-      , label_ [for_ (toPathPiece i)] $ toHtml lbl-      , br_ []-      ]+  mkRadios nm choices' = foldTraverse_ (mkRadio nm) choices'+  mkRadio nm (i, val, lbl, checked) =+    [ input_ $+        (if checked then (checked_ :) else id)+          [type_ "radio", id_ (toPathPiece i), name_ (toPathPiece nm), value_ (toPathPiece val)]+    , label_ [for_ (toPathPiece i)] $ toHtml lbl+    , br_ []+    ]  -- | create @\<select\>\<\/select\>@ element plus its @\<option\>\<\/option\>@ children. -- -- see also: 'selectMultiple' select-  :: (Functor m, Monad m, FormError error, ErrorInputType error ~ input, FormInput input, ToHtml lbl, Monad f)-  => [(a, lbl)] -- ^ value, label+  :: (Functor m, Monad m, FormError error, ErrorInputType error ~ input, FormInput input, Monad f)+  => [(a, Html ())] -- ^ value, label   -> (a -> Bool) -- ^ isDefault, must match *exactly one* element in the list of choices   -> Form m input error (HtmlT f ()) a select choices isDefault =   G.inputChoice isDefault choices mkSelect   where-    mkSelect :: (ToHtml lbl, Monad f) => FormId -> [(a, Int, lbl, Bool)] -> HtmlT f ()-    mkSelect nm choices' =-      select_ [name_ (toPathPiece nm)] $-        traverse_ mkOption choices'-    mkOption :: (ToHtml lbl, Monad f) => (a, Int, lbl, Bool) -> HtmlT f ()-    mkOption (_, val, lbl, selected) =-      option_-        ( (if selected then ((:) (selected_ "selected")) else id)-          [value_ (toPathPiece val)]-        )-        (toHtml lbl)+  mkSelect :: (ToHtml lbl, Monad f) => FormId -> [(a, Int, lbl, Bool)] -> HtmlT f ()+  mkSelect nm choices' =+    select_ [name_ (toPathPiece nm)] $+      traverse_ mkOption choices'+  mkOption :: (ToHtml lbl, Monad f) => (a, Int, lbl, Bool) -> HtmlT f ()+  mkOption (_, val, lbl, selected) =+    option_+      ( (if selected then ((:) (selected_ "selected")) else id)+        [value_ (toPathPiece val)]+      )+      (toHtml lbl)  -- | create @\<select multiple=\"multiple\"\>\<\/select\>@ element plus its @\<option\>\<\/option\>@ children. -- -- This creates a @\<select\>@ element which allows more than one item to be selected. selectMultiple-  :: (Functor m, Monad m, FormError error, ErrorInputType error ~ input, FormInput input, ToHtml lbl, Monad f)-  => [(a, lbl)] -- ^ value, label, initially checked+  :: (Functor m, Monad m, FormError error, ErrorInputType error ~ input, FormInput input, Monad f)+  => [(a, Html ())] -- ^ value, label, initially checked   -> (a -> Bool) -- ^ isSelected initially   -> Form m input error (HtmlT f ()) [a] selectMultiple choices isSelected =   G.inputMulti choices mkSelect isSelected   where-    mkSelect :: (ToHtml lbl, Monad f) => FormId -> [(a, Int, lbl, Bool)] -> HtmlT f ()-    mkSelect nm choices' =-      select_ [name_ (toPathPiece nm), multiple_ "multiple"] $-        traverse_ mkOption choices'-    mkOption :: (ToHtml lbl, Monad f) => (a, Int, lbl, Bool) -> HtmlT f ()-    mkOption (_, val, lbl, selected) =-      option_-        ( (if selected then ((:) (selected_ "selected")) else id)-          [value_ (toPathPiece val)]-        )-        (toHtml lbl)+  mkSelect :: (ToHtml lbl, Monad f) => FormId -> [(a, Int, lbl, Bool)] -> HtmlT f ()+  mkSelect nm choices' =+    select_ [name_ (toPathPiece nm), multiple_ "multiple"] $+      traverse_ mkOption choices'+  mkOption :: (ToHtml lbl, Monad f) => (a, Int, lbl, Bool) -> HtmlT f ()+  mkOption (_, val, lbl, selected) =+    option_+      ( (if selected then ((:) (selected_ "selected")) else id)+        [value_ (toPathPiece val)]+      )+      (toHtml lbl) -{--inputMultiSelectOptGroup :: (Functor m, XMLGenerator x, EmbedAsChild x groupLbl, EmbedAsChild x lbl, EmbedAsAttr x (Attr String FormId), FormError error, ErrorInputType error ~ input, FormInput input, Monad m, Applicative f) =>-                   [(groupLbl, [(a, lbl, Bool)])]  -- ^ value, label, initially checked-                -> Form m input error (HtmlT f ()) [a]-inputMultiSelectOptGroup choices =-    G.inputMulti choices mkSelect-    where-      mkSelect nm choices' =-          [<select name=nm multiple="multiple">-            <% mapM mkOptGroup choices' %>-           </select>-          ]-      mkOptGroup (grpLabel, options) =-          <optgroup label=grpLabel>-           <% mapM mkOption options %>-          </optgroup>-      mkOption (_, val, lbl, selected) =-          <option value=val (if selected then ["selected" := "selected"] else [])>-           <% lbl %>-          </option>--}+