From 56ca6d7914809bf41ac8a83a14b5d6cd4517f44b Mon Sep 17 00:00:00 2001
From: Ben Sima <ben@bsima.me>
Date: Fri, 11 May 2018 12:55:08 -0700
Subject: [PATCH] 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