-- --------------------------------------------------------------------------
{- |
   Module      :  $Header$
   Copyright   :  Copyright (C) 2009 Björn Peemöller, Stefan Roggensack
   License     :  BSD3

   Maintainer  :  {inf6254, inf6509}fh-wedel.de
   Stability   :  experimental
   Portability :  portable
   Version     :  $Id: Main.hs 57 2009-05-29 11:33:59Z inf6254 $

   Helper functions for creating xhtml form elements
-}
-- --------------------------------------------------------------------------
module Hawk.View.Template.Helper.FormHelper
  ( -- Selection
    select
  , multiselect
  , options
  , optionsWithSelected
  , optionsFromString
  , checkbox
  , radio

    -- Input
  , textfield
  , textarea
  , password
  , hidden
  , submit
  , submitWithName
  , fileupload

    -- other
  , form
  , slabel
  , label
  , textlink
  , link
  , linkA
  , image
  ) where

import Hawk.View.Template.Helper.TagHelper

-- --------------------------------------------------------------------------
-- Selection: combobox, checkbox, radio button
-- --------------------------------------------------------------------------

-- | Create a dropdown selection box
select :: String     -- ^ name of the field
       -> XmlTrees   -- ^ options to select
       -> Attributes -- ^ additional 'Attributes' for the select tag
       -> XmlTree
select name opts attrs = contentTag "select" attrs' opts
  where attrs' = attrs ++ [("id", name), ("name", name)]


-- | Create a multiselect dropdown box
multiselect  :: String     -- ^ name of the field
             -> XmlTrees   -- ^ options to select
             -> Attributes -- ^ additional 'Attributes' for the select tag
             -> XmlTree
multiselect name opts attrs = select name opts attrs'
  where attrs' = ("multiple", "multiple") : attrs


-- | Create a list of options
options :: (a -> String)
        -> (a -> String)
        -> [a]
        -> XmlTrees
options showVal showOpt
  = map (\o -> contentTag "option" (attrs o) [mkText $ showOpt o])
  where attrs o = [("value", showVal o)]

-- | Create a list of options for selection
optionsWithSelected :: (Eq a, Show a)
        => (a -> String)  -- ^ function for printing the value
        -> (a -> String)  -- ^ function for printing the label for choosing
        -> a              -- ^ pre-selected value
        -> [a]            -- ^ the value list
        -> XmlTrees
optionsWithSelected showVal showOpt s
  = map (\o -> contentTag "option" (attrs o) [mkText $ showOpt o])
  where
    attrs o    = ("value", showVal o) : selected o
    selected o = [("selected", "selected") | o == s]


-- | Create an option list from a list of 'String' pairs (key, value)
optionsFromString :: [(String, String)] -- ^ the options
                  -> XmlTrees
optionsFromString = map $ \(v, s) -> contentTag "option" [("value", v)] [mkText s]


-- | Create a checkbox field
checkbox :: String     -- ^ name of the field
         -> String     -- ^ value of the field
         -> Bool       -- ^ flag whether the checkbox should be checked
         -> Attributes -- ^ additional 'Attributes'
         -> XmlTree
checkbox name _value checked attrs = input name attrs' --inputWithValue name value attrs'
  where
    attrs' = ("type","checkbox") : checkedAttr checked ++ attrs


-- | Create a radio button.
--   The id will be generated by concatenating the name, an underscore and
--   the value: /name ++ '_':value/. If you want to explicitly set the id
--   just put the id into the 'Attributes'.
radio :: String     -- ^ name of the field
      -> String     -- ^ value of the field
      -> Bool       -- ^ flag whether the radio button should be checked
      -> Attributes -- ^ additional 'Attributes'
      -> XmlTree
radio name value checked attrs = inputWithValue name value attrs'
  where
    attrs' =  ("type", "radio") : checkedAttr checked ++ attrs ++ [("id",name ++ '_':value)]

-- | Create an checked attribute
checkedAttr :: Bool -> [(String, String)]
checkedAttr b = [("checked", "checked") | b]


-- --------------------------------------------------------------------------
-- Input: text, textarea, password, hidden, submit button, fileupload
-- --------------------------------------------------------------------------

-- | Create a text input field
textfield :: String      -- ^ name of the text field
          -> String      -- ^ value of the text field
          -> Attributes  -- ^ additional 'Attributes'
          -> XmlTree
textfield name value attrs = inputWithValue name value attrs'
  where attrs' =  ("type", "text") : attrs


-- | Create a textarea field
textarea :: String     -- ^ name of the textarea field
         -> String     -- ^ value of the textarea field
         -> Attributes -- ^ additional 'Attributes'
         -> XmlTree
textarea name value attrs = contentTag "textarea" attrs' [mkText value]
  where attrs' = attrs ++ [("name", name), ("id", name)]


-- | Create a password field
password :: String -> String -> Attributes -> XmlTree
password name value attrs = inputWithValue name value attrs'
  where attrs' = ("type", "password") : attrs


-- | Create a hidden field
hidden :: String     -- ^ name of the hidden field
       -> String     -- ^ value of the hidden field
       -> Attributes -- ^ additional 'Attributes'
       -> XmlTree
hidden name value attrs = inputWithValue name value attrs'
  where attrs' = ("type", "hidden") : attrs


-- | Create a submit button
submit :: String -> Attributes -> XmlTree
submit value attrs = inputWithValue "commit" value attrs'
  where attrs' = ("type", "submit") : attrs

submitWithName :: String -> String -> Attributes -> XmlTree
submitWithName name value attrs = inputWithValue name value attrs'
  where attrs' = ("type", "submit") : attrs

-- | Create a fileupload field
fileupload :: String -> Attributes -> XmlTree
fileupload name attrs = input name attrs'
  where attrs' =  ("type", "file") : attrs


-- Create a input field with a value
inputWithValue :: String -> String -> Attributes -> XmlTree
inputWithValue name value attrs = input name attrs'
  where attrs' = ("value", value) : attrs


-- Create a input field
input :: String -> Attributes -> XmlTree
input name attrs = tag "input" attrs'
  where attrs' = ("name", name) : ("id", name) : attrs


-- --------------------------------------------------------------------------
-- labels, links, images
-- --------------------------------------------------------------------------

form :: String -> String -> String -> Attributes -> XmlTrees -> XmlTree
form name method action attrs = contentTag "form" attrs'
  where attrs' = ("id", name) : ("method", method) : ("action", action) : attrs

-- | Create a label with the name as value
slabel :: String -> Attributes -> XmlTree
slabel name = label name name


-- | Create a label with name and value
label :: String -> String -> Attributes -> XmlTree
label name value attrs = contentTag "label" attrs' [mkText value]
  where attrs' = ("for", name) : attrs


-- | Create a link with a text to show
textlink :: String -> String -> XmlTree
textlink target content = link target [mkText content]

-- | Create a link with an arbitrary content
link :: String -> XmlTrees -> XmlTree
link target = linkA target []

-- | Create a link with an arbitrary content
linkA :: String -> Attributes -> XmlTrees -> XmlTree
linkA target attrs = contentTag "a" attrs'
  where attrs' = ("href", target) : attrs


-- | Create an image element
image :: String -> String -> Attributes -> XmlTree
image title src attrs = tag "img" attrs'
  where attrs' = [("alt", title), ("title", title), ("src", src)] ++ attrs