packages feed

ditto-lucid 0.3.2 → 0.4

raw patch · 4 files changed

+148/−139 lines, 4 filesdep ~dittoPVP ok

version bump matches the API change (PVP)

Dependency ranges changed: ditto

API changes (from Hackage documentation)

- Ditto.Lucid: encodeFormId :: FormId -> Text
- Ditto.Lucid.Named: inputTextMReq :: (Monad m, FormError input err, PathPiece text, Applicative f) => (input -> Either err text) -> String -> Maybe text -> Form m input err (HtmlT f ()) text
- Ditto.Lucid.Unnamed: inputTextMReq :: (Monad m, FormError input err, PathPiece text, Applicative f) => (input -> Either err text) -> Maybe text -> Form m input err (HtmlT f ()) text
+ Ditto.Lucid: withChildErrors :: (Environment m input, ToHtml error, Monad f) => (HtmlT f () -> [error] -> HtmlT f ()) -> Form m input error (HtmlT f ()) a -> Form m input error (HtmlT f ()) a
+ Ditto.Lucid.Named: inputMaybeText :: (Environment m input, FormError input err, PathPiece text, Applicative f) => (input -> Either err text) -> Text -> Maybe text -> Form m input err (HtmlT f ()) (Maybe text)
+ Ditto.Lucid.Unnamed: inputMaybeText :: (Environment m input, FormError input err, PathPiece text, Applicative f) => (input -> Either err text) -> Maybe text -> Form m input err (HtmlT f ()) (Maybe text)
- Ditto.Lucid: br :: (Monad m, Applicative f) => Form m input error (HtmlT f ()) ()
+ Ditto.Lucid: br :: (Environment m input, Applicative f) => Form m input error (HtmlT f ()) ()
- Ditto.Lucid: childErrorList :: (Monad m, ToHtml error, Monad f) => Form m input error (HtmlT f ()) ()
+ Ditto.Lucid: childErrorList :: (Environment m input, ToHtml error, Monad f) => Form m input error (HtmlT f ()) ()
- Ditto.Lucid: errorList :: (Monad m, ToHtml error, Monad f) => Form m input error (HtmlT f ()) ()
+ Ditto.Lucid: errorList :: (Environment m input, ToHtml error, Monad f) => Form m input error (HtmlT f ()) ()
- Ditto.Lucid: fieldset :: (Monad m, Functor m, Applicative f) => Form m input error (HtmlT f ()) a -> Form m input error (HtmlT f ()) a
+ Ditto.Lucid: fieldset :: (Environment m input, Functor m, Applicative f) => Form m input error (HtmlT f ()) a -> Form m input error (HtmlT f ()) a
- Ditto.Lucid: li :: (Monad m, Functor m, Applicative f) => Form m input error (HtmlT f ()) a -> Form m input error (HtmlT f ()) a
+ Ditto.Lucid: li :: (Environment m input, Functor m, Applicative f) => Form m input error (HtmlT f ()) a -> Form m input error (HtmlT f ()) a
- Ditto.Lucid: ol :: (Monad m, Functor m, Applicative f) => Form m input error (HtmlT f ()) a -> Form m input error (HtmlT f ()) a
+ Ditto.Lucid: ol :: (Environment m input, Functor m, Applicative f) => Form m input error (HtmlT f ()) a -> Form m input error (HtmlT f ()) a
- Ditto.Lucid: setAttr :: (Monad m, Functor m, Applicative f) => [Attribute] -> Form m input error (HtmlT f ()) a -> Form m input error (HtmlT f ()) a
+ Ditto.Lucid: setAttr :: (Environment m input, Functor m, Applicative f) => [Attribute] -> Form m input error (HtmlT f ()) a -> Form m input error (HtmlT f ()) a
- Ditto.Lucid: ul :: (Monad m, Functor m, Applicative f) => Form m input error (HtmlT f ()) a -> Form m input error (HtmlT f ()) a
+ Ditto.Lucid: ul :: (Environment m input, Functor m, Applicative f) => Form m input error (HtmlT f ()) a -> Form m input error (HtmlT f ()) a
- Ditto.Lucid: withErrors :: (Monad m, ToHtml error, Monad f) => (HtmlT f () -> [error] -> HtmlT f ()) -> Form m input error (HtmlT f ()) a -> Form m input error (HtmlT f ()) a
+ Ditto.Lucid: withErrors :: (Environment m input, ToHtml error, Monad f) => (HtmlT f () -> [error] -> HtmlT f ()) -> Form m input error (HtmlT f ()) a -> Form m input error (HtmlT f ()) a
- Ditto.Lucid.Named: arbitraryHtml :: Monad m => view -> Form m input err view ()
+ Ditto.Lucid.Named: arbitraryHtml :: Environment m input => view -> Form m input err view ()
- Ditto.Lucid.Named: button :: (Monad m, FormError input err, Monad f) => String -> HtmlT f () -> Form m input err (HtmlT f ()) ()
+ Ditto.Lucid.Named: button :: (Environment m input, FormError input err, Monad f) => Text -> HtmlT f () -> Form m input err (HtmlT f ()) ()
- Ditto.Lucid.Named: buttonReset :: (Monad m, FormError input err, Monad f) => String -> HtmlT f () -> Form m input err (HtmlT f ()) ()
+ Ditto.Lucid.Named: buttonReset :: (Environment m input, FormError input err, Monad f) => Text -> HtmlT f () -> Form m input err (HtmlT f ()) ()
- Ditto.Lucid.Named: buttonSubmit :: (Monad m, FormError input err, PathPiece text, ToHtml children, Monad f) => (input -> Either err text) -> String -> text -> children -> Form m input err (HtmlT f ()) (Maybe text)
+ Ditto.Lucid.Named: buttonSubmit :: (Environment m input, FormError input err, PathPiece text, ToHtml children, Monad f) => (input -> Either err text) -> Text -> text -> children -> Form m input err (HtmlT f ()) (Maybe text)
- Ditto.Lucid.Named: inputButton :: (Monad m, FormError input err, PathPiece text, Applicative f) => String -> text -> Form m input err (HtmlT f ()) ()
+ Ditto.Lucid.Named: inputButton :: (Environment m input, FormError input err, PathPiece text, Applicative f) => Text -> text -> Form m input err (HtmlT f ()) ()
- Ditto.Lucid.Named: inputCheckbox :: forall err input m f. (Monad m, FormError input err, Applicative f) => Bool -> String -> Form m input err (HtmlT f ()) Bool
+ Ditto.Lucid.Named: inputCheckbox :: forall err input m f. (Environment m input, FormError input err, Applicative f) => Bool -> Text -> Form m input err (HtmlT f ()) Bool
- Ditto.Lucid.Named: inputCheckboxes :: (Functor m, Monad m, FormError input err, FormInput input, ToHtml lbl, Monad f) => String -> [(a, lbl)] -> (a -> Bool) -> Form m input err (HtmlT f ()) [a]
+ Ditto.Lucid.Named: inputCheckboxes :: (Functor m, Environment m input, FormError input err, FormInput input, ToHtml lbl, Monad f, PathPiece a, Eq a) => Text -> [(a, lbl)] -> (input -> Either err [a]) -> (a -> Bool) -> Form m input err (HtmlT f ()) [a]
- Ditto.Lucid.Named: inputDouble :: (Monad m, FormError input err, Applicative f) => (input -> Either err Double) -> String -> Double -> Form m input err (HtmlT f ()) Double
+ Ditto.Lucid.Named: inputDouble :: (Environment m input, FormError input err, Applicative f) => (input -> Either err Double) -> Text -> Double -> Form m input err (HtmlT f ()) Double
- Ditto.Lucid.Named: inputFile :: (Monad m, FormError input err, FormInput input, Applicative f) => String -> Form m input err (HtmlT f ()) (FileType input)
+ Ditto.Lucid.Named: inputFile :: (Environment m input, FormError input err, FormInput input, Applicative f, ft ~ FileType input, Monoid ft) => Text -> Form m input err (HtmlT f ()) (FileType input)
- Ditto.Lucid.Named: inputHidden :: (Monad m, FormError input err, PathPiece text, Applicative f) => (input -> Either err text) -> String -> text -> Form m input err (HtmlT f ()) text
+ Ditto.Lucid.Named: inputHidden :: (Environment m input, FormError input err, PathPiece text, Applicative f) => (input -> Either err text) -> Text -> text -> Form m input err (HtmlT f ()) text
- Ditto.Lucid.Named: inputInt :: (Monad m, FormError input err, Applicative f) => (input -> Either err Int) -> String -> Int -> Form m input err (HtmlT f ()) Int
+ Ditto.Lucid.Named: inputInt :: (Environment m input, FormError input err, Applicative f) => (input -> Either err Int) -> Text -> Int -> Form m input err (HtmlT f ()) Int
- Ditto.Lucid.Named: inputPassword :: (Monad m, FormError input err, PathPiece text, Applicative f) => (input -> Either err text) -> String -> text -> Form m input err (HtmlT f ()) text
+ Ditto.Lucid.Named: inputPassword :: (Environment m input, FormError input err, PathPiece text, Applicative f) => (input -> Either err text) -> Text -> text -> Form m input err (HtmlT f ()) text
- Ditto.Lucid.Named: inputRadio :: (Functor m, Monad m, FormError input err, FormInput input, Monad f) => String -> [(a, Html ())] -> (a -> Bool) -> Form m input err (HtmlT f ()) a
+ Ditto.Lucid.Named: inputRadio :: (Functor m, Environment m input, FormError input err, FormInput input, Monad f, PathPiece a, Eq a) => Text -> NonEmpty (a, Html ()) -> (input -> Either err a) -> (a -> Bool) -> Form m input err (HtmlT f ()) a
- Ditto.Lucid.Named: inputReset :: (Monad m, FormError input err, PathPiece text, Applicative f) => String -> text -> Form m input err (HtmlT f ()) ()
+ Ditto.Lucid.Named: inputReset :: (Environment m input, FormError input err, PathPiece text, Applicative f) => Text -> text -> Form m input err (HtmlT f ()) ()
- Ditto.Lucid.Named: inputSubmit :: (Monad m, FormError input err, PathPiece text, Applicative f) => (input -> Either err text) -> String -> text -> Form m input err (HtmlT f ()) (Maybe text)
+ Ditto.Lucid.Named: inputSubmit :: (Environment m input, FormError input err, PathPiece text, Applicative f) => (input -> Either err text) -> Text -> text -> Form m input err (HtmlT f ()) (Maybe text)
- Ditto.Lucid.Named: inputText :: (Monad m, FormError input err, PathPiece text, Applicative f) => (input -> Either err text) -> String -> text -> Form m input err (HtmlT f ()) text
+ Ditto.Lucid.Named: inputText :: (Environment m input, FormError input err, PathPiece text, Applicative f) => (input -> Either err text) -> Text -> text -> Form m input err (HtmlT f ()) text
- Ditto.Lucid.Named: label :: (Monad m, Monad f) => HtmlT f () -> String -> Form m input err (HtmlT f ()) ()
+ Ditto.Lucid.Named: label :: (Environment m input, Monad f) => HtmlT f () -> Text -> Form m input err (HtmlT f ()) ()
- Ditto.Lucid.Named: select :: (Functor m, Monad m, FormError input err, FormInput input, Monad f) => String -> [(a, Html ())] -> (a -> Bool) -> Form m input err (HtmlT f ()) a
+ Ditto.Lucid.Named: select :: (Functor m, Environment m input, FormError input err, FormInput input, Monad f, PathPiece a, Eq a) => Text -> NonEmpty (a, Html ()) -> (input -> Either err a) -> (a -> Bool) -> Form m input err (HtmlT f ()) a
- Ditto.Lucid.Named: selectMultiple :: (Functor m, Monad m, FormError input err, FormInput input, Monad f) => String -> [(a, Html ())] -> (a -> Bool) -> Form m input err (HtmlT f ()) [a]
+ Ditto.Lucid.Named: selectMultiple :: (Functor m, Environment m input, FormError input err, FormInput input, Monad f, PathPiece a, Eq a) => Text -> [(a, Html ())] -> (input -> Either err [a]) -> (a -> Bool) -> Form m input err (HtmlT f ()) [a]
- Ditto.Lucid.Named: textarea :: (Monad m, FormError input err, ToHtml text, Monad f) => (input -> Either err text) -> Int -> Int -> String -> text -> Form m input err (HtmlT f ()) text
+ Ditto.Lucid.Named: textarea :: (Environment m input, FormError input err, ToHtml text, Monad f) => (input -> Either err text) -> Int -> Int -> Text -> text -> Form m input err (HtmlT f ()) text
- Ditto.Lucid.Unnamed: arbitraryHtml :: Monad m => view -> Form m input err view ()
+ Ditto.Lucid.Unnamed: arbitraryHtml :: Environment m input => view -> Form m input err view ()
- Ditto.Lucid.Unnamed: button :: (Monad m, FormError input err, ToHtml children, Monad f) => children -> Form m input err (HtmlT f ()) ()
+ Ditto.Lucid.Unnamed: button :: (Environment m input, FormError input err, ToHtml children, Monad f) => children -> Form m input err (HtmlT f ()) ()
- Ditto.Lucid.Unnamed: buttonReset :: (Monad m, FormError input err, ToHtml children, Monad f) => children -> Form m input err (HtmlT f ()) ()
+ Ditto.Lucid.Unnamed: buttonReset :: (Environment m input, FormError input err, ToHtml children, Monad f) => children -> Form m input err (HtmlT f ()) ()
- Ditto.Lucid.Unnamed: buttonSubmit :: (Monad m, FormError input err, PathPiece text, ToHtml children, Monad f) => (input -> Either err text) -> text -> children -> Form m input err (HtmlT f ()) (Maybe text)
+ Ditto.Lucid.Unnamed: buttonSubmit :: (Environment m input, FormError input err, PathPiece text, ToHtml children, Monad f) => (input -> Either err text) -> text -> children -> Form m input err (HtmlT f ()) (Maybe text)
- Ditto.Lucid.Unnamed: inputButton :: (Monad m, FormError input err, PathPiece text, Applicative f) => text -> Form m input err (HtmlT f ()) ()
+ Ditto.Lucid.Unnamed: inputButton :: (Environment m input, FormError input err, PathPiece text, Applicative f) => text -> Form m input err (HtmlT f ()) ()
- Ditto.Lucid.Unnamed: inputCheckbox :: forall err input m f. (Monad m, FormError input err, Applicative f) => Bool -> Form m input err (HtmlT f ()) Bool
+ Ditto.Lucid.Unnamed: inputCheckbox :: forall err input m f. (Environment m input, FormError input err, Applicative f) => Bool -> Form m input err (HtmlT f ()) Bool
- Ditto.Lucid.Unnamed: inputCheckboxes :: (Functor m, Monad m, FormError input err, FormInput input, Monad f) => [(a, Html ())] -> (a -> Bool) -> Form m input err (HtmlT f ()) [a]
+ Ditto.Lucid.Unnamed: inputCheckboxes :: (Functor m, Environment m input, FormError input err, FormInput input, Monad f, PathPiece a, Eq a) => [(a, Html ())] -> (input -> Either err [a]) -> (a -> Bool) -> Form m input err (HtmlT f ()) [a]
- Ditto.Lucid.Unnamed: inputDouble :: (Monad m, FormError input err, Applicative f) => (input -> Either err Double) -> Double -> Form m input err (HtmlT f ()) Double
+ Ditto.Lucid.Unnamed: inputDouble :: (Environment m input, FormError input err, Applicative f) => (input -> Either err Double) -> Double -> Form m input err (HtmlT f ()) Double
- Ditto.Lucid.Unnamed: inputFile :: (Monad m, FormError input err, FormInput input, Applicative f) => Form m input err (HtmlT f ()) (FileType input)
+ Ditto.Lucid.Unnamed: inputFile :: (Environment m input, FormError input err, FormInput input, Applicative f, ft ~ FileType input, Monoid ft) => Form m input err (HtmlT f ()) (FileType input)
- Ditto.Lucid.Unnamed: inputHidden :: (Monad m, FormError input err, PathPiece text, Applicative f) => (input -> Either err text) -> text -> Form m input err (HtmlT f ()) text
+ Ditto.Lucid.Unnamed: inputHidden :: (Environment m input, FormError input err, PathPiece text, Applicative f) => (input -> Either err text) -> text -> Form m input err (HtmlT f ()) text
- Ditto.Lucid.Unnamed: inputInt :: (Monad m, FormError input err, Applicative f) => (input -> Either err Int) -> Int -> Form m input err (HtmlT f ()) Int
+ Ditto.Lucid.Unnamed: inputInt :: (Environment m input, FormError input err, Applicative f) => (input -> Either err Int) -> Int -> Form m input err (HtmlT f ()) Int
- Ditto.Lucid.Unnamed: inputPassword :: (Monad m, FormError input err, PathPiece text, Applicative f) => (input -> Either err text) -> text -> Form m input err (HtmlT f ()) text
+ Ditto.Lucid.Unnamed: inputPassword :: (Environment m input, FormError input err, PathPiece text, Applicative f) => (input -> Either err text) -> text -> Form m input err (HtmlT f ()) text
- Ditto.Lucid.Unnamed: inputRadio :: (Functor m, Monad m, FormError input err, FormInput input, Monad f) => [(a, Html ())] -> (a -> Bool) -> Form m input err (HtmlT f ()) a
+ Ditto.Lucid.Unnamed: inputRadio :: (Functor m, Environment m input, FormError input err, FormInput input, Monad f, PathPiece a, Eq a) => NonEmpty (a, Html ()) -> (input -> Either err a) -> (a -> Bool) -> Form m input err (HtmlT f ()) a
- Ditto.Lucid.Unnamed: inputReset :: (Monad m, FormError input err, PathPiece text, Applicative f) => text -> Form m input err (HtmlT f ()) ()
+ Ditto.Lucid.Unnamed: inputReset :: (Environment m input, FormError input err, PathPiece text, Applicative f) => text -> Form m input err (HtmlT f ()) ()
- Ditto.Lucid.Unnamed: inputSubmit :: (Monad m, FormError input err, PathPiece text, Applicative f) => (input -> Either err text) -> text -> Form m input err (HtmlT f ()) (Maybe text)
+ Ditto.Lucid.Unnamed: inputSubmit :: (Environment m input, FormError input err, PathPiece text, Applicative f) => (input -> Either err text) -> text -> Form m input err (HtmlT f ()) (Maybe text)
- Ditto.Lucid.Unnamed: inputText :: (Monad m, FormError input err, PathPiece text, Applicative f) => (input -> Either err text) -> text -> Form m input err (HtmlT f ()) text
+ Ditto.Lucid.Unnamed: inputText :: (Environment m input, FormError input err, PathPiece text, Applicative f) => (input -> Either err text) -> text -> Form m input err (HtmlT f ()) text
- Ditto.Lucid.Unnamed: label :: (Monad m, Monad f) => HtmlT f () -> Form m input err (HtmlT f ()) ()
+ Ditto.Lucid.Unnamed: label :: (Environment m input, Monad f) => HtmlT f () -> Form m input err (HtmlT f ()) ()
- Ditto.Lucid.Unnamed: select :: (Functor m, Monad m, FormError input err, FormInput input, Monad f) => [(a, Html ())] -> (a -> Bool) -> Form m input err (HtmlT f ()) a
+ Ditto.Lucid.Unnamed: select :: (Functor m, Environment m input, FormError input err, FormInput input, Monad f, PathPiece a, Eq a) => NonEmpty (a, Html ()) -> (input -> Either err a) -> (a -> Bool) -> Form m input err (HtmlT f ()) a
- Ditto.Lucid.Unnamed: selectMultiple :: (Functor m, Monad m, FormError input err, FormInput input, Monad f) => [(a, Html ())] -> (a -> Bool) -> Form m input err (HtmlT f ()) [a]
+ Ditto.Lucid.Unnamed: selectMultiple :: (Functor m, Environment m input, FormError input err, FormInput input, Monad f, PathPiece a, Eq a) => [(a, Html ())] -> (input -> Either err [a]) -> (a -> Bool) -> Form m input err (HtmlT f ()) [a]
- Ditto.Lucid.Unnamed: textarea :: (Monad m, FormError input err, ToHtml text, Monad f) => (input -> Either err text) -> Int -> Int -> text -> Form m input err (HtmlT f ()) text
+ Ditto.Lucid.Unnamed: textarea :: (Environment m input, FormError input err, ToHtml text, Monad f) => (input -> Either err text) -> Int -> Int -> text -> Form m input err (HtmlT f ()) text

Files

ditto-lucid.cabal view
@@ -1,5 +1,5 @@ Name:                ditto-lucid-Version:             0.3.2+Version:             0.4 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@@ -25,7 +25,7 @@   build-depends:       base >4.5 && <5     , lucid < 3.0.0-    , ditto >= 0.3.1 && <= 0.4+    , ditto >= 0.4 && <= 0.5     , text >= 0.11 && < 1.3     , path-pieces   hs-source-dirs: src
src/Ditto/Lucid.hs view
@@ -8,14 +8,9 @@  import Data.Foldable (traverse_) import Data.Text (Text)-import Lucid import Ditto.Core-import Ditto.Generalized as G-import Ditto.Result (FormId)-import qualified Data.Text as T--encodeFormId :: FormId -> Text-encodeFormId = T.pack . show+import Ditto.Generalized.Unnamed as G+import Lucid  -- | create @\<form action=action method=\"GET\" enctype=\"application/xxx-form-urlencoded\"\>@ formGenGET@@ -47,7 +42,7 @@  -- | add an attribute to the 'Html' for a form element. setAttr-  :: (Monad m, Functor m, Applicative f)+  :: (Environment m input, Functor m, Applicative f)   => [Attribute]   -> Form m input error (HtmlT f ()) a    -> Form m input error (HtmlT f ()) a@@ -57,7 +52,7 @@ -- -- The @<\ul\>@ will have the attribute @class=\"ditto-error-list\"@. errorList-  :: (Monad m, ToHtml error, Monad f)+  :: (Environment m input, ToHtml error, Monad f)   => Form m input error (HtmlT f ()) () errorList = G.errors mkErrors   where@@ -73,7 +68,7 @@ -- -- The @<\ul\>@ will have the attribute @class=\"ditto-error-list\"@. childErrorList-  :: (Monad m, ToHtml error, Monad f)+  :: (Environment m input, ToHtml error, Monad f)   => Form m input error (HtmlT f ()) () childErrorList = G.childErrors mkErrors   where@@ -87,41 +82,51 @@ -- -- The @<\ul\>@ will have the attribute @class=\"ditto-error-list\"@. withErrors-  :: (Monad m, ToHtml error, Monad f)+  :: (Environment m input, ToHtml error, Monad f)   => (HtmlT f () -> [error] -> HtmlT f ())   -> Form m input error (HtmlT f ()) a   -> Form m input error (HtmlT f ()) a withErrors renderError form = G.withErrors renderError form +-- | create a sibling element to the formlet which includes it and it's childrens' error message+--+-- The @<\ul\>@ will have the attribute @class=\"ditto-error-list\"@.+withChildErrors+  :: (Environment m input, ToHtml error, Monad f)+  => (HtmlT f () -> [error] -> HtmlT f ())+  -> Form m input error (HtmlT f ()) a+  -> Form m input error (HtmlT f ()) a+withChildErrors renderError form = G.withChildErrors renderError form+ -- | create a @\<br\>@ tag.-br :: (Monad m, Applicative f) => Form m input error (HtmlT f ()) ()+br :: (Environment m input, Applicative f) => Form m input error (HtmlT f ()) () br = view (br_ [])  -- | wrap a @\<fieldset class=\"ditto\"\>@ around a 'Form' -- fieldset-  :: (Monad m, Functor m, Applicative f)+  :: (Environment m input, Functor m, Applicative f)   => Form m input error (HtmlT f ()) a   -> Form m input error (HtmlT f ()) a fieldset frm = mapView (fieldset_ [class_ "ditto"]) frm  -- | wrap an @\<ol class=\"ditto\"\>@ around a 'Form' ol-  :: (Monad m, Functor m, Applicative f)+  :: (Environment m input, Functor m, Applicative f)   => Form m input error (HtmlT f ()) a   -> Form m input error (HtmlT f ()) a ol frm = mapView (ol_ [class_ "ditto"]) frm  -- | wrap a @\<ul class=\"ditto\"\>@ around a 'Form' ul-  :: (Monad m, Functor m, Applicative f)+  :: (Environment m input, Functor m, Applicative f)   => Form m input error (HtmlT f ()) a   -> Form m input error (HtmlT f ()) a ul frm = mapView (ul_ [class_ "ditto"]) frm  -- | wrap a @\<li class=\"ditto\"\>@ around a 'Form' li-  :: (Monad m, Functor m, Applicative f)+  :: (Environment m input, Functor m, Applicative f)   => Form m input error (HtmlT f ()) a   -> Form m input error (HtmlT f ()) a li frm = mapView (li_ [class_ "ditto"]) frm
src/Ditto/Lucid/Named.hs view
@@ -5,11 +5,12 @@ module Ditto.Lucid.Named where  import Data.Foldable (traverse_, fold)+import Data.List.NonEmpty+import Data.Text (Text) import Ditto.Backend import Ditto.Core-import Ditto.Lucid (encodeFormId) import Ditto.Generalized.Named as G-import Ditto.Result (FormId, Result (Ok), unitRange)+import Ditto.Types import Lucid import Web.PathPieces import qualified Data.Text as T@@ -18,30 +19,30 @@ foldTraverse_ f = traverse_ (fold . f)  inputText-  :: (Monad m, FormError input err, PathPiece text, Applicative f)+  :: (Environment m input, FormError input err, PathPiece text, Applicative f)   => (input -> Either err text)-  -> String+  -> Text   -> text   -> Form m input err (HtmlT f ()) text inputText getInput name initialValue = G.input name getInput inputField initialValue   where   inputField i a = input_ [type_ "text", id_ (encodeFormId i), name_ (encodeFormId i), value_ (toPathPiece a)] -inputTextMReq-  :: (Monad m, FormError input err, PathPiece text, Applicative f)+inputMaybeText+  :: (Environment m input, FormError input err, PathPiece text, Applicative f)   => (input -> Either err text)-  -> String+  -> Text   -> Maybe text-  -> Form m input err (HtmlT f ()) text-inputTextMReq getInput name initialValue = G.inputMaybeReq name getInput inputField initialValue+  -> Form m input err (HtmlT f ()) (Maybe text)+inputMaybeText getInput name initialValue = G.inputMaybe name getInput inputField initialValue   where-  inputField i Nothing = input_ [type_ "text", id_ (encodeFormId i), name_ (encodeFormId i), required_ "required"]-  inputField i (Just a) = input_ [type_ "text", id_ (encodeFormId i), name_ (encodeFormId i), value_ (toPathPiece a), required_ "required"]+  inputField i a = let attrs = maybe [] (pure . value_ . toPathPiece) a in +    input_ $ type_ "text" : id_ (encodeFormId i) : name_ (encodeFormId i) : attrs  inputPassword-  :: (Monad m, FormError input err, PathPiece text, Applicative f)+  :: (Environment m input, FormError input err, PathPiece text, Applicative f)   => (input -> Either err text)-  -> String+  -> Text   -> text   -> Form m input err (HtmlT f ()) text inputPassword getInput name initialValue = G.input name getInput inputField initialValue@@ -49,9 +50,9 @@   inputField i a = input_ [type_ "password", id_ (encodeFormId i), name_ (encodeFormId i), value_ (toPathPiece a)]  inputSubmit-  :: (Monad m, FormError input err, PathPiece text, Applicative f)+  :: (Environment m input, FormError input err, PathPiece text, Applicative f)   => (input -> Either err text)-  -> String+  -> Text   -> text   -> Form m input err (HtmlT f ()) (Maybe text) inputSubmit getInput name initialValue = G.inputMaybe name getInput inputField (Just initialValue)@@ -59,8 +60,8 @@   inputField i a = input_ [type_ "submit", id_ (encodeFormId i), name_ (encodeFormId i), value_ (toPathPiece a)]  inputReset-  :: (Monad m, FormError input err, PathPiece text, Applicative f)-  => String+  :: (Environment m input, FormError input err, PathPiece text, Applicative f)+  => Text   -> text   -> Form m input err (HtmlT f ()) () inputReset name lbl = G.inputNoData name inputField@@ -68,9 +69,9 @@   inputField i = input_ [type_ "submit", id_ (encodeFormId i), name_ (encodeFormId i), value_ (toPathPiece lbl)]  inputHidden-  :: (Monad m, FormError input err, PathPiece text, Applicative f)+  :: (Environment m input, FormError input err, PathPiece text, Applicative f)   => (input -> Either err text)-  -> String+  -> Text   -> text   -> Form m input err (HtmlT f ()) text inputHidden getInput name initialValue = G.input name getInput inputField initialValue@@ -78,8 +79,8 @@   inputField i a = input_ [type_ "hidden", id_ (encodeFormId i), name_ (encodeFormId i), value_ (toPathPiece a)]  inputButton-  :: (Monad m, FormError input err, PathPiece text, Applicative f)-  => String+  :: (Environment m input, FormError input err, PathPiece text, Applicative f)+  => Text   -> text   -> Form m input err (HtmlT f ()) () inputButton name lbl = G.inputNoData name inputField@@ -87,11 +88,11 @@   inputField i = input_ [type_ "button", id_ (encodeFormId i), name_ (encodeFormId i), value_ (toPathPiece lbl)]  textarea-  :: (Monad m, FormError input err, ToHtml text, Monad f)+  :: (Environment m input, FormError input err, ToHtml text, Monad f)   => (input -> Either err text)   -> Int -- ^ cols   -> Int -- ^ rows-  -> String+  -> Text   -> text -- ^ initial text   -> Form m input err (HtmlT f ()) text textarea getInput cols rows name initialValue = G.input name getInput textareaView initialValue@@ -109,8 +110,8 @@ -- -- This control may succeed even if the user does not actually select a file to upload. In that case the uploaded name will likely be \"\" and the file contents will be empty as well. inputFile-  :: (Monad m, FormError input err, FormInput input, Applicative f)-  => String+  :: (Environment m input, FormError input err, FormInput input, Applicative f, ft ~ FileType input, Monoid ft)+  => Text   -> Form m input err (HtmlT f ()) (FileType input) inputFile name = G.inputFile name fileView   where@@ -118,9 +119,9 @@  -- | Create a @\<button type=\"submit\"\>@ element buttonSubmit-  :: (Monad m, FormError input err, PathPiece text, ToHtml children, Monad f)+  :: (Environment m input, FormError input err, PathPiece text, ToHtml children, Monad f)   => (input -> Either err text)-  -> String+  -> Text   -> text   -> children   -> Form m input err (HtmlT f ()) (Maybe text)@@ -132,8 +133,8 @@ -- -- This element does not add any data to the form data set. buttonReset-  :: (Monad m, FormError input err, Monad f)-  => String+  :: (Environment m input, FormError input err, Monad f)+  => Text   -> HtmlT f ()   -> Form m input err (HtmlT f ()) () buttonReset name c = G.inputNoData name inputField@@ -144,8 +145,8 @@ -- -- This element does not add any data to the form data set. button-  :: (Monad m, FormError input err, Monad f)-  => String+  :: (Environment m input, FormError input err, Monad f)+  => Text   -> HtmlT f ()   -> Form m input err (HtmlT f ()) () button name c = G.inputNoData name inputField@@ -158,21 +159,21 @@ -- -- > label "some input field: " ++> inputText "" label-  :: (Monad m, Monad f)+  :: (Environment m input, Monad f)   => HtmlT f ()-  -> String+  -> Text   -> Form m input err (HtmlT f ()) () label c name = G.label name mkLabel   where   mkLabel i = label_ [for_ (encodeFormId i)] c -arbitraryHtml :: Monad m => view -> Form m input err view ()+arbitraryHtml :: Environment m input => view -> Form m input err view () arbitraryHtml = view  inputInt-  :: (Monad m, FormError input err, Applicative f)+  :: (Environment m input, FormError input err, Applicative f)   => (input -> Either err Int)-  -> String+  -> Text   -> Int   -> Form m input err (HtmlT f ()) Int inputInt getInput name initialValue = G.input name getInput inputField initialValue@@ -186,9 +187,9 @@       ]  inputDouble-  :: (Monad m, FormError input err, Applicative f)+  :: (Environment m input, FormError input err, Applicative f)   => (input -> Either err Double)-  -> String+  -> Text   -> Double   -> Form m input err (HtmlT f ()) Double inputDouble getInput name initialValue = G.input name getInput inputField initialValue@@ -201,12 +202,12 @@ -- -- see also 'inputCheckboxes' inputCheckbox-  :: forall err input m f. (Monad m, FormError input err, Applicative f)+  :: forall err input m f. (Environment m input, FormError input err, Applicative f)   => Bool -- ^ initially checked-  -> String -- ^+  -> Text -- ^   -> Form m input err (HtmlT f ()) Bool inputCheckbox initiallyChecked name =-  Form $ do+  Form (successDecode True) (pure initiallyChecked) $ do     i <- getNamedFormId name     v <- getFormInput' i     case v of@@ -221,8 +222,7 @@               [type_ "checkbox", id_ (encodeFormId i), name_ (encodeFormId i), value_ (encodeFormId i)]      in pure           ( View $ const $ checkbox-          , pure $-            Ok+          , Ok               ( Proved                 { pos = unitRange i                 , unProved = if checked then True else False@@ -233,15 +233,16 @@ -- | Create a group of @\<input type=\"checkbox\"\>@ elements -- inputCheckboxes-  :: (Functor m, Monad m, FormError input err, FormInput input, ToHtml lbl, Monad f)-  => String+  :: (Functor m, Environment m input, FormError input err, FormInput input, ToHtml lbl, Monad f, PathPiece a, Eq a)+  => Text   -> [(a, lbl)] -- ^ value, label, initially checked+  -> (input -> Either err [a])   -> (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 name choices mkCheckboxes isChecked+inputCheckboxes name choices fromInput isChecked = G.inputMulti name choices fromInput mkCheckboxes isChecked   where   mkCheckboxes nm choices' = foldTraverse_ (mkCheckbox nm) choices'-  mkCheckbox nm (i, val, lbl, checked) =+  mkCheckbox nm (Choice i lbl checked val) =     [ input_ $         ( (if checked then (checked_ :) else id)           [type_ "checkbox", id_ (encodeFormId i), name_ (encodeFormId nm), value_ (toPathPiece val)]@@ -251,16 +252,17 @@  -- | Create a group of @\<input type=\"radio\"\>@ elements inputRadio-  :: (Functor m, Monad m, FormError input err, FormInput input, Monad f)-  => String-  -> [(a, Html ())] -- ^ value, label, initially checked+  :: (Functor m, Environment m input, FormError input err, FormInput input, Monad f, PathPiece a, Eq a)+  => Text+  -> NonEmpty (a, Html ()) -- ^ value, label, initially checked+  -> (input -> Either err a)   -> (a -> Bool) -- ^ isDefault   -> Form m input err (HtmlT f ()) a-inputRadio name choices isDefault =-  G.inputChoice name isDefault choices mkRadios+inputRadio name choices fromInput isDefault =+  G.inputChoice name isDefault choices fromInput mkRadios   where   mkRadios nm choices' = foldTraverse_ (mkRadio nm) choices'-  mkRadio nm (i, val, lbl, checked) =+  mkRadio nm (Choice i lbl checked val) =     [ input_ $         (if checked then (checked_ :) else id)           [type_ "radio", id_ (encodeFormId i), name_ (encodeFormId nm), value_ (toPathPiece val)]@@ -272,19 +274,20 @@ -- -- see also: 'selectMultiple' select-  :: (Functor m, Monad m, FormError input err, FormInput input, Monad f)-  => String-  -> [(a, Html ())] -- ^ value, label+  :: (Functor m, Environment m input, FormError input err, FormInput input, Monad f, PathPiece a, Eq a)+  => Text+  -> NonEmpty (a, Html ()) -- ^ value, label+  -> (input -> Either err a)   -> (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 name isDefault choices mkSelect+select name choices fromInput isDefault = G.inputChoice name isDefault choices fromInput mkSelect   where-  mkSelect :: (ToHtml lbl, Monad f) => FormId -> [(a, Int, lbl, Bool)] -> HtmlT f ()+  mkSelect :: (ToHtml lbl, Monad f, PathPiece a) => FormId -> [Choice lbl a] -> HtmlT f ()   mkSelect nm choices' =     select_ [name_ (encodeFormId nm)] $       traverse_ mkOption choices'-  mkOption :: (ToHtml lbl, Monad f) => (a, Int, lbl, Bool) -> HtmlT f ()-  mkOption (_, val, lbl, selected) =+  mkOption :: (ToHtml lbl, Monad f, PathPiece a) => Choice lbl a -> HtmlT f ()+  mkOption (Choice _ lbl selected val) =     option_       ( (if selected then ((:) (selected_ "selected")) else id)         [value_ (toPathPiece val)]@@ -295,19 +298,20 @@ -- -- This creates a @\<select\>@ element which allows more than one item to be selected. selectMultiple-  :: (Functor m, Monad m, FormError input err, FormInput input, Monad f)-  => String+  :: (Functor m, Environment m input, FormError input err, FormInput input, Monad f, PathPiece a, Eq a)+  => Text   -> [(a, Html ())] -- ^ value, label, initially checked+  -> (input -> Either err [a])   -> (a -> Bool) -- ^ isSelected initially   -> Form m input err (HtmlT f ()) [a]-selectMultiple name choices isSelected = G.inputMulti name choices mkSelect isSelected+selectMultiple name choices fromInput isSelected = G.inputMulti name choices fromInput mkSelect isSelected   where-  mkSelect :: (ToHtml lbl, Monad f) => FormId -> [(a, Int, lbl, Bool)] -> HtmlT f ()+  mkSelect :: (ToHtml lbl, Monad f, PathPiece a) => FormId -> [Choice lbl a] -> HtmlT f ()   mkSelect nm choices' =     select_ [name_ (encodeFormId nm), multiple_ "multiple"] $       traverse_ mkOption choices'-  mkOption :: (ToHtml lbl, Monad f) => (a, Int, lbl, Bool) -> HtmlT f ()-  mkOption (_, val, lbl, selected) =+  mkOption :: (ToHtml lbl, Monad f, PathPiece a) => Choice lbl a -> HtmlT f ()+  mkOption (Choice _ lbl selected val) =     option_       ( (if selected then ((:) (selected_ "selected")) else id)         [value_ (toPathPiece val)]
src/Ditto/Lucid/Unnamed.hs view
@@ -7,18 +7,18 @@ import Data.Foldable (traverse_, fold) import Ditto.Backend import Ditto.Core-import Ditto.Generalized as G-import Ditto.Lucid-import Ditto.Result (FormId, Result (Ok), unitRange)+import Ditto.Generalized.Unnamed as G+import Ditto.Types import Lucid import Web.PathPieces+import Data.List.NonEmpty import qualified Data.Text as T  foldTraverse_ :: (Foldable t, Applicative f, Monoid (f b)) => (a -> t (f b)) -> t a -> f () foldTraverse_ f = traverse_ (fold . f)  inputText-  :: (Monad m, FormError input err, PathPiece text, Applicative f)+  :: (Environment m input, FormError input err, PathPiece text, Applicative f)   => (input -> Either err text)   -> text   -> Form m input err (HtmlT f ()) text@@ -26,18 +26,18 @@   where   inputField i a = input_ [type_ "text", id_ (encodeFormId i), name_ (encodeFormId i), value_ (toPathPiece a)] -inputTextMReq-  :: (Monad m, FormError input err, PathPiece text, Applicative f)+inputMaybeText+  :: (Environment m input, FormError input err, PathPiece text, Applicative f)   => (input -> Either err text)   -> Maybe text-  -> Form m input err (HtmlT f ()) text-inputTextMReq getInput initialValue = G.inputMaybeReq getInput inputField initialValue+  -> Form m input err (HtmlT f ()) (Maybe text)+inputMaybeText getInput initialValue = G.inputMaybe getInput inputField initialValue   where-  inputField i Nothing = input_ [type_ "text", id_ (encodeFormId i), name_ (encodeFormId i), required_ "required"]-  inputField i (Just a) = input_ [type_ "text", id_ (encodeFormId i), name_ (encodeFormId i), value_ (toPathPiece a), required_ "required"]+  inputField i a = let attrs = maybe [] (pure . value_ . toPathPiece) a in +    input_ $ type_ "text" : id_ (encodeFormId i) : name_ (encodeFormId i) : attrs  inputPassword-  :: (Monad m, FormError input err, PathPiece text, Applicative f)+  :: (Environment m input, FormError input err, PathPiece text, Applicative f)   => (input -> Either err text)   -> text   -> Form m input err (HtmlT f ()) text@@ -46,7 +46,7 @@   inputField i a = input_ [type_ "password", id_ (encodeFormId i), name_ (encodeFormId i), value_ (toPathPiece a)]  inputSubmit-  :: (Monad m, FormError input err, PathPiece text, Applicative f)+  :: (Environment m input, FormError input err, PathPiece text, Applicative f)   => (input -> Either err text)   -> text   -> Form m input err (HtmlT f ()) (Maybe text)@@ -55,7 +55,7 @@   inputField i a = input_ [type_ "submit", id_ (encodeFormId i), name_ (encodeFormId i), value_ (toPathPiece a)]  inputReset-  :: (Monad m, FormError input err, PathPiece text, Applicative f)+  :: (Environment m input, FormError input err, PathPiece text, Applicative f)   => text   -> Form m input err (HtmlT f ()) () inputReset lbl = G.inputNoData inputField@@ -63,7 +63,7 @@   inputField i = input_ [type_ "submit", id_ (encodeFormId i), name_ (encodeFormId i), value_ (toPathPiece lbl)]  inputHidden-  :: (Monad m, FormError input err, PathPiece text, Applicative f)+  :: (Environment m input, FormError input err, PathPiece text, Applicative f)   => (input -> Either err text)   -> text   -> Form m input err (HtmlT f ()) text@@ -72,7 +72,7 @@   inputField i a = input_ [type_ "hidden", id_ (encodeFormId i), name_ (encodeFormId i), value_ (toPathPiece a)]  inputButton-  :: (Monad m, FormError input err, PathPiece text, Applicative f)+  :: (Environment m input, FormError input err, PathPiece text, Applicative f)   => text   -> Form m input err (HtmlT f ()) () inputButton lbl = G.inputNoData inputField@@ -80,7 +80,7 @@   inputField i = input_ [type_ "button", id_ (encodeFormId i), name_ (encodeFormId i), value_ (toPathPiece lbl)]  textarea-  :: (Monad m, FormError input err, ToHtml text, Monad f)+  :: (Environment m input, FormError input err, ToHtml text, Monad f)   => (input -> Either err text)   -> Int -- ^ cols   -> Int -- ^ rows@@ -101,7 +101,7 @@ -- -- This control may succeed even if the user does not actually select a file to upload. In that case the uploaded name will likely be \"\" and the file contents will be empty as well. inputFile-  :: (Monad m, FormError input err, FormInput input, Applicative f)+  :: (Environment m input, FormError input err, FormInput input, Applicative f, ft ~ FileType input, Monoid ft)   => Form m input err (HtmlT f ()) (FileType input) inputFile = G.inputFile fileView   where@@ -109,7 +109,7 @@  -- | Create a @\<button type=\"submit\"\>@ element buttonSubmit-  :: (Monad m, FormError input err, PathPiece text, ToHtml children, Monad f)+  :: (Environment m input, FormError input err, PathPiece text, ToHtml children, Monad f)   => (input -> Either err text)   -> text   -> children@@ -122,7 +122,7 @@ -- -- This element does not add any data to the form data set. buttonReset-  :: (Monad m, FormError input err, ToHtml children, Monad f)+  :: (Environment m input, FormError input err, ToHtml children, Monad f)   => children   -> Form m input err (HtmlT f ()) () buttonReset c = G.inputNoData inputField @@ -133,7 +133,7 @@ -- -- This element does not add any data to the form data set. button-  :: (Monad m, FormError input err, ToHtml children, Monad f)+  :: (Environment m input, FormError input err, ToHtml children, Monad f)   => children   -> Form m input err (HtmlT f ()) () button c = G.inputNoData inputField@@ -146,21 +146,20 @@ -- -- > label "some input field: " ++> inputText "" label-  :: (Monad m, Monad f)+  :: (Environment m input, Monad f)   => HtmlT f ()   -> Form m input err (HtmlT f ()) () label c = G.label mkLabel   where   mkLabel i = label_ [for_ (encodeFormId i)] c -arbitraryHtml :: Monad m => view -> Form m input err view ()+arbitraryHtml :: Environment m input => view -> Form m input err view () arbitraryHtml wrap =-  Form $ do+  Form (successDecode ()) (pure ()) $ do     id' <- getFormId     pure       ( View (const $ wrap)-      , pure-        ( Ok $ Proved+      , ( Ok $ Proved           { pos = unitRange id'           , unProved = ()           }@@ -168,7 +167,7 @@       )  inputInt-  :: (Monad m, FormError input err, Applicative f)+  :: (Environment m input, FormError input err, Applicative f)   => (input -> Either err Int)   -> Int   -> Form m input err (HtmlT f ()) Int@@ -183,7 +182,7 @@       ]  inputDouble-  :: (Monad m, FormError input err, Applicative f)+  :: (Environment m input, FormError input err, Applicative f)   => (input -> Either err Double)   -> Double   -> Form m input err (HtmlT f ()) Double@@ -197,11 +196,11 @@ -- -- see also 'inputCheckboxes' inputCheckbox-  :: forall err input m f. (Monad m, FormError input err, Applicative f)+  :: forall err input m f. (Environment m input, FormError input err, Applicative f)   => Bool -- ^ initially checked   -> Form m input err (HtmlT f ()) Bool inputCheckbox initiallyChecked =-  Form $ do+  Form (successDecode True) (pure initiallyChecked) $ do     i <- getFormId     v <- getFormInput' i     case v of@@ -216,8 +215,7 @@               [type_ "checkbox", id_ (encodeFormId i), name_ (encodeFormId i), value_ (encodeFormId i)]      in pure           ( View $ const $ checkbox-          , pure $-            Ok+          , Ok               ( Proved                 { pos = unitRange i                 , unProved = if checked then True else False@@ -228,16 +226,16 @@ -- | Create a group of @\<input type=\"checkbox\"\>@ elements -- inputCheckboxes-  :: (Functor m, Monad m, FormError input err, FormInput input, Monad f)+  :: (Functor m, Environment m input, FormError input err, FormInput input, Monad f, PathPiece a, Eq a)   => [(a, Html ())] -- ^ value, label, initially checked+  -> (input -> Either err [a])   -> (a -> Bool) -- ^ function which indicates if a value should be checked initially   -> Form m input err (HtmlT f ()) [a]-inputCheckboxes choices isChecked =-  G.inputMulti choices mkCheckboxes isChecked+inputCheckboxes choices fromInput isChecked =+  G.inputMulti choices fromInput mkCheckboxes isChecked   where-  mkCheckboxes :: Monad f => FormId -> [(FormId, Int, Html (), Bool)] -> HtmlT f ()   mkCheckboxes nm choices' = foldTraverse_ (mkCheckbox nm) choices'-  mkCheckbox nm (i, val, lbl, checked) =+  mkCheckbox nm (Choice i lbl checked val) =     [ input_ $         ( (if checked then (checked_ :) else id)           [type_ "checkbox", id_ (encodeFormId i), name_ (encodeFormId nm), value_ (toPathPiece val)]@@ -247,15 +245,16 @@  -- | Create a group of @\<input type=\"radio\"\>@ elements inputRadio-  :: (Functor m, Monad m, FormError input err, FormInput input, Monad f)-  => [(a, Html ())] -- ^ value, label, initially checked+  :: (Functor m, Environment m input, FormError input err, FormInput input, Monad f, PathPiece a, Eq a)+  => NonEmpty (a, Html ()) -- ^ value, label, initially checked+  -> (input -> Either err a)   -> (a -> Bool) -- ^ isDefault   -> Form m input err (HtmlT f ()) a-inputRadio choices isDefault =-  G.inputChoice isDefault choices mkRadios+inputRadio choices fromInput isDefault =+  G.inputChoice isDefault choices fromInput mkRadios   where   mkRadios nm choices' = foldTraverse_ (mkRadio nm) choices'-  mkRadio nm (i, val, lbl, checked) =+  mkRadio nm (Choice i lbl checked val) =     [ input_ $         (if checked then (checked_ :) else id)           [type_ "radio", id_ (encodeFormId i), name_ (encodeFormId nm), value_ (toPathPiece val)]@@ -267,19 +266,20 @@ -- -- see also: 'selectMultiple' select-  :: (Functor m, Monad m, FormError input err, FormInput input, Monad f)-  => [(a, Html ())] -- ^ value, label+  :: (Functor m, Environment m input, FormError input err, FormInput input, Monad f, PathPiece a, Eq a)+  => NonEmpty (a, Html ()) -- ^ value, label+  -> (input -> Either err a)   -> (a -> Bool) -- ^ isDefault, must match *exactly one* element in the list of choices   -> Form m input err (HtmlT f ()) a-select choices isDefault =-  G.inputChoice isDefault choices mkSelect+select choices fromInput isDefault =+  G.inputChoice isDefault choices fromInput mkSelect   where-  mkSelect :: (ToHtml lbl, Monad f) => FormId -> [(a, Int, lbl, Bool)] -> HtmlT f ()+  mkSelect :: (ToHtml lbl, Monad f, PathPiece a) => FormId -> [Choice lbl a] -> HtmlT f ()   mkSelect nm choices' =     select_ [name_ (encodeFormId nm)] $       traverse_ mkOption choices'-  mkOption :: (ToHtml lbl, Monad f) => (a, Int, lbl, Bool) -> HtmlT f ()-  mkOption (_, val, lbl, selected) =+  mkOption :: (ToHtml lbl, Monad f, PathPiece a) => Choice lbl a -> HtmlT f ()+  mkOption (Choice _ lbl selected val) =     option_       ( (if selected then ((:) (selected_ "selected")) else id)         [value_ (toPathPiece val)]@@ -290,23 +290,23 @@ -- -- This creates a @\<select\>@ element which allows more than one item to be selected. selectMultiple-  :: (Functor m, Monad m, FormError input err, FormInput input, Monad f)+  :: (Functor m, Environment m input, FormError input err, FormInput input, Monad f, PathPiece a, Eq a)   => [(a, Html ())] -- ^ value, label, initially checked+  -> (input -> Either err [a])   -> (a -> Bool) -- ^ isSelected initially   -> Form m input err (HtmlT f ()) [a]-selectMultiple choices isSelected =-  G.inputMulti choices mkSelect isSelected+selectMultiple choices fromInput isSelected =+  G.inputMulti choices fromInput mkSelect isSelected   where-  mkSelect :: (ToHtml lbl, Monad f) => FormId -> [(a, Int, lbl, Bool)] -> HtmlT f ()+  mkSelect :: (ToHtml lbl, Monad f, PathPiece a) => FormId -> [Choice lbl a] -> HtmlT f ()   mkSelect nm choices' =     select_ [name_ (encodeFormId nm), multiple_ "multiple"] $       traverse_ mkOption choices'-  mkOption :: (ToHtml lbl, Monad f) => (a, Int, lbl, Bool) -> HtmlT f ()-  mkOption (_, val, lbl, selected) =+  mkOption :: (ToHtml lbl, Monad f, PathPiece a) => Choice lbl a -> HtmlT f ()+  mkOption (Choice _ lbl selected val) =     option_       ( (if selected then ((:) (selected_ "selected")) else id)         [value_ (toPathPiece val)]       )       (toHtml lbl)-