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.Text (Text)
|
||||||
import Data.String (IsString(..))
|
import Data.String (IsString(..))
|
||||||
import Yesod.Core
|
import Yesod.Core
|
||||||
|
|
||||||
import qualified Data.Text as T
|
|
||||||
|
|
||||||
import Yesod.Form.Types
|
import Yesod.Form.Types
|
||||||
import Yesod.Form.Functions
|
import Yesod.Form.Functions
|
||||||
|
|
||||||
@ -82,12 +79,6 @@ withSmallInput fs = fs { fsAttrs = newAttrs }
|
|||||||
where newAttrs = addClass "input-sm" (fsAttrs fs)
|
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
|
-- | How many bootstrap grid columns should be taken (see
|
||||||
-- 'BootstrapFormLayout').
|
-- 'BootstrapFormLayout').
|
||||||
--
|
--
|
||||||
|
|||||||
@ -51,10 +51,13 @@ module Yesod.Form.Functions
|
|||||||
, parseHelper
|
, parseHelper
|
||||||
, parseHelperGen
|
, parseHelperGen
|
||||||
, convertField
|
, convertField
|
||||||
|
, addClass
|
||||||
|
, removeClass
|
||||||
) where
|
) where
|
||||||
|
|
||||||
import Yesod.Form.Types
|
import Yesod.Form.Types
|
||||||
import Data.Text (Text, pack)
|
import Data.Text (Text, pack)
|
||||||
|
import qualified Data.Text as T
|
||||||
import Control.Arrow (second)
|
import Control.Arrow (second)
|
||||||
import Control.Monad.Trans.Class
|
import Control.Monad.Trans.Class
|
||||||
import Control.Monad.Trans.RWS (ask, get, put, runRWST, tell, evalRWST, local, mapRWST)
|
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
|
fParse' ts = fmap (fmap (fmap to)) . fParse ts
|
||||||
fView' ti tn at ei = fView ti tn at (fmap from ei)
|
fView' ti tn at ei = fView ti tn at (fmap from ei)
|
||||||
in Field fParse' fView' fEnctype
|
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