ditto-lucid 0.1.3.0 → 0.2

raw patch · 4 files changed

+70/−78 lines, 4 filesdep ~dittoPVP ok

version bump matches the API change (PVP)

Dependency ranges changed: ditto

API changes (from Hackage documentation)

Files

• ditto-lucid.cabal +3/−2
• src/Ditto/Lucid.hs +5/−8
• src/Ditto/Lucid/Named.hs +31/−34
• src/Ditto/Lucid/Unnamed.hs +31/−34

@@ -1,5 +1,5 @@ Name:                ditto-lucid-Version:             0.1.3.0+Version:             0.2 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@@ -17,6 +17,7 @@   location: https://github.com/goolord/ditto-lucid.git  Library+  ghc-options: -Wall   exposed-modules:      Ditto.Lucid     Ditto.Lucid.Unnamed@@ -24,7 +25,7 @@   build-depends:       base >4.5 && <5     , lucid < 3.0.0-    , ditto >= 0.1.3.0 && <= 0.2+    , ditto >= 0.2 && <= 0.3     , text >= 0.11 && < 1.3     , path-pieces   hs-source-dirs: src

@@ -2,23 +2,20 @@ {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TypeFamilies #-} +{-# OPTIONS_GHC -fno-warn-orphans #-}+ module Ditto.Lucid where  import Data.Foldable (traverse_)-import Data.Monoid ((<>), mconcat, mempty) import Data.Text (Text) import Lucid-import Ditto.Backend import Ditto.Core import Ditto.Generalized as G-import Ditto.Result (FormId, Result (Ok), unitRange)-import Web.PathPieces+import Ditto.Result (FormId) import qualified Data.Text as T-import qualified Text.Read -instance PathPiece FormId where-  toPathPiece fid = T.pack (show fid)-  fromPathPiece fidT = Nothing+encodeFormId :: FormId -> Text+encodeFormId = T.pack . show  -- | create @\<form action=action method=\"GET\" enctype=\"application/xxx-form-urlencoded\"\>@ formGenGET

@@ -5,17 +5,14 @@ module Ditto.Lucid.Named where  import Data.Foldable (traverse_, fold)-import Data.Monoid ((<>), mconcat, mempty)-import Data.Text (Text) import Ditto.Backend import Ditto.Core+import Ditto.Lucid (encodeFormId) import Ditto.Generalized.Named as G-import Ditto.Lucid import Ditto.Result (FormId, Result (Ok), unitRange) import Lucid import Web.PathPieces 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)@@ -28,7 +25,7 @@   -> 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_ (toPathPiece i), name_ (toPathPiece i), value_ (toPathPiece a)]+  inputField i a = input_ [type_ "text", id_ (encodeFormId i), name_ (encodeFormId i), value_ (toPathPiece a)]  inputPassword   :: (Monad m, FormError err, PathPiece text, Applicative f)@@ -38,7 +35,7 @@   -> Form m input err (HtmlT f ()) text 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_ (encodeFormId i), name_ (encodeFormId i), value_ (toPathPiece a)]  inputSubmit   :: (Monad m, FormError err, PathPiece text, Applicative f)@@ -46,18 +43,18 @@   -> String   -> text   -> Form m input err (HtmlT f ()) (Maybe text)-inputSubmit getInput name initialValue = G.inputMaybe name getInput inputField initialValue+inputSubmit getInput name initialValue = G.inputMaybe name getInput inputField (Just initialValue)   where-  inputField i a = input_ [type_ "submit", id_ (toPathPiece i), name_ (toPathPiece i), value_ (toPathPiece a)]+  inputField i a = input_ [type_ "submit", id_ (encodeFormId i), name_ (encodeFormId 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 name inputField lbl+inputReset name lbl = G.inputNoData name inputField   where-  inputField i a = input_ [type_ "submit", id_ (toPathPiece i), name_ (toPathPiece i), value_ (toPathPiece a)]+  inputField i = input_ [type_ "submit", id_ (encodeFormId i), name_ (encodeFormId i), value_ (toPathPiece lbl)]  inputHidden   :: (Monad m, FormError err, PathPiece text, Applicative f)@@ -67,16 +64,16 @@   -> Form m input err (HtmlT f ()) text 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_ (encodeFormId i), name_ (encodeFormId 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 name inputField label+inputButton name lbl = G.inputNoData name inputField   where-  inputField i a = input_ [type_ "button", id_ (toPathPiece i), name_ (toPathPiece i), value_ (toPathPiece a)]+  inputField i = input_ [type_ "button", id_ (encodeFormId i), name_ (encodeFormId i), value_ (toPathPiece lbl)]  textarea   :: (Monad m, FormError err, ToHtml text, Monad f)@@ -92,8 +89,8 @@     textarea_       [ rows_ (toPathPiece rows)       , cols_ (toPathPiece cols)-      , id_ (toPathPiece i)-      , name_ (toPathPiece i)+      , id_ (encodeFormId i)+      , name_ (encodeFormId i)       ] $       toHtml txt @@ -106,7 +103,7 @@   -> Form m input err (HtmlT f ()) (FileType input) inputFile name = G.inputFile name fileView   where-  fileView i = input_ [type_ "file", id_ (toPathPiece i), name_ (toPathPiece i)]+  fileView i = input_ [type_ "file", id_ (encodeFormId i), name_ (encodeFormId i)]  -- | Create a @\<button type=\"submit\"\>@ element buttonSubmit@@ -116,9 +113,9 @@   -> text   -> children   -> Form m input err (HtmlT f ()) (Maybe text)-buttonSubmit getInput name text c = G.inputMaybe name getInput inputField text+buttonSubmit getInput name text c = G.inputMaybe name getInput inputField (Just 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_ (encodeFormId i), name_ (encodeFormId i), value_ (toPathPiece a)] $ toHtml c  -- | create a  @\<button type=\"reset\"\>\<\/button\>@ element --@@ -128,9 +125,9 @@   => String   -> HtmlT f ()   -> Form m input err (HtmlT f ()) ()-buttonReset name c = G.inputNoData name inputField Nothing+buttonReset name c = G.inputNoData name inputField   where-  inputField i a = button_ [type_ "reset", id_ (toPathPiece i), name_ (toPathPiece i)] c+  inputField i = button_ [type_ "reset", id_ (encodeFormId i), name_ (encodeFormId i)] c  -- | create a  @\<button type=\"button\"\>\<\/button\>@ element --@@ -140,9 +137,9 @@   => String   -> HtmlT f ()   -> Form m input err (HtmlT f ()) ()-button name c = G.inputNoData name inputField Nothing+button name c = G.inputNoData name inputField   where-  inputField i a = button_ [type_ "button", id_ (toPathPiece i), name_ (toPathPiece i)] c+  inputField i = button_ [type_ "button", id_ (encodeFormId i), name_ (encodeFormId i)] c  -- | create a @\<label\>@ element. --@@ -156,7 +153,7 @@   -> Form m input err (HtmlT f ()) () label c name = G.label name mkLabel   where-    mkLabel i = label_ [for_ (toPathPiece i)] c+  mkLabel i = label_ [for_ (encodeFormId i)] c  arbitraryHtml :: Monad m => view -> Form m input err view () arbitraryHtml = view@@ -172,8 +169,8 @@   inputField i a =     input_       [ type_ "number"-      , id_ (toPathPiece i)-      , name_ (toPathPiece i)+      , id_ (encodeFormId i)+      , name_ (encodeFormId i)       , value_ (toPathPiece a)       ] @@ -185,7 +182,7 @@   -> Form m input err (HtmlT f ()) Double 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_ (encodeFormId i), name_ (encodeFormId i), value_ (T.pack $ show a)]  -- | Create a single @\<input type=\"checkbox\"\>@ element --@@ -193,7 +190,7 @@ -- -- see also 'inputCheckboxes' inputCheckbox-  :: forall x err input m f. (Monad m, FormError err, ErrorInputType err ~ input, Applicative f)+  :: forall err input m f. (Monad m, FormError err, ErrorInputType err ~ input, Applicative f)   => Bool -- ^ initially checked   -> String -- ^   -> Form m input err (HtmlT f ()) Bool@@ -210,7 +207,7 @@     let checkbox =           input_ $             (if checked then (:) checked_ else id)-              [type_ "checkbox", id_ (toPathPiece i), name_ (toPathPiece i), value_ (toPathPiece i)]+              [type_ "checkbox", id_ (encodeFormId i), name_ (encodeFormId i), value_ (encodeFormId i)]      in pure           ( View $ const $ checkbox           , pure $@@ -236,9 +233,9 @@   mkCheckbox nm (i, val, lbl, checked) =     [ input_ $         ( (if checked then (checked_ :) else id)-          [type_ "checkbox", id_ (toPathPiece i), name_ (toPathPiece nm), value_ (toPathPiece val)]+          [type_ "checkbox", id_ (encodeFormId i), name_ (encodeFormId nm), value_ (toPathPiece val)]         )-    , label_ [for_ (toPathPiece i)] $ toHtml lbl+    , label_ [for_ (encodeFormId i)] $ toHtml lbl     ]  -- | Create a group of @\<input type=\"radio\"\>@ elements@@ -255,8 +252,8 @@   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+          [type_ "radio", id_ (encodeFormId i), name_ (encodeFormId nm), value_ (toPathPiece val)]+    , label_ [for_ (encodeFormId i)] $ toHtml lbl     , br_ []     ] @@ -273,7 +270,7 @@   where   mkSelect :: (ToHtml lbl, Monad f) => FormId -> [(a, Int, lbl, Bool)] -> HtmlT f ()   mkSelect nm choices' =-    select_ [name_ (toPathPiece nm)] $+    select_ [name_ (encodeFormId nm)] $       traverse_ mkOption choices'   mkOption :: (ToHtml lbl, Monad f) => (a, Int, lbl, Bool) -> HtmlT f ()   mkOption (_, val, lbl, selected) =@@ -296,7 +293,7 @@   where   mkSelect :: (ToHtml lbl, Monad f) => FormId -> [(a, Int, lbl, Bool)] -> HtmlT f ()   mkSelect nm choices' =-    select_ [name_ (toPathPiece nm), multiple_ "multiple"] $+    select_ [name_ (encodeFormId nm), multiple_ "multiple"] $       traverse_ mkOption choices'   mkOption :: (ToHtml lbl, Monad f) => (a, Int, lbl, Bool) -> HtmlT f ()   mkOption (_, val, lbl, selected) =

@@ -5,8 +5,6 @@ module Ditto.Lucid.Unnamed where  import Data.Foldable (traverse_, fold)-import Data.Monoid ((<>), mconcat, mempty)-import Data.Text (Text) import Ditto.Backend import Ditto.Core import Ditto.Generalized as G@@ -15,7 +13,6 @@ import Lucid import Web.PathPieces 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)@@ -27,7 +24,7 @@   -> Form m input error (HtmlT f ()) text inputText getInput initialValue = G.input 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_ (encodeFormId i), name_ (encodeFormId i), value_ (toPathPiece a)]  inputPassword   :: (Monad m, FormError error, PathPiece text, Applicative f)@@ -36,24 +33,24 @@   -> 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_ (encodeFormId i), name_ (encodeFormId i), value_ (toPathPiece a)]  inputSubmit   :: (Monad m, FormError error, PathPiece text, Applicative f)   => (input -> Either error text)   -> text   -> Form m input error (HtmlT f ()) (Maybe text)-inputSubmit getInput initialValue = G.inputMaybe getInput inputField initialValue+inputSubmit getInput initialValue = G.inputMaybe getInput inputField (Just initialValue)   where-  inputField i a = input_ [type_ "submit", id_ (toPathPiece i), name_ (toPathPiece i), value_ (toPathPiece a)]+  inputField i a = input_ [type_ "submit", id_ (encodeFormId i), name_ (encodeFormId i), value_ (toPathPiece a)]  inputReset   :: (Monad m, FormError error, PathPiece text, Applicative f)   => text   -> Form m input error (HtmlT f ()) ()-inputReset lbl = G.inputNoData inputField lbl+inputReset lbl = G.inputNoData inputField   where-  inputField i a = input_ [type_ "submit", id_ (toPathPiece i), name_ (toPathPiece i), value_ (toPathPiece a)]+  inputField i = input_ [type_ "submit", id_ (encodeFormId i), name_ (encodeFormId i), value_ (toPathPiece lbl)]  inputHidden   :: (Monad m, FormError error, PathPiece text, Applicative f)@@ -62,15 +59,15 @@   -> 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_ (encodeFormId i), name_ (encodeFormId i), value_ (toPathPiece a)]  inputButton   :: (Monad m, FormError error, PathPiece text, Applicative f)   => text   -> Form m input error (HtmlT f ()) ()-inputButton label = G.inputNoData inputField label+inputButton lbl = G.inputNoData inputField   where-  inputField i a = input_ [type_ "button", id_ (toPathPiece i), name_ (toPathPiece i), value_ (toPathPiece a)]+  inputField i = input_ [type_ "button", id_ (encodeFormId i), name_ (encodeFormId i), value_ (toPathPiece lbl)]  textarea   :: (Monad m, FormError error, ToHtml text, Monad f)@@ -85,8 +82,8 @@     textarea_       [ rows_ (toPathPiece rows)       , cols_ (toPathPiece cols)-      , id_ (toPathPiece i)-      , name_ (toPathPiece i)+      , id_ (encodeFormId i)+      , name_ (encodeFormId i)       ] $       toHtml txt @@ -98,7 +95,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_ (encodeFormId i), name_ (encodeFormId i)]  -- | Create a @\<button type=\"submit\"\>@ element buttonSubmit@@ -107,9 +104,9 @@   -> text   -> children   -> Form m input error (HtmlT f ()) (Maybe text)-buttonSubmit getInput text c = G.inputMaybe getInput inputField text+buttonSubmit getInput text c = G.inputMaybe getInput inputField (Just 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_ (encodeFormId i), name_ (encodeFormId i), value_ (toPathPiece a)] $ toHtml c  -- | create a  @\<button type=\"reset\"\>\<\/button\>@ element --@@ -118,9 +115,9 @@   :: (Monad m, FormError error, ToHtml children, Monad f)   => children   -> Form m input error (HtmlT f ()) ()-buttonReset c = G.inputNoData inputField Nothing+buttonReset c = G.inputNoData inputField    where-  inputField i a = button_ [type_ "reset", id_ (toPathPiece i), name_ (toPathPiece i)] $ toHtml c+  inputField i = button_ [type_ "reset", id_ (encodeFormId i), name_ (encodeFormId i)] $ toHtml c  -- | create a  @\<button type=\"button\"\>\<\/button\>@ element --@@ -129,9 +126,9 @@   :: (Monad m, FormError error, ToHtml children, Monad f)   => children   -> Form m input error (HtmlT f ()) ()-button c = G.inputNoData inputField Nothing+button c = G.inputNoData inputField   where-  inputField i a = button_ [type_ "button", id_ (toPathPiece i), name_ (toPathPiece i)] $ toHtml c+  inputField i = button_ [type_ "button", id_ (encodeFormId i), name_ (encodeFormId i)] $ toHtml c  -- | create a @\<label\>@ element. --@@ -144,7 +141,7 @@   -> Form m input error (HtmlT f ()) () label c = G.label mkLabel   where-  mkLabel i = label_ [for_ (toPathPiece i)] c+  mkLabel i = label_ [for_ (encodeFormId i)] c  arbitraryHtml :: Monad m => view -> Form m input error view () arbitraryHtml wrap =@@ -170,8 +167,8 @@   inputField i a =     input_       [ type_ "number"-      , id_ (toPathPiece i)-      , name_ (toPathPiece i)+      , id_ (encodeFormId i)+      , name_ (encodeFormId i)       , value_ (toPathPiece a)       ] @@ -182,7 +179,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_ (encodeFormId i), name_ (encodeFormId i), value_ (T.pack $ show a)]  -- | Create a single @\<input type=\"checkbox\"\>@ element --@@ -190,7 +187,7 @@ -- -- see also 'inputCheckboxes' inputCheckbox-  :: forall x error input m f. (Monad m, FormError error, ErrorInputType error ~ input, Applicative f)+  :: forall error input m f. (Monad m, FormError error, ErrorInputType error ~ input, Applicative f)   => Bool -- ^ initially checked   -> Form m input error (HtmlT f ()) Bool inputCheckbox initiallyChecked =@@ -200,13 +197,13 @@     case v of       Default -> mkCheckbox i initiallyChecked       Missing -> mkCheckbox i False -- checkboxes only appear in the submitted data when checked-      Found input -> mkCheckbox i True+      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)]+              [type_ "checkbox", id_ (encodeFormId i), name_ (encodeFormId i), value_ (encodeFormId i)]      in pure           ( View $ const $ checkbox           , pure $@@ -233,9 +230,9 @@   mkCheckbox nm (i, val, lbl, checked) =     [ input_ $         ( (if checked then (checked_ :) else id)-          [type_ "checkbox", id_ (toPathPiece i), name_ (toPathPiece nm), value_ (toPathPiece val)]+          [type_ "checkbox", id_ (encodeFormId i), name_ (encodeFormId nm), value_ (toPathPiece val)]         )-    , label_ [for_ (toPathPiece i)] $ toHtml lbl+    , label_ [for_ (encodeFormId i)] $ toHtml lbl     ]  -- | Create a group of @\<input type=\"radio\"\>@ elements@@ -251,8 +248,8 @@   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+          [type_ "radio", id_ (encodeFormId i), name_ (encodeFormId nm), value_ (toPathPiece val)]+    , label_ [for_ (encodeFormId i)] $ toHtml lbl     , br_ []     ] @@ -269,7 +266,7 @@   where   mkSelect :: (ToHtml lbl, Monad f) => FormId -> [(a, Int, lbl, Bool)] -> HtmlT f ()   mkSelect nm choices' =-    select_ [name_ (toPathPiece nm)] $+    select_ [name_ (encodeFormId nm)] $       traverse_ mkOption choices'   mkOption :: (ToHtml lbl, Monad f) => (a, Int, lbl, Bool) -> HtmlT f ()   mkOption (_, val, lbl, selected) =@@ -292,7 +289,7 @@   where   mkSelect :: (ToHtml lbl, Monad f) => FormId -> [(a, Int, lbl, Bool)] -> HtmlT f ()   mkSelect nm choices' =-    select_ [name_ (toPathPiece nm), multiple_ "multiple"] $+    select_ [name_ (encodeFormId nm), multiple_ "multiple"] $       traverse_ mkOption choices'   mkOption :: (ToHtml lbl, Monad f) => (a, Int, lbl, Bool) -> HtmlT f ()   mkOption (_, val, lbl, selected) =