    {-# LANGUAGE QuasiQuotes #-}
    {-# LANGUAGE OverloadedStrings #-}
    {-# LANGUAGE TypeFamilies #-}
    {-# LANGUAGE FlexibleContexts #-}
    {-# LANGUAGE CPP #-}
    -- | A module providing a means of creating multiple input forms, such as a
    -- list of 0 or more recipients.
    module Yesod.Form.MassInput
        ( inputList
        , massDivs
        , massTable
        ) where

    import Yesod.Form.Types
    import Yesod.Form.Functions
    import Yesod.Form.Fields (checkBoxField)
    import Yesod.Core
    import Control.Monad.Trans.RWS (get, put, ask)
    import Data.Maybe (fromMaybe)
    import Data.Text.Read (decimal)
    import Control.Monad (liftM)
    import Data.Either (partitionEithers)
    import Data.Traversable (sequenceA)
    import qualified Data.Map as Map
    import Data.Maybe (listToMaybe)

    down :: Monad m => Int -> MForm m ()
    down :: forall (m :: * -> *). Monad m => Int -> MForm m ()
    down Int
    0 = ()
    -> RWST
         (Maybe (Env, FileEnv), HandlerSite m, [Lang]) Enctype Ints m ()
    forall a.
    a
    -> RWST
         (Maybe (Env, FileEnv), HandlerSite m, [Lang]) Enctype Ints m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ()
    down Int
    i | Int
    i Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    < Int
    0 = [Char]
    -> RWST
         (Maybe (Env, FileEnv), HandlerSite m, [Lang]) Enctype Ints m ()
    forall a. HasCallStack => [Char] -> a
    error [Char]
    "called down with a negative number"
    down Int
    i = do
        is <- RWST
      (Maybe (Env, FileEnv), HandlerSite m, [Lang]) Enctype Ints m Ints
    forall w (m :: * -> *) r s. (Monoid w, Monad m) => RWST r w s m s
    get
        put $ IntCons 0 is
        down $ i - 1

    up :: Monad m => Int -> MForm m ()
    up :: forall (m :: * -> *). Monad m => Int -> MForm m ()
    up Int
    0 = ()
    -> RWST
         (Maybe (Env, FileEnv), HandlerSite m, [Lang]) Enctype Ints m ()
    forall a.
    a
    -> RWST
         (Maybe (Env, FileEnv), HandlerSite m, [Lang]) Enctype Ints m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ()
    up Int
    i | Int
    i Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    < Int
    0 = [Char]
    -> RWST
         (Maybe (Env, FileEnv), HandlerSite m, [Lang]) Enctype Ints m ()
    forall a. HasCallStack => [Char] -> a
    error [Char]
    "called down with a negative number"
    up Int
    i = do
        is <- RWST
      (Maybe (Env, FileEnv), HandlerSite m, [Lang]) Enctype Ints m Ints
    forall w (m :: * -> *) r s. (Monoid w, Monad m) => RWST r w s m s
    get
        case is of
            IntSingle Int
    _ -> [Char]
    -> RWST
         (Maybe (Env, FileEnv), HandlerSite m, [Lang]) Enctype Ints m ()
    forall a. HasCallStack => [Char] -> a
    error [Char]
    "up on IntSingle"
            IntCons Int
    _ Ints
    is' -> Ints
    -> RWST
         (Maybe (Env, FileEnv), HandlerSite m, [Lang]) Enctype Ints m ()
    forall w (m :: * -> *) s r.
    (Monoid w, Monad m) =>
    s -> RWST r w s m ()
    put Ints
    is' RWST
      (Maybe (Env, FileEnv), HandlerSite m, [Lang]) Enctype Ints m ()
    -> RWST
         (Maybe (Env, FileEnv), HandlerSite m, [Lang]) Enctype Ints m Lang
    -> RWST
         (Maybe (Env, FileEnv), HandlerSite m, [Lang]) Enctype Ints m Lang
    forall a b.
    RWST (Maybe (Env, FileEnv), HandlerSite m, [Lang]) Enctype Ints m a
    -> RWST
         (Maybe (Env, FileEnv), HandlerSite m, [Lang]) Enctype Ints m b
    -> RWST
         (Maybe (Env, FileEnv), HandlerSite m, [Lang]) Enctype Ints m b
    forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
    >> RWST
      (Maybe (Env, FileEnv), HandlerSite m, [Lang]) Enctype Ints m Lang
    forall (m :: * -> *). Monad m => MForm m Lang
    newFormIdent RWST
      (Maybe (Env, FileEnv), HandlerSite m, [Lang]) Enctype Ints m Lang
    -> RWST
         (Maybe (Env, FileEnv), HandlerSite m, [Lang]) Enctype Ints m ()
    -> RWST
         (Maybe (Env, FileEnv), HandlerSite m, [Lang]) Enctype Ints m ()
    forall a b.
    RWST (Maybe (Env, FileEnv), HandlerSite m, [Lang]) Enctype Ints m a
    -> RWST
         (Maybe (Env, FileEnv), HandlerSite m, [Lang]) Enctype Ints m b
    -> RWST
         (Maybe (Env, FileEnv), HandlerSite m, [Lang]) Enctype Ints m b
    forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
    >> ()
    -> RWST
         (Maybe (Env, FileEnv), HandlerSite m, [Lang]) Enctype Ints m ()
    forall a.
    a
    -> RWST
         (Maybe (Env, FileEnv), HandlerSite m, [Lang]) Enctype Ints m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ()
        up $ i - 1

    -- | Generate a form that accepts 0 or more values from the user, allowing the
    -- user to specify that a new row is necessary.
    inputList :: (xml ~ WidgetFor site (), RenderMessage site FormMessage)
              => Html
              -- ^ label for the form
              -> ([[FieldView site]] -> xml)
              -- ^ how to display the rows, usually either 'massDivs' or 'massTable'
              -> (Maybe a -> AForm (HandlerFor site) a)
              -- ^ display a single row of the form, where @Maybe a@ gives the
              -- previously submitted value
              -> Maybe [a]
              -- ^ default initial values for the form
              -> AForm (HandlerFor site) [a]
    inputList :: forall xml site a.
    (xml ~ WidgetFor site (), RenderMessage site FormMessage) =>
    Html
    -> ([[FieldView site]] -> xml)
    -> (Maybe a -> AForm (HandlerFor site) a)
    -> Maybe [a]
    -> AForm (HandlerFor site) [a]
    inputList Html
    label [[FieldView site]] -> xml
    fixXml Maybe a -> AForm (HandlerFor site) a
    single Maybe [a]
    mdef = MForm (HandlerFor site) (FormResult [a], [FieldView site])
    -> AForm (HandlerFor site) [a]
    forall (m :: * -> *) site a.
    (HandlerSite m ~ site, Monad m) =>
    MForm m (FormResult a, [FieldView site]) -> AForm m a
    formToAForm (MForm (HandlerFor site) (FormResult [a], [FieldView site])
     -> AForm (HandlerFor site) [a])
    -> MForm (HandlerFor site) (FormResult [a], [FieldView site])
    -> AForm (HandlerFor site) [a]
    forall a b. (a -> b) -> a -> b
    $ do
        theId <- HandlerFor site Lang
    -> RWST
         (Maybe (Env, FileEnv), site, [Lang])
         Enctype
         Ints
         (HandlerFor site)
         Lang
    forall (m :: * -> *) a.
    Monad m =>
    m a -> RWST (Maybe (Env, FileEnv), site, [Lang]) Enctype Ints m a
    forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
    (MonadTrans t, Monad m) =>
    m a -> t m a
    lift HandlerFor site Lang
    forall (m :: * -> *). MonadHandler m => m Lang
    newIdent
        down 1
        countName <- newFormIdent
        addName <- newFormIdent
        (menv, _, _) <- ask
        let readInt Lang
    t =
                case Reader a
    forall a. Integral a => Reader a
    decimal Lang
    t of
                    Right (a
    i, Lang
    "") -> a -> Maybe a
    forall a. a -> Maybe a
    Just a
    i
                    Either [Char] (a, Lang)
    _ -> Maybe a
    forall a. Maybe a
    Nothing
        let vals =
                case Maybe (Env, FileEnv)
    menv of
                    Maybe (Env, FileEnv)
    Nothing -> (a -> Maybe a) -> [a] -> [Maybe a]
    forall a b. (a -> b) -> [a] -> [b]
    map a -> Maybe a
    forall a. a -> Maybe a
    Just ([a] -> [Maybe a]) -> [a] -> [Maybe a]
    forall a b. (a -> b) -> a -> b
    $ [a] -> Maybe [a] -> [a]
    forall a. a -> Maybe a -> a
    fromMaybe [] Maybe [a]
    mdef
                    Just (Env
    env, FileEnv
    _) ->
                        let toAdd :: Bool
    toAdd = Bool -> ([Lang] -> Bool) -> Maybe [Lang] -> Bool
    forall b a. b -> (a -> b) -> Maybe a -> b
    maybe Bool
    False (Bool -> [Lang] -> Bool
    forall a b. a -> b -> a
    const Bool
    True) (Maybe [Lang] -> Bool) -> Maybe [Lang] -> Bool
    forall a b. (a -> b) -> a -> b
    $ Lang -> Env -> Maybe [Lang]
    forall k a. Ord k => k -> Map k a -> Maybe a
    Map.lookup Lang
    addName Env
    env
                            count' :: Int
    count' = Int -> Maybe Int -> Int
    forall a. a -> Maybe a -> a
    fromMaybe Int
    0 (Maybe Int -> Int) -> Maybe Int -> Int
    forall a b. (a -> b) -> a -> b
    $ Lang -> Env -> Maybe [Lang]
    forall k a. Ord k => k -> Map k a -> Maybe a
    Map.lookup Lang
    countName Env
    env Maybe [Lang] -> ([Lang] -> Maybe Lang) -> Maybe Lang
    forall a b. Maybe a -> (a -> Maybe b) -> Maybe b
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>= [Lang] -> Maybe Lang
    forall a. [a] -> Maybe a
    listToMaybe Maybe Lang -> (Lang -> Maybe Int) -> Maybe Int
    forall a b. Maybe a -> (a -> Maybe b) -> Maybe b
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>= Lang -> Maybe Int
    forall {a}. Integral a => Lang -> Maybe a
    readInt
                            count :: Int
    count = (if Bool
    toAdd then Int
    1 else Int
    0) Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    count'
                         in Int -> Maybe a -> [Maybe a]
    forall a. Int -> a -> [a]
    replicate Int
    count Maybe a
    forall a. Maybe a
    Nothing
        let count = [Maybe a] -> Int
    forall a. [a] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length [Maybe a]
    vals
        (res, xmls, views) <- liftM fixme $ mapM (withDelete . single) vals
        up 1
        return (res, [FieldView
            { fvLabel = label
            , fvTooltip = Nothing
            , fvId = theId
            , fvInput = [whamlet|
    $newline never
    ^{fixXml views}
    <p>
        $forall xml <- xmls
            ^{xml}
        <input .count type=hidden name=#{countName} value=#{count}>
        <input type=checkbox name=#{addName}>
        Add another row
    |]
            , fvErrors = Nothing
            , fvRequired = False
            }])

    withDelete :: (xml ~ WidgetFor site (), RenderMessage site FormMessage)
               => AForm (HandlerFor site) a
               -> MForm (HandlerFor site) (Either xml (FormResult a, [FieldView site]))
    withDelete :: forall xml site a.
    (xml ~ WidgetFor site (), RenderMessage site FormMessage) =>
    AForm (HandlerFor site) a
    -> MForm
         (HandlerFor site) (Either xml (FormResult a, [FieldView site]))
    withDelete AForm (HandlerFor site) a
    af = do
        Int -> MForm (HandlerFor site) ()
    forall (m :: * -> *). Monad m => Int -> MForm m ()
    down Int
    1
        deleteName <- RWST
      (Maybe (Env, FileEnv), site, [Lang])
      Enctype
      Ints
      (HandlerFor site)
      Lang
    MForm (HandlerFor site) Lang
    forall (m :: * -> *). Monad m => MForm m Lang
    newFormIdent
        (menv, _, _) <- ask
        res <- case menv >>= Map.lookup deleteName . fst of
            Just (Lang
    "yes":[Lang]
    _) -> Either (WidgetFor site ()) (FormResult a, [FieldView site])
    -> RWST
         (Maybe (Env, FileEnv), site, [Lang])
         Enctype
         Ints
         (HandlerFor site)
         (Either (WidgetFor site ()) (FormResult a, [FieldView site]))
    forall a.
    a
    -> RWST
         (Maybe (Env, FileEnv), site, [Lang])
         Enctype
         Ints
         (HandlerFor site)
         a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Either (WidgetFor site ()) (FormResult a, [FieldView site])
     -> RWST
          (Maybe (Env, FileEnv), site, [Lang])
          Enctype
          Ints
          (HandlerFor site)
          (Either (WidgetFor site ()) (FormResult a, [FieldView site])))
    -> Either (WidgetFor site ()) (FormResult a, [FieldView site])
    -> RWST
         (Maybe (Env, FileEnv), site, [Lang])
         Enctype
         Ints
         (HandlerFor site)
         (Either (WidgetFor site ()) (FormResult a, [FieldView site]))
    forall a b. (a -> b) -> a -> b
    $ WidgetFor site ()
    -> Either (WidgetFor site ()) (FormResult a, [FieldView site])
    forall a b. a -> Either a b
    Left [whamlet|
    $newline never
    <input type=hidden name=#{deleteName} value=yes>
    |]
            Maybe [Lang]
    _ -> do
                (_, xml2) <- AForm (HandlerFor site) Bool
    -> MForm
         (HandlerFor site)
         (FormResult Bool, [FieldView site] -> [FieldView site])
    forall (m :: * -> *) site a.
    (Monad m, HandlerSite m ~ site) =>
    AForm m a
    -> MForm m (FormResult a, [FieldView site] -> [FieldView site])
    aFormToForm (AForm (HandlerFor site) Bool
     -> MForm
          (HandlerFor site)
          (FormResult Bool, [FieldView site] -> [FieldView site]))
    -> AForm (HandlerFor site) Bool
    -> MForm
         (HandlerFor site)
         (FormResult Bool, [FieldView site] -> [FieldView site])
    forall a b. (a -> b) -> a -> b
    $ Field (HandlerFor site) Bool
    -> FieldSettings site -> Maybe Bool -> AForm (HandlerFor site) Bool
    forall site (m :: * -> *) a.
    (RenderMessage site FormMessage, HandlerSite m ~ site,
     MonadHandler m) =>
    Field m a -> FieldSettings site -> Maybe a -> AForm m a
    areq Field (HandlerFor site) Bool
    forall (m :: * -> *). Monad m => Field m Bool
    checkBoxField FieldSettings
                    { fsLabel :: SomeMessage site
    fsLabel = FormMessage -> SomeMessage site
    forall master msg.
    RenderMessage master msg =>
    msg -> SomeMessage master
    SomeMessage FormMessage
    MsgDelete
                    , fsTooltip :: Maybe (SomeMessage site)
    fsTooltip = Maybe (SomeMessage site)
    forall a. Maybe a
    Nothing
                    , fsName :: Maybe Lang
    fsName = Lang -> Maybe Lang
    forall a. a -> Maybe a
    Just Lang
    deleteName
                    , fsId :: Maybe Lang
    fsId = Maybe Lang
    forall a. Maybe a
    Nothing
                    , fsAttrs :: [(Lang, Lang)]
    fsAttrs = []
                    } (Maybe Bool -> AForm (HandlerFor site) Bool)
    -> Maybe Bool -> AForm (HandlerFor site) Bool
    forall a b. (a -> b) -> a -> b
    $ Bool -> Maybe Bool
    forall a. a -> Maybe a
    Just Bool
    False
                (res, xml) <- aFormToForm af
                return $ Right (res, xml $ xml2 [])
        up 1
        return res

    fixme :: [Either xml (FormResult a, [FieldView site])]
          -> (FormResult [a], [xml], [[FieldView site]])
    fixme :: forall xml a site.
    [Either xml (FormResult a, [FieldView site])]
    -> (FormResult [a], [xml], [[FieldView site]])
    fixme [Either xml (FormResult a, [FieldView site])]
    eithers =
        (FormResult [a]
    res, [xml]
    xmls, ((FormResult a, [FieldView site]) -> [FieldView site])
    -> [(FormResult a, [FieldView site])] -> [[FieldView site]]
    forall a b. (a -> b) -> [a] -> [b]
    map (FormResult a, [FieldView site]) -> [FieldView site]
    forall a b. (a, b) -> b
    snd [(FormResult a, [FieldView site])]
    rest)
      where
        ([xml]
    xmls, [(FormResult a, [FieldView site])]
    rest) = [Either xml (FormResult a, [FieldView site])]
    -> ([xml], [(FormResult a, [FieldView site])])
    forall a b. [Either a b] -> ([a], [b])
    partitionEithers [Either xml (FormResult a, [FieldView site])]
    eithers
        res :: FormResult [a]
    res = [FormResult a] -> FormResult [a]
    forall (t :: * -> *) (f :: * -> *) a.
    (Traversable t, Applicative f) =>
    t (f a) -> f (t a)
    forall (f :: * -> *) a. Applicative f => [f a] -> f [a]
    Data.Traversable.sequenceA ([FormResult a] -> FormResult [a])
    -> [FormResult a] -> FormResult [a]
    forall a b. (a -> b) -> a -> b
    $ ((FormResult a, [FieldView site]) -> FormResult a)
    -> [(FormResult a, [FieldView site])] -> [FormResult a]
    forall a b. (a -> b) -> [a] -> [b]
    map (FormResult a, [FieldView site]) -> FormResult a
    forall a b. (a, b) -> a
    fst [(FormResult a, [FieldView site])]
    rest

    massDivs, massTable
             :: [[FieldView site]]
             -> WidgetFor site ()
    massDivs :: forall site. [[FieldView site]] -> WidgetFor site ()
    massDivs [[FieldView site]]
    viewss = [whamlet|
    $newline never
    $forall views <- viewss
        <fieldset>
            $forall view <- views
                <div :fvRequired view:.required :not $ fvRequired view:.optional>
                    <label for=#{fvId view}>#{fvLabel view}
                    $maybe tt <- fvTooltip view
                        <div .tooltip>#{tt}
                    ^{fvInput view}
                    $maybe err <- fvErrors view
                        <div .errors>#{err}
    |]

    massTable :: forall site. [[FieldView site]] -> WidgetFor site ()
    massTable [[FieldView site]]
    viewss = [whamlet|
    $newline never
    $forall views <- viewss
        <fieldset>
            <table>
                $forall view <- views
                    <tr :fvRequired view:.required :not $ fvRequired view:.optional>
                        <td>
                            <label for=#{fvId view}>#{fvLabel view}
                            $maybe tt <- fvTooltip view
                                <div .tooltip>#{tt}
                        <td>^{fvInput view}
                        $maybe err <- fvErrors view
                            <td .errors>#{err}
    |]