{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE QuasiQuotes  #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE CPP #-}

-- | A module providing a means of creating multiple input forms without
-- the need to submit the form to generate a new input field unlike
-- in "MassInput".
module Yesod.Form.MultiInput
    ( MultiSettings (..)
    , MultiView (..)
    , mmulti
    , amulti
    , bs3Settings
    , bs3FASettings
    , bs4Settings
    , bs4FASettings
    ) where

import Control.Arrow (second)
import Control.Monad (liftM)
import Control.Monad.Trans.RWS (ask, tell)
import qualified Data.Map as Map
import Data.Maybe (fromJust, listToMaybe, fromMaybe, isJust)
import Data.Text (Text)
import qualified Data.Text as T
import Text.Julius (rawJS)
import Yesod.Core
import Yesod.Form.Fields (intField)
import Yesod.Form.Functions
import Yesod.Form.Types

#ifdef MIN_VERSION_shakespeare(2,0,18)
#if MIN_VERSION_shakespeare(2,0,18)
#else
import Text.Julius (ToJavascript (..))
instance ToJavascript String where toJavascript = toJavascript . toJSON
instance ToJavascript Text where toJavascript = toJavascript . toJSON
#endif
#endif

-- | By default delete buttons have a @margin-left@ property of @0.75rem@.
-- You can override this by specifying an alternative value in a class
-- which is then passed inside 'MultiSettings'.
--
-- @since 1.7.0
data MultiSettings site = MultiSettings
    { MultiSettings site -> Text
msAddClass :: !Text -- ^ Class to be applied to the "add another" button.
    , MultiSettings site -> Text
msDelClass :: !Text -- ^ Class to be applied to the "delete" button.
    , MultiSettings site -> Text
msTooltipClass :: Text -- ^ Only used in applicative forms. Class to be applied to the tooltip.
    , MultiSettings site -> Text
msWrapperErrClass :: !Text -- ^ Class to be applied to the wrapper if it's field has an error.
    , MultiSettings site -> Maybe Html
msAddInner :: !(Maybe Html) -- ^ Inner Html of add button, defaults to "Add Another". Useful for adding icons inside buttons.
    , MultiSettings site -> Maybe Html
msDelInner :: !(Maybe Html) -- ^ Inner Html of delete button, defaults to "Delete". Useful for adding icons inside buttons.
    , MultiSettings site -> Maybe (Html -> WidgetFor site ())
msErrWidget :: Maybe (Html -> WidgetFor site ()) -- ^ Only used in applicative forms. Create a widget for displaying errors.
    }

-- | The general structure of each individually generated field is as follows.
-- There is an external wrapper element containing both an inner wrapper and any
-- error messages that apply to that specific field. The inner wrapper contains
-- both the field and it's corresponding delete button.
--
-- The structure is illustrated by the following:
-- 
-- > <div .#{wrapperClass}>
-- >     <div .#{wrapperClass}-inner>
-- >         ^{fieldWidget}
-- >         ^{deleteButton}
-- >     ^{maybeErrorMessages}
--
-- Each wrapper element has the same class which is automatically generated. This class
-- is returned in the 'MultiView' should you wish to change the styling. The inner wrapper
-- uses the same class followed by @-inner@. By default the wrapper and inner wrapper has
-- classes are as follows:
-- 
-- > .#{wrapperClass} {
-- >     margin-bottom: 1rem;
-- > }
-- >
-- > .#{wrapperClass}-inner {
-- >     display: flex;
-- >     flex-direction: row;
-- > }
--
-- @since 1.7.0
data MultiView site = MultiView
    { MultiView site -> FieldView site
mvCounter :: FieldView site -- ^ Hidden counter field.
    , MultiView site -> [FieldView site]
mvFields :: [FieldView site] -- ^ Input fields.
    , MultiView site -> FieldView site
mvAddBtn :: FieldView site -- ^ Button to add another field.
    , MultiView site -> Text
mvWrapperClass :: Text -- ^ Class applied to a div wrapping each field with it's delete button.
    }

-- | 'MultiSettings' for Bootstrap 3.
--
-- @since 1.6.0
bs3Settings :: MultiSettings site
bs3Settings :: MultiSettings site
bs3Settings = Text
-> Text
-> Text
-> Text
-> Maybe Html
-> Maybe Html
-> Maybe (Html -> WidgetFor site ())
-> MultiSettings site
forall site.
Text
-> Text
-> Text
-> Text
-> Maybe Html
-> Maybe Html
-> Maybe (Html -> WidgetFor site ())
-> MultiSettings site
MultiSettings
    Text
"btn btn-default"
    Text
"btn btn-danger"
    Text
"help-block"
    Text
"has-error"
    Maybe Html
forall a. Maybe a
Nothing Maybe Html
forall a. Maybe a
Nothing ((Html -> WidgetFor site ()) -> Maybe (Html -> WidgetFor site ())
forall a. a -> Maybe a
Just Html -> WidgetFor site ()
forall a site. ToMarkup a => a -> WidgetFor site ()
errW)
    where
        errW :: a -> WidgetFor site ()
errW a
err = 
            [whamlet|
                <span .help-block>#{err}
            |]

-- | 'MultiSettings' for Bootstrap 4.
--
-- @since 1.6.0
bs4Settings :: MultiSettings site
bs4Settings :: MultiSettings site
bs4Settings = Text
-> Text
-> Text
-> Text
-> Maybe Html
-> Maybe Html
-> Maybe (Html -> WidgetFor site ())
-> MultiSettings site
forall site.
Text
-> Text
-> Text
-> Text
-> Maybe Html
-> Maybe Html
-> Maybe (Html -> WidgetFor site ())
-> MultiSettings site
MultiSettings
    Text
"btn btn-secondary"
    Text
"btn btn-danger"
    Text
"form-text text-muted"
    Text
"has-error"
    Maybe Html
forall a. Maybe a
Nothing Maybe Html
forall a. Maybe a
Nothing ((Html -> WidgetFor site ()) -> Maybe (Html -> WidgetFor site ())
forall a. a -> Maybe a
Just Html -> WidgetFor site ()
forall a site. ToMarkup a => a -> WidgetFor site ()
errW)
    where
        errW :: a -> WidgetFor site ()
errW a
err =
            [whamlet|
                <div .invalid-feedback>#{err}
            |]

-- | 'MultiSettings' for Bootstrap 3 with Font Awesome 5 Icons.
-- Uses @fa-plus@ for the add button and @fa-trash-alt@ for the delete button.
--
-- @since 1.7.0
bs3FASettings :: MultiSettings site
bs3FASettings :: MultiSettings site
bs3FASettings = Text
-> Text
-> Text
-> Text
-> Maybe Html
-> Maybe Html
-> Maybe (Html -> WidgetFor site ())
-> MultiSettings site
forall site.
Text
-> Text
-> Text
-> Text
-> Maybe Html
-> Maybe Html
-> Maybe (Html -> WidgetFor site ())
-> MultiSettings site
MultiSettings
    Text
"btn btn-default"
    Text
"btn btn-danger"
    Text
"help-block"
    Text
"has-error"
    Maybe Html
addIcon Maybe Html
delIcon ((Html -> WidgetFor site ()) -> Maybe (Html -> WidgetFor site ())
forall a. a -> Maybe a
Just Html -> WidgetFor site ()
forall a site. ToMarkup a => a -> WidgetFor site ()
errW)
    where
        addIcon :: Maybe Html
addIcon = Html -> Maybe Html
forall a. a -> Maybe a
Just [shamlet|<i class="fas fa-plus">|]
        delIcon :: Maybe Html
delIcon = Html -> Maybe Html
forall a. a -> Maybe a
Just [shamlet|<i class="fas fa-trash-alt">|]
        errW :: a -> WidgetFor site ()
errW a
err = 
            [whamlet|
                <span .help-block>#{err}
            |]

-- | 'MultiSettings' for Bootstrap 4 with Font Awesome 5 Icons.
-- Uses @fa-plus@ for the add button and @fa-trash-alt@ for the delete button.
--
-- @since 1.7.0
bs4FASettings :: MultiSettings site
bs4FASettings :: MultiSettings site
bs4FASettings = Text
-> Text
-> Text
-> Text
-> Maybe Html
-> Maybe Html
-> Maybe (Html -> WidgetFor site ())
-> MultiSettings site
forall site.
Text
-> Text
-> Text
-> Text
-> Maybe Html
-> Maybe Html
-> Maybe (Html -> WidgetFor site ())
-> MultiSettings site
MultiSettings
    Text
"btn btn-secondary"
    Text
"btn btn-danger"
    Text
"form-text text-muted"
    Text
"has-error"
    Maybe Html
addIcon Maybe Html
delIcon ((Html -> WidgetFor site ()) -> Maybe (Html -> WidgetFor site ())
forall a. a -> Maybe a
Just Html -> WidgetFor site ()
forall a site. ToMarkup a => a -> WidgetFor site ()
errW)
    where
        addIcon :: Maybe Html
addIcon = Html -> Maybe Html
forall a. a -> Maybe a
Just [shamlet|<i class="fas fa-plus">|]
        delIcon :: Maybe Html
delIcon = Html -> Maybe Html
forall a. a -> Maybe a
Just [shamlet|<i class="fas fa-trash-alt">|]
        errW :: a -> WidgetFor site ()
errW a
err =
            [whamlet|
                <div .invalid-feedback>#{err}
            |]

-- | Applicative equivalent of 'mmulti'.
--
-- Note about tooltips:
-- Rather than displaying the tooltip alongside each field the
-- tooltip is displayed once at the top of the multi-field set.
--
-- @since 1.6.0
amulti :: (site ~ HandlerSite m, MonadHandler m, RenderMessage site FormMessage)
    => Field m a
    -> FieldSettings site
    -> [a]
    -> Int
    -> MultiSettings site
    -> AForm m [a]
amulti :: Field m a
-> FieldSettings site
-> [a]
-> Int
-> MultiSettings site
-> AForm m [a]
amulti Field m a
field FieldSettings site
fs [a]
defs Int
minVals MultiSettings site
ms = MForm m (FormResult [a], [FieldView site]) -> AForm m [a]
forall (m :: * -> *) site a.
(HandlerSite m ~ site, Monad m) =>
MForm m (FormResult a, [FieldView site]) -> AForm m a
formToAForm (MForm m (FormResult [a], [FieldView site]) -> AForm m [a])
-> MForm m (FormResult [a], [FieldView site]) -> AForm m [a]
forall a b. (a -> b) -> a -> b
$
    ((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)
mform
    where
        mform :: RWST
  (Maybe (Env, FileEnv), site, [Text])
  Enctype
  Ints
  m
  (FormResult [a], FieldView site)
mform = do
            (FormResult [a]
fr, MultiView {[FieldView site]
Text
FieldView site
mvWrapperClass :: Text
mvAddBtn :: FieldView site
mvFields :: [FieldView site]
mvCounter :: FieldView site
mvWrapperClass :: forall site. MultiView site -> Text
mvAddBtn :: forall site. MultiView site -> FieldView site
mvFields :: forall site. MultiView site -> [FieldView site]
mvCounter :: forall site. MultiView site -> FieldView site
..}) <- Field m a
-> FieldSettings site
-> [a]
-> Int
-> MultiSettings site
-> MForm m (FormResult [a], MultiView site)
forall site (m :: * -> *) a.
(site ~ HandlerSite m, MonadHandler m,
 RenderMessage site FormMessage) =>
Field m a
-> FieldSettings site
-> [a]
-> Int
-> MultiSettings site
-> MForm m (FormResult [a], MultiView site)
mmulti Field m a
field FieldSettings site
fs [a]
defs Int
minVals MultiSettings site
ms

            let (FieldView site
fv : [FieldView site]
_) = [FieldView site]
mvFields
                widget :: WidgetFor site ()
widget = do
                    [whamlet|
                        $maybe tooltip <- fvTooltip fv
                            <small .#{msTooltipClass ms}>#{tooltip}

                        ^{fvInput mvCounter}

                        $forall fv <- mvFields
                            ^{fvInput fv}

                        ^{fvInput mvAddBtn}
                    |]
                view :: FieldView site
view = FieldView :: forall site.
Html
-> Maybe Html
-> Text
-> WidgetFor site ()
-> Maybe Html
-> Bool
-> FieldView site
FieldView
                    { fvLabel :: Html
fvLabel = FieldView site -> Html
forall site. FieldView site -> Html
fvLabel FieldView site
fv
                    , fvTooltip :: Maybe Html
fvTooltip = Maybe Html
forall a. Maybe a
Nothing
                    , fvId :: Text
fvId = FieldView site -> Text
forall site. FieldView site -> Text
fvId FieldView site
fv
                    , fvInput :: WidgetFor site ()
fvInput = WidgetFor site ()
widget
                    , fvErrors :: Maybe Html
fvErrors = FieldView site -> Maybe Html
forall site. FieldView site -> Maybe Html
fvErrors FieldView site
mvAddBtn
                    , fvRequired :: Bool
fvRequired = Bool
False
                    }
            
            (FormResult [a], FieldView site)
-> RWST
     (Maybe (Env, FileEnv), site, [Text])
     Enctype
     Ints
     m
     (FormResult [a], FieldView site)
forall (m :: * -> *) a. Monad m => a -> m a
return (FormResult [a]
fr, FieldView site
view)

-- | Converts a form field into a monadic form containing an arbitrary
-- number of the given fields as specified by the user. Returns a list
-- of results, failing if the length of the list is less than the minimum
-- requested values.
--
-- @since 1.6.0
mmulti :: (site ~ HandlerSite m, MonadHandler m, RenderMessage site FormMessage)
    => Field m a
    -> FieldSettings site
    -> [a]
    -> Int
    -> MultiSettings site
    -> MForm m (FormResult [a], MultiView site)
mmulti :: Field m a
-> FieldSettings site
-> [a]
-> Int
-> MultiSettings site
-> MForm m (FormResult [a], MultiView site)
mmulti Field m a
field FieldSettings site
fs [a]
defs Int
minVals' MultiSettings site
ms = do
    Text
wrapperClass <- 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
forall (m :: * -> *). MonadHandler m => m Text
newIdent
    let minVals :: Int
minVals = if Int
minVals' Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0 then Int
0 else Int
minVals'
    Field m a
-> FieldSettings site
-> Text
-> [a]
-> Int
-> MultiSettings site
-> MForm m (FormResult [a], MultiView site)
forall site (m :: * -> *) a.
(site ~ HandlerSite m, MonadHandler m,
 RenderMessage site FormMessage) =>
Field m a
-> FieldSettings site
-> Text
-> [a]
-> Int
-> MultiSettings site
-> MForm m (FormResult [a], MultiView site)
mhelperMulti Field m a
field FieldSettings site
fs Text
wrapperClass [a]
defs Int
minVals MultiSettings site
ms

-- Helper function, does most of the work for mmulti.
mhelperMulti :: (site ~ HandlerSite m, MonadHandler m, RenderMessage site FormMessage)
    => Field m a
    -> FieldSettings site
    -> Text
    -> [a]
    -> Int
    -> MultiSettings site
    -> MForm m (FormResult [a], MultiView site)
mhelperMulti :: Field m a
-> FieldSettings site
-> Text
-> [a]
-> Int
-> MultiSettings site
-> MForm m (FormResult [a], MultiView site)
mhelperMulti field :: Field m a
field@Field {Enctype
[Text]
-> [FileInfo] -> m (Either (SomeMessage (HandlerSite m)) (Maybe a))
FieldViewFunc m a
fieldParse :: forall (m :: * -> *) a.
Field m a
-> [Text]
-> [FileInfo]
-> m (Either (SomeMessage (HandlerSite m)) (Maybe a))
fieldView :: forall (m :: * -> *) a. Field m a -> FieldViewFunc m a
fieldEnctype :: forall (m :: * -> *) a. Field m a -> Enctype
fieldEnctype :: Enctype
fieldView :: FieldViewFunc m a
fieldParse :: [Text]
-> [FileInfo] -> m (Either (SomeMessage (HandlerSite m)) (Maybe a))
..} fs :: FieldSettings site
fs@FieldSettings {[(Text, Text)]
Maybe Text
Maybe (SomeMessage site)
SomeMessage site
fsLabel :: forall master. FieldSettings master -> SomeMessage master
fsTooltip :: forall master. FieldSettings master -> Maybe (SomeMessage master)
fsId :: forall master. FieldSettings master -> Maybe Text
fsName :: forall master. FieldSettings master -> Maybe Text
fsAttrs :: forall master. FieldSettings master -> [(Text, Text)]
fsAttrs :: [(Text, Text)]
fsName :: Maybe Text
fsId :: Maybe Text
fsTooltip :: Maybe (SomeMessage site)
fsLabel :: SomeMessage site
..} Text
wrapperClass [a]
defs Int
minVals MultiSettings {Maybe Html
Maybe (Html -> WidgetFor site ())
Text
msErrWidget :: Maybe (Html -> WidgetFor site ())
msDelInner :: Maybe Html
msAddInner :: Maybe Html
msWrapperErrClass :: Text
msTooltipClass :: Text
msDelClass :: Text
msAddClass :: Text
msErrWidget :: forall site.
MultiSettings site -> Maybe (Html -> WidgetFor site ())
msDelInner :: forall site. MultiSettings site -> Maybe Html
msAddInner :: forall site. MultiSettings site -> Maybe Html
msWrapperErrClass :: forall site. MultiSettings site -> Text
msTooltipClass :: forall site. MultiSettings site -> Text
msDelClass :: forall site. MultiSettings site -> Text
msAddClass :: forall site. MultiSettings site -> Text
..} = do
    Maybe Env
mp <- RWST
  (Maybe (Env, FileEnv), site, [Text]) Enctype Ints m (Maybe Env)
forall (m :: * -> *). Monad m => MForm m (Maybe Env)
askParams
    (Maybe (Env, FileEnv)
_, site
site, [Text]
langs) <- RWST
  (Maybe (Env, FileEnv), site, [Text])
  Enctype
  Ints
  m
  (Maybe (Env, FileEnv), site, [Text])
forall w (m :: * -> *) r s. (Monoid w, Monad m) => RWST r w s m r
ask
    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
    Text
cName <- RWST (Maybe (Env, FileEnv), site, [Text]) Enctype Ints m Text
forall (m :: * -> *). Monad m => MForm m Text
newFormIdent
    Text
cid <- 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
forall (m :: * -> *). MonadHandler m => m Text
newIdent
    Text
addBtnId <- 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
forall (m :: * -> *). MonadHandler m => m Text
newIdent
    Text
delBtnPrefix <- 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
forall (m :: * -> *). MonadHandler m => m Text
newIdent

    let mr2 :: Text -> Text
mr2 = site -> [Text] -> Text -> Text
forall master message.
RenderMessage master message =>
master -> [Text] -> message -> Text
renderMessage site
site [Text]
langs
        cDef :: Int
cDef = [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [a]
defs
        cfs :: FieldSettings site
cfs = 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 SomeMessage site
"" Maybe (SomeMessage site)
forall a. Maybe a
Nothing (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
cid) (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
cName) [(Text
"hidden", Text
"true")]
        mkName :: Int -> Text
mkName Int
i = Text
name Text -> Text -> Text
`T.append` (String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ Char
'-' Char -> String -> String
forall a. a -> [a] -> [a]
: Int -> String
forall a. Show a => a -> String
show Int
i)
        mkId :: Int -> Text
mkId Int
i = Text
theId Text -> Text -> Text
`T.append` (String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ Char
'-' Char -> String -> String
forall a. a -> [a] -> [a]
: Int -> String
forall a. Show a => a -> String
show Int
i)
        mkNames :: Int -> [(Int, (Text, Text))]
mkNames Int
c = [(Int
i, (Int -> Text
mkName Int
i, Int -> Text
mkId Int
i)) | Int
i <- [Int
0 .. Int
c]]
        onMissingSucc :: p -> p -> FormResult (Maybe a)
onMissingSucc p
_ p
_ = Maybe a -> FormResult (Maybe a)
forall a. a -> FormResult a
FormSuccess Maybe a
forall a. Maybe a
Nothing
        onMissingFail :: master -> [Text] -> FormResult a
onMissingFail master
m [Text]
l = [Text] -> FormResult a
forall a. [Text] -> FormResult a
FormFailure [master -> [Text] -> FormMessage -> Text
forall master message.
RenderMessage master message =>
master -> [Text] -> message -> Text
renderMessage master
m [Text]
l FormMessage
MsgValueRequired]
        isSuccNothing :: FormResult (Maybe a) -> Bool
isSuccNothing FormResult (Maybe a)
r = case FormResult (Maybe a)
r of
            FormSuccess Maybe a
Nothing -> Bool
True
            FormResult (Maybe a)
_ -> Bool
False

    Maybe FileEnv
mfs <- RWST
  (Maybe (Env, FileEnv), site, [Text]) Enctype Ints m (Maybe FileEnv)
forall (m :: * -> *). Monad m => MForm m (Maybe FileEnv)
askFiles
    
    -- get counter value (starts counting from 0)
    cr :: (FormResult Int, Either Text Int)
cr@(FormResult Int
cRes, Either Text Int
_) <- case Maybe Env
mp of
        Maybe Env
Nothing -> (FormResult Int, Either Text Int)
-> RWST
     (Maybe (Env, FileEnv), site, [Text])
     Enctype
     Ints
     m
     (FormResult Int, Either Text Int)
forall (m :: * -> *) a. Monad m => a -> m a
return (FormResult Int
forall a. FormResult a
FormMissing, Int -> Either Text Int
forall a b. b -> Either a b
Right Int
cDef)
        Just Env
p -> Field m Int
-> FieldSettings site
-> Env
-> Maybe FileEnv
-> Text
-> (site -> [Text] -> FormResult Int)
-> (Int -> FormResult Int)
-> MForm m (FormResult Int, Either Text Int)
forall site (m :: * -> *) a b.
(site ~ HandlerSite m, MonadHandler m) =>
Field m a
-> FieldSettings site
-> Env
-> Maybe FileEnv
-> Text
-> (site -> [Text] -> FormResult b)
-> (a -> FormResult b)
-> MForm m (FormResult b, Either Text a)
mkRes Field m Int
forall (m :: * -> *) i.
(Monad m, Integral i, RenderMessage (HandlerSite m) FormMessage) =>
Field m i
intField FieldSettings site
cfs Env
p Maybe FileEnv
mfs Text
cName site -> [Text] -> FormResult Int
forall master a.
RenderMessage master FormMessage =>
master -> [Text] -> FormResult a
onMissingFail Int -> FormResult Int
forall a. a -> FormResult a
FormSuccess

    -- generate counter view
    FieldView site
cView <- Field m Int
-> FieldSettings site
-> (FormResult Int, Either Text Int)
-> Maybe (WidgetFor site (), Text, Int)
-> Maybe (Html -> WidgetFor site ())
-> Text
-> Text
-> Text
-> Bool
-> MForm m (FieldView site)
forall site (m :: * -> *) a b.
(site ~ HandlerSite m, MonadHandler m) =>
Field m a
-> FieldSettings site
-> (FormResult b, Either Text a)
-> Maybe (WidgetFor site (), Text, Int)
-> Maybe (Html -> WidgetFor site ())
-> Text
-> Text
-> Text
-> Bool
-> MForm m (FieldView site)
mkView Field m Int
forall (m :: * -> *) i.
(Monad m, Integral i, RenderMessage (HandlerSite m) FormMessage) =>
Field m i
intField FieldSettings site
cfs (FormResult Int, Either Text Int)
cr Maybe (WidgetFor site (), Text, Int)
forall a. Maybe a
Nothing Maybe (Html -> WidgetFor site ())
forall a. Maybe a
Nothing Text
msWrapperErrClass Text
cid Text
cName Bool
True

    let counter :: Int
counter = case FormResult Int
cRes of
            FormSuccess Int
c -> Int
c
            FormResult Int
_             -> Int
cDef

    -- get results of fields
    [(FormResult (Maybe a), Either Text a)]
results <- case Maybe Env
mp of
        Maybe Env
Nothing -> [(FormResult (Maybe a), Either Text a)]
-> RWST
     (Maybe (Env, FileEnv), site, [Text])
     Enctype
     Ints
     m
     [(FormResult (Maybe a), Either Text a)]
forall (m :: * -> *) a. Monad m => a -> m a
return ([(FormResult (Maybe a), Either Text a)]
 -> RWST
      (Maybe (Env, FileEnv), site, [Text])
      Enctype
      Ints
      m
      [(FormResult (Maybe a), Either Text a)])
-> [(FormResult (Maybe a), Either Text a)]
-> RWST
     (Maybe (Env, FileEnv), site, [Text])
     Enctype
     Ints
     m
     [(FormResult (Maybe a), Either Text a)]
forall a b. (a -> b) -> a -> b
$
            if Int
cDef Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0
                then [(FormResult (Maybe a)
forall a. FormResult a
FormMissing, Text -> Either Text a
forall a b. a -> Either a b
Left Text
"")]
                else [(FormResult (Maybe a)
forall a. FormResult a
FormMissing, a -> Either Text a
forall a b. b -> Either a b
Right a
d) | a
d <- [a]
defs]
        Just Env
p -> (Text
 -> RWST
      (Maybe (Env, FileEnv), site, [Text])
      Enctype
      Ints
      m
      (FormResult (Maybe a), Either Text a))
-> [Text]
-> RWST
     (Maybe (Env, FileEnv), site, [Text])
     Enctype
     Ints
     m
     [(FormResult (Maybe a), Either Text a)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM
            (\Text
n -> Field m a
-> FieldSettings site
-> Env
-> Maybe FileEnv
-> Text
-> (site -> [Text] -> FormResult (Maybe a))
-> (a -> FormResult (Maybe a))
-> MForm m (FormResult (Maybe a), Either Text a)
forall site (m :: * -> *) a b.
(site ~ HandlerSite m, MonadHandler m) =>
Field m a
-> FieldSettings site
-> Env
-> Maybe FileEnv
-> Text
-> (site -> [Text] -> FormResult b)
-> (a -> FormResult b)
-> MForm m (FormResult b, Either Text a)
mkRes Field m a
field FieldSettings site
fs Env
p Maybe FileEnv
mfs Text
n site -> [Text] -> FormResult (Maybe a)
forall p p a. p -> p -> FormResult (Maybe a)
onMissingSucc (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))
            (((Int, (Text, Text)) -> Text) -> [(Int, (Text, Text))] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map ((Text, Text) -> Text
forall a b. (a, b) -> a
fst ((Text, Text) -> Text)
-> ((Int, (Text, Text)) -> (Text, Text))
-> (Int, (Text, Text))
-> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int, (Text, Text)) -> (Text, Text)
forall a b. (a, b) -> b
snd) ([(Int, (Text, Text))] -> [Text])
-> [(Int, (Text, Text))] -> [Text]
forall a b. (a -> b) -> a -> b
$ Int -> [(Int, (Text, Text))]
mkNames Int
counter)

    -- delete button

    -- The delFunction is included down with the add button rather than with
    -- each delete button to ensure that the function only gets included once.
    let delFunction :: WidgetFor site ()
delFunction = JavascriptUrl (Route site) -> WidgetFor site ()
forall site a (m :: * -> *).
(ToWidget site a, MonadWidget m, HandlerSite m ~ site) =>
a -> m ()
toWidget
            [julius|
                function deleteField_#{rawJS theId}(wrapper) {
                    var numFields = $('.#{rawJS wrapperClass}').length;

                    if (numFields == 1)
                    {
                        wrapper.find("*").each(function() {
                            removeVals($(this));
                        });
                    }
                    else
                        wrapper.remove();
                }

                function removeVals(e) {
                    // input types where we don't want to reset the value
                    const keepValueTypes = ["radio", "checkbox", "button"];

                    // uncheck any checkboxes or radio fields and empty any text boxes
                    if(e.prop('checked') == true)
                        e.prop('checked', false);

                    if(!keepValueTypes.includes(e.prop('type')))
                        e.val("").trigger("change");
                        // trigger change is to ensure WYSIWYG editors are updated
                        // when their hidden code field is cleared
                }
            |]

        mkDelBtn :: Text -> WidgetFor site ()
mkDelBtn Text
fieldId = do
            let delBtnId :: Text
delBtnId = Text
delBtnPrefix Text -> Text -> Text
`T.append` Text
fieldId
            [whamlet|
                <button ##{delBtnId} .#{msDelClass} style="margin-left: 0.75rem" type="button">
                    $maybe inner <- msDelInner
                        #{inner}
                    $nothing
                        Delete
            |]
            JavascriptUrl (Route site) -> WidgetFor site ()
forall site a (m :: * -> *).
(ToWidget site a, MonadWidget m, HandlerSite m ~ site) =>
a -> m ()
toWidget
                [julius|
                    $('##{rawJS delBtnId}').click(function() {
                        var field = $('##{rawJS fieldId}');
                        deleteField_#{rawJS theId}(field.parents('.#{rawJS wrapperClass}'));
                    });                    
                |]

    -- generate field views
    ([FormResult (Maybe a)]
rs, [FieldView site]
fvs) <- do
        let mkView' :: ((Int, (Text, Text)), (FormResult (Maybe a), Either Text a))
-> RWST
     (Maybe (Env, FileEnv), site, [Text])
     Enctype
     Ints
     m
     (FormResult (Maybe a), FieldView site)
mkView' ((Int
c, (Text
n,Text
i)), r :: (FormResult (Maybe a), Either Text a)
r@(FormResult (Maybe a)
res, Either Text a
_)) = do
                let del :: Maybe (WidgetFor site (), Text, Int)
del = (WidgetFor site (), Text, Int)
-> Maybe (WidgetFor site (), Text, Int)
forall a. a -> Maybe a
Just (Text -> WidgetFor site ()
mkDelBtn Text
i, Text
wrapperClass, Int
c)
                FieldView site
fv <- Field m a
-> FieldSettings site
-> (FormResult (Maybe a), Either Text a)
-> Maybe (WidgetFor site (), Text, Int)
-> Maybe (Html -> WidgetFor site ())
-> Text
-> Text
-> Text
-> Bool
-> MForm m (FieldView site)
forall site (m :: * -> *) a b.
(site ~ HandlerSite m, MonadHandler m) =>
Field m a
-> FieldSettings site
-> (FormResult b, Either Text a)
-> Maybe (WidgetFor site (), Text, Int)
-> Maybe (Html -> WidgetFor site ())
-> Text
-> Text
-> Text
-> Bool
-> MForm m (FieldView site)
mkView Field m a
field FieldSettings site
fs (FormResult (Maybe a), Either Text a)
r Maybe (WidgetFor site (), Text, Int)
del Maybe (Html -> WidgetFor site ())
msErrWidget Text
msWrapperErrClass Text
i Text
n Bool
True
                (FormResult (Maybe a), FieldView site)
-> RWST
     (Maybe (Env, FileEnv), site, [Text])
     Enctype
     Ints
     m
     (FormResult (Maybe a), FieldView site)
forall (m :: * -> *) a. Monad m => a -> m a
return (FormResult (Maybe a)
res, FieldView site
fv)
            xs :: [((Int, (Text, Text)), (FormResult (Maybe a), Either Text a))]
xs = [(Int, (Text, Text))]
-> [(FormResult (Maybe a), Either Text a)]
-> [((Int, (Text, Text)), (FormResult (Maybe a), Either Text a))]
forall a b. [a] -> [b] -> [(a, b)]
zip (Int -> [(Int, (Text, Text))]
mkNames Int
counter) [(FormResult (Maybe a), Either Text a)]
results
            notSuccNothing :: (a, (FormResult (Maybe a), b)) -> Bool
notSuccNothing (a
_, (FormResult (Maybe a)
r,b
_)) = Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ FormResult (Maybe a) -> Bool
forall a. FormResult (Maybe a) -> Bool
isSuccNothing FormResult (Maybe a)
r
            ys :: [((Int, (Text, Text)), (FormResult (Maybe a), Either Text a))]
ys = case (((Int, (Text, Text)), (FormResult (Maybe a), Either Text a))
 -> Bool)
-> [((Int, (Text, Text)), (FormResult (Maybe a), Either Text a))]
-> [((Int, (Text, Text)), (FormResult (Maybe a), Either Text a))]
forall a. (a -> Bool) -> [a] -> [a]
filter ((Int, (Text, Text)), (FormResult (Maybe a), Either Text a))
-> Bool
forall a a b. (a, (FormResult (Maybe a), b)) -> Bool
notSuccNothing [((Int, (Text, Text)), (FormResult (Maybe a), Either Text a))]
xs of
                [] -> [((Int
0, (Int -> Text
mkName Int
0, Int -> Text
mkId Int
0)), (Maybe a -> FormResult (Maybe a)
forall a. a -> FormResult a
FormSuccess Maybe a
forall a. Maybe a
Nothing, Text -> Either Text a
forall a b. a -> Either a b
Left Text
""))] -- always need at least one value to generate a field
                [((Int, (Text, Text)), (FormResult (Maybe a), Either Text a))]
zs -> [((Int, (Text, Text)), (FormResult (Maybe a), Either Text a))]
zs
        [(FormResult (Maybe a), FieldView site)]
rvs <- (((Int, (Text, Text)), (FormResult (Maybe a), Either Text a))
 -> RWST
      (Maybe (Env, FileEnv), site, [Text])
      Enctype
      Ints
      m
      (FormResult (Maybe a), FieldView site))
-> [((Int, (Text, Text)), (FormResult (Maybe a), Either Text a))]
-> RWST
     (Maybe (Env, FileEnv), site, [Text])
     Enctype
     Ints
     m
     [(FormResult (Maybe a), FieldView site)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM ((Int, (Text, Text)), (FormResult (Maybe a), Either Text a))
-> RWST
     (Maybe (Env, FileEnv), site, [Text])
     Enctype
     Ints
     m
     (FormResult (Maybe a), FieldView site)
mkView' [((Int, (Text, Text)), (FormResult (Maybe a), Either Text a))]
ys
        ([FormResult (Maybe a)], [FieldView site])
-> RWST
     (Maybe (Env, FileEnv), site, [Text])
     Enctype
     Ints
     m
     ([FormResult (Maybe a)], [FieldView site])
forall (m :: * -> *) a. Monad m => a -> m a
return (([FormResult (Maybe a)], [FieldView site])
 -> RWST
      (Maybe (Env, FileEnv), site, [Text])
      Enctype
      Ints
      m
      ([FormResult (Maybe a)], [FieldView site]))
-> ([FormResult (Maybe a)], [FieldView site])
-> RWST
     (Maybe (Env, FileEnv), site, [Text])
     Enctype
     Ints
     m
     ([FormResult (Maybe a)], [FieldView site])
forall a b. (a -> b) -> a -> b
$ [(FormResult (Maybe a), FieldView site)]
-> ([FormResult (Maybe a)], [FieldView site])
forall a b. [(a, b)] -> ([a], [b])
unzip [(FormResult (Maybe a), FieldView site)]
rvs
    
    -- check values
    let rs' :: [FormResult a]
rs' = [ (Maybe a -> a) -> FormResult (Maybe a) -> FormResult a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Maybe a -> a
forall a. HasCallStack => Maybe a -> a
fromJust FormResult (Maybe a)
r | FormResult (Maybe a)
r <- [FormResult (Maybe a)]
rs
                                , Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ FormResult (Maybe a) -> Bool
forall a. FormResult (Maybe a) -> Bool
isSuccNothing FormResult (Maybe a)
r ]
        err :: Text
err = String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ String
"Please enter at least " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
minVals String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" values."
        (FormResult [a]
res, Bool
tooFewVals) = 
            case (FormResult ([a] -> [a]) -> FormResult [a] -> FormResult [a])
-> FormResult [a] -> [FormResult ([a] -> [a])] -> FormResult [a]
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr FormResult ([a] -> [a]) -> FormResult [a] -> FormResult [a]
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
(<*>) ([a] -> FormResult [a]
forall a. a -> FormResult a
FormSuccess []) ((FormResult a -> FormResult ([a] -> [a]))
-> [FormResult a] -> [FormResult ([a] -> [a])]
forall a b. (a -> b) -> [a] -> [b]
map ((a -> [a] -> [a]) -> FormResult a -> FormResult ([a] -> [a])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((a -> [a] -> [a]) -> FormResult a -> FormResult ([a] -> [a]))
-> (a -> [a] -> [a]) -> FormResult a -> FormResult ([a] -> [a])
forall a b. (a -> b) -> a -> b
$ (:)) [FormResult a]
rs') of
                FormSuccess [a]
xs ->
                    if [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [a]
xs Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
minVals
                        then ([Text] -> FormResult [a]
forall a. [Text] -> FormResult a
FormFailure [Text
err], Bool
True)
                        else ([a] -> FormResult [a]
forall a. a -> FormResult a
FormSuccess [a]
xs, Bool
False)
                FormResult [a]
fRes -> (FormResult [a]
fRes, Bool
False)
    
        -- create add button
        -- also includes some styling / functions that we only want to include once
        btnWidget :: WidgetFor site ()
btnWidget = do
            [whamlet|
                <button ##{addBtnId} .#{msAddClass} type="button">
                    $maybe inner <- msAddInner
                        #{inner}
                    $nothing
                        Add Another
            |]
            (RY site -> Css) -> WidgetFor site ()
forall site a (m :: * -> *).
(ToWidget site a, MonadWidget m, HandlerSite m ~ site) =>
a -> m ()
toWidget
                [lucius|
                    .#{wrapperClass} {
                        margin-bottom: 1rem;
                    }
                    .#{wrapperClass}-inner {
                        display: flex;
                        flex-direction: row;
                    }
                |]
            WidgetFor site ()
delFunction -- function used by delete buttons, included here so that it only gets included once
            JavascriptUrl (Route site) -> WidgetFor site ()
forall site a (m :: * -> *).
(ToWidget site a, MonadWidget m, HandlerSite m ~ site) =>
a -> m ()
toWidget
                [julius|
                    var extraFields_#{rawJS theId} = 0;
                    $('##{rawJS addBtnId}').click(function() {
                        extraFields_#{rawJS theId}++;
                        var newNumber = parseInt(#{show counter}) + extraFields_#{rawJS theId};
                        $("#" + #{cid}).val(newNumber);
                        var newName = #{name} + "-" + newNumber;
                        var newId = #{theId} + "-" + newNumber;
                        var newDelId = #{delBtnPrefix} + newId;
                        
                        // get new wrapper and remove old error messages
                        var newWrapper = $('.#{rawJS wrapperClass}').first().clone();
                        newWrapper.children( ':not(.#{rawJS wrapperClass}-inner)' ).remove();
                        newWrapper.removeClass(#{msWrapperErrClass});

                        // get counter from wrapper
                        var oldCount = newWrapper.data("counter");
                        var oldName = #{name} + "-" + oldCount;
                        var oldId = #{theId} + "-" + oldCount;
                        var oldDelBtn = #{delBtnPrefix} + oldId;

                        // replace any id, name or for attributes that began with
                        // the old values and replace them with the new values
                        var idRegex = new RegExp("^" + oldId);
                        var nameRegex = new RegExp("^" + oldName);

                        var els = newWrapper.find("*");
                        els.each(function() {
                            var e = $(this);

                            if(e.prop('id') != undefined)
                                e.prop('id', e.prop('id').replace(idRegex, newId));

                            if(e.prop('name') != undefined)
                                e.prop('name', e.prop('name').replace(nameRegex, newName));

                            if(e.prop('for') != undefined)
                                e.prop('for', e.prop('for').replace(idRegex, newId)); // radio fields use id in for attribute

                            removeVals(e);
                        });

                        // set new counter on wrapper
                        newWrapper.attr("data-counter", newNumber);

                        var newDelBtn = newWrapper.find('[id^=#{rawJS delBtnPrefix}]');
                        newDelBtn.prop('id', newDelId);
                        newDelBtn.click(() => deleteField_#{rawJS theId}(newWrapper));

                        newWrapper.insertBefore('##{rawJS addBtnId}');
                    });
                |]

        btnView :: FieldView site
btnView = FieldView :: forall site.
Html
-> Maybe Html
-> Text
-> WidgetFor site ()
-> Maybe Html
-> Bool
-> FieldView site
FieldView
            { fvLabel :: Html
fvLabel = Text -> Html
forall a. ToMarkup a => a -> Html
toHtml (Text -> Html) -> Text -> Html
forall a b. (a -> b) -> a -> b
$ Text -> Text
mr2 (Text
"" :: Text)
            , fvTooltip :: Maybe Html
fvTooltip = Maybe Html
forall a. Maybe a
Nothing
            , fvId :: Text
fvId = Text
addBtnId
            , fvInput :: WidgetFor site ()
fvInput = WidgetFor site ()
btnWidget
            , fvErrors :: Maybe Html
fvErrors = if Bool
tooFewVals then Html -> Maybe Html
forall a. a -> Maybe a
Just (Html -> Maybe Html) -> Html -> Maybe Html
forall a b. (a -> b) -> a -> b
$ Text -> Html
forall a. ToMarkup a => a -> Html
toHtml Text
err else Maybe Html
forall a. Maybe a
Nothing
            , fvRequired :: Bool
fvRequired = Bool
False
            }

    (FormResult [a], MultiView site)
-> RWST
     (Maybe (Env, FileEnv), site, [Text])
     Enctype
     Ints
     m
     (FormResult [a], MultiView site)
forall (m :: * -> *) a. Monad m => a -> m a
return (FormResult [a]
res, FieldView site
-> [FieldView site] -> FieldView site -> Text -> MultiView site
forall site.
FieldView site
-> [FieldView site] -> FieldView site -> Text -> MultiView site
MultiView FieldView site
cView [FieldView site]
fvs FieldView site
btnView Text
wrapperClass)

-- Search for the given field's name in the environment,
-- parse any values found and construct a FormResult.
mkRes :: (site ~ HandlerSite m, MonadHandler m)
    => Field m a
    -> FieldSettings site
    -> Env
    -> Maybe FileEnv
    -> Text
    -> (site -> [Text] -> FormResult b)
    -> (a -> FormResult b)
    -> MForm m (FormResult b, Either Text a)
mkRes :: Field m a
-> FieldSettings site
-> Env
-> Maybe FileEnv
-> Text
-> (site -> [Text] -> FormResult b)
-> (a -> FormResult b)
-> MForm m (FormResult b, Either Text a)
mkRes Field {Enctype
[Text]
-> [FileInfo] -> m (Either (SomeMessage (HandlerSite m)) (Maybe a))
FieldViewFunc m a
fieldEnctype :: Enctype
fieldView :: FieldViewFunc m a
fieldParse :: [Text]
-> [FileInfo] -> m (Either (SomeMessage (HandlerSite m)) (Maybe a))
fieldParse :: forall (m :: * -> *) a.
Field m a
-> [Text]
-> [FileInfo]
-> m (Either (SomeMessage (HandlerSite m)) (Maybe a))
fieldView :: forall (m :: * -> *) a. Field m a -> FieldViewFunc m a
fieldEnctype :: forall (m :: * -> *) a. Field m a -> Enctype
..} FieldSettings {[(Text, Text)]
Maybe Text
Maybe (SomeMessage site)
SomeMessage site
fsAttrs :: [(Text, Text)]
fsName :: Maybe Text
fsId :: Maybe Text
fsTooltip :: Maybe (SomeMessage site)
fsLabel :: SomeMessage site
fsLabel :: forall master. FieldSettings master -> SomeMessage master
fsTooltip :: forall master. FieldSettings master -> Maybe (SomeMessage master)
fsId :: forall master. FieldSettings master -> Maybe Text
fsName :: forall master. FieldSettings master -> Maybe Text
fsAttrs :: forall master. FieldSettings master -> [(Text, Text)]
..} Env
p Maybe FileEnv
mfs Text
name site -> [Text] -> FormResult b
onMissing a -> FormResult b
onFound = 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, FileEnv)
_, site
site, [Text]
langs) <- RWST
  (Maybe (Env, FileEnv), site, [Text])
  Enctype
  Ints
  m
  (Maybe (Env, FileEnv), site, [Text])
forall w (m :: * -> *) r s. (Monoid w, Monad m) => RWST r w s m r
ask
    let 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 site
msg -> ([Text] -> FormResult b
forall a. [Text] -> FormResult a
FormFailure [site -> [Text] -> SomeMessage site -> Text
forall master message.
RenderMessage master message =>
master -> [Text] -> message -> Text
renderMessage site
site [Text]
langs SomeMessage site
msg], Either Text a
-> (Text -> Either Text a) -> Maybe Text -> Either Text a
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Text -> Either Text a
forall a b. a -> Either a b
Left Text
"") Text -> Either Text a
forall a b. a -> Either a b
Left ([Text] -> Maybe Text
forall a. [a] -> Maybe a
listToMaybe [Text]
mvals))
        Right Maybe a
mx ->
            case Maybe a
mx of
                Maybe a
Nothing -> (site -> [Text] -> FormResult b
onMissing site
site [Text]
langs, Text -> Either Text a
forall a b. a -> Either a b
Left Text
"") 
                Just a
x -> (a -> FormResult b
onFound a
x, a -> Either Text a
forall a b. b -> Either a b
Right a
x)

-- Generate a FieldView for the given field with the given result.
mkView :: (site ~ HandlerSite m, MonadHandler m)
    => Field m a
    -> FieldSettings site
    -> (FormResult b, Either Text a)
    -- Delete button widget, class for div wrapping each field with it's delete button and counter value for that field.
    -- Nothing if the field passed doesn't need a delete button e.g. if it is the counter field.
    -> Maybe (WidgetFor site (), Text, Int)
    -> Maybe (Html -> WidgetFor site ()) -- Function to display error messages.
    -> Text
    -> Text
    -> Text
    -> Bool
    -> MForm m (FieldView site)
mkView :: Field m a
-> FieldSettings site
-> (FormResult b, Either Text a)
-> Maybe (WidgetFor site (), Text, Int)
-> Maybe (Html -> WidgetFor site ())
-> Text
-> Text
-> Text
-> Bool
-> MForm m (FieldView site)
mkView Field {Enctype
[Text]
-> [FileInfo] -> m (Either (SomeMessage (HandlerSite m)) (Maybe a))
FieldViewFunc m a
fieldEnctype :: Enctype
fieldView :: FieldViewFunc m a
fieldParse :: [Text]
-> [FileInfo] -> m (Either (SomeMessage (HandlerSite m)) (Maybe a))
fieldParse :: forall (m :: * -> *) a.
Field m a
-> [Text]
-> [FileInfo]
-> m (Either (SomeMessage (HandlerSite m)) (Maybe a))
fieldView :: forall (m :: * -> *) a. Field m a -> FieldViewFunc m a
fieldEnctype :: forall (m :: * -> *) a. Field m a -> Enctype
..} FieldSettings {[(Text, Text)]
Maybe Text
Maybe (SomeMessage site)
SomeMessage site
fsAttrs :: [(Text, Text)]
fsName :: Maybe Text
fsId :: Maybe Text
fsTooltip :: Maybe (SomeMessage site)
fsLabel :: SomeMessage site
fsLabel :: forall master. FieldSettings master -> SomeMessage master
fsTooltip :: forall master. FieldSettings master -> Maybe (SomeMessage master)
fsId :: forall master. FieldSettings master -> Maybe Text
fsName :: forall master. FieldSettings master -> Maybe Text
fsAttrs :: forall master. FieldSettings master -> [(Text, Text)]
..} (FormResult b
res, Either Text a
val) Maybe (WidgetFor site (), Text, Int)
mdel Maybe (Html -> WidgetFor site ())
merrW Text
errClass Text
theId Text
name Bool
isReq = do
    (Maybe (Env, FileEnv)
_, site
site, [Text]
langs) <- RWST
  (Maybe (Env, FileEnv), site, [Text])
  Enctype
  Ints
  m
  (Maybe (Env, FileEnv), site, [Text])
forall w (m :: * -> *) r s. (Monoid w, Monad m) => RWST r w s m r
ask
    let mr2 :: SomeMessage site -> Text
mr2 = site -> [Text] -> SomeMessage site -> Text
forall master message.
RenderMessage master message =>
master -> [Text] -> message -> Text
renderMessage site
site [Text]
langs
        merr :: Maybe Html
merr = case FormResult b
res of
                FormFailure [Text
e] -> Html -> Maybe Html
forall a. a -> Maybe a
Just (Html -> Maybe Html) -> Html -> Maybe Html
forall a b. (a -> b) -> a -> b
$ Text -> Html
forall a. ToMarkup a => a -> Html
toHtml Text
e
                FormResult b
_ -> Maybe Html
forall a. Maybe a
Nothing
        fv' :: WidgetFor (HandlerSite m) ()
fv' = FieldViewFunc m a
fieldView Text
theId Text
name [(Text, Text)]
fsAttrs Either Text a
val Bool
isReq
        fv :: WidgetFor site ()
fv = do
            [whamlet|
                $maybe (delBtn, wrapperClass, counter) <- mdel
                    <div .#{wrapperClass} :isJust merr:.#{errClass} data-counter=#{counter}>
                        <div .#{wrapperClass}-inner>
                            ^{fv'}
                            ^{delBtn}
                            
                        $maybe err <- merr
                            $maybe errW <- merrW
                                ^{errW err}
                        
                $nothing
                    ^{fv'}
            |]
    FieldView site
-> RWST
     (Maybe (Env, FileEnv), site, [Text])
     Enctype
     Ints
     m
     (FieldView site)
forall (m :: * -> *) a. Monad m => a -> m a
return (FieldView site
 -> RWST
      (Maybe (Env, FileEnv), site, [Text])
      Enctype
      Ints
      m
      (FieldView site))
-> FieldView site
-> RWST
     (Maybe (Env, FileEnv), site, [Text])
     Enctype
     Ints
     m
     (FieldView site)
forall a b. (a -> b) -> a -> b
$ FieldView :: forall site.
Html
-> Maybe Html
-> Text
-> WidgetFor site ()
-> Maybe Html
-> Bool
-> FieldView site
FieldView
        { fvLabel :: Html
fvLabel = Text -> Html
forall a. ToMarkup a => a -> Html
toHtml (Text -> Html) -> Text -> Html
forall a b. (a -> b) -> a -> b
$ SomeMessage site -> Text
mr2 SomeMessage site
fsLabel
        , fvTooltip :: Maybe Html
fvTooltip = (Text -> Html) -> Maybe Text -> Maybe Html
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Text -> Html
forall a. ToMarkup a => a -> Html
toHtml (Maybe Text -> Maybe Html) -> Maybe Text -> Maybe Html
forall a b. (a -> b) -> a -> b
$ (SomeMessage site -> Text)
-> Maybe (SomeMessage site) -> Maybe Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap SomeMessage site -> Text
mr2 Maybe (SomeMessage site)
fsTooltip
        , fvId :: Text
fvId = Text
theId
        , fvInput :: WidgetFor site ()
fvInput = WidgetFor site ()
fv
        , fvErrors :: Maybe Html
fvErrors = Maybe Html
merr
        , fvRequired :: Bool
fvRequired = Bool
isReq
        }