{-# LANGUAGE CPP #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE QuasiQuotes #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE TupleSections #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeOperators #-}

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
      -- ** Post\/Redirect\/Get
    , runFormPRG
      -- * 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
    , lookupRawFieldInput
    ) 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, when)
import Data.IORef (IORef, newIORef, modifyIORef', readIORef)
import qualified Data.Aeson as A
import Data.Byteable (constEqBytes)
import qualified Data.ByteString.Lazy as BL
import Text.Blaze (Markup, toMarkup)
#define Html Markup
#define toHtml toMarkup
import Yesod.Core
import Network.Wai (Request, requestMethod, rawPathInfo)
import Data.Maybe (listToMaybe, fromMaybe)
import qualified Data.Map as Map
import qualified Data.Text.Encoding as TE
import qualified Data.Text.Encoding.Error as TEE
import Control.Arrow (first)

-- | Get a unique identifier.
newFormIdent :: Monad m => MForm m Text
newFormIdent :: forall (m :: * -> *). Monad m => MForm m Text
newFormIdent = do
    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 -> Ints
incrInts Ints
i
    put i'
    return $ pack $ 'f' : show 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 :: forall (m :: * -> *) site a.
(HandlerSite m ~ site, Monad m) =>
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
    ((a, xmls), ints', 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
    return (a, (++) xmls, ints', enc)

aFormToForm :: (Monad m, HandlerSite m ~ site)
            => AForm m a
            -> MForm m (FormResult a, [FieldView site] -> [FieldView site])
aFormToForm :: forall (m :: * -> *) site a.
(Monad m, HandlerSite m ~ site) =>
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 <- 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
    (env, site, langs) <- ask
    (a, xml, ints', enc) <- lift $ aform (site, langs) env ints
    put ints'
    tell enc
    return (a, xml)

askParams :: Monad m => MForm m (Maybe Env)
askParams :: forall (m :: * -> *). Monad m => MForm m (Maybe Env)
askParams = do
    (x, _, _) <- 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
    return $ liftM fst x

askFiles :: Monad m => MForm m (Maybe FileEnv)
askFiles :: forall (m :: * -> *). Monad m => MForm m (Maybe FileEnv)
askFiles = do
    (x, _, _) <- 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
    return $ liftM snd 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 :: forall site (m :: * -> *) a.
(RenderMessage site FormMessage, HandlerSite m ~ site,
 MonadHandler m) =>
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
-> RWST
     (Maybe (Env, FileEnv),
      HandlerSite (WriterT [FieldView (HandlerSite m)] m), [Text])
     Enctype
     Ints
     (WriterT [FieldView (HandlerSite m)] 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 :: 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 msg
msg = RWST
  (Maybe (Env, FileEnv), HandlerSite m, [Text])
  Enctype
  Ints
  m
  (FormResult a, FieldView (HandlerSite m))
-> RWST
     (Maybe (Env, FileEnv), site, [Text])
     Enctype
     Ints
     (WriterT [FieldView site] m)
     (FormResult a)
RWST
  (Maybe (Env, FileEnv), HandlerSite m, [Text])
  Enctype
  Ints
  m
  (FormResult a, FieldView (HandlerSite m))
-> RWST
     (Maybe (Env, FileEnv),
      HandlerSite (WriterT [FieldView (HandlerSite m)] 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 (HandlerSite m))
 -> RWST
      (Maybe (Env, FileEnv), site, [Text])
      Enctype
      Ints
      (WriterT [FieldView site] m)
      (FormResult a))
-> (Maybe a
    -> RWST
         (Maybe (Env, FileEnv), HandlerSite m, [Text])
         Enctype
         Ints
         m
         (FormResult a, FieldView (HandlerSite m)))
-> Maybe a
-> RWST
     (Maybe (Env, FileEnv), site, [Text])
     Enctype
     Ints
     (WriterT [FieldView site] m)
     (FormResult a)
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

-- | 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 :: forall (m :: * -> *) site a.
(MonadHandler m, HandlerSite m ~ site) =>
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 (HandlerSite m))
-> RWST
     (Maybe (Env, FileEnv), site, [Text])
     Enctype
     Ints
     (WriterT [FieldView site] m)
     (FormResult (Maybe a))
RWST
  (Maybe (Env, FileEnv), HandlerSite m, [Text])
  Enctype
  Ints
  m
  (FormResult (Maybe a), FieldView (HandlerSite m))
-> RWST
     (Maybe (Env, FileEnv),
      HandlerSite (WriterT [FieldView (HandlerSite m)] 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 (HandlerSite m))
 -> RWST
      (Maybe (Env, FileEnv), site, [Text])
      Enctype
      Ints
      (WriterT [FieldView site] m)
      (FormResult (Maybe a)))
-> (Maybe (Maybe a)
    -> RWST
         (Maybe (Env, FileEnv), HandlerSite m, [Text])
         Enctype
         Ints
         m
         (FormResult (Maybe a), FieldView (HandlerSite m)))
-> Maybe (Maybe a)
-> RWST
     (Maybe (Env, FileEnv), site, [Text])
     Enctype
     Ints
     (WriterT [FieldView site] m)
     (FormResult (Maybe a))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Field m a
-> FieldSettings site
-> Maybe (Maybe a)
-> MForm 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 :: forall (m :: * -> *) a.
MonadHandler m =>
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)])
RWST
  (Maybe (Env, FileEnv),
   HandlerSite (WriterT [FieldView (HandlerSite m)] 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 :: forall (m :: * -> *) site a.
(MonadHandler m, HandlerSite m ~ site) =>
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 a b. (a -> b) -> m a -> m b
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 :: forall (m :: * -> *) site a.
(MonadHandler m, HandlerSite m ~ site) =>
MForm m (a, FieldView site) -> WForm m a
mFormToWForm = (m ((a, FieldView site), Ints, Enctype)
 -> WriterT [FieldView (HandlerSite m)] m (a, Ints, Enctype))
-> RWST
     (Maybe (Env, FileEnv), HandlerSite m, [Text])
     Enctype
     Ints
     m
     (a, FieldView site)
-> RWST
     (Maybe (Env, FileEnv), HandlerSite m, [Text])
     Enctype
     Ints
     (WriterT [FieldView (HandlerSite m)] 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 (HandlerSite m)] m (a, Ints, Enctype))
 -> RWST
      (Maybe (Env, FileEnv), HandlerSite m, [Text])
      Enctype
      Ints
      m
      (a, FieldView site)
 -> RWST
      (Maybe (Env, FileEnv), HandlerSite m, [Text])
      Enctype
      Ints
      (WriterT [FieldView (HandlerSite m)] m)
      a)
-> (m ((a, FieldView site), Ints, Enctype)
    -> WriterT [FieldView (HandlerSite m)] m (a, Ints, Enctype))
-> RWST
     (Maybe (Env, FileEnv), HandlerSite m, [Text])
     Enctype
     Ints
     m
     (a, FieldView site)
-> RWST
     (Maybe (Env, FileEnv), HandlerSite m, [Text])
     Enctype
     Ints
     (WriterT [FieldView (HandlerSite m)] m)
     a
forall a b. (a -> b) -> a -> b
$ \m ((a, FieldView site), Ints, Enctype)
f -> do
  ((a, view), ints, enctype) <- m ((a, FieldView site), Ints, Enctype)
-> WriterT [FieldView site] m ((a, FieldView site), Ints, Enctype)
forall (m :: * -> *) a.
Monad m =>
m a -> WriterT [FieldView site] m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift m ((a, FieldView site), Ints, Enctype)
f
  writer ((a, ints, enctype), [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 :: forall site (m :: * -> *) a.
(RenderMessage site FormMessage, HandlerSite m ~ site,
 MonadHandler m) =>
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
-> 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
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 :: 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 msg
msg Maybe a
mdef = Field m a
-> FieldSettings site
-> Maybe a
-> (site -> [Text] -> FormResult a)
-> (a -> FormResult a)
-> Bool
-> RWST
     (Maybe (Env, FileEnv), HandlerSite m, [Text])
     Enctype
     Ints
     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 :: 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
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
-> RWST
     (Maybe (Env, FileEnv), HandlerSite m, [Text])
     Enctype
     Ints
     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

-- | Per-request store of the raw parameter values each field was run
-- against, keyed by field name; see 'lookupRawFieldInput'.
newtype RawFieldInput = RawFieldInput (IORef (Map.Map Text [Text]))

rawFieldInputRef :: MonadHandler m => m (IORef (Map.Map Text [Text]))
rawFieldInputRef :: forall (m :: * -> *). MonadHandler m => m (IORef Env)
rawFieldInputRef = do
    RawFieldInput ref <- ByteString -> m RawFieldInput -> m RawFieldInput
forall (m :: * -> *) a.
(MonadHandler m, Typeable a) =>
ByteString -> m a -> m a
cachedBy ByteString
"yesod-form-raw-field-input" (m RawFieldInput -> m RawFieldInput)
-> m RawFieldInput -> m RawFieldInput
forall a b. (a -> b) -> a -> b
$
        (IORef Env -> RawFieldInput) -> m (IORef Env) -> m RawFieldInput
forall a b. (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap IORef Env -> RawFieldInput
RawFieldInput (m (IORef Env) -> m RawFieldInput)
-> m (IORef Env) -> m RawFieldInput
forall a b. (a -> b) -> a -> b
$ IO (IORef Env) -> m (IORef Env)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (IORef Env) -> m (IORef Env))
-> IO (IORef Env) -> m (IORef Env)
forall a b. (a -> b) -> a -> b
$ Env -> IO (IORef Env)
forall a. a -> IO (IORef a)
newIORef Env
forall k a. Map k a
Map.empty
    return ref

-- | The raw parameter values the named field was run against in this
-- request, whether from a direct submission or a Post\/Redirect\/Get
-- replay ('runFormPRG'). Empty if no form containing the field has run
-- with a submission in this request (e.g. 'generateFormPost', or an
-- 'identifyForm'-wrapped form that was not the one submitted).
--
-- This lets the view of a field rendering several inputs under one name
-- restore all of the user's raw input after a failed submission: the
-- @Either Text a@ argument a view receives can only carry the first
-- submitted value. Only fields run through 'mreq'\/'mopt' (and the
-- applicative\/widget helpers built on them) record their values here.
--
-- @since 1.7.11
lookupRawFieldInput :: MonadHandler m => Text -> m [Text]
lookupRawFieldInput :: forall (m :: * -> *). MonadHandler m => Text -> m [Text]
lookupRawFieldInput Text
name = do
    ref <- m (IORef Env)
forall (m :: * -> *). MonadHandler m => m (IORef Env)
rawFieldInputRef
    Map.findWithDefault [] name `liftM` liftIO (readIORef ref)

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 :: 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 {Enctype
[Text]
-> [FileInfo] -> m (Either (SomeMessage (HandlerSite m)) (Maybe a))
FieldViewFunc m a
fieldParse :: [Text]
-> [FileInfo] -> m (Either (SomeMessage (HandlerSite m)) (Maybe a))
fieldView :: FieldViewFunc m a
fieldEnctype :: Enctype
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))
..} FieldSettings {[(Text, Text)]
Maybe Text
Maybe (SomeMessage site)
SomeMessage site
fsLabel :: SomeMessage site
fsTooltip :: Maybe (SomeMessage site)
fsId :: Maybe Text
fsName :: Maybe Text
fsAttrs :: [(Text, Text)]
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
..} 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
    mp <- RWST
  (Maybe (Env, FileEnv), site, [Text]) Enctype Ints m (Maybe Env)
MForm m (Maybe Env)
forall (m :: * -> *). Monad m => MForm m (Maybe Env)
askParams
    name <- maybe newFormIdent return fsName
    theId <- lift $ maybe newIdent return fsId
    (_, site, langs) <- ask
    let mr2 = site -> [Text] -> SomeMessage site -> Text
forall master message.
RenderMessage master message =>
master -> [Text] -> message -> Text
renderMessage site
site [Text]
langs
    (res, val) <-
        case 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 a.
a -> RWST (Maybe (Env, FileEnv), site, [Text]) Enctype Ints m 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
                mfs <- RWST
  (Maybe (Env, FileEnv), site, [Text]) Enctype Ints m (Maybe FileEnv)
MForm m (Maybe FileEnv)
forall (m :: * -> *). Monad m => MForm m (Maybe FileEnv)
askFiles
                let 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] -> 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 a b. Maybe a -> (a -> Maybe b) -> Maybe b
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
                lift $ do
                    ref <- rawFieldInputRef
                    liftIO $ modifyIORef' ref $ Map.insert name mvals
                emx <- lift $ fieldParse mvals files
                return $ case 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)
    return (res, FieldView
        { fvLabel = toHtml $ mr2 fsLabel
        , fvTooltip = fmap toHtml $ fmap mr2 fsTooltip
        , fvId = theId
        , fvInput = fieldView theId name fsAttrs val isReq
        , fvErrors =
            case 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 = 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 :: forall site (m :: * -> *) a.
(RenderMessage site FormMessage, HandlerSite m ~ site,
 MonadHandler m) =>
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 :: 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 msg
msg = RWST
  (Maybe (Env, FileEnv), site, [Text])
  Enctype
  Ints
  m
  (FormResult a, [FieldView site])
-> AForm m a
MForm 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 b c d. (b -> c) -> (d, b) -> (d, c)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (d, b) (d, c)
second FieldView site -> [FieldView site]
forall a. a -> [a]
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 :: forall (m :: * -> *) a.
MonadHandler m =>
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 b c d. (b -> c) -> (d, b) -> (d, c)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (d, b) (d, c)
second FieldView (HandlerSite m) -> [FieldView (HandlerSite m)]
forall a. a -> [a]
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 :: forall (m :: * -> *) a.
Monad m =>
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 :: forall (m :: * -> *) a xml.
(RenderMessage (HandlerSite m) FormMessage, MonadResource m,
 MonadHandler m) =>
(Markup -> MForm m (FormResult a, xml))
-> m ((FormResult a, xml), Enctype)
runFormPost Markup -> MForm m (FormResult a, xml)
form = do
    env <- m (Maybe (Env, FileEnv))
forall (m :: * -> *). MonadHandler m => m (Maybe (Env, FileEnv))
postEnv
    postHelper form env

postHelper  :: (MonadHandler m, RenderMessage (HandlerSite m) FormMessage)
            => (Html -> MForm m (FormResult a, xml))
            -> Maybe (Env, FileEnv)
            -> m ((FormResult a, xml), Enctype)
postHelper :: 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 = do
    req <- m YesodRequest
forall (m :: * -> *). MonadHandler m => m YesodRequest
getRequest
    let tokenKey = Text
defaultCsrfParamName
    let token =
            case YesodRequest -> Maybe Text
reqToken YesodRequest
req of
                Maybe Text
Nothing -> Markup
forall a. Monoid a => a
mempty
                Just Text
n -> [shamlet|<input type=hidden name=#{tokenKey} value=#{n}>|]
    m <- getYesod
    langs <- languages
    ((res, xml), enctype) <- runFormGeneric (form token) m langs env
    let 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
    return ((res', xml), 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 :: forall (m :: * -> *) a xml.
(RenderMessage (HandlerSite m) FormMessage, MonadHandler m) =>
(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 b c d. (b -> c) -> (b, d) -> (c, d)
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

-- | Run a form for the Post\/Redirect\/Get pattern, so that invalid input
-- and its validation errors survive a redirect.
--
-- Use this in /both/ the GET and POST handlers of a route, exactly as you
-- would 'runFormPost':
--
-- * On a POST request this behaves exactly like 'runFormPost' (including
--   CSRF protection). Additionally, on 'FormFailure' the submitted
--   parameters are stashed in the user session so that your handler can
--   simply 'redirect' back to the GET route instead of re-rendering. On
--   'FormSuccess' any previously stashed parameters for this route are
--   cleared. On 'FormMissing' (another 'identifyForm'-wrapped form on the
--   page was the one submitted) the stash is left untouched.
--
-- * On a GET request, if stashed parameters exist for the current path,
--   they are removed from the session and the form is run against them:
--   the fields re-render with the user's input and validation errors, just
--   as a non-redirecting handler would have rendered them. A fresh CSRF
--   token is rendered into the form (the stashed token is discarded, and
--   no token check is performed on a replay). If nothing is stashed, this
--   behaves like 'generateFormPost' (the result is 'FormMissing').
--
-- > getRegisterR :: Handler Html
-- > getRegisterR = do
-- >     ((_res, widget), enctype) <- runFormPRG personForm
-- >     defaultLayout
-- >         [whamlet|
-- >             <form method=post action=@{RegisterR} enctype=#{enctype}>
-- >                 ^{widget}
-- >         |]
-- >
-- > postRegisterR :: Handler Html
-- > postRegisterR = do
-- >     ((res, _widget), _enctype) <- runFormPRG personForm
-- >     case res of
-- >         FormSuccess person -> do
-- >             -- insert into the database, etc.
-- >             setMessage "Registered!"
-- >             redirect RegisterR
-- >         _ -> redirect RegisterR
--
-- Notes and caveats:
--
-- * The stash is keyed by request path, so the GET and POST handlers must
--   share a route (the common Yesod pattern). Form pages on different
--   routes do not interfere with each other; two tabs on the /same/ path
--   share one stash (the last failed submission wins).
--
-- * Multiple forms on one page work when wrapped with 'identifyForm': on
--   replay, only the form that was actually submitted re-renders with
--   values and errors; the others return 'FormMissing' and render blank.
--   (The stash is popped once per request and shared between calls via
--   the per-request cache, so every form in the handler sees it.)
--
-- * Uploaded files are not stashed; file fields re-render empty after the
--   redirect.
--
-- * The stashed parameters live in the user session. With the default
--   client-session backend the whole session must fit in a cookie
--   (roughly 4KB), so this is unsuitable for very large forms. If the
--   stash fails to decode, it is discarded and a blank form is generated.
--
-- * If the application has no session backend, stashing is a no-op and
--   this degrades to 'runFormPost'\/'generateFormPost' semantics (input
--   will not survive the redirect).
--
-- * If your POST handler re-renders on failure instead of redirecting, do
--   not use this function: the stash would be consumed by an unrelated
--   later GET of the same path.
--
-- * On a replay the form may even produce 'FormSuccess' (e.g. a 'checkM'
--   validation whose outcome depends on external state); the result is
--   returned as-is. GET handlers normally use only the widget.
--
-- * A HEAD request reads the stash without consuming it, so that
--   middleware such as @autoHead@ does not eat the replay meant for the
--   subsequent GET.
--
-- @since 1.7.10
runFormPRG
    :: (RenderMessage (HandlerSite m) FormMessage, MonadResource m, MonadHandler m)
    => (Html -> MForm m (FormResult a, xml))
    -> m ((FormResult a, xml), Enctype)
runFormPRG :: forall (m :: * -> *) a xml.
(RenderMessage (HandlerSite m) FormMessage, MonadResource m,
 MonadHandler m) =>
(Markup -> MForm m (FormResult a, xml))
-> m ((FormResult a, xml), Enctype)
runFormPRG Markup -> MForm m (FormResult a, xml)
form = do
    req <- m YesodRequest
forall (m :: * -> *). MonadHandler m => m YesodRequest
getRequest
    let method = Request -> ByteString
requestMethod (Request -> ByteString) -> Request -> ByteString
forall a b. (a -> b) -> a -> b
$ YesodRequest -> Request
reqWaiRequest YesodRequest
req
        key = Request -> Text
prgSessionKey (Request -> Text) -> Request -> Text
forall a b. (a -> b) -> a -> b
$ YesodRequest -> Request
reqWaiRequest YesodRequest
req
    if method == "GET" || method == "HEAD"
        then do
            -- The per-request cache lets several calls in one handler
            -- (multiple forms on a page) all see the stash, even though it
            -- is deleted from the session on first read.
            PRGStash menv <- cachedBy (TE.encodeUtf8 key) $ do
                mbs <- lookupSessionBS key
                when (method /= "HEAD") $ deleteSession key
                return $ PRGStash $ mbs >>= A.decodeStrict
            case menv of
                Maybe Env
Nothing -> (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
                Just Env
env -> (Markup -> MForm m (FormResult a, xml))
-> Env -> m ((FormResult a, xml), Enctype)
forall (m :: * -> *) a.
MonadHandler m =>
(Markup -> MForm m a) -> Env -> m (a, Enctype)
replayHelper Markup -> MForm m (FormResult a, xml)
form Env
env
        else do
            env <- postEnv
            res@((formRes, _), _) <- postHelper form env
            case (formRes, env) of
                (FormSuccess{}, Maybe (Env, FileEnv)
_) -> Text -> m ()
forall (m :: * -> *). MonadHandler m => Text -> m ()
deleteSession Text
key
                (FormFailure{}, Just (Env
params, FileEnv
_)) -> Text -> ByteString -> m ()
forall (m :: * -> *). MonadHandler m => Text -> ByteString -> m ()
setSessionBS Text
key (ByteString -> m ()) -> ByteString -> m ()
forall a b. (a -> b) -> a -> b
$
                    LazyByteString -> ByteString
BL.toStrict (LazyByteString -> ByteString) -> LazyByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ Env -> LazyByteString
forall a. ToJSON a => a -> LazyByteString
A.encode (Env -> LazyByteString) -> Env -> LazyByteString
forall a b. (a -> b) -> a -> b
$
                    Text -> Env -> Env
forall k a. Ord k => k -> Map k a -> Map k a
Map.delete Text
defaultCsrfParamName Env
params
                -- FormMissing means another identified form on this page
                -- was the one submitted; leave its stash alone.
                (FormResult a, Maybe (Env, FileEnv))
_ -> () -> m ()
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
            return res

-- | Per-request cache wrapper for the Post\/Redirect\/Get stash; see
-- 'runFormPRG'.
newtype PRGStash = PRGStash (Maybe Env)

-- | Like 'postHelper', but runs the form against a supplied 'Env' (with an
-- empty 'FileEnv') instead of the current request body. A fresh CSRF token
-- fragment is rendered into the form, and no token check is performed: the
-- replayed submission was already checked by 'postHelper' when it was
-- stashed, and this run is a re-render, not a submission.
replayHelper :: MonadHandler m
             => (Html -> MForm m a)
             -> Env
             -> m (a, Enctype)
replayHelper :: forall (m :: * -> *) a.
MonadHandler m =>
(Markup -> MForm m a) -> Env -> m (a, Enctype)
replayHelper Markup -> MForm m a
form Env
env = do
    req <- m YesodRequest
forall (m :: * -> *). MonadHandler m => m YesodRequest
getRequest
    let token =
            case YesodRequest -> Maybe Text
reqToken YesodRequest
req of
                Maybe Text
Nothing -> Markup
forall a. Monoid a => a
mempty
                Just Text
n -> [shamlet|<input type=hidden name=#{defaultCsrfParamName} value=#{n}>|]
    m <- getYesod
    langs <- languages
    runFormGeneric (form token) m langs (Just (env, Map.empty))

-- | Session key for the Post\/Redirect\/Get stash, namespaced by request
-- path so that form pages on different routes do not interfere.
prgSessionKey :: Request -> Text
prgSessionKey :: Request -> Text
prgSessionKey Request
req = Text
"_PRG:" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> OnDecodeError -> ByteString -> Text
TE.decodeUtf8With OnDecodeError
TEE.lenientDecode (Request -> ByteString
rawPathInfo Request
req)

postEnv :: MonadHandler m => m (Maybe (Env, FileEnv))
postEnv :: forall (m :: * -> *). MonadHandler m => m (Maybe (Env, FileEnv))
postEnv = do
    req <- m YesodRequest
forall (m :: * -> *). MonadHandler m => m YesodRequest
getRequest
    if requestMethod (reqWaiRequest req) == "GET"
        then return Nothing
        else do
            (p, f) <- runRequestBody
            let 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
            return $ Just (p', Map.unionsWith (++) $ map (\(Text
k, FileInfo
v) -> Text -> [FileInfo] -> FileEnv
forall k a. k -> a -> Map k a
Map.singleton Text
k [FileInfo
v]) f)

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

runFormGet :: MonadHandler m
           => (Html -> MForm m a)
           -> m (a, Enctype)
runFormGet :: forall (m :: * -> *) a.
MonadHandler m =>
(Markup -> MForm m a) -> m (a, Enctype)
runFormGet Markup -> MForm m a
form = do
    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 =
            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)
    getHelper form 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' :: forall (m :: * -> *) a xml.
MonadHandler m =>
(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 b c d. (b -> c) -> (b, d) -> (c, d)
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 :: forall (m :: * -> *) a.
MonadHandler m =>
(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 :: 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 = do
    let fragment :: Markup
fragment = [shamlet|<input type=hidden name=#{getKey}>|]
    langs <- m [Text]
forall (m :: * -> *). MonadHandler m => m [Text]
languages
    m <- getYesod
    runFormGeneric (form fragment) m langs 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 :: forall (m :: * -> *) a.
Monad m =>
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.
    mp <- MForm m (Maybe Env)
forall (m :: * -> *). Monad m => MForm m (Maybe Env)
askParams
    let missing = (Maybe Env
mp Maybe Env -> (Env -> Maybe [Text]) -> Maybe [Text]
forall a b. Maybe a -> (a -> Maybe b) -> Maybe b
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 | 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
    ( res', w) <- eraseParams (form fragment')

    -- Empty forms now properly return FormMissing. [#1072](https://github.com/yesodweb/yesod/issues/1072)
    let res = if Bool
missing then FormResult a
forall a. FormResult a
FormMissing else FormResult a
res'
    return ( res, 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 :: forall (m :: * -> *) a. Monad m => FormRender m a
renderTable AForm m a
aform Markup
fragment = do
    (res, views') <- AForm m a
-> RWST
     (Maybe (Env, FileEnv), HandlerSite m, [Text])
     Enctype
     Ints
     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)] -> [FieldView (HandlerSite m)]
views' []
    let 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}
|]
    return (res, widget)
  where
    addIsFirst :: [b] -> [(Bool, b)]
addIsFirst [] = []
    addIsFirst (b
x:[b]
y) = (Bool
True, b
x) (Bool, b) -> [(Bool, b)] -> [(Bool, b)]
forall a. a -> [a] -> [a]
: (b -> (Bool, b)) -> [b] -> [(Bool, b)]
forall a b. (a -> b) -> [a] -> [b]
map (Bool
False, ) [b]
y

-- | render a field inside a div
renderDivs :: forall (m :: * -> *) a. Monad m => FormRender m a
renderDivs = Bool
-> AForm m a
-> Markup
-> RWST
     (Maybe (Env, FileEnv), HandlerSite m, [Text])
     Enctype
     Ints
     m
     (FormResult a, WidgetFor (HandlerSite m) ())
forall (m :: * -> *) a. Monad m => Bool -> FormRender m a
renderDivsMaybeLabels Bool
True

-- | render a field inside a div, not displaying any label
renderDivsNoLabels :: forall (m :: * -> *) a. Monad m => FormRender m a
renderDivsNoLabels = Bool
-> AForm m a
-> Markup
-> RWST
     (Maybe (Env, FileEnv), HandlerSite m, [Text])
     Enctype
     Ints
     m
     (FormResult a, WidgetFor (HandlerSite m) ())
forall (m :: * -> *) a. Monad m => Bool -> FormRender m a
renderDivsMaybeLabels Bool
False

renderDivsMaybeLabels :: Monad m => Bool -> FormRender m a
renderDivsMaybeLabels :: forall (m :: * -> *) a. Monad m => Bool -> FormRender m a
renderDivsMaybeLabels Bool
withLabels AForm m a
aform Markup
fragment = do
    (res, views') <- AForm m a
-> RWST
     (Maybe (Env, FileEnv), HandlerSite m, [Text])
     Enctype
     Ints
     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)] -> [FieldView (HandlerSite m)]
views' []
    let 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}
|]
    return (res, 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 :: forall (m :: * -> *) a. Monad m => FormRender m a
renderBootstrap2 AForm m a
aform Markup
fragment = do
    (res, views') <- AForm m a
-> RWST
     (Maybe (Env, FileEnv), HandlerSite m, [Text])
     Enctype
     Ints
     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)] -> [FieldView (HandlerSite m)]
views' []
        has (Just a
_) = Bool
True
        has Maybe a
Nothing  = Bool
False
    let 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}
                |]
    return (res, widget)

-- | Deprecated synonym for 'renderBootstrap2'.
renderBootstrap :: Monad m => FormRender m a
renderBootstrap :: forall (m :: * -> *) a. Monad m => 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 :: 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
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 a. a -> m 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 :: forall (m :: * -> *) msg a.
(Monad m, RenderMessage (HandlerSite m) msg) =>
(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 :: 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)
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 :: 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 b)
f b -> a
inv Field m a
field = Field m a
field
    { fieldParse = \[Text]
ts [FileInfo]
fs -> do
        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 e1 of
            Left SomeMessage (HandlerSite m)
msg -> Either (SomeMessage (HandlerSite m)) (Maybe b)
-> m (Either (SomeMessage (HandlerSite m)) (Maybe b))
forall a. a -> m a
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 a. a -> m a
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 = \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 a b. (a -> b) -> Either Text a -> Either Text b
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 :: forall (m :: * -> *) a.
Monad m =>
SomeMessage (HandlerSite m) -> Field m a -> Field m a
customErrorMessage SomeMessage (HandlerSite m)
msg Field m a
field = Field m a
field
    { 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 :: forall site msg.
RenderMessage site msg =>
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 :: forall (m :: * -> *) site a.
(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))
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 :: forall (m :: * -> *) site msg a.
(Monad m, RenderMessage site msg) =>
(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 a. a -> m 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 a. a -> m 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 a. a -> m 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 :: forall (m :: * -> *) a b.
Functor m =>
(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 a b. (a -> b) -> m a -> m 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 a b.
(a -> b)
-> Either (SomeMessage (HandlerSite m)) a
-> Either (SomeMessage (HandlerSite m)) b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((a -> b) -> Maybe a -> Maybe b
forall a b. (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 a b. (a -> b) -> Either Text a -> Either Text b
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", HasCallStack => Text -> Text -> Text -> Text
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