{-# LANGUAGE QuasiQuotes #-}
{-# LANGUAGE TupleSections #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE CPP #-}
module Yesod.Form.Functions
(
newFormIdent
, askParams
, askFiles
, formToAForm
, aFormToForm
, mFormToWForm
, wFormToAForm
, wFormToMForm
, wreq
, wreqMsg
, wopt
, mreq
, mreqMsg
, mopt
, areq
, areqMsg
, aopt
, runFormPost
, runFormPostNoToken
, runFormGet
, generateFormPost
, generateFormGet'
, generateFormGet
, identifyForm
, FormRender
, renderTable
, renderDivs
, renderDivsNoLabels
, renderBootstrap
, renderBootstrap2
, check
, checkBool
, checkM
, checkMMap
, customErrorMessage
, 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)
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
$ '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 i :: 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
+ 1
incrInts (IntCons i :: Int
i is :: Ints
is) = (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ 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 form :: 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
$ \(site :: HandlerSite m
site, langs :: [Text]
langs) env :: Maybe (Env, FileEnv)
env ints :: Ints
ints -> do
((a :: FormResult a
a, xmls :: [FieldView site]
xmls), ints' :: Ints
ints', enc :: 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 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
(env :: Maybe (Env, FileEnv)
env, site :: site
site, langs :: [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
(a :: FormResult a
a, xml :: [FieldView site] -> [FieldView site]
xml, ints' :: Ints
ints', enc :: 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
(x :: Maybe (Env, FileEnv)
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
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
(x :: Maybe (Env, FileEnv)
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
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
wreq :: (RenderMessage site FormMessage, HandlerSite m ~ site, MonadHandler m)
=> Field m a
-> FieldSettings site
-> Maybe a
-> WForm m (FormResult a)
wreq :: Field m a
-> FieldSettings site -> Maybe a -> WForm m (FormResult a)
wreq f :: Field m a
f fs :: 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
wreqMsg :: (RenderMessage site msg, HandlerSite m ~ site, MonadHandler m)
=> Field m a
-> FieldSettings site
-> msg
-> Maybe a
-> WForm m (FormResult a)
wreqMsg :: Field m a
-> FieldSettings site -> msg -> Maybe a -> WForm m (FormResult a)
wreqMsg f :: Field m a
f fs :: FieldSettings site
fs msg :: 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
wopt :: (MonadHandler m, HandlerSite m ~ site)
=> Field m a
-> FieldSettings site
-> Maybe (Maybe a)
-> WForm m (FormResult (Maybe a))
wopt :: Field m a
-> FieldSettings site
-> Maybe (Maybe a)
-> WForm m (FormResult (Maybe a))
wopt f :: Field m a
f fs :: 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
wFormToAForm :: MonadHandler m
=> WForm m (FormResult a)
-> AForm m a
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
wFormToMForm :: (MonadHandler m, HandlerSite m ~ site)
=> WForm m a
-> MForm m (a, [FieldView site])
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
a, ints :: b
ints, enctype :: c
enctype), views :: b
views) = ((a
a, b
views), b
ints, c
enctype)
mFormToWForm :: (MonadHandler m, HandlerSite m ~ site)
=> MForm m (a, FieldView site)
-> WForm m a
mFormToWForm :: MForm m (a, FieldView site) -> WForm m a
mFormToWForm = (m ((a, FieldView site), Ints, Enctype)
-> WriterT [FieldView site] m (a, Ints, Enctype))
-> MForm m (a, FieldView site) -> WForm 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))
-> MForm m (a, FieldView site) -> WForm m a)
-> (m ((a, FieldView site), Ints, Enctype)
-> WriterT [FieldView site] m (a, Ints, Enctype))
-> MForm m (a, FieldView site)
-> WForm m a
forall a b. (a -> b) -> a -> b
$ \f :: m ((a, FieldView site), Ints, Enctype)
f -> do
((a :: a
a, view :: FieldView site
view), ints :: Ints
ints, enctype :: 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])
mreq :: (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
-> FieldSettings site
-> Maybe a
-> MForm m (FormResult a, FieldView site)
mreq field :: Field m a
field fs :: FieldSettings site
fs mdef :: 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
mreqMsg :: (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
-> FieldSettings site
-> msg
-> Maybe a
-> MForm m (FormResult a, FieldView site)
mreqMsg field :: Field m a
field fs :: FieldSettings site
fs msg :: msg
msg mdef :: 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 m :: site
m l :: [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]
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 :: Field m a
field fs :: FieldSettings site
fs mdef :: 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)
-> (a -> FormResult b)
-> Bool
-> 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 {..} FieldSettings {..} mdef :: Maybe a
mdef onMissing :: site -> [Text] -> FormResult b
onMissing onFound :: a -> FormResult b
onFound isReq :: 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
(_, site :: site
site, langs :: [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
(res :: FormResult b
res, val :: Either Text a
val) <-
case Maybe Env
mp of
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 "") a -> Either Text a
forall a b. b -> Either a b
Right Maybe a
mdef)
Just p :: 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 e :: 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 -> Either Text a
forall a b. a -> Either a b
Left ([Text] -> Maybe Text
forall a. [a] -> Maybe a
listToMaybe [Text]
mvals))
Right mx :: Maybe a
mx ->
case Maybe a
mx of
Nothing -> (site -> [Text] -> FormResult b
onMissing site
site [Text]
langs, Text -> Either Text a
forall a b. a -> Either a b
Left "")
Just x :: 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 [e :: 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
_ -> Maybe Markup
forall a. Maybe a
Nothing
, fvRequired :: Bool
fvRequired = Bool
isReq
})
areq :: (RenderMessage site FormMessage, HandlerSite m ~ site, MonadHandler m)
=> Field m a
-> FieldSettings site
-> Maybe a
-> AForm m a
areq :: Field m a -> FieldSettings site -> Maybe a -> AForm m a
areq f :: Field m a
f fs :: 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
areqMsg :: (RenderMessage site msg, HandlerSite m ~ site, MonadHandler m)
=> Field m a
-> FieldSettings site
-> msg
-> Maybe a
-> AForm m a
areqMsg :: Field m a -> FieldSettings site -> msg -> Maybe a -> AForm m a
areqMsg f :: Field m a
f fs :: FieldSettings site
fs msg :: 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
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 a :: Field m a
a b :: 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 form :: MForm m a
form site :: HandlerSite m
site langs :: [Text]
langs env :: 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 0)
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 form :: 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 form :: Markup -> MForm m (FormResult a, xml)
form env :: 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
Nothing -> Markup
forall a. Monoid a => a
Data.Monoid.mempty
Just n :: 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
((res :: FormResult a
res, xml :: xml
xml), enctype :: 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
(_, Nothing) -> FormResult a
forall a. FormResult a
FormMissing
(FormSuccess{}, Just (params :: Env
params, _))
| 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
res
where (Just [t1 :: Text
t1]) === :: Maybe [Text] -> Maybe Text -> Bool
=== (Just t2 :: 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
Nothing === Nothing = Bool
True
_ === _ = 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)
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 form :: 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
== "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
(p :: [(Text, Text)]
p, f :: [(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 (\(x :: Text
x, y :: 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 (\(k :: Text
k, v :: 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 form :: 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 form :: 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
Nothing -> Maybe (Env, FileEnv)
forall a. Maybe a
Nothing
Just _ -> (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 (\(x :: Text
x, y :: 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
generateFormGet'
:: MonadHandler m
=> (Html -> MForm m (FormResult a, xml))
-> m (xml, Enctype)
generateFormGet' :: (Markup -> MForm m (FormResult a, xml)) -> m (xml, Enctype)
generateFormGet' form :: 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 form :: 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 = "_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 form :: Markup -> MForm m a
form env :: 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
identifyForm
:: Monad m
=> Text
-> (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 identVal :: Text
identVal form :: Markup -> MForm m (FormResult a, WidgetFor (HandlerSite m) ())
form = \fragment :: Markup
fragment -> do
let fragment' :: Markup
fragment' =
[shamlet|
<input type=hidden name=#{identifyFormKey} value=identify-#{identVal}>
#{fragment}
|]
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 ["identify-" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
identVal]
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 (\(_, h :: HandlerSite m
h, l :: [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' :: FormResult a
res', w :: 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')
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 = "_formid"
type FormRender m a =
AForm m a
-> Html
-> MForm m (FormResult a, WidgetFor (HandlerSite m) ())
renderTable, renderDivs, renderDivsNoLabels :: Monad m => FormRender m a
renderTable :: FormRender m a
renderTable aform :: AForm m a
aform fragment :: Markup
fragment = do
(res :: FormResult a
res, views' :: [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) ())
-> RWST
(Maybe (Env, FileEnv), HandlerSite m, [Text])
Enctype
Ints
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 (x :: t
x:y :: [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
renderDivs :: FormRender m a
renderDivs = Bool -> FormRender m a
forall (m :: * -> *) a. Monad m => Bool -> FormRender m a
renderDivsMaybeLabels Bool
True
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 withLabels :: Bool
withLabels aform :: AForm m a
aform fragment :: Markup
fragment = do
(res :: FormResult a
res, views' :: [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) ())
-> RWST
(Maybe (Env, FileEnv), HandlerSite m, [Text])
Enctype
Ints
m
(FormResult a, WidgetFor (HandlerSite m) ())
forall (m :: * -> *) a. Monad m => a -> m a
return (FormResult a
res, WidgetFor (HandlerSite m) ()
widget)
renderBootstrap2 :: Monad m => FormRender m a
renderBootstrap2 :: FormRender m a
renderBootstrap2 aform :: AForm m a
aform fragment :: Markup
fragment = do
(res :: FormResult a
res, views' :: [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 _) = Bool
True
has 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) ())
-> RWST
(Maybe (Env, FileEnv), HandlerSite m, [Text])
Enctype
Ints
m
(FormResult a, WidgetFor (HandlerSite m) ())
forall (m :: * -> *) a. Monad m => a -> m a
return (FormResult a
res, WidgetFor (HandlerSite m) ()
widget)
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 f :: 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
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 b :: a -> Bool
b s :: 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
$ \x :: 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 f :: 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
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 f :: a -> m (Either msg b)
f inv :: b -> a
inv field :: Field m a
field = Field m a
field
{ fieldParse :: [Text]
-> [FileInfo] -> m (Either (SomeMessage (HandlerSite m)) (Maybe b))
fieldParse = \ts :: [Text]
ts fs :: [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 msg :: 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 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
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 = \i :: Text
i n :: Text
n a :: [(Text, Text)]
a eres :: Either Text b
eres req :: 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
}
customErrorMessage :: Monad m => SomeMessage (HandlerSite m) -> Field m a -> Field m a
customErrorMessage :: SomeMessage (HandlerSite m) -> Field m a -> Field m a
customErrorMessage msg :: SomeMessage (HandlerSite m)
msg field :: Field m a
field = Field m a
field
{ fieldParse :: [Text]
-> [FileInfo] -> m (Either (SomeMessage (HandlerSite m)) (Maybe a))
fieldParse = \ts :: [Text]
ts fs :: [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
}
fieldSettingsLabel :: RenderMessage site msg => msg -> FieldSettings site
fieldSettingsLabel :: msg -> FieldSettings site
fieldSettingsLabel msg :: 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 []
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
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 _ [] _ = 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 _ ("":_) _ = 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 f :: Text -> Either msg a
f (x :: Text
x:_) _ = 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
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 to :: a -> b
to from :: b -> a
from (Field fParse :: [Text]
-> [FileInfo] -> m (Either (SomeMessage (HandlerSite m)) (Maybe a))
fParse fView :: FieldViewFunc m a
fView fEnctype :: Enctype
fEnctype) = let
fParse' :: [Text]
-> [FileInfo] -> m (Either (SomeMessage (HandlerSite m)) (Maybe b))
fParse' ts :: [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' ti :: Text
ti tn :: Text
tn at :: [(Text, Text)]
at ei :: 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
removeClass :: Text
-> [(Text, Text)]
-> [(Text, Text)]
removeClass :: Text -> [(Text, Text)] -> [(Text, Text)]
removeClass _ [] = []
removeClass klass :: Text
klass (("class", old :: Text
old):rest :: [(Text, Text)]
rest) = ("class", Text -> Text -> Text -> Text
T.replace Text
klass " " Text
old) (Text, Text) -> [(Text, Text)] -> [(Text, Text)]
forall a. a -> [a] -> [a]
: [(Text, Text)]
rest
removeClass klass :: Text
klass (other :: (Text, Text)
other :rest :: [(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
addClass :: Text
-> [(Text, Text)]
-> [(Text, Text)]
addClass :: Text -> [(Text, Text)] -> [(Text, Text)]
addClass klass :: Text
klass [] = [("class", Text
klass)]
addClass klass :: Text
klass (("class", old :: Text
old):rest :: [(Text, Text)]
rest) = ("class", [Text] -> Text
T.concat [Text
old, " ", Text
klass]) (Text, Text) -> [(Text, Text)] -> [(Text, Text)]
forall a. a -> [a] -> [a]
: [(Text, Text)]
rest
addClass klass :: Text
klass (other :: (Text, Text)
other :rest :: [(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