    {-# LANGUAGE QuasiQuotes, ScopedTypeVariables, TypeFamilies #-}

    module Text.Reform.Hamlet.Common where

    import Data.Text.Lazy (Text, pack)
    import qualified Data.Text as T
    import Text.Blaze (ToMarkup(..))
    import Text.Reform.Backend
    import Text.Reform.Core
    import Text.Reform.Generalized as G
    import Text.Reform.Result (FormId, Result(Ok), unitRange)
    import Text.Hamlet (hamlet, HtmlUrl)

    instance ToMarkup FormId where
        toMarkup fid = toMarkup (show fid)

    inputText :: (FormError error, Monad m, ToMarkup text) => (input -> Either error text) -> text -> Form m input error (HtmlUrl url) () text
    inputText getInput initialValue = G.input getInput inputField initialValue
        where
          inputField i a = [hamlet|<input type="text" id=#{i} name=#{i} value=#{a}>|]

    inputPassword :: (Monad m, FormError error, ToMarkup text) =>
                 (input -> Either error text)
              -> text
              -> Form m input error (HtmlUrl url) () text
    inputPassword getInput initialValue = G.input getInput inputField initialValue
        where
          inputField i a = [hamlet|<input type="password" id=#{i} name=#{i} value=#{a}>|]

    inputSubmit :: (Monad m, FormError error, ToMarkup text) =>
                 (input -> Either error text)
              -> text
              -> Form m input error (HtmlUrl url) () (Maybe text)
    inputSubmit getInput initialValue = G.inputMaybe getInput inputField initialValue
        where
          inputField i a = [hamlet|<input type="submit" id=#{i} name=#{i} value=#{a}>|]

    inputReset :: (Monad m, FormError error, ToMarkup text) =>
                  text
               -> Form m input error (HtmlUrl url) () ()
    inputReset lbl = G.inputNoData inputField lbl
        where
          inputField i a = [hamlet|<input type="reset" id=#{i} name=#{i} value=#{a}>|]

    inputHidden :: (Monad m, FormError error, ToMarkup text) =>
                 (input -> Either error text)
              -> text
              -> Form m input error (HtmlUrl url) () text
    inputHidden getInput initialValue = G.input getInput inputField initialValue
        where
          inputField i a = [hamlet|<input type="hidden" id=#{i} name=#{i} value=#{a}>|]

    inputButton :: (Monad m, FormError error, ToMarkup text) =>
                 text
              -> Form m input error (HtmlUrl url) () ()

    inputButton label = G.inputNoData inputField label
        where
          inputField i a = [hamlet|<input type="button" id=#{i} name=#{i} value=#{a}>|]

    textarea :: (Monad m, FormError error, ToMarkup text) =>
                (input -> Either error text)
             -> Int    -- ^ cols
             -> Int    -- ^ rows
             -> text   -- ^ initial text
             -> Form m input error (HtmlUrl url) () text
    textarea getInput cols rows initialValue = G.input getInput textareaView initialValue
        where
          textareaView i txt = [hamlet|<textarea rows=#{rows} cols=#{cols} id=#{i} name=#{i}>#{txt}|]

    -- | Create an @\<input type=\"file\"\>@ element
    --
    -- This control may succeed even if the user does not actually select a file to upload. In that case the uploaded name will likely be "" and the file contents will be empty as well.
    inputFile :: (Monad m, FormError error, FormInput input, ErrorInputType error ~ input) =>
                 Form m input error (HtmlUrl url) () (FileType input)
    inputFile = G.inputFile fileView
        where
          fileView i = [hamlet|<input type="file" name=#{i} id=#{i}>|]

    -- | Create a @\<button type=\"submit\"\>@ element
    buttonSubmit :: (Monad m, FormError error, ToMarkup text, ToMarkup children) =>
                    (input -> Either error text)
                 -> text
                 -> children
                 -> Form m input error (HtmlUrl url) () (Maybe text)
    buttonSubmit getInput text c = G.inputMaybe getInput inputField text
        where
          inputField i a = [hamlet|<button type="submit" id=#{i} name=#{i} value=#{a}>#{c}|]

    buttonReset :: (Monad m, FormError error, ToMarkup children) =>
                   children
                 -> Form m input error (HtmlUrl url) () ()
    buttonReset c = G.inputNoData inputField Nothing
        where
          inputField i a = [hamlet|<button type="reset" id=#{i} name=#{i}>#{c}|]

    button :: (Monad m, FormError error, ToMarkup children) =>
                   children
                 -> Form m input error (HtmlUrl url) () ()
    button c = G.inputNoData inputField Nothing
        where
          inputField i a = [hamlet|<button type="button" id=#{i} name=#{i}>#{c}|]

    label :: (Monad m, ToMarkup c) =>
             c
          -> Form m input error (HtmlUrl url) () ()
    label c = G.label mkLabel
        where
          mkLabel i = [hamlet|<label for=#{i}>#{c}|]

    -- FIXME: should this use inputMaybe?
    inputCheckbox :: forall x error input m url. (Monad m, FormInput input, FormError error, ErrorInputType error ~ input) =>
                       Bool  -- ^ initially checked
                    -> Form m input error (HtmlUrl url) () Bool
    inputCheckbox initiallyChecked =
        Form $
          do i <- getFormId
             v <- getFormInput' i
             case v of
               Default   -> mkCheckbox i initiallyChecked
               Missing   -> mkCheckbox i False -- checkboxes only appear in the submitted data when checked
               (Found input) ->
                   case getInputText input of
                     (Right _) -> mkCheckbox i True
                     (Left  (e :: error) ) -> mkCheckbox i False
        where
          mkCheckbox i checked =
              return ( View $ const $ [hamlet|
    $if checked
      <input type="checkbox" id=#{i} name=#{i} value=#{i} checked="checked">
    $else
      <input type="checkbox" id=#{i} name=#{i} value=#{i}>
    |]
                     , return $ Ok (Proved { proofs   = ()
                                           , pos      = unitRange i
                                           , unProved = if checked then True else False
                                           })
                     )

    inputCheckboxes :: (Functor m, Monad m, FormError error, ErrorInputType error ~ input, FormInput input, ToMarkup lbl) =>
                      [(a, lbl)]  -- ^ value, label, initially checked
                    -> (a -> Bool) -- ^ function which indicates if a value should be checked initially
                    -> Form m input error (HtmlUrl url) () [a]
    inputCheckboxes choices isChecked =
        G.inputMulti choices mkCheckboxes isChecked
        where
          mkCheckboxes nm choices' = [hamlet|
    $forall (i, val, lbl, checked) <- choices'
      $if checked
        <input type="checkbox" id=#{i} name=#{nm} value=#{show val} checked="checked">
      $else
        <input type="checkbox" id=#{i} name=#{nm} value=#{show val}>
      <label for=#{i}>#{lbl}
    |]

    inputRadio :: (Functor m, Monad m, FormError error, ErrorInputType error ~ input, FormInput input, ToMarkup lbl) =>
                  [(a, lbl)]  -- ^ value, label, initially checked
               -> (a -> Bool) -- ^ isDefault
               -> Form m input error (HtmlUrl url) () a
    inputRadio choices isDefault =
        G.inputChoice isDefault choices mkRadios
        where
          mkRadios nm choices' = [hamlet|
    $forall (i, val, lbl, checked) <- choices'
      $if checked
        <input type="radio" id=#{i} name=#{nm} value=#{show val} checked="checked">
      $else
        <input type="radio" id=#{i} name=#{nm} value=#{show val}>
      <label for=#{i}>#{lbl}
      <br>
    |]

    select :: (Functor m, Monad m, FormError error, ErrorInputType error ~ input, FormInput input, ToMarkup lbl) =>
                  [(a, lbl)]  -- ^ value, label
               -> (a -> Bool) -- ^ isDefault, must match *exactly one* element in the list of choices
               -> Form m input error (HtmlUrl url) () a
    select choices isDefault  =
        G.inputChoice isDefault choices mkSelect
        where
          mkSelect nm choices' = [hamlet|
    <select name=#{nm}>
      $forall (_, val, lbl, selected) <- choices'
        $if selected
          <option value=#{val} selected="selected">#{lbl}
        $else
          <option value=#{val}>#{lbl}
    |]

    selectMultiple :: (Functor m, Monad m, FormError error, ErrorInputType error ~ input, FormInput input, ToMarkup lbl) =>
                      [(a, lbl)]  -- ^ value, label, initially checked
                   -> (a -> Bool)  -- ^ isSelected initially
                   -> Form m input error (HtmlUrl url) () [a]
    selectMultiple choices isSelected =
        G.inputMulti choices mkSelect isSelected
        where
          mkSelect nm choices' = [hamlet|
    <select name=#{nm} multiple="multiple">
      $forall (_, val, lbl, selected) <- choices'
        $if selected
          <option value=#{val} selected="selected">#{lbl}
        $else
          <option value=#{val}>#{lbl}
    |]

    errorList :: (Monad m, ToMarkup error) =>
                 Form m input error (HtmlUrl url) () ()
    errorList = G.errors mkErrors
        where
          mkErrors []   = [hamlet||]
          mkErrors errs = [hamlet|
    <ul .reform-error-list>
      $forall e <- errs
        <li>#{e}
    |]

    childErrorList :: (Monad m, ToMarkup error) =>
                 Form m input error (HtmlUrl url) () ()
    childErrorList = G.childErrors mkErrors
        where
          mkErrors []   = [hamlet||]
          mkErrors errs = [hamlet|
    <ul .reform-error-list>
      $forall e <- errs
        <li>#{e}
    |]

    br :: Monad m => Form m input error (HtmlUrl url) () ()
    br = view [hamlet|<br>|]

    fieldset :: (Monad m, Functor m, ToMarkup c) =>
                Form m input error c proof a
             -> Form m input error (HtmlUrl url) proof a
    fieldset frm = mapView (\xml -> [hamlet|<fieldset .reform>#{xml}|]) frm

    ol :: (Monad m, Functor m, ToMarkup c) =>
          Form m input error c proof a
       -> Form m input error (HtmlUrl url) proof a
    ol frm = mapView (\xml -> [hamlet|<ol .reform>#{xml}|]) frm

    ul :: (Monad m, Functor m, ToMarkup c) =>
          Form m input error c proof a
       -> Form m input error (HtmlUrl url) proof a
    ul frm = mapView (\xml -> [hamlet|<ul .reform>#{xml}|]) frm

    li :: (Monad m, Functor m, ToMarkup c) =>
          Form m input error c proof a
       -> Form m input error (HtmlUrl url) proof a
    li frm = mapView (\xml -> [hamlet|<li .reform>#{xml}|]) frm

    -- | create @\<form action=action method=\"POST\" enctype=\"multipart/form-data\"\>@
    form :: ToMarkup action =>
            action              -- ^ action url
         -> [(Text,Text)]       -- ^ hidden fields to add to form
         -> HtmlUrl url         -- ^ children
         -> HtmlUrl url
    form action hidden children
        = [hamlet|
    <form action=#{action} method="POST" enctype="multipart/form-data">
      $forall (name, value) <- hidden
        <input type="hidden" name=#{name} value=#{value}>
      ^{children}
    |]