From 56ca6d7914809bf41ac8a83a14b5d6cd4517f44b Mon Sep 17 00:00:00 2001 From: Ben Sima Date: Fri, 11 May 2018 12:55:08 -0700 Subject: [PATCH 1/8] Move 'addClass' to Yesod.Form.Functions and add 'removeClass' 'addClass' is more general than just Bootstrap forms. In particular, it is copied into the yesod-form-bootstrap4 project and I found myself using it in my custom forms. It would be useful to have it exported for use elsewhere. I added 'removeClass' because I needed it while creating a custom 'readonly' input in a form and thought it might be generally useful. --- yesod-form/Yesod/Form/Bootstrap3.hs | 9 --------- yesod-form/Yesod/Form/Functions.hs | 19 +++++++++++++++++++ 2 files changed, 19 insertions(+), 9 deletions(-) diff --git a/yesod-form/Yesod/Form/Bootstrap3.hs b/yesod-form/Yesod/Form/Bootstrap3.hs index 5d2a4ffb..e99f82ba 100644 --- a/yesod-form/Yesod/Form/Bootstrap3.hs +++ b/yesod-form/Yesod/Form/Bootstrap3.hs @@ -33,9 +33,6 @@ import Control.Monad (liftM) import Data.Text (Text) import Data.String (IsString(..)) import Yesod.Core - -import qualified Data.Text as T - import Yesod.Form.Types import Yesod.Form.Functions @@ -82,12 +79,6 @@ withSmallInput fs = fs { fsAttrs = newAttrs } where newAttrs = addClass "input-sm" (fsAttrs fs) -addClass :: Text -> [(Text, Text)] -> [(Text, Text)] -addClass klass [] = [("class", klass)] -addClass klass (("class", old):rest) = ("class", T.concat [old, " ", klass]) : rest -addClass klass (other :rest) = other : addClass klass rest - - -- | How many bootstrap grid columns should be taken (see -- 'BootstrapFormLayout'). -- diff --git a/yesod-form/Yesod/Form/Functions.hs b/yesod-form/Yesod/Form/Functions.hs index fe02e8db..83264bac 100644 --- a/yesod-form/Yesod/Form/Functions.hs +++ b/yesod-form/Yesod/Form/Functions.hs @@ -51,10 +51,13 @@ module Yesod.Form.Functions , parseHelper , parseHelperGen , convertField + , addClass + , removeClass ) where import Yesod.Form.Types import Data.Text (Text, pack) +import qualified Data.Text as T import Control.Arrow (second) import Control.Monad.Trans.Class import Control.Monad.Trans.RWS (ask, get, put, runRWST, tell, evalRWST, local, mapRWST) @@ -615,3 +618,19 @@ convertField to from (Field fParse fView fEnctype) = let fParse' ts = fmap (fmap (fmap to)) . fParse ts fView' ti tn at ei = fView ti tn at (fmap from ei) in Field fParse' fView' fEnctype + +-- | Removes a CSS class from the 'fsAttrs' in a 'FieldSettings'. +removeClass :: Text -- ^ The class to remove + -> [(Text, Text)] -- ^ List of existing 'fsAttrs' + -> [(Text, Text)] +removeClass _ [] = [] +removeClass klass (("class", old):rest) = ("class"::Text, T.replace klass " " old) : rest +removeClass klass (other :rest) = other : removeClass klass rest + +-- | Adds a CSS class to the 'fsAttrs' in a 'FieldSettings'. +addClass :: Text -- ^ The class to add + -> [(Text, Text)] -- ^ List of existing 'fsAttrs' + -> [(Text, Text)] +addClass klass [] = [("class"::Text, klass)] +addClass klass (("class", old):rest) = ("class", T.concat [old, " ", klass]) : rest +addClass klass (other :rest) = other : addClass klass rest From 0dffa0e29aaadc618dc6c75a0a882cf6667f2523 Mon Sep 17 00:00:00 2001 From: Ben Sima Date: Fri, 11 May 2018 13:30:50 -0700 Subject: [PATCH 2/8] Bump version 1.6.2 --- yesod-form/yesod-form.cabal | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/yesod-form/yesod-form.cabal b/yesod-form/yesod-form.cabal index adfcd2a9..f3e2fa51 100644 --- a/yesod-form/yesod-form.cabal +++ b/yesod-form/yesod-form.cabal @@ -1,5 +1,5 @@ name: yesod-form -version: 1.6.1 +version: 1.6.2 license: MIT license-file: LICENSE author: Michael Snoyman From c57ba494728988c4aef8b7cf0870bf55289c30a4 Mon Sep 17 00:00:00 2001 From: Ben Sima Date: Fri, 11 May 2018 13:28:55 -0700 Subject: [PATCH 3/8] Add @since documentation --- yesod-form/Yesod/Form/Functions.hs | 4 ++++ 1 file changed, 4 insertions(+) diff --git a/yesod-form/Yesod/Form/Functions.hs b/yesod-form/Yesod/Form/Functions.hs index 83264bac..77f1f840 100644 --- a/yesod-form/Yesod/Form/Functions.hs +++ b/yesod-form/Yesod/Form/Functions.hs @@ -620,6 +620,8 @@ convertField to from (Field fParse fView fEnctype) = let in Field fParse' fView' fEnctype -- | Removes a CSS class from the 'fsAttrs' in a 'FieldSettings'. +-- +-- @since 1.6.2 removeClass :: Text -- ^ The class to remove -> [(Text, Text)] -- ^ List of existing 'fsAttrs' -> [(Text, Text)] @@ -628,6 +630,8 @@ removeClass klass (("class", old):rest) = ("class"::Text, T.replace klass " " ol removeClass klass (other :rest) = other : removeClass klass rest -- | Adds a CSS class to the 'fsAttrs' in a 'FieldSettings'. +-- +-- @since 1.6.2 addClass :: Text -- ^ The class to add -> [(Text, Text)] -- ^ List of existing 'fsAttrs' -> [(Text, Text)] From 6334e77515139e69c16c5e1106c11ac00ee6732f Mon Sep 17 00:00:00 2001 From: Ben Sima Date: Fri, 11 May 2018 13:35:12 -0700 Subject: [PATCH 4/8] Update changelog --- yesod-form/ChangeLog.md | 5 +++++ 1 file changed, 5 insertions(+) diff --git a/yesod-form/ChangeLog.md b/yesod-form/ChangeLog.md index 79a704be..eecf753a 100644 --- a/yesod-form/ChangeLog.md +++ b/yesod-form/ChangeLog.md @@ -1,3 +1,8 @@ +## 1.6.2 + +* Move `addClass` from private/undocumented in `Yesod.Form.Bootstrap3` to `Yesod.Form.Functions` +* Add `Yesod.Form.Functions.removeClass` + ## 1.6.1 * Explicitly define `(<>)` in the `Semigroup` instance for `Enctype` From c163a0841abf647664108d79c8c96706b7c8030a Mon Sep 17 00:00:00 2001 From: Ben Sima Date: Fri, 11 May 2018 13:36:10 -0700 Subject: [PATCH 5/8] Add PR link to Changelog --- yesod-form/ChangeLog.md | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/yesod-form/ChangeLog.md b/yesod-form/ChangeLog.md index eecf753a..1251b945 100644 --- a/yesod-form/ChangeLog.md +++ b/yesod-form/ChangeLog.md @@ -1,7 +1,7 @@ ## 1.6.2 -* Move `addClass` from private/undocumented in `Yesod.Form.Bootstrap3` to `Yesod.Form.Functions` -* Add `Yesod.Form.Functions.removeClass` +* Move `addClass` from private/undocumented in `Yesod.Form.Bootstrap3` to `Yesod.Form.Functions` [#1510](https://github.com/yesodweb/yesod/pull/1510) +* Add `Yesod.Form.Functions.removeClass` [#1510](https://github.com/yesodweb/yesod/pull/1510) ## 1.6.1 From e8a145ae88b33eb799ece722801a3356d96b6e1a Mon Sep 17 00:00:00 2001 From: Ben Sima Date: Mon, 14 May 2018 08:45:09 -0700 Subject: [PATCH 6/8] Add examples to addClass and removeClass --- yesod-form/Yesod/Form/Functions.hs | 12 ++++++++++++ 1 file changed, 12 insertions(+) diff --git a/yesod-form/Yesod/Form/Functions.hs b/yesod-form/Yesod/Form/Functions.hs index 77f1f840..847609b0 100644 --- a/yesod-form/Yesod/Form/Functions.hs +++ b/yesod-form/Yesod/Form/Functions.hs @@ -621,6 +621,12 @@ convertField to from (Field fParse fView fEnctype) = let -- | Removes a CSS class from the 'fsAttrs' in a 'FieldSettings'. -- +-- ==== __Examples__ +-- +-- > removeFormControl :: FieldSettings site -> FieldSettings site +-- > removeFormControl fs = fs { fsAttrs = newAttrs } +-- > where newAttrs = removeClass "form-control" (fsAttrs fs) +-- -- @since 1.6.2 removeClass :: Text -- ^ The class to remove -> [(Text, Text)] -- ^ List of existing 'fsAttrs' @@ -631,6 +637,12 @@ removeClass klass (other :rest) = other : removeClass klass rest -- | Adds a CSS class to the 'fsAttrs' in a 'FieldSettings'. -- +-- ==== __Examples__ +-- +-- > withLargeInput :: FieldSettings site -> FieldSettings site +-- > withLargeInput fs = fs { fsAttrs = newAttrs } +-- > where newAttrs = addClass "input-lg" (fsAttrs fs) +-- -- @since 1.6.2 addClass :: Text -- ^ The class to add -> [(Text, Text)] -- ^ List of existing 'fsAttrs' From e906768ee9cbd4accd1a8f8c1a9bda64951b8932 Mon Sep 17 00:00:00 2001 From: Ben Sima Date: Tue, 15 May 2018 12:50:39 -0700 Subject: [PATCH 7/8] Replace addClass/removeClass examples with ghci-driven examples --- yesod-form/Yesod/Form/Functions.hs | 10 ++++------ 1 file changed, 4 insertions(+), 6 deletions(-) diff --git a/yesod-form/Yesod/Form/Functions.hs b/yesod-form/Yesod/Form/Functions.hs index 847609b0..de6d40b2 100644 --- a/yesod-form/Yesod/Form/Functions.hs +++ b/yesod-form/Yesod/Form/Functions.hs @@ -623,9 +623,8 @@ convertField to from (Field fParse fView fEnctype) = let -- -- ==== __Examples__ -- --- > removeFormControl :: FieldSettings site -> FieldSettings site --- > removeFormControl fs = fs { fsAttrs = newAttrs } --- > where newAttrs = removeClass "form-control" (fsAttrs fs) +-- >>> removeClass "form-control" [("class","form-control login-form"),("id","home-login")] +-- [("class"," login-form"),("id","home-login")] -- -- @since 1.6.2 removeClass :: Text -- ^ The class to remove @@ -639,9 +638,8 @@ removeClass klass (other :rest) = other : removeClass klass rest -- -- ==== __Examples__ -- --- > withLargeInput :: FieldSettings site -> FieldSettings site --- > withLargeInput fs = fs { fsAttrs = newAttrs } --- > where newAttrs = addClass "input-lg" (fsAttrs fs) +-- >>> addClass "login-form" [("class", "form-control"), ("id", "home-login")] +-- [("class","form-control login-form"),("id","home-login")] -- -- @since 1.6.2 addClass :: Text -- ^ The class to add From 1d95f8315b390ae16063d23e173960942c062ae4 Mon Sep 17 00:00:00 2001 From: Ben Sima Date: Tue, 15 May 2018 12:51:14 -0700 Subject: [PATCH 8/8] Remove unnecessary type annotation --- yesod-form/Yesod/Form/Functions.hs | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/yesod-form/Yesod/Form/Functions.hs b/yesod-form/Yesod/Form/Functions.hs index de6d40b2..89d6451c 100644 --- a/yesod-form/Yesod/Form/Functions.hs +++ b/yesod-form/Yesod/Form/Functions.hs @@ -631,7 +631,7 @@ removeClass :: Text -- ^ The class to remove -> [(Text, Text)] -- ^ List of existing 'fsAttrs' -> [(Text, Text)] removeClass _ [] = [] -removeClass klass (("class", old):rest) = ("class"::Text, T.replace klass " " old) : rest +removeClass klass (("class", old):rest) = ("class", T.replace klass " " old) : rest removeClass klass (other :rest) = other : removeClass klass rest -- | Adds a CSS class to the 'fsAttrs' in a 'FieldSettings'. @@ -645,6 +645,6 @@ removeClass klass (other :rest) = other : removeClass klass rest addClass :: Text -- ^ The class to add -> [(Text, Text)] -- ^ List of existing 'fsAttrs' -> [(Text, Text)] -addClass klass [] = [("class"::Text, klass)] +addClass klass [] = [("class", klass)] addClass klass (("class", old):rest) = ("class", T.concat [old, " ", klass]) : rest addClass klass (other :rest) = other : addClass klass rest