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.
This commit is contained in:
Ben Sima 2018-05-11 12:55:08 -07:00
parent 5861357923
commit 56ca6d7914
2 changed files with 19 additions and 9 deletions

View File

@ -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').
--

View File

@ -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