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:
parent
5861357923
commit
56ca6d7914
@ -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').
|
||||
--
|
||||
|
||||
@ -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
|
||||
|
||||
Loading…
Reference in New Issue
Block a user