{-# LANGUAGE OverloadedStrings #-}

-----------------------------------------------------------------------------
-- |
-- Module: Layout.Bootstrap.Forms
-- 
-- Generic form builder and processor.
-- Not-so bootstrap, but uses it's widgets.
--
-- Example form:
--
-- > checkForm = (emptyForm []) { required = [ textField "Service" "test:pass" "Service ID. For example: «test:pass»."
-- >                                         , textField "Account" "9999995000" "Account ID. For example: «5077322496»." ]
-- >                            , optional = [ textField "Amount" "0.12" "Amount to check." ]
--
-----------------------------------------------------------------------------

module Layout.Bootstrap.Forms where

import Text.Blaze (ToHtml)
import Text.Blaze.Html5 (toHtml, toValue, (!))
import qualified Text.Blaze.Html5 as H
import qualified Text.Blaze.Html5.Attributes as A
import qualified Data.Text as T
import Control.Monad (forM, forM_)
import qualified Data.Map as HM

import Layout.Bootstrap.Widgets (
  fieldset, form,
  simpleInput, Input(..),
  formActions, button)

-- * Form composition

type FormData = HM.Map T.Text [T.Text]

-- | Form container
data Form = Form { required :: [Input]
                 , optional :: [Input]
                 , extra    :: [Input]
                 , formValues :: FormData
                 , formErrors :: FormData
                 } deriving (Show)

instance ToHtml Form where
    toHtml form = do makeFields "Required" $! required form
                     makeFields "Optional" $! optional form
                     makeFields "Extra" $! extra form

                     case extra form of
                          [] -> ""
                          fs -> extraFields fs

                     formActions $! do
                        button "submit" ["btn-primary"] "Commit Request"
                        button "reset" [] "Reset Form"

                  where
                      value key = case HM.findWithDefault [] (T.toLower key) (formValues form) of
                                    [] -> ""
                                    [""] -> ""
                                    v:vs -> v

                      err key = HM.findWithDefault [] (T.toLower key) (formErrors form)

                      makeFields title fields = case fields of
                                                    [] -> ""
                                                    fs -> fieldset title $ mapM_ toHtml (withErrors . withValues $ fields)

                      withValues = map (\field -> case value (title field) of
                                                      "" -> field
                                                      fv -> field { value = fv })

                      withErrors = map (\field -> case err (title field) of
                                                      [] -> field
                                                      fe -> field { errors = True })

                      extraFields fs = forM_ fs (\f -> H.input
                                                       ! A.type_ "hidden"
                                                       ! A.name "extra"
                                                       ! (A.value . toValue . title $ f))

-- | Very basic form. You can add fancy required/optional fields with record modifiers
-- or generate simple textfields from a list of names.
emptyForm :: [T.Text] -> Form
emptyForm extra = Form [] [] (map simpleInput extra) HM.empty HM.empty

-- | Text field builder to be used with 'Form' constructor.
textField :: T.Text -> T.Text -> T.Text -> Input
textField title placeholder help = Input title placeholder help "" False

-- * Processing with HappStack

-- | Fill in form values and errors using 'formData'.
--
-- @
-- import Happstack.Server (lookTexts', ServerPartT)
--
-- -- Use inside 'ServerPart':
-- form <- lookValues checkForm
--
-- lookValues :: Form -> ServerPartT IO Form
-- lookValues form = do
--     reqd <- formData $ required form
--     optl <- formData $ optional form
--     extr <- formData $ extra form
--
--    return form { formValues = HM.unions $ map HM.fromList [reqd, optl, extr]
--                , formErrors = HM.fromList $ checkRequired reqd }
--
-- -- Load assoc list of values from current request.
-- formData :: [Input] -> ServerPartT IO [(T.Text, [T.Text])]
-- formData fs = forM fs
--     (\field -> do
--         let name = T.toLower $ title field
--         value <- lookTexts' $ T.unpack name
--         return (name, value))
--   
-- isRequired title = (title, ["This field is required."])
-- checkRequired = concatMap (\(title, values) -> case values of
--                                                    [] -> [isRequired title]
--                                                    [""] -> [isRequired title]
--                                                    _ -> [])
-- @