{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE ExistentialQuantification #-}
{-# LANGUAGE CPP #-}
{-# LANGUAGE MultiParamTypeClasses #-}
module Yesod.Form.Types
    ( -- * Helpers
      Enctype (..)
    , FormResult (..)
    , FormMessage (..)
    , Env
    , FileEnv
    , Ints (..)
      -- * Form
    , WForm
    , MForm
    , AForm (..)
      -- * Build forms
    , Field (..)
    , FieldSettings (..)
    , FieldView (..)
    , FieldViewFunc
    ) where

import Control.Monad.Trans.RWS (RWST)
import Control.Monad.Trans.Writer (WriterT)
import Data.Text (Text)
import Data.Monoid (Monoid (..))
import Text.Blaze (Markup, ToMarkup (toMarkup), ToValue (toValue))
#define Html Markup
#define ToHtml ToMarkup
#define toHtml toMarkup
import Control.Applicative ((<$>), Alternative (..), Applicative (..))
import Control.Monad (liftM)
import Control.Monad.Trans.Class
import Data.String (IsString (..))
import Yesod.Core
import qualified Data.Map as Map
import Data.Semigroup (Semigroup, (<>))
import Data.Traversable
import Data.Foldable

-- | A form can produce three different results: there was no data available,
-- the data was invalid, or there was a successful parse.
--
-- The 'Applicative' instance will concatenate the failure messages in two
-- 'FormResult's.
-- The 'Alternative' instance will choose 'FormFailure' before 'FormSuccess',
-- and 'FormMissing' last of all.
data FormResult a = FormMissing
                  | FormFailure [Text]
                  | FormSuccess a
    deriving (Int -> FormResult a -> ShowS
[FormResult a] -> ShowS
FormResult a -> String
(Int -> FormResult a -> ShowS)
-> (FormResult a -> String)
-> ([FormResult a] -> ShowS)
-> Show (FormResult a)
forall a. Show a => Int -> FormResult a -> ShowS
forall a. Show a => [FormResult a] -> ShowS
forall a. Show a => FormResult a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [FormResult a] -> ShowS
$cshowList :: forall a. Show a => [FormResult a] -> ShowS
show :: FormResult a -> String
$cshow :: forall a. Show a => FormResult a -> String
showsPrec :: Int -> FormResult a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> FormResult a -> ShowS
Show, FormResult a -> FormResult a -> Bool
(FormResult a -> FormResult a -> Bool)
-> (FormResult a -> FormResult a -> Bool) -> Eq (FormResult a)
forall a. Eq a => FormResult a -> FormResult a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: FormResult a -> FormResult a -> Bool
$c/= :: forall a. Eq a => FormResult a -> FormResult a -> Bool
== :: FormResult a -> FormResult a -> Bool
$c== :: forall a. Eq a => FormResult a -> FormResult a -> Bool
Eq)
instance Functor FormResult where
    fmap :: (a -> b) -> FormResult a -> FormResult b
fmap a -> b
_ FormResult a
FormMissing = FormResult b
forall a. FormResult a
FormMissing
    fmap a -> b
_ (FormFailure [Text]
errs) = [Text] -> FormResult b
forall a. [Text] -> FormResult a
FormFailure [Text]
errs
    fmap a -> b
f (FormSuccess a
a) = b -> FormResult b
forall a. a -> FormResult a
FormSuccess (b -> FormResult b) -> b -> FormResult b
forall a b. (a -> b) -> a -> b
$ a -> b
f a
a
instance Control.Applicative.Applicative FormResult where
    pure :: a -> FormResult a
pure = a -> FormResult a
forall a. a -> FormResult a
FormSuccess
    (FormSuccess a -> b
f) <*> :: FormResult (a -> b) -> FormResult a -> FormResult b
<*> (FormSuccess a
g) = b -> FormResult b
forall a. a -> FormResult a
FormSuccess (b -> FormResult b) -> b -> FormResult b
forall a b. (a -> b) -> a -> b
$ a -> b
f a
g
    (FormFailure [Text]
x) <*> (FormFailure [Text]
y) = [Text] -> FormResult b
forall a. [Text] -> FormResult a
FormFailure ([Text] -> FormResult b) -> [Text] -> FormResult b
forall a b. (a -> b) -> a -> b
$ [Text]
x [Text] -> [Text] -> [Text]
forall a. [a] -> [a] -> [a]
++ [Text]
y
    (FormFailure [Text]
x) <*> FormResult a
_ = [Text] -> FormResult b
forall a. [Text] -> FormResult a
FormFailure [Text]
x
    FormResult (a -> b)
_ <*> (FormFailure [Text]
y) = [Text] -> FormResult b
forall a. [Text] -> FormResult a
FormFailure [Text]
y
    FormResult (a -> b)
_ <*> FormResult a
_ = FormResult b
forall a. FormResult a
FormMissing
instance Data.Monoid.Monoid m => Monoid (FormResult m) where
    mempty :: FormResult m
mempty = m -> FormResult m
forall (f :: * -> *) a. Applicative f => a -> f a
pure m
forall a. Monoid a => a
mempty
    mappend :: FormResult m -> FormResult m -> FormResult m
mappend FormResult m
x FormResult m
y = m -> m -> m
forall a. Monoid a => a -> a -> a
mappend (m -> m -> m) -> FormResult m -> FormResult (m -> m)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FormResult m
x FormResult (m -> m) -> FormResult m -> FormResult m
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> FormResult m
y
instance Semigroup m => Semigroup (FormResult m) where
    FormResult m
x <> :: FormResult m -> FormResult m -> FormResult m
<> FormResult m
y = m -> m -> m
forall a. Semigroup a => a -> a -> a
(<>) (m -> m -> m) -> FormResult m -> FormResult (m -> m)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Control.Applicative.<$> FormResult m
x FormResult (m -> m) -> FormResult m -> FormResult m
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> FormResult m
y

-- | @since 1.4.5
instance Data.Foldable.Foldable FormResult where
    foldMap :: (a -> m) -> FormResult a -> m
foldMap a -> m
f FormResult a
r = case FormResult a
r of
      FormSuccess a
a -> a -> m
f a
a
      FormFailure [Text]
_errs -> m
forall a. Monoid a => a
mempty
      FormResult a
FormMissing -> m
forall a. Monoid a => a
mempty

-- | @since 1.4.5
instance Data.Traversable.Traversable FormResult where
    traverse :: (a -> f b) -> FormResult a -> f (FormResult b)
traverse a -> f b
f FormResult a
r = case FormResult a
r of
      FormSuccess a
a -> (b -> FormResult b) -> f b -> f (FormResult b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap b -> FormResult b
forall a. a -> FormResult a
FormSuccess (a -> f b
f a
a)
      FormFailure [Text]
errs -> FormResult b -> f (FormResult b)
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([Text] -> FormResult b
forall a. [Text] -> FormResult a
FormFailure [Text]
errs)
      FormResult a
FormMissing -> FormResult b -> f (FormResult b)
forall (f :: * -> *) a. Applicative f => a -> f a
pure FormResult b
forall a. FormResult a
FormMissing

-- | @since 1.4.15
instance Alternative FormResult where
    empty :: FormResult a
empty = FormResult a
forall a. FormResult a
FormMissing

    FormFailure [Text]
e    <|> :: FormResult a -> FormResult a -> FormResult a
<|> FormResult a
_             = [Text] -> FormResult a
forall a. [Text] -> FormResult a
FormFailure [Text]
e
    FormResult a
_                <|> FormFailure [Text]
e = [Text] -> FormResult a
forall a. [Text] -> FormResult a
FormFailure [Text]
e
    FormSuccess a
s    <|> FormSuccess a
_ = a -> FormResult a
forall a. a -> FormResult a
FormSuccess a
s
    FormResult a
FormMissing      <|> FormResult a
result        = FormResult a
result
    FormResult a
result           <|> FormResult a
FormMissing   = FormResult a
result

-- | The encoding type required by a form. The 'ToHtml' instance produces values
-- that can be inserted directly into HTML.
data Enctype = UrlEncoded | Multipart
    deriving (Enctype -> Enctype -> Bool
(Enctype -> Enctype -> Bool)
-> (Enctype -> Enctype -> Bool) -> Eq Enctype
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Enctype -> Enctype -> Bool
$c/= :: Enctype -> Enctype -> Bool
== :: Enctype -> Enctype -> Bool
$c== :: Enctype -> Enctype -> Bool
Eq, Int -> Enctype
Enctype -> Int
Enctype -> [Enctype]
Enctype -> Enctype
Enctype -> Enctype -> [Enctype]
Enctype -> Enctype -> Enctype -> [Enctype]
(Enctype -> Enctype)
-> (Enctype -> Enctype)
-> (Int -> Enctype)
-> (Enctype -> Int)
-> (Enctype -> [Enctype])
-> (Enctype -> Enctype -> [Enctype])
-> (Enctype -> Enctype -> [Enctype])
-> (Enctype -> Enctype -> Enctype -> [Enctype])
-> Enum Enctype
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: Enctype -> Enctype -> Enctype -> [Enctype]
$cenumFromThenTo :: Enctype -> Enctype -> Enctype -> [Enctype]
enumFromTo :: Enctype -> Enctype -> [Enctype]
$cenumFromTo :: Enctype -> Enctype -> [Enctype]
enumFromThen :: Enctype -> Enctype -> [Enctype]
$cenumFromThen :: Enctype -> Enctype -> [Enctype]
enumFrom :: Enctype -> [Enctype]
$cenumFrom :: Enctype -> [Enctype]
fromEnum :: Enctype -> Int
$cfromEnum :: Enctype -> Int
toEnum :: Int -> Enctype
$ctoEnum :: Int -> Enctype
pred :: Enctype -> Enctype
$cpred :: Enctype -> Enctype
succ :: Enctype -> Enctype
$csucc :: Enctype -> Enctype
Enum, Enctype
Enctype -> Enctype -> Bounded Enctype
forall a. a -> a -> Bounded a
maxBound :: Enctype
$cmaxBound :: Enctype
minBound :: Enctype
$cminBound :: Enctype
Bounded)
instance ToHtml Enctype where
    toHtml UrlEncoded = "application/x-www-form-urlencoded"
    toHtml Multipart = "multipart/form-data"
instance ToValue Enctype where
    toValue :: Enctype -> AttributeValue
toValue Enctype
UrlEncoded = AttributeValue
"application/x-www-form-urlencoded"
    toValue Enctype
Multipart = AttributeValue
"multipart/form-data"
instance Monoid Enctype where
    mempty :: Enctype
mempty = Enctype
UrlEncoded
#if !(MIN_VERSION_base(4,11,0))
    mappend = (<>)
#endif
instance Semigroup Enctype where
    Enctype
UrlEncoded <> :: Enctype -> Enctype -> Enctype
<> Enctype
UrlEncoded = Enctype
UrlEncoded
    Enctype
_          <> Enctype
_          = Enctype
Multipart

data Ints = IntCons Int Ints | IntSingle Int
instance Show Ints where
    show :: Ints -> String
show (IntSingle Int
i) = Int -> String
forall a. Show a => a -> String
show Int
i
    show (IntCons Int
i Ints
is) = Int -> String
forall a. Show a => a -> String
show Int
i String -> ShowS
forall a. [a] -> [a] -> [a]
++ (Char
'-' Char -> ShowS
forall a. a -> [a] -> [a]
: Ints -> String
forall a. Show a => a -> String
show Ints
is)

type Env = Map.Map Text [Text]
type FileEnv = Map.Map Text [FileInfo]

-- | 'MForm' variant stacking a 'WriterT'. The following code example using a
-- monadic form 'MForm':
--
-- > formToAForm $ do
-- >   (field1F, field1V) <- mreq textField MsgField1 Nothing
-- >   (field2F, field2V) <- mreq (checkWith field1F textField) MsgField2 Nothing
-- >   (field3F, field3V) <- mreq (checkWith field1F textField) MsgField3 Nothing
-- >   return
-- >     ( MyForm <$> field1F <*> field2F <*> field3F
-- >     , [field1V, field2V, field3V]
-- >     )
--
-- Could be rewritten as follows using 'WForm':
--
-- > wFormToAForm $ do
-- >   field1F <- wreq textField MsgField1 Nothing
-- >   field2F <- wreq (checkWith field1F textField) MsgField2 Nothing
-- >   field3F <- wreq (checkWith field1F textField) MsgField3 Nothing
-- >   return $ MyForm <$> field1F <*> field2F <*> field3F
--
-- @since 1.4.14
type WForm m a = MForm (WriterT [FieldView (HandlerSite m)] m) a

type MForm m a = RWST
    (Maybe (Env, FileEnv), HandlerSite m, [Lang])
    Enctype
    Ints
    m
    a

newtype AForm m a = AForm
    { AForm m a
-> (HandlerSite m, [Text])
-> Maybe (Env, FileEnv)
-> Ints
-> m (FormResult a,
      [FieldView (HandlerSite m)] -> [FieldView (HandlerSite m)], Ints,
      Enctype)
unAForm :: (HandlerSite m, [Text])
              -> Maybe (Env, FileEnv)
              -> Ints
              -> m (FormResult a, [FieldView (HandlerSite m)] -> [FieldView (HandlerSite m)], Ints, Enctype)
    }
instance Monad m => Functor (AForm m) where
    fmap :: (a -> b) -> AForm m a -> AForm m b
fmap a -> b
f (AForm (HandlerSite m, [Text])
-> Maybe (Env, FileEnv)
-> Ints
-> m (FormResult a,
      [FieldView (HandlerSite m)] -> [FieldView (HandlerSite m)], Ints,
      Enctype)
a) =
        ((HandlerSite m, [Text])
 -> Maybe (Env, FileEnv)
 -> Ints
 -> m (FormResult b,
       [FieldView (HandlerSite m)] -> [FieldView (HandlerSite m)], Ints,
       Enctype))
-> AForm m b
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 b,
        [FieldView (HandlerSite m)] -> [FieldView (HandlerSite m)], Ints,
        Enctype))
 -> AForm m b)
-> ((HandlerSite m, [Text])
    -> Maybe (Env, FileEnv)
    -> Ints
    -> m (FormResult b,
          [FieldView (HandlerSite m)] -> [FieldView (HandlerSite m)], Ints,
          Enctype))
-> AForm m b
forall a b. (a -> b) -> a -> b
$ \(HandlerSite m, [Text])
x Maybe (Env, FileEnv)
y Ints
z -> ((FormResult a,
  [FieldView (HandlerSite m)] -> [FieldView (HandlerSite m)], Ints,
  Enctype)
 -> (FormResult b,
     [FieldView (HandlerSite m)] -> [FieldView (HandlerSite m)], Ints,
     Enctype))
-> m (FormResult a,
      [FieldView (HandlerSite m)] -> [FieldView (HandlerSite m)], Ints,
      Enctype)
-> m (FormResult b,
      [FieldView (HandlerSite m)] -> [FieldView (HandlerSite m)], Ints,
      Enctype)
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM (FormResult a,
 [FieldView (HandlerSite m)] -> [FieldView (HandlerSite m)], Ints,
 Enctype)
-> (FormResult b,
    [FieldView (HandlerSite m)] -> [FieldView (HandlerSite m)], Ints,
    Enctype)
go (m (FormResult a,
    [FieldView (HandlerSite m)] -> [FieldView (HandlerSite m)], Ints,
    Enctype)
 -> m (FormResult b,
       [FieldView (HandlerSite m)] -> [FieldView (HandlerSite m)], Ints,
       Enctype))
-> m (FormResult a,
      [FieldView (HandlerSite m)] -> [FieldView (HandlerSite m)], Ints,
      Enctype)
-> m (FormResult b,
      [FieldView (HandlerSite m)] -> [FieldView (HandlerSite m)], 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)
a (HandlerSite m, [Text])
x Maybe (Env, FileEnv)
y Ints
z
      where
        go :: (FormResult a,
 [FieldView (HandlerSite m)] -> [FieldView (HandlerSite m)], Ints,
 Enctype)
-> (FormResult b,
    [FieldView (HandlerSite m)] -> [FieldView (HandlerSite m)], Ints,
    Enctype)
go (FormResult a
w, [FieldView (HandlerSite m)] -> [FieldView (HandlerSite m)]
x, Ints
y, Enctype
z) = ((a -> b) -> FormResult a -> FormResult b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f FormResult a
w, [FieldView (HandlerSite m)] -> [FieldView (HandlerSite m)]
x, Ints
y, Enctype
z)
instance Monad m => Applicative (AForm m) where
    pure :: a -> AForm m a
pure a
x = ((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
$ (Maybe (Env, FileEnv)
 -> Ints
 -> m (FormResult a,
       [FieldView (HandlerSite m)] -> [FieldView (HandlerSite m)], Ints,
       Enctype))
-> (HandlerSite m, [Text])
-> Maybe (Env, FileEnv)
-> Ints
-> m (FormResult a,
      [FieldView (HandlerSite m)] -> [FieldView (HandlerSite m)], Ints,
      Enctype)
forall a b. a -> b -> a
const ((Maybe (Env, FileEnv)
  -> Ints
  -> m (FormResult a,
        [FieldView (HandlerSite m)] -> [FieldView (HandlerSite m)], Ints,
        Enctype))
 -> (HandlerSite m, [Text])
 -> Maybe (Env, FileEnv)
 -> Ints
 -> m (FormResult a,
       [FieldView (HandlerSite m)] -> [FieldView (HandlerSite m)], Ints,
       Enctype))
-> (Maybe (Env, FileEnv)
    -> Ints
    -> m (FormResult a,
          [FieldView (HandlerSite m)] -> [FieldView (HandlerSite m)], Ints,
          Enctype))
-> (HandlerSite m, [Text])
-> Maybe (Env, FileEnv)
-> Ints
-> m (FormResult a,
      [FieldView (HandlerSite m)] -> [FieldView (HandlerSite m)], Ints,
      Enctype)
forall a b. (a -> b) -> a -> b
$ (Ints
 -> m (FormResult a,
       [FieldView (HandlerSite m)] -> [FieldView (HandlerSite m)], Ints,
       Enctype))
-> Maybe (Env, FileEnv)
-> Ints
-> m (FormResult a,
      [FieldView (HandlerSite m)] -> [FieldView (HandlerSite m)], Ints,
      Enctype)
forall a b. a -> b -> a
const ((Ints
  -> m (FormResult a,
        [FieldView (HandlerSite m)] -> [FieldView (HandlerSite m)], Ints,
        Enctype))
 -> Maybe (Env, FileEnv)
 -> Ints
 -> m (FormResult a,
       [FieldView (HandlerSite m)] -> [FieldView (HandlerSite m)], Ints,
       Enctype))
-> (Ints
    -> m (FormResult a,
          [FieldView (HandlerSite m)] -> [FieldView (HandlerSite m)], Ints,
          Enctype))
-> Maybe (Env, FileEnv)
-> Ints
-> m (FormResult a,
      [FieldView (HandlerSite m)] -> [FieldView (HandlerSite m)], Ints,
      Enctype)
forall a b. (a -> b) -> a -> b
$ \Ints
ints -> (FormResult a,
 [FieldView (HandlerSite m)] -> [FieldView (HandlerSite m)], Ints,
 Enctype)
-> m (FormResult a,
      [FieldView (HandlerSite m)] -> [FieldView (HandlerSite m)], Ints,
      Enctype)
forall (m :: * -> *) a. Monad m => a -> m a
return (a -> FormResult a
forall a. a -> FormResult a
FormSuccess a
x, [FieldView (HandlerSite m)] -> [FieldView (HandlerSite m)]
forall a. a -> a
id, Ints
ints, Enctype
forall a. Monoid a => a
mempty)
    (AForm (HandlerSite m, [Text])
-> Maybe (Env, FileEnv)
-> Ints
-> m (FormResult (a -> b),
      [FieldView (HandlerSite m)] -> [FieldView (HandlerSite m)], Ints,
      Enctype)
f) <*> :: AForm m (a -> b) -> AForm m a -> AForm m b
<*> (AForm (HandlerSite m, [Text])
-> Maybe (Env, FileEnv)
-> Ints
-> m (FormResult a,
      [FieldView (HandlerSite m)] -> [FieldView (HandlerSite m)], Ints,
      Enctype)
g) = ((HandlerSite m, [Text])
 -> Maybe (Env, FileEnv)
 -> Ints
 -> m (FormResult b,
       [FieldView (HandlerSite m)] -> [FieldView (HandlerSite m)], Ints,
       Enctype))
-> AForm m b
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 b,
        [FieldView (HandlerSite m)] -> [FieldView (HandlerSite m)], Ints,
        Enctype))
 -> AForm m b)
-> ((HandlerSite m, [Text])
    -> Maybe (Env, FileEnv)
    -> Ints
    -> m (FormResult b,
          [FieldView (HandlerSite m)] -> [FieldView (HandlerSite m)], Ints,
          Enctype))
-> AForm m b
forall a b. (a -> b) -> a -> b
$ \(HandlerSite m, [Text])
mr Maybe (Env, FileEnv)
env Ints
ints -> do
        (FormResult (a -> b)
a, [FieldView (HandlerSite m)] -> [FieldView (HandlerSite m)]
b, Ints
ints', Enctype
c) <- (HandlerSite m, [Text])
-> Maybe (Env, FileEnv)
-> Ints
-> m (FormResult (a -> b),
      [FieldView (HandlerSite m)] -> [FieldView (HandlerSite m)], Ints,
      Enctype)
f (HandlerSite m, [Text])
mr Maybe (Env, FileEnv)
env Ints
ints
        (FormResult a
x, [FieldView (HandlerSite m)] -> [FieldView (HandlerSite m)]
y, Ints
ints'', Enctype
z) <- (HandlerSite m, [Text])
-> Maybe (Env, FileEnv)
-> Ints
-> m (FormResult a,
      [FieldView (HandlerSite m)] -> [FieldView (HandlerSite m)], Ints,
      Enctype)
g (HandlerSite m, [Text])
mr Maybe (Env, FileEnv)
env Ints
ints'
        (FormResult b,
 [FieldView (HandlerSite m)] -> [FieldView (HandlerSite m)], Ints,
 Enctype)
-> m (FormResult b,
      [FieldView (HandlerSite m)] -> [FieldView (HandlerSite m)], Ints,
      Enctype)
forall (m :: * -> *) a. Monad m => a -> m a
return (FormResult (a -> b)
a FormResult (a -> b) -> FormResult a -> FormResult b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> FormResult a
x, [FieldView (HandlerSite m)] -> [FieldView (HandlerSite m)]
b ([FieldView (HandlerSite m)] -> [FieldView (HandlerSite m)])
-> ([FieldView (HandlerSite m)] -> [FieldView (HandlerSite m)])
-> [FieldView (HandlerSite m)]
-> [FieldView (HandlerSite m)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [FieldView (HandlerSite m)] -> [FieldView (HandlerSite m)]
y, Ints
ints'', Enctype
c Enctype -> Enctype -> Enctype
forall a. Monoid a => a -> a -> a
`mappend` Enctype
z)
instance (Monad m, Monoid a) => Monoid (AForm m a) where
    mempty :: AForm m a
mempty = a -> AForm m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
forall a. Monoid a => a
mempty
    mappend :: AForm m a -> AForm m a -> AForm m a
mappend AForm m a
a AForm m a
b = a -> a -> a
forall a. Monoid a => a -> a -> a
mappend (a -> a -> a) -> AForm m a -> AForm m (a -> a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> AForm m a
a AForm m (a -> a) -> AForm m a -> AForm m a
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> AForm m a
b
instance (Monad m, Semigroup a) => Semigroup (AForm m a) where
    AForm m a
a <> :: AForm m a -> AForm m a -> AForm m a
<> AForm m a
b = a -> a -> a
forall a. Semigroup a => a -> a -> a
(<>) (a -> a -> a) -> AForm m a -> AForm m (a -> a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> AForm m a
a AForm m (a -> a) -> AForm m a -> AForm m a
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> AForm m a
b

instance MonadTrans AForm where
    lift :: m a -> AForm m a
lift m a
f = ((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, [Text])
_ Maybe (Env, FileEnv)
_ Ints
ints -> do
        a
x <- m a
f
        (FormResult a,
 [FieldView (HandlerSite m)] -> [FieldView (HandlerSite m)], Ints,
 Enctype)
-> m (FormResult a,
      [FieldView (HandlerSite m)] -> [FieldView (HandlerSite m)], Ints,
      Enctype)
forall (m :: * -> *) a. Monad m => a -> m a
return (a -> FormResult a
forall a. a -> FormResult a
FormSuccess a
x, [FieldView (HandlerSite m)] -> [FieldView (HandlerSite m)]
forall a. a -> a
id, Ints
ints, Enctype
forall a. Monoid a => a
mempty)

data FieldSettings master = FieldSettings
    { FieldSettings master -> SomeMessage master
fsLabel :: SomeMessage master
    , FieldSettings master -> Maybe (SomeMessage master)
fsTooltip :: Maybe (SomeMessage master)
    , FieldSettings master -> Maybe Text
fsId :: Maybe Text
    , FieldSettings master -> Maybe Text
fsName :: Maybe Text
    , FieldSettings master -> [(Text, Text)]
fsAttrs :: [(Text, Text)]
    }

instance IsString (FieldSettings a) where
    fromString :: String -> FieldSettings a
fromString String
s = SomeMessage a
-> Maybe (SomeMessage a)
-> Maybe Text
-> Maybe Text
-> [(Text, Text)]
-> FieldSettings a
forall master.
SomeMessage master
-> Maybe (SomeMessage master)
-> Maybe Text
-> Maybe Text
-> [(Text, Text)]
-> FieldSettings master
FieldSettings (String -> SomeMessage a
forall a. IsString a => String -> a
fromString String
s) Maybe (SomeMessage a)
forall a. Maybe a
Nothing Maybe Text
forall a. Maybe a
Nothing Maybe Text
forall a. Maybe a
Nothing []

data FieldView site = FieldView
    { FieldView site -> Markup
fvLabel :: Html
    , FieldView site -> Maybe Markup
fvTooltip :: Maybe Html
    , FieldView site -> Text
fvId :: Text
    , FieldView site -> WidgetFor site ()
fvInput :: WidgetFor site ()
    , FieldView site -> Maybe Markup
fvErrors :: Maybe Html
    , FieldView site -> Bool
fvRequired :: Bool
    }

type FieldViewFunc m a
    = Text -- ^ ID
   -> Text -- ^ Name
   -> [(Text, Text)] -- ^ Attributes
   -> Either Text a -- ^ Either (invalid text) or (legitimate result)
   -> Bool -- ^ Required?
   -> WidgetFor (HandlerSite m) ()

data Field m a = Field
    { Field m a
-> [Text]
-> [FileInfo]
-> m (Either (SomeMessage (HandlerSite m)) (Maybe a))
fieldParse :: [Text] -> [FileInfo] -> m (Either (SomeMessage (HandlerSite m)) (Maybe a))
    , Field m a -> FieldViewFunc m a
fieldView :: FieldViewFunc m a
    , Field m a -> Enctype
fieldEnctype :: Enctype
    }

data FormMessage = MsgInvalidInteger Text
                 | MsgInvalidNumber Text
                 | MsgInvalidEntry Text
                 | MsgInvalidUrl Text
                 | MsgInvalidEmail Text
                 | MsgInvalidTimeFormat
                 | MsgInvalidHour Text
                 | MsgInvalidMinute Text
                 | MsgInvalidSecond Text
                 | MsgInvalidDay
                 | MsgCsrfWarning
                 | MsgValueRequired
                 | MsgInputNotFound Text
                 | MsgSelectNone
                 | MsgInvalidBool Text
                 | MsgBoolYes
                 | MsgBoolNo
                 | MsgDelete
    deriving (Int -> FormMessage -> ShowS
[FormMessage] -> ShowS
FormMessage -> String
(Int -> FormMessage -> ShowS)
-> (FormMessage -> String)
-> ([FormMessage] -> ShowS)
-> Show FormMessage
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [FormMessage] -> ShowS
$cshowList :: [FormMessage] -> ShowS
show :: FormMessage -> String
$cshow :: FormMessage -> String
showsPrec :: Int -> FormMessage -> ShowS
$cshowsPrec :: Int -> FormMessage -> ShowS
Show, FormMessage -> FormMessage -> Bool
(FormMessage -> FormMessage -> Bool)
-> (FormMessage -> FormMessage -> Bool) -> Eq FormMessage
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: FormMessage -> FormMessage -> Bool
$c/= :: FormMessage -> FormMessage -> Bool
== :: FormMessage -> FormMessage -> Bool
$c== :: FormMessage -> FormMessage -> Bool
Eq, ReadPrec [FormMessage]
ReadPrec FormMessage
Int -> ReadS FormMessage
ReadS [FormMessage]
(Int -> ReadS FormMessage)
-> ReadS [FormMessage]
-> ReadPrec FormMessage
-> ReadPrec [FormMessage]
-> Read FormMessage
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [FormMessage]
$creadListPrec :: ReadPrec [FormMessage]
readPrec :: ReadPrec FormMessage
$creadPrec :: ReadPrec FormMessage
readList :: ReadS [FormMessage]
$creadList :: ReadS [FormMessage]
readsPrec :: Int -> ReadS FormMessage
$creadsPrec :: Int -> ReadS FormMessage
Read)