{-# LANGUAGE OverloadedStrings #-}
module Text.Digestive.Blaze.Html5
    ( BlazeFormHtml
    , inputText
    , inputText'
    , inputHidden
    , inputHidden'
    , inputTextArea
    , inputTextArea'
    , inputTextRead
    , inputPassword
    , inputPassword'
    , inputCheckBox
    , inputRadio
    , inputFile
    , inputSelect
    , submit
    , label
    , errors
    , childErrors
    , inputList
    , inputListJs
    , module Text.Digestive.Forms.Html
    ) where

import Control.Monad (forM_, unless, when)
import Data.Maybe (fromMaybe)
import Data.Monoid (mempty)
import Data.String (IsString(..))
import Data.Text (Text)

import Text.Blaze (Attribute)
import Text.Blaze.Html5 (Html, (!), toValue, toHtml)
import qualified Text.Blaze.Html5 as H
import qualified Text.Blaze.Html5.Attributes as A

import Text.Digestive.Types
import Text.Digestive.Forms (FormInput (..))
import qualified Text.Digestive.Forms as Forms
import qualified Text.Digestive.Common as Common
import Text.Digestive.Forms.Html

-- | Form HTML generated by blaze
--
type BlazeFormHtml = FormHtml Html

-- | 'applyClasses' instantiated for blaze
--
applyClasses' :: [FormHtmlConfig -> [String]]  -- ^ Labels to apply
              -> FormHtmlConfig                -- ^ Label configuration
              -> Html                          -- ^ HTML element
              -> Html                          -- ^ Resulting element
applyClasses' = applyClasses $ \element value ->
    element ! A.class_ (toValue value)

-- | Applies an attribute to some HTML, but only if an associated
-- boolean value is true.
attrWhenTrue :: Attribute -> Bool -> Html -> Html
attrWhenTrue a True  h = h ! a
attrWhenTrue _ False h = h

-- | Checks the input element when the argument is true
checked :: Bool -> Html -> Html
checked = attrWhenTrue (A.checked "checked")

-- | Selects an @<option>@ when the argument is true.
selected :: Bool -> Html -> Html
selected = attrWhenTrue (A.selected "selected")

inputText :: (Monad m, Functor m, FormInput i f)
          => Formlet m i e BlazeFormHtml Text
inputText = Forms.inputText inputTextHTML

inputText' :: (Monad m, Functor m, FormInput i f)
           => Formlet m i e BlazeFormHtml String
inputText' = Forms.inputString inputTextHTML

inputTextHTML :: (H.ToValue b, IsString b, Show a)
              => a -> Maybe b -> FormHtml Html
inputTextHTML id' inp = createFormHtml $ \cfg ->
    applyClasses' [htmlInputClasses] cfg $
        H.input ! A.type_ "text"
                ! A.name (toValue $ show id')
                ! A.id (toValue $ show id')
                ! A.value (toValue $ fromMaybe "" inp)

inputHidden :: (Monad m, Functor m, FormInput i f)
            => Formlet m i e BlazeFormHtml Text
inputHidden = Forms.inputText inputHiddenHTML

inputHidden' :: (Monad m, Functor m, FormInput i f)
             => Formlet m i e BlazeFormHtml String
inputHidden' = Forms.inputString inputHiddenHTML

inputHiddenHTML :: (H.ToValue b, IsString b, Show a)
                => a -> Maybe b -> FormHtml Html
inputHiddenHTML id' inp = createFormHtml $ \cfg ->
    applyClasses' [htmlInputClasses] cfg $
        H.input ! A.type_ "hidden"
                ! A.name (toValue $ show id')
                ! A.id (toValue $ show id')
                ! A.value (toValue $ fromMaybe "" inp)

inputTextArea :: (Monad m, Functor m, FormInput i f)
              => Maybe Int                        -- ^ Rows
              -> Maybe Int                        -- ^ Columns
              -> Maybe Text                       -- ^ Default input
              -> Form m i e BlazeFormHtml Text    -- ^ Result
inputTextArea r c = Forms.inputText $ inputTextAreaHTML r c

inputTextArea' :: (Monad m, Functor m, FormInput i f)
               => Maybe Int                        -- ^ Rows
               -> Maybe Int                        -- ^ Columns
               -> Maybe String                     -- ^ Default input
               -> Form m i e BlazeFormHtml String  -- ^ Result
inputTextArea' r c = Forms.inputString $ inputTextAreaHTML r c

inputTextAreaHTML :: (H.ToHtml d, IsString d, Show b, Show c, Show a)
                  => Maybe a -> Maybe b -> c -> Maybe d -> FormHtml Html
inputTextAreaHTML r c id' inp = createFormHtml $ \cfg ->
    applyClasses' [htmlInputClasses] cfg $ rows r $ cols c $
        H.textarea ! A.name (toValue $ show id')
                   ! A.id (toValue $ show id')
                   $ toHtml $ fromMaybe "" inp
  where
    rows Nothing = id
    rows (Just x) = (! A.rows (toValue $ show x))
    cols Nothing = id
    cols (Just x) = (! A.cols (toValue $ show x))

inputTextRead :: (Monad m, Functor m, FormInput i f, Show a, Read a)
              => e
              -> Maybe a
              -> Form m i e BlazeFormHtml a
inputTextRead error' = flip Forms.inputRead error' $ \id' inp ->
    createFormHtml $ \cfg -> applyClasses' [htmlInputClasses] cfg $
        H.input ! A.type_ "text"
                ! A.name (toValue $ show id')
                ! A.id (toValue $ show id')
                ! A.value (toValue $ fromMaybe "" inp)

inputPassword :: (Monad m, Functor m, FormInput i f)
              => Bool                                 -- ^ Retain input?
              -> Form m i e BlazeFormHtml Text        -- ^ Resulting form
inputPassword retain = Forms.inputText (inputPasswordHTML retain) Nothing

inputPassword' :: (Monad m, Functor m, FormInput i f)
               => Bool                                -- ^ Retain input?
               -> Form m i e BlazeFormHtml String     -- ^ Resulting form
inputPassword' retain = Forms.inputString (inputPasswordHTML retain) Nothing

inputPasswordHTML :: (H.ToValue b, IsString b, Show a)
                  => Bool -> a -> Maybe b -> FormHtml Html
inputPasswordHTML retain id' inp =
    createFormHtml $ \cfg -> applyClasses' [htmlInputClasses] cfg $
        H.input ! A.type_ "password"
                ! A.name (toValue $ show id')
                ! A.id (toValue $ show id')
                ! A.value (toValue value)
  where
    value = if retain then fromMaybe "" inp else ""

inputCheckBox :: (Monad m, Functor m, FormInput i f)
              => Bool
              -> Form m i e BlazeFormHtml Bool
inputCheckBox inp = flip Forms.inputBool inp $ \id' inp' ->
    createFormHtml $ \cfg -> applyClasses' [htmlInputClasses] cfg $
        checked inp' $ H.input ! A.type_ "checkbox"
                               ! A.name (toValue $ show id')
                               ! A.id (toValue $ show id')

inputRadio :: (Monad m, Functor m, FormInput i f, Eq a)
           => Bool                        -- ^ Use @<br>@ tags
           -> a                           -- ^ Default option
           -> [(a, Html)]                 -- ^ Choices with their names
           -> Form m i e BlazeFormHtml a  -- ^ Resulting form
inputRadio br def choices = Forms.inputChoice toView def (map fst choices)
  where
    toView group id' sel val = createFormHtml $ \cfg -> do
        applyClasses' [htmlInputClasses] cfg $ checked sel $
            H.input ! A.type_ "radio"
                    ! A.name (toValue $ show group)
                    ! A.value (toValue id')
                    ! A.id (toValue id')
        H.label ! A.for (toValue id')
                $ fromMaybe mempty $ lookup val choices
        when br H.br

inputSelect :: (Monad m, Functor m, FormInput i f, Eq a)
            => a                           -- ^ Default option
            -> [(a, Html)]                 -- ^ Choices with their names
            -> Form m i e BlazeFormHtml a  -- ^ Resulting form
inputSelect def choices = Form $ do
    id' <- getFormId
    unForm $ mapViewHtml (H.select ! A.name (toValue $ show id') ) $
        Forms.inputChoice toView def (map fst choices)
  where
    toView _ id' sel val = createFormHtml $ \cfg -> do
        applyClasses' [htmlInputClasses] cfg $ selected sel $
            H.option ! A.type_ "radio"
                     ! A.value (toValue id')
                     $ fromMaybe mempty $ lookup val choices

inputFile :: (Monad m, Functor m, FormInput i f)
          => Form m i e BlazeFormHtml (Maybe f)  -- ^ Form
inputFile = Forms.inputFile toView
  where
    toView id' = createFormHtmlWith MultiPart $ \cfg ->
        applyClasses' [htmlInputClasses] cfg $
            H.input ! A.type_ "file"
                    ! A.name (toValue $ show id')
                    ! A.id (toValue $ show id')

submit :: Monad m
       => String                       -- ^ Text on the submit button
       -> Form m i e BlazeFormHtml ()  -- ^ Submit button
submit text = view $ createFormHtml $ \cfg ->
    applyClasses' [htmlInputClasses, htmlSubmitClasses] cfg $
        H.input ! A.type_ "submit"
                ! A.value (toValue text)

label :: Monad m
      => String
      -> Form m i e BlazeFormHtml ()
label string = Common.label $ \id' -> createFormHtml $ \cfg ->
    applyClasses' [htmlLabelClasses] cfg $
        H.label ! A.for (toValue $ show id')
                $ toHtml string

errorList :: [Html] -> BlazeFormHtml
errorList errors' = createFormHtml $ \cfg -> unless (null errors') $
    applyClasses' [htmlErrorListClasses] cfg $
        H.ul $ forM_ errors' $ applyClasses' [htmlErrorClasses] cfg . H.li

errors :: Monad m
       => Form m i Html BlazeFormHtml ()
errors = Common.errors errorList

childErrors :: Monad m
            => Form m i Html BlazeFormHtml ()
childErrors = Common.childErrors errorList

-- | Wraps the more generic 'Text.Digestive.Forms.inputList' function to
-- provide a reasonable default for adding add/remove controls to a form.
-- The whole thing is wrapped in another div with the class inputList.  For
-- this function to work, the javascript code in 'inputListJs' or something
-- similar must be in scope.
--
-- The user needs to specify the hidden formlet because transformRead requires
-- an error parameter, and this function can't specify it without loss of
-- generality.  The idea is that the extra power of being able to customize
-- the formlet is worth the small amount of extra code compared to having to
-- specify the error.
--
inputList :: (Monad m, Functor m, FormInput i f)
          => Formlet m i e BlazeFormHtml Int
          -- ^ The formlet holding the number of items in the list
          -> Formlet m i e BlazeFormHtml a
          -- ^ The formlet used for each list item.  This function surrounds it
          -- with a div tag with the inputListItem class.
          -> Formlet m i e BlazeFormHtml [a]
          -- ^ The dynamic list formlet
inputList hidden single d =
    mapView (fmap addControls) $ Forms.inputList hidden s d
  where
    s def = mapView (fmap (H.div ! A.class_ "inputListItem")) $ single def
    addControls form =
        H.div ! A.class_ "inputList" $ do
            H.div $ do
                H.input ! A.type_ "button"
                        ! A.onclick "addItem(this); return false;"
                        ! A.value "Add Item"
                H.input ! A.type_ "button"
                        ! A.onclick "removeItem(this); return false;"
                        ! A.value "Remove Item"
            form

-- | A string containing the javascript functions needed for inputList.  This
-- code requires JQuery.
--
inputListJs :: String
inputListJs = unlines
    ["// Requires that JQuery also be in scope"
    ,"function findInputList(button) {"
    ,"  var mainDiv = $(button).parent();"
    ,"  while ( !mainDiv.hasClass('inputList') ) {"
    ,"    mainDiv = $(mainDiv).parent();"
    ,"  }"
    ,"  return mainDiv;"
    ,"}"
    ,""
    ,"function findItems(button) {"
    ,"  return $('.inputListItem', findInputList(button));"
    ,"}"
    ,""
    ,"function addItem(button) {"
    ,"  var count = $(':hidden', findInputList(button))[0];"
    ,"  var items = findItems(button);"
    ,"  var item = $(items[items.length-1]);"
    ,"  var newItem = item.clone(true);"
    ,"  var i;"
    ,""
    ,"  // Increment counter"
    ,"  $(count).val(parseInt($(count).val())+1);"
    ,""
    ,"  // We have to change the raw html because IE doesn't allow the"
    ,"  // name field to be changed."
    ,"  newItem.html(newItem.html().replace(/fval\\[(\\d+\\.)*(\\d+)\\.(\\d+)\\]/g,"
    ,"    function(a, b, c, d) {"
    ,"      var newC = parseInt(c)+1;"
    ,"      return a.replace(/\\d+\\.\\d+\\]/, newC+'.'+d+']');"
    ,"    }"
    ,"  ));"
    ,"  newItem.appendTo(item.parent());"
    ,""
    ,"  // Copy the values of all children that had the name attribute set."
    ,"  // The direct html insertion does not preserve the most current"
    ,"  // values.  It only preserves default values, so if we want values"
    ,"  // copied, we have to use an approach like this."
    ,"  var items2 = findItems(button);"
    ,"  var newLast = $(items2[items2.length-1]);"
    ,"  var c1 = $('[name]', item);"
    ,"  var c2 = $('[name]', newLast);"
    ,"  if ( c1.length == c2.length ) {"
    ,"    for ( i = 0; i < c1.length; i++ ) {"
    ,"      $(c2[i]).val($(c1[i]).val());"
    ,"    }"
    ,"  }"
    ,"}"
    ,""
    ,"function removeItem(button) {"
    ,"  var items = findItems(button);"
    ,"  if ( items.length > 1 ) {"
    ,"    var count = $(':hidden', findInputList(button))[0];"
    ,"    var item = $(items[items.length-1]);"
    ,"    item.remove();"
    ,""
    ,"    // Decrement counter"
    ,"    $(count).val(parseInt($(count).val())-1);"
    ,"  } else {"
    ,"    alert('Cannot remove any more rows');"
    ,"  }"
    ,"}"
    ]