{-# LANGUAGE QuasiQuotes #-}
{-# LANGUAGE TupleSections #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE CPP #-}
module Yesod.Form.Functions
    ( -- * Running in MForm monad
      newFormIdent
    , askParams
    , askFiles
      -- * Applicative/Monadic conversion
    , formToAForm
    , aFormToForm
    , mFormToWForm
    , wFormToAForm
    , wFormToMForm
      -- * Fields to Forms
    , wreq
    , wreqMsg
    , wopt
    , mreq
    , mreqMsg
    , mopt
    , areq
    , areqMsg
    , aopt
      -- * Run a form
    , runFormPost
    , runFormPostNoToken
    , runFormGet
      -- * Generate a blank form
    , generateFormPost
    , generateFormGet'
    , generateFormGet
      -- * More than one form on a handler
    , identifyForm
      -- * Rendering
    , FormRender
    , renderTable
    , renderDivs
    , renderDivsNoLabels
    , renderBootstrap
    , renderBootstrap2
      -- * Validation
    , check
    , checkBool
    , checkM
    , checkMMap
    , customErrorMessage
      -- * Utilities
    , fieldSettingsLabel
    , 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)
import Control.Monad.Trans.Writer (runWriterT, writer)
import Control.Monad (liftM, join)
import Data.Byteable (constEqBytes)
import Text.Blaze (Markup, toMarkup)
#define Html Markup
#define toHtml toMarkup
import Yesod.Core
import Network.Wai (requestMethod)
import Data.Monoid (mempty, (<>))
import Data.Maybe (listToMaybe, fromMaybe)
import qualified Data.Map as Map
import qualified Data.Text.Encoding as TE
import Control.Arrow (first)

-- | Get a unique identifier.
newFormIdent :: Monad m => MForm m Text
newFormIdent :: MForm m Text
newFormIdent = do
    Ints
i <- RWST
  (Maybe (Env, FileEnv), HandlerSite m, [Text]) Enctype Ints m Ints
forall w (m :: * -> *) r s. (Monoid w, Monad m) => RWST r w s m s
get
    let i' :: Ints
i' = Ints -> Ints
incrInts Ints
i
    Ints
-> RWST
     (Maybe (Env, FileEnv), HandlerSite m, [Text]) Enctype Ints m ()
forall w (m :: * -> *) s r.
(Monoid w, Monad m) =>
s -> RWST r w s m ()
put Ints
i'
    Text -> MForm m Text
forall (m :: * -> *) a. Monad m => a -> m a
return (Text -> MForm m Text) -> Text -> MForm m Text
forall a b. (a -> b) -> a -> b
$ String -> Text
pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ Char
'f' Char -> String -> String
forall a. a -> [a] -> [a]
: Ints -> String
forall a. Show a => a -> String
show Ints
i'
  where
    incrInts :: Ints -> Ints
incrInts (IntSingle Int
i) = Int -> Ints
IntSingle (Int -> Ints) -> Int -> Ints
forall a b. (a -> b) -> a -> b
$ Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1
    incrInts (IntCons Int
i Ints
is) = (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) Int -> Ints -> Ints
`IntCons` Ints
is

formToAForm :: (HandlerSite m ~ site, Monad m)
            => MForm m (FormResult a, [FieldView site])
            -> AForm m a
formToAForm :: MForm m (FormResult a, [FieldView site]) -> AForm m a
formToAForm MForm m (FormResult a, [FieldView site])
form = ((HandlerSite m, [Text])
 -> Maybe (Env, FileEnv)
 -> Ints
 -> m (FormResult a,
       [FieldView (HandlerSite m)] -> [FieldView (HandlerSite m)], Ints,
       Enctype))
-> AForm m a
forall (m :: * -> *) a.
((HandlerSite m, [Text])
 -> Maybe (Env, FileEnv)
 -> Ints
 -> m (FormResult a,
       [FieldView (HandlerSite m)] -> [FieldView (HandlerSite m)], Ints,
       Enctype))
-> AForm m a
AForm (((HandlerSite m, [Text])
  -> Maybe (Env, FileEnv)
  -> Ints
  -> m (FormResult a,
        [FieldView (HandlerSite m)] -> [FieldView (HandlerSite m)], Ints,
        Enctype))
 -> AForm m a)
-> ((HandlerSite m, [Text])
    -> Maybe (Env, FileEnv)
    -> Ints
    -> m (FormResult a,
          [FieldView (HandlerSite m)] -> [FieldView (HandlerSite m)], Ints,
          Enctype))
-> AForm m a
forall a b. (a -> b) -> a -> b
$ \(HandlerSite m
site, [Text]
langs) Maybe (Env, FileEnv)
env Ints
ints -> do
    ((FormResult a
a, [FieldView site]
xmls), Ints
ints', Enctype
enc) <- RWST
  (Maybe (Env, FileEnv), site, [Text])
  Enctype
  Ints
  m
  (FormResult a, [FieldView site])
-> (Maybe (Env, FileEnv), site, [Text])
-> Ints
-> m ((FormResult a, [FieldView site]), Ints, Enctype)
forall r w s (m :: * -> *) a.
RWST r w s m a -> r -> s -> m (a, s, w)
runRWST RWST
  (Maybe (Env, FileEnv), site, [Text])
  Enctype
  Ints
  m
  (FormResult a, [FieldView site])
MForm m (FormResult a, [FieldView site])
form (Maybe (Env, FileEnv)
env, site
HandlerSite m
site, [Text]
langs) Ints
ints
    (FormResult a, [FieldView site] -> [FieldView site], Ints, Enctype)
-> m (FormResult a, [FieldView site] -> [FieldView site], Ints,
      Enctype)
forall (m :: * -> *) a. Monad m => a -> m a
return (FormResult a
a, [FieldView site] -> [FieldView site] -> [FieldView site]
forall a. [a] -> [a] -> [a]
(++) [FieldView site]
xmls, Ints
ints', Enctype
enc)

aFormToForm :: (Monad m, HandlerSite m ~ site)
            => AForm m a
            -> MForm m (FormResult a, [FieldView site] -> [FieldView site])
aFormToForm :: AForm m a
-> MForm m (FormResult a, [FieldView site] -> [FieldView site])
aFormToForm (AForm (HandlerSite m, [Text])
-> Maybe (Env, FileEnv)
-> Ints
-> m (FormResult a,
      [FieldView (HandlerSite m)] -> [FieldView (HandlerSite m)], Ints,
      Enctype)
aform) = do
    Ints
ints <- RWST (Maybe (Env, FileEnv), site, [Text]) Enctype Ints m Ints
forall w (m :: * -> *) r s. (Monoid w, Monad m) => RWST r w s m s
get
    (Maybe (Env, FileEnv)
env, site
site, [Text]
langs) <- RWST
  (Maybe (Env, FileEnv), site, [Text])
  Enctype
  Ints
  m
  (Maybe (Env, FileEnv), site, [Text])
forall w (m :: * -> *) r s. (Monoid w, Monad m) => RWST r w s m r
ask
    (FormResult a
a, [FieldView site] -> [FieldView site]
xml, Ints
ints', Enctype
enc) <- m (FormResult a, [FieldView site] -> [FieldView site], Ints,
   Enctype)
-> RWST
     (Maybe (Env, FileEnv), site, [Text])
     Enctype
     Ints
     m
     (FormResult a, [FieldView site] -> [FieldView site], Ints, Enctype)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m (FormResult a, [FieldView site] -> [FieldView site], Ints,
    Enctype)
 -> RWST
      (Maybe (Env, FileEnv), site, [Text])
      Enctype
      Ints
      m
      (FormResult a, [FieldView site] -> [FieldView site], Ints,
       Enctype))
-> m (FormResult a, [FieldView site] -> [FieldView site], Ints,
      Enctype)
-> RWST
     (Maybe (Env, FileEnv), site, [Text])
     Enctype
     Ints
     m
     (FormResult a, [FieldView site] -> [FieldView site], Ints, Enctype)
forall a b. (a -> b) -> a -> b
$ (HandlerSite m, [Text])
-> Maybe (Env, FileEnv)
-> Ints
-> m (FormResult a,
      [FieldView (HandlerSite m)] -> [FieldView (HandlerSite m)], Ints,
      Enctype)
aform (site
HandlerSite m
site, [Text]
langs) Maybe (Env, FileEnv)
env Ints
ints
    Ints -> RWST (Maybe (Env, FileEnv), site, [Text]) Enctype Ints m ()
forall w (m :: * -> *) s r.
(Monoid w, Monad m) =>
s -> RWST r w s m ()
put Ints
ints'
    Enctype
-> RWST (Maybe (Env, FileEnv), site, [Text]) Enctype Ints m ()
forall (m :: * -> *) w r s. Monad m => w -> RWST r w s m ()
tell Enctype
enc
    (FormResult a, [FieldView site] -> [FieldView site])
-> RWST
     (Maybe (Env, FileEnv), site, [Text])
     Enctype
     Ints
     m
     (FormResult a, [FieldView site] -> [FieldView site])
forall (m :: * -> *) a. Monad m => a -> m a
return (FormResult a
a, [FieldView site] -> [FieldView site]
xml)

askParams :: Monad m => MForm m (Maybe Env)
askParams :: MForm m (Maybe Env)
askParams = do
    (Maybe (Env, FileEnv)
x, HandlerSite m
_, [Text]
_) <- RWST
  (Maybe (Env, FileEnv), HandlerSite m, [Text])
  Enctype
  Ints
  m
  (Maybe (Env, FileEnv), HandlerSite m, [Text])
forall w (m :: * -> *) r s. (Monoid w, Monad m) => RWST r w s m r
ask
    Maybe Env -> MForm m (Maybe Env)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe Env -> MForm m (Maybe Env))
-> Maybe Env -> MForm m (Maybe Env)
forall a b. (a -> b) -> a -> b
$ ((Env, FileEnv) -> Env) -> Maybe (Env, FileEnv) -> Maybe Env
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM (Env, FileEnv) -> Env
forall a b. (a, b) -> a
fst Maybe (Env, FileEnv)
x

askFiles :: Monad m => MForm m (Maybe FileEnv)
askFiles :: MForm m (Maybe FileEnv)
askFiles = do
    (Maybe (Env, FileEnv)
x, HandlerSite m
_, [Text]
_) <- RWST
  (Maybe (Env, FileEnv), HandlerSite m, [Text])
  Enctype
  Ints
  m
  (Maybe (Env, FileEnv), HandlerSite m, [Text])
forall w (m :: * -> *) r s. (Monoid w, Monad m) => RWST r w s m r
ask
    Maybe FileEnv -> MForm m (Maybe FileEnv)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe FileEnv -> MForm m (Maybe FileEnv))
-> Maybe FileEnv -> MForm m (Maybe FileEnv)
forall a b. (a -> b) -> a -> b
$ ((Env, FileEnv) -> FileEnv)
-> Maybe (Env, FileEnv) -> Maybe FileEnv
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM (Env, FileEnv) -> FileEnv
forall a b. (a, b) -> b
snd Maybe (Env, FileEnv)
x

-- | Converts a form field into monadic form 'WForm'. This field requires a
-- value and will return 'FormFailure' if left empty.
--
-- @since 1.4.14
wreq :: (RenderMessage site FormMessage, HandlerSite m ~ site, MonadHandler m)
     => Field m a           -- ^ form field
     -> FieldSettings site  -- ^ settings for this field
     -> Maybe a             -- ^ optional default value
     -> WForm m (FormResult a)
wreq :: Field m a
-> FieldSettings site -> Maybe a -> WForm m (FormResult a)
wreq Field m a
f FieldSettings site
fs = Field m a
-> FieldSettings site
-> FormMessage
-> Maybe a
-> WForm m (FormResult a)
forall site msg (m :: * -> *) a.
(RenderMessage site msg, HandlerSite m ~ site, MonadHandler m) =>
Field m a
-> FieldSettings site -> msg -> Maybe a -> WForm m (FormResult a)
wreqMsg Field m a
f FieldSettings site
fs FormMessage
MsgValueRequired

-- | Same as @wreq@ but with your own message to be rendered in case the value
-- is not provided.
--
-- This is useful when you have several required fields on the page and you
-- want to differentiate between which fields were left blank. Otherwise the
-- user sees "Value is required" multiple times, which is ambiguous.
--
-- @since 1.6.7
wreqMsg :: (RenderMessage site msg, HandlerSite m ~ site, MonadHandler m)
        => Field m a           -- ^ form field
        -> FieldSettings site  -- ^ settings for this field
        -> msg                 -- ^ message to use in case value is Nothing
        -> Maybe a             -- ^ optional default value
        -> WForm m (FormResult a)
wreqMsg :: Field m a
-> FieldSettings site -> msg -> Maybe a -> WForm m (FormResult a)
wreqMsg Field m a
f FieldSettings site
fs msg
msg = RWST
  (Maybe (Env, FileEnv), HandlerSite m, [Text])
  Enctype
  Ints
  m
  (FormResult a, FieldView site)
-> RWST
     (Maybe (Env, FileEnv), HandlerSite m, [Text])
     Enctype
     Ints
     (WriterT [FieldView (HandlerSite m)] m)
     (FormResult a)
forall (m :: * -> *) site a.
(MonadHandler m, HandlerSite m ~ site) =>
MForm m (a, FieldView site) -> WForm m a
mFormToWForm (RWST
   (Maybe (Env, FileEnv), HandlerSite m, [Text])
   Enctype
   Ints
   m
   (FormResult a, FieldView site)
 -> RWST
      (Maybe (Env, FileEnv), HandlerSite m, [Text])
      Enctype
      Ints
      (WriterT [FieldView (HandlerSite m)] m)
      (FormResult a))
-> (Maybe a
    -> RWST
         (Maybe (Env, FileEnv), HandlerSite m, [Text])
         Enctype
         Ints
         m
         (FormResult a, FieldView site))
-> Maybe a
-> RWST
     (Maybe (Env, FileEnv), HandlerSite m, [Text])
     Enctype
     Ints
     (WriterT [FieldView (HandlerSite m)] m)
     (FormResult a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Field m a
-> FieldSettings site
-> msg
-> Maybe a
-> RWST
     (Maybe (Env, FileEnv), HandlerSite m, [Text])
     Enctype
     Ints
     m
     (FormResult a, FieldView site)
forall site msg (m :: * -> *) a.
(RenderMessage site msg, HandlerSite m ~ site, MonadHandler m) =>
Field m a
-> FieldSettings site
-> msg
-> Maybe a
-> MForm m (FormResult a, FieldView site)
mreqMsg Field m a
f FieldSettings site
fs msg
msg

-- | Converts a form field into monadic form 'WForm'. This field is optional,
-- i.e.  if filled in, it returns 'Just a', if left empty, it returns
-- 'Nothing'.  Arguments are the same as for 'wreq' (apart from type of default
-- value).
--
-- @since 1.4.14
wopt :: (MonadHandler m, HandlerSite m ~ site)
     => Field m a           -- ^ form field
     -> FieldSettings site  -- ^ settings for this field
     -> Maybe (Maybe a)     -- ^ optional default value
     -> WForm m (FormResult (Maybe a))
wopt :: Field m a
-> FieldSettings site
-> Maybe (Maybe a)
-> WForm m (FormResult (Maybe a))
wopt Field m a
f FieldSettings site
fs = RWST
  (Maybe (Env, FileEnv), HandlerSite m, [Text])
  Enctype
  Ints
  m
  (FormResult (Maybe a), FieldView site)
-> RWST
     (Maybe (Env, FileEnv), HandlerSite m, [Text])
     Enctype
     Ints
     (WriterT [FieldView (HandlerSite m)] m)
     (FormResult (Maybe a))
forall (m :: * -> *) site a.
(MonadHandler m, HandlerSite m ~ site) =>
MForm m (a, FieldView site) -> WForm m a
mFormToWForm (RWST
   (Maybe (Env, FileEnv), HandlerSite m, [Text])
   Enctype
   Ints
   m
   (FormResult (Maybe a), FieldView site)
 -> RWST
      (Maybe (Env, FileEnv), HandlerSite m, [Text])
      Enctype
      Ints
      (WriterT [FieldView (HandlerSite m)] m)
      (FormResult (Maybe a)))
-> (Maybe (Maybe a)
    -> RWST
         (Maybe (Env, FileEnv), HandlerSite m, [Text])
         Enctype
         Ints
         m
         (FormResult (Maybe a), FieldView site))
-> Maybe (Maybe a)
-> RWST
     (Maybe (Env, FileEnv), HandlerSite m, [Text])
     Enctype
     Ints
     (WriterT [FieldView (HandlerSite m)] m)
     (FormResult (Maybe a))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Field m a
-> FieldSettings site
-> Maybe (Maybe a)
-> RWST
     (Maybe (Env, FileEnv), HandlerSite m, [Text])
     Enctype
     Ints
     m
     (FormResult (Maybe a), FieldView site)
forall site (m :: * -> *) a.
(site ~ HandlerSite m, MonadHandler m) =>
Field m a
-> FieldSettings site
-> Maybe (Maybe a)
-> MForm m (FormResult (Maybe a), FieldView site)
mopt Field m a
f FieldSettings site
fs

-- | Converts a monadic form 'WForm' into an applicative form 'AForm'.
--
-- @since 1.4.14
wFormToAForm :: MonadHandler m
             => WForm m (FormResult a)  -- ^ input form
             -> AForm m a               -- ^ output form
wFormToAForm :: WForm m (FormResult a) -> AForm m a
wFormToAForm = MForm m (FormResult a, [FieldView (HandlerSite m)]) -> AForm m a
forall (m :: * -> *) site a.
(HandlerSite m ~ site, Monad m) =>
MForm m (FormResult a, [FieldView site]) -> AForm m a
formToAForm (MForm m (FormResult a, [FieldView (HandlerSite m)]) -> AForm m a)
-> (RWST
      (Maybe (Env, FileEnv), HandlerSite m, [Text])
      Enctype
      Ints
      (WriterT [FieldView (HandlerSite m)] m)
      (FormResult a)
    -> MForm m (FormResult a, [FieldView (HandlerSite m)]))
-> RWST
     (Maybe (Env, FileEnv), HandlerSite m, [Text])
     Enctype
     Ints
     (WriterT [FieldView (HandlerSite m)] m)
     (FormResult a)
-> AForm m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RWST
  (Maybe (Env, FileEnv), HandlerSite m, [Text])
  Enctype
  Ints
  (WriterT [FieldView (HandlerSite m)] m)
  (FormResult a)
-> MForm m (FormResult a, [FieldView (HandlerSite m)])
forall (m :: * -> *) site a.
(MonadHandler m, HandlerSite m ~ site) =>
WForm m a -> MForm m (a, [FieldView site])
wFormToMForm

-- | Converts a monadic form 'WForm' into another monadic form 'MForm'.
--
-- @since 1.4.14
wFormToMForm :: (MonadHandler m, HandlerSite m ~ site)
             => WForm m a                      -- ^ input form
             -> MForm m (a, [FieldView site])  -- ^ output form
wFormToMForm :: WForm m a -> MForm m (a, [FieldView site])
wFormToMForm = (WriterT [FieldView site] m (a, Ints, Enctype)
 -> m ((a, [FieldView site]), Ints, Enctype))
-> RWST
     (Maybe (Env, FileEnv), site, [Text])
     Enctype
     Ints
     (WriterT [FieldView site] m)
     a
-> RWST
     (Maybe (Env, FileEnv), site, [Text])
     Enctype
     Ints
     m
     (a, [FieldView site])
forall (m :: * -> *) a s w (n :: * -> *) b w' r.
(m (a, s, w) -> n (b, s, w')) -> RWST r w s m a -> RWST r w' s n b
mapRWST ((((a, Ints, Enctype), [FieldView site])
 -> ((a, [FieldView site]), Ints, Enctype))
-> m ((a, Ints, Enctype), [FieldView site])
-> m ((a, [FieldView site]), Ints, Enctype)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((a, Ints, Enctype), [FieldView site])
-> ((a, [FieldView site]), Ints, Enctype)
forall a b c b. ((a, b, c), b) -> ((a, b), b, c)
group (m ((a, Ints, Enctype), [FieldView site])
 -> m ((a, [FieldView site]), Ints, Enctype))
-> (WriterT [FieldView site] m (a, Ints, Enctype)
    -> m ((a, Ints, Enctype), [FieldView site]))
-> WriterT [FieldView site] m (a, Ints, Enctype)
-> m ((a, [FieldView site]), Ints, Enctype)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WriterT [FieldView site] m (a, Ints, Enctype)
-> m ((a, Ints, Enctype), [FieldView site])
forall w (m :: * -> *) a. WriterT w m a -> m (a, w)
runWriterT)
  where
    group :: ((a, b, c), b) -> ((a, b), b, c)
group ((a
a, b
ints, c
enctype), b
views) = ((a
a, b
views), b
ints, c
enctype)

-- | Converts a monadic form 'MForm' into another monadic form 'WForm'.
--
-- @since 1.4.14
mFormToWForm :: (MonadHandler m, HandlerSite m ~ site)
             => MForm m (a, FieldView site)  -- ^ input form
             -> WForm m a                    -- ^ output form
mFormToWForm :: MForm m (a, FieldView site) -> WForm m a
mFormToWForm = (m ((a, FieldView site), Ints, Enctype)
 -> WriterT [FieldView site] m (a, Ints, Enctype))
-> RWST
     (Maybe (Env, FileEnv), site, [Text])
     Enctype
     Ints
     m
     (a, FieldView site)
-> RWST
     (Maybe (Env, FileEnv), site, [Text])
     Enctype
     Ints
     (WriterT [FieldView site] m)
     a
forall (m :: * -> *) a s w (n :: * -> *) b w' r.
(m (a, s, w) -> n (b, s, w')) -> RWST r w s m a -> RWST r w' s n b
mapRWST ((m ((a, FieldView site), Ints, Enctype)
  -> WriterT [FieldView site] m (a, Ints, Enctype))
 -> RWST
      (Maybe (Env, FileEnv), site, [Text])
      Enctype
      Ints
      m
      (a, FieldView site)
 -> RWST
      (Maybe (Env, FileEnv), site, [Text])
      Enctype
      Ints
      (WriterT [FieldView site] m)
      a)
-> (m ((a, FieldView site), Ints, Enctype)
    -> WriterT [FieldView site] m (a, Ints, Enctype))
-> RWST
     (Maybe (Env, FileEnv), site, [Text])
     Enctype
     Ints
     m
     (a, FieldView site)
-> RWST
     (Maybe (Env, FileEnv), site, [Text])
     Enctype
     Ints
     (WriterT [FieldView site] m)
     a
forall a b. (a -> b) -> a -> b
$ \m ((a, FieldView site), Ints, Enctype)
f -> do
  ((a
a, FieldView site
view), Ints
ints, Enctype
enctype) <- m ((a, FieldView site), Ints, Enctype)
-> WriterT [FieldView site] m ((a, FieldView site), Ints, Enctype)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift m ((a, FieldView site), Ints, Enctype)
f
  ((a, Ints, Enctype), [FieldView site])
-> WriterT [FieldView site] m (a, Ints, Enctype)
forall (m :: * -> *) a w. Monad m => (a, w) -> WriterT w m a
writer ((a
a, Ints
ints, Enctype
enctype), [FieldView site
view])

-- | Converts a form field into monadic form. This field requires a value
-- and will return 'FormFailure' if left empty.
mreq :: (RenderMessage site FormMessage, HandlerSite m ~ site, MonadHandler m)
     => Field m a           -- ^ form field
     -> FieldSettings site  -- ^ settings for this field
     -> Maybe a             -- ^ optional default value
     -> MForm m (FormResult a, FieldView site)
mreq :: Field m a
-> FieldSettings site
-> Maybe a
-> MForm m (FormResult a, FieldView site)
mreq Field m a
field FieldSettings site
fs Maybe a
mdef = Field m a
-> FieldSettings site
-> FormMessage
-> Maybe a
-> MForm m (FormResult a, FieldView site)
forall site msg (m :: * -> *) a.
(RenderMessage site msg, HandlerSite m ~ site, MonadHandler m) =>
Field m a
-> FieldSettings site
-> msg
-> Maybe a
-> MForm m (FormResult a, FieldView site)
mreqMsg Field m a
field FieldSettings site
fs FormMessage
MsgValueRequired Maybe a
mdef

-- | Same as @mreq@ but with your own message to be rendered in case the value
-- is not provided.
--
-- This is useful when you have several required fields on the page and you
-- want to differentiate between which fields were left blank. Otherwise the
-- user sees "Value is required" multiple times, which is ambiguous.
--
-- @since 1.6.6
mreqMsg :: (RenderMessage site msg, HandlerSite m ~ site, MonadHandler m)
        => Field m a           -- ^ form field
        -> FieldSettings site  -- ^ settings for this field
        -> msg                 -- ^ Message to use in case value is Nothing
        -> Maybe a             -- ^ optional default value
        -> MForm m (FormResult a, FieldView site)
mreqMsg :: Field m a
-> FieldSettings site
-> msg
-> Maybe a
-> MForm m (FormResult a, FieldView site)
mreqMsg Field m a
field FieldSettings site
fs msg
msg Maybe a
mdef = Field m a
-> FieldSettings site
-> Maybe a
-> (site -> [Text] -> FormResult a)
-> (a -> FormResult a)
-> Bool
-> MForm m (FormResult a, FieldView site)
forall site (m :: * -> *) a b.
(site ~ HandlerSite m, MonadHandler m) =>
Field m a
-> FieldSettings site
-> Maybe a
-> (site -> [Text] -> FormResult b)
-> (a -> FormResult b)
-> Bool
-> MForm m (FormResult b, FieldView site)
mhelper Field m a
field FieldSettings site
fs Maybe a
mdef site -> [Text] -> FormResult a
formFailure a -> FormResult a
forall a. a -> FormResult a
FormSuccess Bool
True
  where formFailure :: site -> [Text] -> FormResult a
formFailure site
m [Text]
l = [Text] -> FormResult a
forall a. [Text] -> FormResult a
FormFailure [site -> [Text] -> msg -> Text
forall master message.
RenderMessage master message =>
master -> [Text] -> message -> Text
renderMessage site
m [Text]
l msg
msg]

-- | Converts a form field into monadic form. This field is optional, i.e.
-- if filled in, it returns 'Just a', if left empty, it returns 'Nothing'.
-- Arguments are the same as for 'mreq' (apart from type of default value).
mopt :: (site ~ HandlerSite m, MonadHandler m)
     => Field m a
     -> FieldSettings site
     -> Maybe (Maybe a)
     -> MForm m (FormResult (Maybe a), FieldView site)
mopt :: Field m a
-> FieldSettings site
-> Maybe (Maybe a)
-> MForm m (FormResult (Maybe a), FieldView site)
mopt Field m a
field FieldSettings site
fs Maybe (Maybe a)
mdef = Field m a
-> FieldSettings site
-> Maybe a
-> (site -> [Text] -> FormResult (Maybe a))
-> (a -> FormResult (Maybe a))
-> Bool
-> MForm m (FormResult (Maybe a), FieldView site)
forall site (m :: * -> *) a b.
(site ~ HandlerSite m, MonadHandler m) =>
Field m a
-> FieldSettings site
-> Maybe a
-> (site -> [Text] -> FormResult b)
-> (a -> FormResult b)
-> Bool
-> MForm m (FormResult b, FieldView site)
mhelper Field m a
field FieldSettings site
fs (Maybe (Maybe a) -> Maybe a
forall (m :: * -> *) a. Monad m => m (m a) -> m a
join Maybe (Maybe a)
mdef) (([Text] -> FormResult (Maybe a))
-> site -> [Text] -> FormResult (Maybe a)
forall a b. a -> b -> a
const (([Text] -> FormResult (Maybe a))
 -> site -> [Text] -> FormResult (Maybe a))
-> ([Text] -> FormResult (Maybe a))
-> site
-> [Text]
-> FormResult (Maybe a)
forall a b. (a -> b) -> a -> b
$ FormResult (Maybe a) -> [Text] -> FormResult (Maybe a)
forall a b. a -> b -> a
const (FormResult (Maybe a) -> [Text] -> FormResult (Maybe a))
-> FormResult (Maybe a) -> [Text] -> FormResult (Maybe a)
forall a b. (a -> b) -> a -> b
$ Maybe a -> FormResult (Maybe a)
forall a. a -> FormResult a
FormSuccess Maybe a
forall a. Maybe a
Nothing) (Maybe a -> FormResult (Maybe a)
forall a. a -> FormResult a
FormSuccess (Maybe a -> FormResult (Maybe a))
-> (a -> Maybe a) -> a -> FormResult (Maybe a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Maybe a
forall a. a -> Maybe a
Just) Bool
False

mhelper :: (site ~ HandlerSite m, MonadHandler m)
        => Field m a
        -> FieldSettings site
        -> Maybe a
        -> (site -> [Text] -> FormResult b) -- ^ on missing
        -> (a -> FormResult b) -- ^ on success
        -> Bool -- ^ is it required?
        -> MForm m (FormResult b, FieldView site)

mhelper :: Field m a
-> FieldSettings site
-> Maybe a
-> (site -> [Text] -> FormResult b)
-> (a -> FormResult b)
-> Bool
-> MForm m (FormResult b, FieldView site)
mhelper Field {Enctype
[Text]
-> [FileInfo] -> m (Either (SomeMessage (HandlerSite m)) (Maybe a))
FieldViewFunc m a
fieldEnctype :: forall (m :: * -> *) a. Field m a -> Enctype
fieldView :: forall (m :: * -> *) a. Field m a -> FieldViewFunc m a
fieldParse :: forall (m :: * -> *) a.
Field m a
-> [Text]
-> [FileInfo]
-> m (Either (SomeMessage (HandlerSite m)) (Maybe a))
fieldEnctype :: Enctype
fieldView :: FieldViewFunc m a
fieldParse :: [Text]
-> [FileInfo] -> m (Either (SomeMessage (HandlerSite m)) (Maybe a))
..} FieldSettings {[(Text, Text)]
Maybe Text
Maybe (SomeMessage site)
SomeMessage site
fsAttrs :: forall master. FieldSettings master -> [(Text, Text)]
fsName :: forall master. FieldSettings master -> Maybe Text
fsId :: forall master. FieldSettings master -> Maybe Text
fsTooltip :: forall master. FieldSettings master -> Maybe (SomeMessage master)
fsLabel :: forall master. FieldSettings master -> SomeMessage master
fsAttrs :: [(Text, Text)]
fsName :: Maybe Text
fsId :: Maybe Text
fsTooltip :: Maybe (SomeMessage site)
fsLabel :: SomeMessage site
..} Maybe a
mdef site -> [Text] -> FormResult b
onMissing a -> FormResult b
onFound Bool
isReq = do
    Enctype
-> RWST (Maybe (Env, FileEnv), site, [Text]) Enctype Ints m ()
forall (m :: * -> *) w r s. Monad m => w -> RWST r w s m ()
tell Enctype
fieldEnctype
    Maybe Env
mp <- RWST
  (Maybe (Env, FileEnv), site, [Text]) Enctype Ints m (Maybe Env)
forall (m :: * -> *). Monad m => MForm m (Maybe Env)
askParams
    Text
name <- RWST (Maybe (Env, FileEnv), site, [Text]) Enctype Ints m Text
-> (Text
    -> RWST (Maybe (Env, FileEnv), site, [Text]) Enctype Ints m Text)
-> Maybe Text
-> RWST (Maybe (Env, FileEnv), site, [Text]) Enctype Ints m Text
forall b a. b -> (a -> b) -> Maybe a -> b
maybe RWST (Maybe (Env, FileEnv), site, [Text]) Enctype Ints m Text
forall (m :: * -> *). Monad m => MForm m Text
newFormIdent Text
-> RWST (Maybe (Env, FileEnv), site, [Text]) Enctype Ints m Text
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Text
fsName
    Text
theId <- m Text
-> RWST (Maybe (Env, FileEnv), site, [Text]) Enctype Ints m Text
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m Text
 -> RWST (Maybe (Env, FileEnv), site, [Text]) Enctype Ints m Text)
-> m Text
-> RWST (Maybe (Env, FileEnv), site, [Text]) Enctype Ints m Text
forall a b. (a -> b) -> a -> b
$ m Text -> (Text -> m Text) -> Maybe Text -> m Text
forall b a. b -> (a -> b) -> Maybe a -> b
maybe m Text
forall (m :: * -> *). MonadHandler m => m Text
newIdent Text -> m Text
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Text
fsId
    (Maybe (Env, FileEnv)
_, site
site, [Text]
langs) <- RWST
  (Maybe (Env, FileEnv), site, [Text])
  Enctype
  Ints
  m
  (Maybe (Env, FileEnv), site, [Text])
forall w (m :: * -> *) r s. (Monoid w, Monad m) => RWST r w s m r
ask
    let mr2 :: SomeMessage site -> Text
mr2 = site -> [Text] -> SomeMessage site -> Text
forall master message.
RenderMessage master message =>
master -> [Text] -> message -> Text
renderMessage site
site [Text]
langs
    (FormResult b
res, Either Text a
val) <-
        case Maybe Env
mp of
            Maybe Env
Nothing -> (FormResult b, Either Text a)
-> RWST
     (Maybe (Env, FileEnv), site, [Text])
     Enctype
     Ints
     m
     (FormResult b, Either Text a)
forall (m :: * -> *) a. Monad m => a -> m a
return (FormResult b
forall a. FormResult a
FormMissing, Either Text a -> (a -> Either Text a) -> Maybe a -> Either Text a
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Text -> Either Text a
forall a b. a -> Either a b
Left Text
"") a -> Either Text a
forall a b. b -> Either a b
Right Maybe a
mdef)
            Just Env
p -> do
                Maybe FileEnv
mfs <- RWST
  (Maybe (Env, FileEnv), site, [Text]) Enctype Ints m (Maybe FileEnv)
forall (m :: * -> *). Monad m => MForm m (Maybe FileEnv)
askFiles
                let mvals :: [Text]
mvals = [Text] -> Maybe [Text] -> [Text]
forall a. a -> Maybe a -> a
fromMaybe [] (Maybe [Text] -> [Text]) -> Maybe [Text] -> [Text]
forall a b. (a -> b) -> a -> b
$ Text -> Env -> Maybe [Text]
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Text
name Env
p
                    files :: [FileInfo]
files = [FileInfo] -> Maybe [FileInfo] -> [FileInfo]
forall a. a -> Maybe a -> a
fromMaybe [] (Maybe [FileInfo] -> [FileInfo]) -> Maybe [FileInfo] -> [FileInfo]
forall a b. (a -> b) -> a -> b
$ Maybe FileEnv
mfs Maybe FileEnv -> (FileEnv -> Maybe [FileInfo]) -> Maybe [FileInfo]
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Text -> FileEnv -> Maybe [FileInfo]
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Text
name
                Either (SomeMessage site) (Maybe a)
emx <- m (Either (SomeMessage site) (Maybe a))
-> RWST
     (Maybe (Env, FileEnv), site, [Text])
     Enctype
     Ints
     m
     (Either (SomeMessage site) (Maybe a))
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m (Either (SomeMessage site) (Maybe a))
 -> RWST
      (Maybe (Env, FileEnv), site, [Text])
      Enctype
      Ints
      m
      (Either (SomeMessage site) (Maybe a)))
-> m (Either (SomeMessage site) (Maybe a))
-> RWST
     (Maybe (Env, FileEnv), site, [Text])
     Enctype
     Ints
     m
     (Either (SomeMessage site) (Maybe a))
forall a b. (a -> b) -> a -> b
$ [Text]
-> [FileInfo] -> m (Either (SomeMessage (HandlerSite m)) (Maybe a))
fieldParse [Text]
mvals [FileInfo]
files
                (FormResult b, Either Text a)
-> RWST
     (Maybe (Env, FileEnv), site, [Text])
     Enctype
     Ints
     m
     (FormResult b, Either Text a)
forall (m :: * -> *) a. Monad m => a -> m a
return ((FormResult b, Either Text a)
 -> RWST
      (Maybe (Env, FileEnv), site, [Text])
      Enctype
      Ints
      m
      (FormResult b, Either Text a))
-> (FormResult b, Either Text a)
-> RWST
     (Maybe (Env, FileEnv), site, [Text])
     Enctype
     Ints
     m
     (FormResult b, Either Text a)
forall a b. (a -> b) -> a -> b
$ case Either (SomeMessage site) (Maybe a)
emx of
                    Left (SomeMessage msg
e) -> ([Text] -> FormResult b
forall a. [Text] -> FormResult a
FormFailure [site -> [Text] -> msg -> Text
forall master message.
RenderMessage master message =>
master -> [Text] -> message -> Text
renderMessage site
site [Text]
langs msg
e], Either Text a
-> (Text -> Either Text a) -> Maybe Text -> Either Text a
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Text -> Either Text a
forall a b. a -> Either a b
Left Text
"") Text -> Either Text a
forall a b. a -> Either a b
Left ([Text] -> Maybe Text
forall a. [a] -> Maybe a
listToMaybe [Text]
mvals))
                    Right Maybe a
mx ->
                        case Maybe a
mx of
                            Maybe a
Nothing -> (site -> [Text] -> FormResult b
onMissing site
site [Text]
langs, Text -> Either Text a
forall a b. a -> Either a b
Left Text
"")
                            Just a
x -> (a -> FormResult b
onFound a
x, a -> Either Text a
forall a b. b -> Either a b
Right a
x)
    (FormResult b, FieldView site)
-> RWST
     (Maybe (Env, FileEnv), site, [Text])
     Enctype
     Ints
     m
     (FormResult b, FieldView site)
forall (m :: * -> *) a. Monad m => a -> m a
return (FormResult b
res, FieldView :: forall site.
Markup
-> Maybe Markup
-> Text
-> WidgetFor site ()
-> Maybe Markup
-> Bool
-> FieldView site
FieldView
        { fvLabel :: Markup
fvLabel = toHtml $ mr2 fsLabel
        , fvTooltip :: Maybe Markup
fvTooltip = (Text -> Markup) -> Maybe Text -> Maybe Markup
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap toHtml $ fmap mr2 fsTooltip
        , fvId :: Text
fvId = Text
theId
        , fvInput :: WidgetFor site ()
fvInput = FieldViewFunc m a
fieldView Text
theId Text
name [(Text, Text)]
fsAttrs Either Text a
val Bool
isReq
        , fvErrors :: Maybe Markup
fvErrors =
            case FormResult b
res of
                FormFailure [Text
e] -> Markup -> Maybe Markup
forall a. a -> Maybe a
Just (Markup -> Maybe Markup) -> Markup -> Maybe Markup
forall a b. (a -> b) -> a -> b
$ toHtml e
                FormResult b
_ -> Maybe Markup
forall a. Maybe a
Nothing
        , fvRequired :: Bool
fvRequired = Bool
isReq
        })

-- | Applicative equivalent of 'mreq'.
areq :: (RenderMessage site FormMessage, HandlerSite m ~ site, MonadHandler m)
     => Field m a           -- ^ form field
     -> FieldSettings site  -- ^ settings for this field
     -> Maybe a             -- ^ optional default value
     -> AForm m a
areq :: Field m a -> FieldSettings site -> Maybe a -> AForm m a
areq Field m a
f FieldSettings site
fs = Field m a
-> FieldSettings site -> FormMessage -> Maybe a -> AForm m a
forall site msg (m :: * -> *) a.
(RenderMessage site msg, HandlerSite m ~ site, MonadHandler m) =>
Field m a -> FieldSettings site -> msg -> Maybe a -> AForm m a
areqMsg Field m a
f FieldSettings site
fs FormMessage
MsgValueRequired

-- | Same as @areq@ but with your own message to be rendered in case the value
-- is not provided.
--
-- This is useful when you have several required fields on the page and you
-- want to differentiate between which fields were left blank. Otherwise the
-- user sees "Value is required" multiple times, which is ambiguous.
--
-- @since 1.6.7
areqMsg :: (RenderMessage site msg, HandlerSite m ~ site, MonadHandler m)
        => Field m a           -- ^ form field
        -> FieldSettings site  -- ^ settings for this field
        -> msg                 -- ^ message to use in case value is Nothing
        -> Maybe a             -- ^ optional default value
        -> AForm m a
areqMsg :: Field m a -> FieldSettings site -> msg -> Maybe a -> AForm m a
areqMsg Field m a
f FieldSettings site
fs msg
msg = RWST
  (Maybe (Env, FileEnv), site, [Text])
  Enctype
  Ints
  m
  (FormResult a, [FieldView site])
-> AForm m a
forall (m :: * -> *) site a.
(HandlerSite m ~ site, Monad m) =>
MForm m (FormResult a, [FieldView site]) -> AForm m a
formToAForm (RWST
   (Maybe (Env, FileEnv), site, [Text])
   Enctype
   Ints
   m
   (FormResult a, [FieldView site])
 -> AForm m a)
-> (Maybe a
    -> RWST
         (Maybe (Env, FileEnv), site, [Text])
         Enctype
         Ints
         m
         (FormResult a, [FieldView site]))
-> Maybe a
-> AForm m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((FormResult a, FieldView site)
 -> (FormResult a, [FieldView site]))
-> RWST
     (Maybe (Env, FileEnv), site, [Text])
     Enctype
     Ints
     m
     (FormResult a, FieldView site)
-> RWST
     (Maybe (Env, FileEnv), site, [Text])
     Enctype
     Ints
     m
     (FormResult a, [FieldView site])
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM ((FieldView site -> [FieldView site])
-> (FormResult a, FieldView site)
-> (FormResult a, [FieldView site])
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (d, b) (d, c)
second FieldView site -> [FieldView site]
forall (m :: * -> *) a. Monad m => a -> m a
return) (RWST
   (Maybe (Env, FileEnv), site, [Text])
   Enctype
   Ints
   m
   (FormResult a, FieldView site)
 -> RWST
      (Maybe (Env, FileEnv), site, [Text])
      Enctype
      Ints
      m
      (FormResult a, [FieldView site]))
-> (Maybe a
    -> RWST
         (Maybe (Env, FileEnv), site, [Text])
         Enctype
         Ints
         m
         (FormResult a, FieldView site))
-> Maybe a
-> RWST
     (Maybe (Env, FileEnv), site, [Text])
     Enctype
     Ints
     m
     (FormResult a, [FieldView site])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Field m a
-> FieldSettings site
-> msg
-> Maybe a
-> MForm m (FormResult a, FieldView site)
forall site msg (m :: * -> *) a.
(RenderMessage site msg, HandlerSite m ~ site, MonadHandler m) =>
Field m a
-> FieldSettings site
-> msg
-> Maybe a
-> MForm m (FormResult a, FieldView site)
mreqMsg Field m a
f FieldSettings site
fs msg
msg

-- | Applicative equivalent of 'mopt'.
aopt :: MonadHandler m
     => Field m a
     -> FieldSettings (HandlerSite m)
     -> Maybe (Maybe a)
     -> AForm m (Maybe a)
aopt :: Field m a
-> FieldSettings (HandlerSite m)
-> Maybe (Maybe a)
-> AForm m (Maybe a)
aopt Field m a
a FieldSettings (HandlerSite m)
b = MForm m (FormResult (Maybe a), [FieldView (HandlerSite m)])
-> AForm m (Maybe a)
forall (m :: * -> *) site a.
(HandlerSite m ~ site, Monad m) =>
MForm m (FormResult a, [FieldView site]) -> AForm m a
formToAForm (MForm m (FormResult (Maybe a), [FieldView (HandlerSite m)])
 -> AForm m (Maybe a))
-> (Maybe (Maybe a)
    -> MForm m (FormResult (Maybe a), [FieldView (HandlerSite m)]))
-> Maybe (Maybe a)
-> AForm m (Maybe a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((FormResult (Maybe a), FieldView (HandlerSite m))
 -> (FormResult (Maybe a), [FieldView (HandlerSite m)]))
-> RWST
     (Maybe (Env, FileEnv), HandlerSite m, [Text])
     Enctype
     Ints
     m
     (FormResult (Maybe a), FieldView (HandlerSite m))
-> MForm m (FormResult (Maybe a), [FieldView (HandlerSite m)])
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM ((FieldView (HandlerSite m) -> [FieldView (HandlerSite m)])
-> (FormResult (Maybe a), FieldView (HandlerSite m))
-> (FormResult (Maybe a), [FieldView (HandlerSite m)])
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (d, b) (d, c)
second FieldView (HandlerSite m) -> [FieldView (HandlerSite m)]
forall (m :: * -> *) a. Monad m => a -> m a
return) (RWST
   (Maybe (Env, FileEnv), HandlerSite m, [Text])
   Enctype
   Ints
   m
   (FormResult (Maybe a), FieldView (HandlerSite m))
 -> MForm m (FormResult (Maybe a), [FieldView (HandlerSite m)]))
-> (Maybe (Maybe a)
    -> RWST
         (Maybe (Env, FileEnv), HandlerSite m, [Text])
         Enctype
         Ints
         m
         (FormResult (Maybe a), FieldView (HandlerSite m)))
-> Maybe (Maybe a)
-> MForm m (FormResult (Maybe a), [FieldView (HandlerSite m)])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Field m a
-> FieldSettings (HandlerSite m)
-> Maybe (Maybe a)
-> RWST
     (Maybe (Env, FileEnv), HandlerSite m, [Text])
     Enctype
     Ints
     m
     (FormResult (Maybe a), FieldView (HandlerSite m))
forall site (m :: * -> *) a.
(site ~ HandlerSite m, MonadHandler m) =>
Field m a
-> FieldSettings site
-> Maybe (Maybe a)
-> MForm m (FormResult (Maybe a), FieldView site)
mopt Field m a
a FieldSettings (HandlerSite m)
b

runFormGeneric :: Monad m
               => MForm m a
               -> HandlerSite m
               -> [Text]
               -> Maybe (Env, FileEnv)
               -> m (a, Enctype)
runFormGeneric :: MForm m a
-> HandlerSite m
-> [Text]
-> Maybe (Env, FileEnv)
-> m (a, Enctype)
runFormGeneric MForm m a
form HandlerSite m
site [Text]
langs Maybe (Env, FileEnv)
env = MForm m a
-> (Maybe (Env, FileEnv), HandlerSite m, [Text])
-> Ints
-> m (a, Enctype)
forall (m :: * -> *) r w s a.
Monad m =>
RWST r w s m a -> r -> s -> m (a, w)
evalRWST MForm m a
form (Maybe (Env, FileEnv)
env, HandlerSite m
site, [Text]
langs) (Int -> Ints
IntSingle Int
0)

-- | This function is used to both initially render a form and to later extract
-- results from it. Note that, due to CSRF protection and a few other issues,
-- forms submitted via GET and POST are slightly different. As such, be sure to
-- call the relevant function based on how the form will be submitted, /not/
-- the current request method.
--
-- For example, a common case is displaying a form on a GET request and having
-- the form submit to a POST page. In such a case, both the GET and POST
-- handlers should use 'runFormPost'.
runFormPost :: (RenderMessage (HandlerSite m) FormMessage, MonadResource m, MonadHandler m)
            => (Html -> MForm m (FormResult a, xml))
            -> m ((FormResult a, xml), Enctype)
runFormPost :: (Markup -> MForm m (FormResult a, xml))
-> m ((FormResult a, xml), Enctype)
runFormPost Markup -> MForm m (FormResult a, xml)
form = do
    Maybe (Env, FileEnv)
env <- m (Maybe (Env, FileEnv))
forall (m :: * -> *). MonadHandler m => m (Maybe (Env, FileEnv))
postEnv
    (Markup -> MForm m (FormResult a, xml))
-> Maybe (Env, FileEnv) -> m ((FormResult a, xml), Enctype)
forall (m :: * -> *) a xml.
(MonadHandler m, RenderMessage (HandlerSite m) FormMessage) =>
(Markup -> MForm m (FormResult a, xml))
-> Maybe (Env, FileEnv) -> m ((FormResult a, xml), Enctype)
postHelper Markup -> MForm m (FormResult a, xml)
form Maybe (Env, FileEnv)
env

postHelper  :: (MonadHandler m, RenderMessage (HandlerSite m) FormMessage)
            => (Html -> MForm m (FormResult a, xml))
            -> Maybe (Env, FileEnv)
            -> m ((FormResult a, xml), Enctype)
postHelper :: (Markup -> MForm m (FormResult a, xml))
-> Maybe (Env, FileEnv) -> m ((FormResult a, xml), Enctype)
postHelper Markup -> MForm m (FormResult a, xml)
form Maybe (Env, FileEnv)
env = do
    YesodRequest
req <- m YesodRequest
forall (m :: * -> *). MonadHandler m => m YesodRequest
getRequest
    let tokenKey :: Text
tokenKey = Text
defaultCsrfParamName
    let token :: Markup
token =
            case YesodRequest -> Maybe Text
reqToken YesodRequest
req of
                Maybe Text
Nothing -> Markup
forall a. Monoid a => a
Data.Monoid.mempty
                Just Text
n -> [shamlet|<input type=hidden name=#{tokenKey} value=#{n}>|]
    HandlerSite m
m <- m (HandlerSite m)
forall (m :: * -> *). MonadHandler m => m (HandlerSite m)
getYesod
    [Text]
langs <- m [Text]
forall (m :: * -> *). MonadHandler m => m [Text]
languages
    ((FormResult a
res, xml
xml), Enctype
enctype) <- MForm m (FormResult a, xml)
-> HandlerSite m
-> [Text]
-> Maybe (Env, FileEnv)
-> m ((FormResult a, xml), Enctype)
forall (m :: * -> *) a.
Monad m =>
MForm m a
-> HandlerSite m
-> [Text]
-> Maybe (Env, FileEnv)
-> m (a, Enctype)
runFormGeneric (Markup -> MForm m (FormResult a, xml)
form Markup
token) HandlerSite m
m [Text]
langs Maybe (Env, FileEnv)
env
    let res' :: FormResult a
res' =
            case (FormResult a
res, Maybe (Env, FileEnv)
env) of
                (FormResult a
_, Maybe (Env, FileEnv)
Nothing) -> FormResult a
forall a. FormResult a
FormMissing
                (FormSuccess{}, Just (Env
params, FileEnv
_))
                    | Bool -> Bool
not (Text -> Env -> Maybe [Text]
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Text
tokenKey Env
params Maybe [Text] -> Maybe Text -> Bool
=== YesodRequest -> Maybe Text
reqToken YesodRequest
req) ->
                        [Text] -> FormResult a
forall a. [Text] -> FormResult a
FormFailure [HandlerSite m -> [Text] -> FormMessage -> Text
forall master message.
RenderMessage master message =>
master -> [Text] -> message -> Text
renderMessage HandlerSite m
m [Text]
langs FormMessage
MsgCsrfWarning]
                (FormResult a, Maybe (Env, FileEnv))
_ -> FormResult a
res
            -- It's important to use constant-time comparison (constEqBytes) in order to avoid timing attacks.
            where (Just [Text
t1]) === :: Maybe [Text] -> Maybe Text -> Bool
=== (Just Text
t2) = Text -> ByteString
TE.encodeUtf8 Text
t1 ByteString -> ByteString -> Bool
forall a. Byteable a => a -> a -> Bool
`constEqBytes` Text -> ByteString
TE.encodeUtf8 Text
t2
                  Maybe [Text]
Nothing     === Maybe Text
Nothing   = Bool
True
                  Maybe [Text]
_           === Maybe Text
_         = Bool
False
    ((FormResult a, xml), Enctype) -> m ((FormResult a, xml), Enctype)
forall (m :: * -> *) a. Monad m => a -> m a
return ((FormResult a
res', xml
xml), Enctype
enctype)

-- | Similar to 'runFormPost', except it always ignores the currently available
-- environment. This is necessary in cases like a wizard UI, where a single
-- page will both receive and incoming form and produce a new, blank form. For
-- general usage, you can stick with @runFormPost@.
generateFormPost
    :: (RenderMessage (HandlerSite m) FormMessage, MonadHandler m)
    => (Html -> MForm m (FormResult a, xml))
    -> m (xml, Enctype)
generateFormPost :: (Markup -> MForm m (FormResult a, xml)) -> m (xml, Enctype)
generateFormPost Markup -> MForm m (FormResult a, xml)
form = ((FormResult a, xml) -> xml)
-> ((FormResult a, xml), Enctype) -> (xml, Enctype)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
first (FormResult a, xml) -> xml
forall a b. (a, b) -> b
snd (((FormResult a, xml), Enctype) -> (xml, Enctype))
-> m ((FormResult a, xml), Enctype) -> m (xml, Enctype)
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
`liftM` (Markup -> MForm m (FormResult a, xml))
-> Maybe (Env, FileEnv) -> m ((FormResult a, xml), Enctype)
forall (m :: * -> *) a xml.
(MonadHandler m, RenderMessage (HandlerSite m) FormMessage) =>
(Markup -> MForm m (FormResult a, xml))
-> Maybe (Env, FileEnv) -> m ((FormResult a, xml), Enctype)
postHelper Markup -> MForm m (FormResult a, xml)
form Maybe (Env, FileEnv)
forall a. Maybe a
Nothing

postEnv :: MonadHandler m => m (Maybe (Env, FileEnv))
postEnv :: m (Maybe (Env, FileEnv))
postEnv = do
    YesodRequest
req <- m YesodRequest
forall (m :: * -> *). MonadHandler m => m YesodRequest
getRequest
    if Request -> ByteString
requestMethod (YesodRequest -> Request
reqWaiRequest YesodRequest
req) ByteString -> ByteString -> Bool
forall a. Eq a => a -> a -> Bool
== ByteString
"GET"
        then Maybe (Env, FileEnv) -> m (Maybe (Env, FileEnv))
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (Env, FileEnv)
forall a. Maybe a
Nothing
        else do
            ([(Text, Text)]
p, [(Text, FileInfo)]
f) <- m ([(Text, Text)], [(Text, FileInfo)])
forall (m :: * -> *).
MonadHandler m =>
m ([(Text, Text)], [(Text, FileInfo)])
runRequestBody
            let p' :: Env
p' = ([Text] -> [Text] -> [Text]) -> [Env] -> Env
forall (f :: * -> *) k a.
(Foldable f, Ord k) =>
(a -> a -> a) -> f (Map k a) -> Map k a
Map.unionsWith [Text] -> [Text] -> [Text]
forall a. [a] -> [a] -> [a]
(++) ([Env] -> Env) -> [Env] -> Env
forall a b. (a -> b) -> a -> b
$ ((Text, Text) -> Env) -> [(Text, Text)] -> [Env]
forall a b. (a -> b) -> [a] -> [b]
map (\(Text
x, Text
y) -> Text -> [Text] -> Env
forall k a. k -> a -> Map k a
Map.singleton Text
x [Text
y]) [(Text, Text)]
p
            Maybe (Env, FileEnv) -> m (Maybe (Env, FileEnv))
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe (Env, FileEnv) -> m (Maybe (Env, FileEnv)))
-> Maybe (Env, FileEnv) -> m (Maybe (Env, FileEnv))
forall a b. (a -> b) -> a -> b
$ (Env, FileEnv) -> Maybe (Env, FileEnv)
forall a. a -> Maybe a
Just (Env
p', ([FileInfo] -> [FileInfo] -> [FileInfo]) -> [FileEnv] -> FileEnv
forall (f :: * -> *) k a.
(Foldable f, Ord k) =>
(a -> a -> a) -> f (Map k a) -> Map k a
Map.unionsWith [FileInfo] -> [FileInfo] -> [FileInfo]
forall a. [a] -> [a] -> [a]
(++) ([FileEnv] -> FileEnv) -> [FileEnv] -> FileEnv
forall a b. (a -> b) -> a -> b
$ ((Text, FileInfo) -> FileEnv) -> [(Text, FileInfo)] -> [FileEnv]
forall a b. (a -> b) -> [a] -> [b]
map (\(Text
k, FileInfo
v) -> Text -> [FileInfo] -> FileEnv
forall k a. k -> a -> Map k a
Map.singleton Text
k [FileInfo
v]) [(Text, FileInfo)]
f)

runFormPostNoToken :: MonadHandler m
                   => (Html -> MForm m a)
                   -> m (a, Enctype)
runFormPostNoToken :: (Markup -> MForm m a) -> m (a, Enctype)
runFormPostNoToken Markup -> MForm m a
form = do
    [Text]
langs <- m [Text]
forall (m :: * -> *). MonadHandler m => m [Text]
languages
    HandlerSite m
m <- m (HandlerSite m)
forall (m :: * -> *). MonadHandler m => m (HandlerSite m)
getYesod
    Maybe (Env, FileEnv)
env <- m (Maybe (Env, FileEnv))
forall (m :: * -> *). MonadHandler m => m (Maybe (Env, FileEnv))
postEnv
    MForm m a
-> HandlerSite m
-> [Text]
-> Maybe (Env, FileEnv)
-> m (a, Enctype)
forall (m :: * -> *) a.
Monad m =>
MForm m a
-> HandlerSite m
-> [Text]
-> Maybe (Env, FileEnv)
-> m (a, Enctype)
runFormGeneric (Markup -> MForm m a
form Markup
forall a. Monoid a => a
mempty) HandlerSite m
m [Text]
langs Maybe (Env, FileEnv)
env

runFormGet :: MonadHandler m
           => (Html -> MForm m a)
           -> m (a, Enctype)
runFormGet :: (Markup -> MForm m a) -> m (a, Enctype)
runFormGet Markup -> MForm m a
form = do
    [(Text, Text)]
gets <- (YesodRequest -> [(Text, Text)])
-> m YesodRequest -> m [(Text, Text)]
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM YesodRequest -> [(Text, Text)]
reqGetParams m YesodRequest
forall (m :: * -> *). MonadHandler m => m YesodRequest
getRequest
    let env :: Maybe (Env, FileEnv)
env =
            case Text -> [(Text, Text)] -> Maybe Text
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Text
getKey [(Text, Text)]
gets of
                Maybe Text
Nothing -> Maybe (Env, FileEnv)
forall a. Maybe a
Nothing
                Just Text
_ -> (Env, FileEnv) -> Maybe (Env, FileEnv)
forall a. a -> Maybe a
Just (([Text] -> [Text] -> [Text]) -> [Env] -> Env
forall (f :: * -> *) k a.
(Foldable f, Ord k) =>
(a -> a -> a) -> f (Map k a) -> Map k a
Map.unionsWith [Text] -> [Text] -> [Text]
forall a. [a] -> [a] -> [a]
(++) ([Env] -> Env) -> [Env] -> Env
forall a b. (a -> b) -> a -> b
$ ((Text, Text) -> Env) -> [(Text, Text)] -> [Env]
forall a b. (a -> b) -> [a] -> [b]
map (\(Text
x, Text
y) -> Text -> [Text] -> Env
forall k a. k -> a -> Map k a
Map.singleton Text
x [Text
y]) [(Text, Text)]
gets, FileEnv
forall k a. Map k a
Map.empty)
    (Markup -> MForm m a) -> Maybe (Env, FileEnv) -> m (a, Enctype)
forall (m :: * -> *) a.
MonadHandler m =>
(Markup -> MForm m a) -> Maybe (Env, FileEnv) -> m (a, Enctype)
getHelper Markup -> MForm m a
form Maybe (Env, FileEnv)
env

{- FIXME: generateFormGet' "Will be renamed to generateFormGet in next version of Yesod" -}
-- |
--
-- Since 1.3.11
generateFormGet'
    :: MonadHandler m
    => (Html -> MForm m (FormResult a, xml))
    -> m (xml, Enctype)
generateFormGet' :: (Markup -> MForm m (FormResult a, xml)) -> m (xml, Enctype)
generateFormGet' Markup -> MForm m (FormResult a, xml)
form = ((FormResult a, xml) -> xml)
-> ((FormResult a, xml), Enctype) -> (xml, Enctype)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
first (FormResult a, xml) -> xml
forall a b. (a, b) -> b
snd (((FormResult a, xml), Enctype) -> (xml, Enctype))
-> m ((FormResult a, xml), Enctype) -> m (xml, Enctype)
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
`liftM` (Markup -> MForm m (FormResult a, xml))
-> Maybe (Env, FileEnv) -> m ((FormResult a, xml), Enctype)
forall (m :: * -> *) a.
MonadHandler m =>
(Markup -> MForm m a) -> Maybe (Env, FileEnv) -> m (a, Enctype)
getHelper Markup -> MForm m (FormResult a, xml)
form Maybe (Env, FileEnv)
forall a. Maybe a
Nothing

{-# DEPRECATED generateFormGet "Will require RenderMessage in next version of Yesod" #-}
generateFormGet :: MonadHandler m
                => (Html -> MForm m a)
                -> m (a, Enctype)
generateFormGet :: (Markup -> MForm m a) -> m (a, Enctype)
generateFormGet Markup -> MForm m a
form = (Markup -> MForm m a) -> Maybe (Env, FileEnv) -> m (a, Enctype)
forall (m :: * -> *) a.
MonadHandler m =>
(Markup -> MForm m a) -> Maybe (Env, FileEnv) -> m (a, Enctype)
getHelper Markup -> MForm m a
form Maybe (Env, FileEnv)
forall a. Maybe a
Nothing

getKey :: Text
getKey :: Text
getKey = Text
"_hasdata"

getHelper :: MonadHandler m
          => (Html -> MForm m a)
          -> Maybe (Env, FileEnv)
          -> m (a, Enctype)
getHelper :: (Markup -> MForm m a) -> Maybe (Env, FileEnv) -> m (a, Enctype)
getHelper Markup -> MForm m a
form Maybe (Env, FileEnv)
env = do
    let fragment :: Markup
fragment = [shamlet|<input type=hidden name=#{getKey}>|]
    [Text]
langs <- m [Text]
forall (m :: * -> *). MonadHandler m => m [Text]
languages
    HandlerSite m
m <- m (HandlerSite m)
forall (m :: * -> *). MonadHandler m => m (HandlerSite m)
getYesod
    MForm m a
-> HandlerSite m
-> [Text]
-> Maybe (Env, FileEnv)
-> m (a, Enctype)
forall (m :: * -> *) a.
Monad m =>
MForm m a
-> HandlerSite m
-> [Text]
-> Maybe (Env, FileEnv)
-> m (a, Enctype)
runFormGeneric (Markup -> MForm m a
form Markup
fragment) HandlerSite m
m [Text]
langs Maybe (Env, FileEnv)
env


-- | Creates a hidden field on the form that identifies it.  This
-- identification is then used to distinguish between /missing/
-- and /wrong/ form data when a single handler contains more than
-- one form.
--
-- For instance, if you have the following code on your handler:
--
-- > ((fooRes, fooWidget), fooEnctype) <- runFormPost fooForm
-- > ((barRes, barWidget), barEnctype) <- runFormPost barForm
--
-- Then replace it with
--
-- > ((fooRes, fooWidget), fooEnctype) <- runFormPost $ identifyForm "foo" fooForm
-- > ((barRes, barWidget), barEnctype) <- runFormPost $ identifyForm "bar" barForm
--
-- Note that it's your responsibility to ensure that the
-- identification strings are unique (using the same one twice on a
-- single handler will not generate any errors).  This allows you
-- to create a variable number of forms and still have them work
-- even if their number or order change between the HTML
-- generation and the form submission.
identifyForm
  :: Monad m
  => Text -- ^ Form identification string.
  -> (Html -> MForm m (FormResult a, WidgetFor (HandlerSite m) ()))
  -> (Html -> MForm m (FormResult a, WidgetFor (HandlerSite m) ()))
identifyForm :: Text
-> (Markup -> MForm m (FormResult a, WidgetFor (HandlerSite m) ()))
-> Markup
-> MForm m (FormResult a, WidgetFor (HandlerSite m) ())
identifyForm Text
identVal Markup -> MForm m (FormResult a, WidgetFor (HandlerSite m) ())
form = \Markup
fragment -> do
    -- Create hidden <input>.
    let fragment' :: Markup
fragment' =
          [shamlet|
            <input type=hidden name=#{identifyFormKey} value=identify-#{identVal}>
            #{fragment}
          |]

    -- Check if we got its value back.
    Maybe Env
mp <- MForm m (Maybe Env)
forall (m :: * -> *). Monad m => MForm m (Maybe Env)
askParams
    let missing :: Bool
missing = (Maybe Env
mp Maybe Env -> (Env -> Maybe [Text]) -> Maybe [Text]
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Text -> Env -> Maybe [Text]
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Text
identifyFormKey) Maybe [Text] -> Maybe [Text] -> Bool
forall a. Eq a => a -> a -> Bool
/= [Text] -> Maybe [Text]
forall a. a -> Maybe a
Just [Text
"identify-" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
identVal]

    -- Run the form proper (with our hidden <input>).  If the
    -- data is missing, then do not provide any params to the
    -- form, which will turn its result into FormMissing.  Also,
    -- doing this avoids having lots of fields with red errors.
    let eraseParams :: MForm m (FormResult a, WidgetFor (HandlerSite m) ())
-> MForm m (FormResult a, WidgetFor (HandlerSite m) ())
eraseParams | Bool
missing   = ((Maybe (Env, FileEnv), HandlerSite m, [Text])
 -> (Maybe (Env, FileEnv), HandlerSite m, [Text]))
-> MForm m (FormResult a, WidgetFor (HandlerSite m) ())
-> MForm m (FormResult a, WidgetFor (HandlerSite m) ())
forall r w s (m :: * -> *) a.
(r -> r) -> RWST r w s m a -> RWST r w s m a
local (\(Maybe (Env, FileEnv)
_, HandlerSite m
h, [Text]
l) -> (Maybe (Env, FileEnv)
forall a. Maybe a
Nothing, HandlerSite m
h, [Text]
l))
                    | Bool
otherwise = MForm m (FormResult a, WidgetFor (HandlerSite m) ())
-> MForm m (FormResult a, WidgetFor (HandlerSite m) ())
forall a. a -> a
id
    ( FormResult a
res', WidgetFor (HandlerSite m) ()
w) <- MForm m (FormResult a, WidgetFor (HandlerSite m) ())
-> MForm m (FormResult a, WidgetFor (HandlerSite m) ())
eraseParams (Markup -> MForm m (FormResult a, WidgetFor (HandlerSite m) ())
form Markup
fragment')

    -- Empty forms now properly return FormMissing. [#1072](https://github.com/yesodweb/yesod/issues/1072)
    let res :: FormResult a
res = if Bool
missing then FormResult a
forall a. FormResult a
FormMissing else FormResult a
res'
    (FormResult a, WidgetFor (HandlerSite m) ())
-> MForm m (FormResult a, WidgetFor (HandlerSite m) ())
forall (m :: * -> *) a. Monad m => a -> m a
return ( FormResult a
res, WidgetFor (HandlerSite m) ()
w)

identifyFormKey :: Text
identifyFormKey :: Text
identifyFormKey = Text
"_formid"


type FormRender m a =
       AForm m a
    -> Html
    -> MForm m (FormResult a, WidgetFor (HandlerSite m) ())

renderTable, renderDivs, renderDivsNoLabels :: Monad m => FormRender m a
-- | Render a form into a series of tr tags. Note that, in order to allow
-- you to add extra rows to the table, this function does /not/ wrap up
-- the resulting HTML in a table tag; you must do that yourself.
renderTable :: FormRender m a
renderTable AForm m a
aform Markup
fragment = do
    (FormResult a
res, [FieldView (HandlerSite m)] -> [FieldView (HandlerSite m)]
views') <- AForm m a
-> MForm
     m
     (FormResult a,
      [FieldView (HandlerSite m)] -> [FieldView (HandlerSite m)])
forall (m :: * -> *) site a.
(Monad m, HandlerSite m ~ site) =>
AForm m a
-> MForm m (FormResult a, [FieldView site] -> [FieldView site])
aFormToForm AForm m a
aform
    let views :: [FieldView (HandlerSite m)]
views = [FieldView (HandlerSite m)] -> [FieldView (HandlerSite m)]
views' []
    let widget :: WidgetFor (HandlerSite m) ()
widget = [whamlet|
$newline never
$if null views
    \#{fragment}
$forall (isFirst, view) <- addIsFirst views
    <tr :fvRequired view:.required :not $ fvRequired view:.optional>
        <td>
            $if isFirst
                \#{fragment}
            <label for=#{fvId view}>#{fvLabel view}
            $maybe tt <- fvTooltip view
                <div .tooltip>#{tt}
        <td>^{fvInput view}
        $maybe err <- fvErrors view
            <td .errors>#{err}
|]
    (FormResult a, WidgetFor (HandlerSite m) ())
-> MForm m (FormResult a, WidgetFor (HandlerSite m) ())
forall (m :: * -> *) a. Monad m => a -> m a
return (FormResult a
res, WidgetFor (HandlerSite m) ()
widget)
  where
    addIsFirst :: [t] -> [(Bool, t)]
addIsFirst [] = []
    addIsFirst (t
x:[t]
y) = (Bool
True, t
x) (Bool, t) -> [(Bool, t)] -> [(Bool, t)]
forall a. a -> [a] -> [a]
: (t -> (Bool, t)) -> [t] -> [(Bool, t)]
forall a b. (a -> b) -> [a] -> [b]
map (Bool
False, ) [t]
y

-- | render a field inside a div
renderDivs :: FormRender m a
renderDivs = Bool -> FormRender m a
forall (m :: * -> *) a. Monad m => Bool -> FormRender m a
renderDivsMaybeLabels Bool
True

-- | render a field inside a div, not displaying any label
renderDivsNoLabels :: FormRender m a
renderDivsNoLabels = Bool -> FormRender m a
forall (m :: * -> *) a. Monad m => Bool -> FormRender m a
renderDivsMaybeLabels Bool
False

renderDivsMaybeLabels :: Monad m => Bool -> FormRender m a
renderDivsMaybeLabels :: Bool -> FormRender m a
renderDivsMaybeLabels Bool
withLabels AForm m a
aform Markup
fragment = do
    (FormResult a
res, [FieldView (HandlerSite m)] -> [FieldView (HandlerSite m)]
views') <- AForm m a
-> MForm
     m
     (FormResult a,
      [FieldView (HandlerSite m)] -> [FieldView (HandlerSite m)])
forall (m :: * -> *) site a.
(Monad m, HandlerSite m ~ site) =>
AForm m a
-> MForm m (FormResult a, [FieldView site] -> [FieldView site])
aFormToForm AForm m a
aform
    let views :: [FieldView (HandlerSite m)]
views = [FieldView (HandlerSite m)] -> [FieldView (HandlerSite m)]
views' []
    let widget :: WidgetFor (HandlerSite m) ()
widget = [whamlet|
$newline never
\#{fragment}
$forall view <- views
    <div :fvRequired view:.required :not $ fvRequired view:.optional>
        $if withLabels
                <label for=#{fvId view}>#{fvLabel view}
        $maybe tt <- fvTooltip view
            <div .tooltip>#{tt}
        ^{fvInput view}
        $maybe err <- fvErrors view
            <div .errors>#{err}
|]
    (FormResult a, WidgetFor (HandlerSite m) ())
-> MForm m (FormResult a, WidgetFor (HandlerSite m) ())
forall (m :: * -> *) a. Monad m => a -> m a
return (FormResult a
res, WidgetFor (HandlerSite m) ()
widget)

-- | Render a form using Bootstrap v2-friendly shamlet syntax.
-- If you're using Bootstrap v3, then you should use the
-- functions from module "Yesod.Form.Bootstrap3".
--
-- Sample Hamlet:
--
-- >  <form .form-horizontal method=post action=@{ActionR} enctype=#{formEnctype}>
-- >    <fieldset>
-- >      <legend>_{MsgLegend}
-- >      $case result
-- >        $of FormFailure reasons
-- >          $forall reason <- reasons
-- >            <div .alert .alert-error>#{reason}
-- >        $of _
-- >      ^{formWidget}
-- >      <div .form-actions>
-- >        <input .btn .primary type=submit value=_{MsgSubmit}>
--
-- Since 1.3.14
renderBootstrap2 :: Monad m => FormRender m a
renderBootstrap2 :: FormRender m a
renderBootstrap2 AForm m a
aform Markup
fragment = do
    (FormResult a
res, [FieldView (HandlerSite m)] -> [FieldView (HandlerSite m)]
views') <- AForm m a
-> MForm
     m
     (FormResult a,
      [FieldView (HandlerSite m)] -> [FieldView (HandlerSite m)])
forall (m :: * -> *) site a.
(Monad m, HandlerSite m ~ site) =>
AForm m a
-> MForm m (FormResult a, [FieldView site] -> [FieldView site])
aFormToForm AForm m a
aform
    let views :: [FieldView (HandlerSite m)]
views = [FieldView (HandlerSite m)] -> [FieldView (HandlerSite m)]
views' []
        has :: Maybe a -> Bool
has (Just a
_) = Bool
True
        has Maybe a
Nothing  = Bool
False
    let widget :: WidgetFor (HandlerSite m) ()
widget = [whamlet|
                $newline never
                \#{fragment}
                $forall view <- views
                    <div .control-group .clearfix :fvRequired view:.required :not $ fvRequired view:.optional :has $ fvErrors view:.error>
                        <label .control-label for=#{fvId view}>#{fvLabel view}
                        <div .controls .input>
                            ^{fvInput view}
                            $maybe tt <- fvTooltip view
                                <span .help-block>#{tt}
                            $maybe err <- fvErrors view
                                <span .help-block>#{err}
                |]
    (FormResult a, WidgetFor (HandlerSite m) ())
-> MForm m (FormResult a, WidgetFor (HandlerSite m) ())
forall (m :: * -> *) a. Monad m => a -> m a
return (FormResult a
res, WidgetFor (HandlerSite m) ()
widget)

-- | Deprecated synonym for 'renderBootstrap2'.
renderBootstrap :: Monad m => FormRender m a
renderBootstrap :: FormRender m a
renderBootstrap = FormRender m a
forall (m :: * -> *) a. Monad m => FormRender m a
renderBootstrap2
{-# DEPRECATED renderBootstrap "Please use the Yesod.Form.Bootstrap3 module." #-}

check :: (Monad m, RenderMessage (HandlerSite m) msg)
      => (a -> Either msg a)
      -> Field m a
      -> Field m a
check :: (a -> Either msg a) -> Field m a -> Field m a
check a -> Either msg a
f = (a -> m (Either msg a)) -> Field m a -> Field m a
forall (m :: * -> *) msg a.
(Monad m, RenderMessage (HandlerSite m) msg) =>
(a -> m (Either msg a)) -> Field m a -> Field m a
checkM ((a -> m (Either msg a)) -> Field m a -> Field m a)
-> (a -> m (Either msg a)) -> Field m a -> Field m a
forall a b. (a -> b) -> a -> b
$ Either msg a -> m (Either msg a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Either msg a -> m (Either msg a))
-> (a -> Either msg a) -> a -> m (Either msg a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Either msg a
f

-- | Return the given error message if the predicate is false.
checkBool :: (Monad m, RenderMessage (HandlerSite m) msg)
          => (a -> Bool) -> msg -> Field m a -> Field m a
checkBool :: (a -> Bool) -> msg -> Field m a -> Field m a
checkBool a -> Bool
b msg
s = (a -> Either msg a) -> Field m a -> Field m a
forall (m :: * -> *) msg a.
(Monad m, RenderMessage (HandlerSite m) msg) =>
(a -> Either msg a) -> Field m a -> Field m a
check ((a -> Either msg a) -> Field m a -> Field m a)
-> (a -> Either msg a) -> Field m a -> Field m a
forall a b. (a -> b) -> a -> b
$ \a
x -> if a -> Bool
b a
x then a -> Either msg a
forall a b. b -> Either a b
Right a
x else msg -> Either msg a
forall a b. a -> Either a b
Left msg
s

checkM :: (Monad m, RenderMessage (HandlerSite m) msg)
       => (a -> m (Either msg a))
       -> Field m a
       -> Field m a
checkM :: (a -> m (Either msg a)) -> Field m a -> Field m a
checkM a -> m (Either msg a)
f = (a -> m (Either msg a)) -> (a -> a) -> Field m a -> Field m a
forall (m :: * -> *) msg a b.
(Monad m, RenderMessage (HandlerSite m) msg) =>
(a -> m (Either msg b)) -> (b -> a) -> Field m a -> Field m b
checkMMap a -> m (Either msg a)
f a -> a
forall a. a -> a
id

-- | Same as 'checkM', but modifies the datatype.
--
-- In order to make this work, you must provide a function to convert back from
-- the new datatype to the old one (the second argument to this function).
--
-- Since 1.1.2
checkMMap :: (Monad m, RenderMessage (HandlerSite m) msg)
          => (a -> m (Either msg b))
          -> (b -> a)
          -> Field m a
          -> Field m b
checkMMap :: (a -> m (Either msg b)) -> (b -> a) -> Field m a -> Field m b
checkMMap a -> m (Either msg b)
f b -> a
inv Field m a
field = Field m a
field
    { fieldParse :: [Text]
-> [FileInfo] -> m (Either (SomeMessage (HandlerSite m)) (Maybe b))
fieldParse = \[Text]
ts [FileInfo]
fs -> do
        Either (SomeMessage (HandlerSite m)) (Maybe a)
e1 <- Field m a
-> [Text]
-> [FileInfo]
-> m (Either (SomeMessage (HandlerSite m)) (Maybe a))
forall (m :: * -> *) a.
Field m a
-> [Text]
-> [FileInfo]
-> m (Either (SomeMessage (HandlerSite m)) (Maybe a))
fieldParse Field m a
field [Text]
ts [FileInfo]
fs
        case Either (SomeMessage (HandlerSite m)) (Maybe a)
e1 of
            Left SomeMessage (HandlerSite m)
msg -> Either (SomeMessage (HandlerSite m)) (Maybe b)
-> m (Either (SomeMessage (HandlerSite m)) (Maybe b))
forall (m :: * -> *) a. Monad m => a -> m a
return (Either (SomeMessage (HandlerSite m)) (Maybe b)
 -> m (Either (SomeMessage (HandlerSite m)) (Maybe b)))
-> Either (SomeMessage (HandlerSite m)) (Maybe b)
-> m (Either (SomeMessage (HandlerSite m)) (Maybe b))
forall a b. (a -> b) -> a -> b
$ SomeMessage (HandlerSite m)
-> Either (SomeMessage (HandlerSite m)) (Maybe b)
forall a b. a -> Either a b
Left SomeMessage (HandlerSite m)
msg
            Right Maybe a
Nothing -> Either (SomeMessage (HandlerSite m)) (Maybe b)
-> m (Either (SomeMessage (HandlerSite m)) (Maybe b))
forall (m :: * -> *) a. Monad m => a -> m a
return (Either (SomeMessage (HandlerSite m)) (Maybe b)
 -> m (Either (SomeMessage (HandlerSite m)) (Maybe b)))
-> Either (SomeMessage (HandlerSite m)) (Maybe b)
-> m (Either (SomeMessage (HandlerSite m)) (Maybe b))
forall a b. (a -> b) -> a -> b
$ Maybe b -> Either (SomeMessage (HandlerSite m)) (Maybe b)
forall a b. b -> Either a b
Right Maybe b
forall a. Maybe a
Nothing
            Right (Just a
a) -> (Either msg b -> Either (SomeMessage (HandlerSite m)) (Maybe b))
-> m (Either msg b)
-> m (Either (SomeMessage (HandlerSite m)) (Maybe b))
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM ((msg -> Either (SomeMessage (HandlerSite m)) (Maybe b))
-> (b -> Either (SomeMessage (HandlerSite m)) (Maybe b))
-> Either msg b
-> Either (SomeMessage (HandlerSite m)) (Maybe b)
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (SomeMessage (HandlerSite m)
-> Either (SomeMessage (HandlerSite m)) (Maybe b)
forall a b. a -> Either a b
Left (SomeMessage (HandlerSite m)
 -> Either (SomeMessage (HandlerSite m)) (Maybe b))
-> (msg -> SomeMessage (HandlerSite m))
-> msg
-> Either (SomeMessage (HandlerSite m)) (Maybe b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. msg -> SomeMessage (HandlerSite m)
forall master msg.
RenderMessage master msg =>
msg -> SomeMessage master
SomeMessage) (Maybe b -> Either (SomeMessage (HandlerSite m)) (Maybe b)
forall a b. b -> Either a b
Right (Maybe b -> Either (SomeMessage (HandlerSite m)) (Maybe b))
-> (b -> Maybe b)
-> b
-> Either (SomeMessage (HandlerSite m)) (Maybe b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. b -> Maybe b
forall a. a -> Maybe a
Just)) (m (Either msg b)
 -> m (Either (SomeMessage (HandlerSite m)) (Maybe b)))
-> m (Either msg b)
-> m (Either (SomeMessage (HandlerSite m)) (Maybe b))
forall a b. (a -> b) -> a -> b
$ a -> m (Either msg b)
f a
a
    , fieldView :: FieldViewFunc m b
fieldView = \Text
i Text
n [(Text, Text)]
a Either Text b
eres Bool
req -> Field m a -> FieldViewFunc m a
forall (m :: * -> *) a. Field m a -> FieldViewFunc m a
fieldView Field m a
field Text
i Text
n [(Text, Text)]
a ((b -> a) -> Either Text b -> Either Text a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap b -> a
inv Either Text b
eres) Bool
req
    }

-- | Allows you to overwrite the error message on parse error.
customErrorMessage :: Monad m => SomeMessage (HandlerSite m) -> Field m a -> Field m a
customErrorMessage :: SomeMessage (HandlerSite m) -> Field m a -> Field m a
customErrorMessage SomeMessage (HandlerSite m)
msg Field m a
field = Field m a
field
    { fieldParse :: [Text]
-> [FileInfo] -> m (Either (SomeMessage (HandlerSite m)) (Maybe a))
fieldParse = \[Text]
ts [FileInfo]
fs ->
        (Either (SomeMessage (HandlerSite m)) (Maybe a)
 -> Either (SomeMessage (HandlerSite m)) (Maybe a))
-> m (Either (SomeMessage (HandlerSite m)) (Maybe a))
-> m (Either (SomeMessage (HandlerSite m)) (Maybe a))
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM ((SomeMessage (HandlerSite m)
 -> Either (SomeMessage (HandlerSite m)) (Maybe a))
-> (Maybe a -> Either (SomeMessage (HandlerSite m)) (Maybe a))
-> Either (SomeMessage (HandlerSite m)) (Maybe a)
-> Either (SomeMessage (HandlerSite m)) (Maybe a)
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (Either (SomeMessage (HandlerSite m)) (Maybe a)
-> SomeMessage (HandlerSite m)
-> Either (SomeMessage (HandlerSite m)) (Maybe a)
forall a b. a -> b -> a
const (Either (SomeMessage (HandlerSite m)) (Maybe a)
 -> SomeMessage (HandlerSite m)
 -> Either (SomeMessage (HandlerSite m)) (Maybe a))
-> Either (SomeMessage (HandlerSite m)) (Maybe a)
-> SomeMessage (HandlerSite m)
-> Either (SomeMessage (HandlerSite m)) (Maybe a)
forall a b. (a -> b) -> a -> b
$ SomeMessage (HandlerSite m)
-> Either (SomeMessage (HandlerSite m)) (Maybe a)
forall a b. a -> Either a b
Left SomeMessage (HandlerSite m)
msg) Maybe a -> Either (SomeMessage (HandlerSite m)) (Maybe a)
forall a b. b -> Either a b
Right)
      (m (Either (SomeMessage (HandlerSite m)) (Maybe a))
 -> m (Either (SomeMessage (HandlerSite m)) (Maybe a)))
-> m (Either (SomeMessage (HandlerSite m)) (Maybe a))
-> m (Either (SomeMessage (HandlerSite m)) (Maybe a))
forall a b. (a -> b) -> a -> b
$ Field m a
-> [Text]
-> [FileInfo]
-> m (Either (SomeMessage (HandlerSite m)) (Maybe a))
forall (m :: * -> *) a.
Field m a
-> [Text]
-> [FileInfo]
-> m (Either (SomeMessage (HandlerSite m)) (Maybe a))
fieldParse Field m a
field [Text]
ts [FileInfo]
fs
    }

-- | Generate a 'FieldSettings' from the given label.
fieldSettingsLabel :: RenderMessage site msg => msg -> FieldSettings site
fieldSettingsLabel :: msg -> FieldSettings site
fieldSettingsLabel msg
msg = SomeMessage site
-> Maybe (SomeMessage site)
-> Maybe Text
-> Maybe Text
-> [(Text, Text)]
-> FieldSettings site
forall master.
SomeMessage master
-> Maybe (SomeMessage master)
-> Maybe Text
-> Maybe Text
-> [(Text, Text)]
-> FieldSettings master
FieldSettings (msg -> SomeMessage site
forall master msg.
RenderMessage master msg =>
msg -> SomeMessage master
SomeMessage msg
msg) Maybe (SomeMessage site)
forall a. Maybe a
Nothing Maybe Text
forall a. Maybe a
Nothing Maybe Text
forall a. Maybe a
Nothing []

-- | A helper function for creating custom fields.
--
-- This is intended to help with the common case where a single input value is
-- required, such as when parsing a text field.
--
-- Since 1.1
parseHelper :: (Monad m, RenderMessage site FormMessage)
            => (Text -> Either FormMessage a)
            -> [Text] -> [FileInfo] -> m (Either (SomeMessage site) (Maybe a))
parseHelper :: (Text -> Either FormMessage a)
-> [Text] -> [FileInfo] -> m (Either (SomeMessage site) (Maybe a))
parseHelper = (Text -> Either FormMessage a)
-> [Text] -> [FileInfo] -> m (Either (SomeMessage site) (Maybe a))
forall (m :: * -> *) site msg a.
(Monad m, RenderMessage site msg) =>
(Text -> Either msg a)
-> [Text] -> [FileInfo] -> m (Either (SomeMessage site) (Maybe a))
parseHelperGen

-- | A generalized version of 'parseHelper', allowing any type for the message
-- indicating a bad parse.
--
-- Since 1.3.6
parseHelperGen :: (Monad m, RenderMessage site msg)
               => (Text -> Either msg a)
               -> [Text] -> [FileInfo] -> m (Either (SomeMessage site) (Maybe a))
parseHelperGen :: (Text -> Either msg a)
-> [Text] -> [FileInfo] -> m (Either (SomeMessage site) (Maybe a))
parseHelperGen Text -> Either msg a
_ [] [FileInfo]
_ = Either (SomeMessage site) (Maybe a)
-> m (Either (SomeMessage site) (Maybe a))
forall (m :: * -> *) a. Monad m => a -> m a
return (Either (SomeMessage site) (Maybe a)
 -> m (Either (SomeMessage site) (Maybe a)))
-> Either (SomeMessage site) (Maybe a)
-> m (Either (SomeMessage site) (Maybe a))
forall a b. (a -> b) -> a -> b
$ Maybe a -> Either (SomeMessage site) (Maybe a)
forall a b. b -> Either a b
Right Maybe a
forall a. Maybe a
Nothing
parseHelperGen Text -> Either msg a
_ (Text
"":[Text]
_) [FileInfo]
_ = Either (SomeMessage site) (Maybe a)
-> m (Either (SomeMessage site) (Maybe a))
forall (m :: * -> *) a. Monad m => a -> m a
return (Either (SomeMessage site) (Maybe a)
 -> m (Either (SomeMessage site) (Maybe a)))
-> Either (SomeMessage site) (Maybe a)
-> m (Either (SomeMessage site) (Maybe a))
forall a b. (a -> b) -> a -> b
$ Maybe a -> Either (SomeMessage site) (Maybe a)
forall a b. b -> Either a b
Right Maybe a
forall a. Maybe a
Nothing
parseHelperGen Text -> Either msg a
f (Text
x:[Text]
_) [FileInfo]
_ = Either (SomeMessage site) (Maybe a)
-> m (Either (SomeMessage site) (Maybe a))
forall (m :: * -> *) a. Monad m => a -> m a
return (Either (SomeMessage site) (Maybe a)
 -> m (Either (SomeMessage site) (Maybe a)))
-> Either (SomeMessage site) (Maybe a)
-> m (Either (SomeMessage site) (Maybe a))
forall a b. (a -> b) -> a -> b
$ (msg -> Either (SomeMessage site) (Maybe a))
-> (a -> Either (SomeMessage site) (Maybe a))
-> Either msg a
-> Either (SomeMessage site) (Maybe a)
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (SomeMessage site -> Either (SomeMessage site) (Maybe a)
forall a b. a -> Either a b
Left (SomeMessage site -> Either (SomeMessage site) (Maybe a))
-> (msg -> SomeMessage site)
-> msg
-> Either (SomeMessage site) (Maybe a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. msg -> SomeMessage site
forall master msg.
RenderMessage master msg =>
msg -> SomeMessage master
SomeMessage) (Maybe a -> Either (SomeMessage site) (Maybe a)
forall a b. b -> Either a b
Right (Maybe a -> Either (SomeMessage site) (Maybe a))
-> (a -> Maybe a) -> a -> Either (SomeMessage site) (Maybe a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Maybe a
forall a. a -> Maybe a
Just) (Either msg a -> Either (SomeMessage site) (Maybe a))
-> Either msg a -> Either (SomeMessage site) (Maybe a)
forall a b. (a -> b) -> a -> b
$ Text -> Either msg a
f Text
x

-- | Since a 'Field' cannot be a 'Functor', it is not obvious how to "reuse" a Field
-- on a @newtype@ or otherwise equivalent type. This function allows you to convert
-- a @Field m a@ to a @Field m b@ assuming you provide a bidirectional
-- conversion between the two, through the first two functions.
--
-- A simple example:
--
-- > import Data.Monoid
-- > sumField :: (Functor m, Monad m, RenderMessage (HandlerSite m) FormMessage) => Field m (Sum Int)
-- > sumField = convertField Sum getSum intField
--
-- Another example, not using a newtype, but instead creating a Lazy Text field:
--
-- > import qualified Data.Text.Lazy as TL
-- > TextField :: (Functor m, Monad m, RenderMessage (HandlerSite m) FormMessage) => Field m TL.Text
-- > lazyTextField = convertField TL.fromStrict TL.toStrict textField
--
-- Since 1.3.16
convertField :: (Functor m)
             => (a -> b) -> (b -> a)
             -> Field m a -> Field m b
convertField :: (a -> b) -> (b -> a) -> Field m a -> Field m b
convertField a -> b
to b -> a
from (Field [Text]
-> [FileInfo] -> m (Either (SomeMessage (HandlerSite m)) (Maybe a))
fParse FieldViewFunc m a
fView Enctype
fEnctype) = let
  fParse' :: [Text]
-> [FileInfo] -> m (Either (SomeMessage (HandlerSite m)) (Maybe b))
fParse' [Text]
ts = (Either (SomeMessage (HandlerSite m)) (Maybe a)
 -> Either (SomeMessage (HandlerSite m)) (Maybe b))
-> m (Either (SomeMessage (HandlerSite m)) (Maybe a))
-> m (Either (SomeMessage (HandlerSite m)) (Maybe b))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Maybe a -> Maybe b)
-> Either (SomeMessage (HandlerSite m)) (Maybe a)
-> Either (SomeMessage (HandlerSite m)) (Maybe b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
to)) (m (Either (SomeMessage (HandlerSite m)) (Maybe a))
 -> m (Either (SomeMessage (HandlerSite m)) (Maybe b)))
-> ([FileInfo]
    -> m (Either (SomeMessage (HandlerSite m)) (Maybe a)))
-> [FileInfo]
-> m (Either (SomeMessage (HandlerSite m)) (Maybe b))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Text]
-> [FileInfo] -> m (Either (SomeMessage (HandlerSite m)) (Maybe a))
fParse [Text]
ts
  fView' :: Text
-> Text
-> [(Text, Text)]
-> Either Text b
-> Bool
-> WidgetFor (HandlerSite m) ()
fView' Text
ti Text
tn [(Text, Text)]
at Either Text b
ei = FieldViewFunc m a
fView Text
ti Text
tn [(Text, Text)]
at ((b -> a) -> Either Text b -> Either Text a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap b -> a
from Either Text b
ei)
  in ([Text]
 -> [FileInfo]
 -> m (Either (SomeMessage (HandlerSite m)) (Maybe b)))
-> (Text
    -> Text
    -> [(Text, Text)]
    -> Either Text b
    -> Bool
    -> WidgetFor (HandlerSite m) ())
-> Enctype
-> Field m b
forall (m :: * -> *) a.
([Text]
 -> [FileInfo]
 -> m (Either (SomeMessage (HandlerSite m)) (Maybe a)))
-> FieldViewFunc m a -> Enctype -> Field m a
Field [Text]
-> [FileInfo] -> m (Either (SomeMessage (HandlerSite m)) (Maybe b))
fParse' Text
-> Text
-> [(Text, Text)]
-> Either Text b
-> Bool
-> WidgetFor (HandlerSite m) ()
fView' Enctype
fEnctype

-- | Removes a CSS class from the 'fsAttrs' in a 'FieldSettings'.
--
-- ==== __Examples__
--
-- >>> 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
            -> [(Text, Text)] -- ^ List of existing 'fsAttrs'
            -> [(Text, Text)]
removeClass :: Text -> [(Text, Text)] -> [(Text, Text)]
removeClass Text
_     []                    = []
removeClass Text
klass ((Text
"class", Text
old):[(Text, Text)]
rest) = (Text
"class", Text -> Text -> Text -> Text
T.replace Text
klass Text
" " Text
old) (Text, Text) -> [(Text, Text)] -> [(Text, Text)]
forall a. a -> [a] -> [a]
: [(Text, Text)]
rest
removeClass Text
klass ((Text, Text)
other         :[(Text, Text)]
rest) = (Text, Text)
other (Text, Text) -> [(Text, Text)] -> [(Text, Text)]
forall a. a -> [a] -> [a]
: Text -> [(Text, Text)] -> [(Text, Text)]
removeClass Text
klass [(Text, Text)]
rest

-- | Adds a CSS class to the 'fsAttrs' in a 'FieldSettings'.
--
-- ==== __Examples__
--
-- >>> 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
         -> [(Text, Text)] -- ^ List of existing 'fsAttrs'
         -> [(Text, Text)]
addClass :: Text -> [(Text, Text)] -> [(Text, Text)]
addClass Text
klass []                    = [(Text
"class", Text
klass)]
addClass Text
klass ((Text
"class", Text
old):[(Text, Text)]
rest) = (Text
"class", [Text] -> Text
T.concat [Text
old, Text
" ", Text
klass]) (Text, Text) -> [(Text, Text)] -> [(Text, Text)]
forall a. a -> [a] -> [a]
: [(Text, Text)]
rest
addClass Text
klass ((Text, Text)
other         :[(Text, Text)]
rest) = (Text, Text)
other (Text, Text) -> [(Text, Text)] -> [(Text, Text)]
forall a. a -> [a] -> [a]
: Text -> [(Text, Text)] -> [(Text, Text)]
addClass Text
klass [(Text, Text)]
rest