-- #hide

module Text.XHtml.Extras where

import Text.XHtml.Internals
import Text.XHtml.Strict.Elements
import Text.XHtml.Strict.Attributes

--
-- * Converting strings to HTML
--

-- | Convert a 'String' to 'Html', converting
--   characters that need to be escaped to HTML entities.
stringToHtml :: String -> Html
stringToHtml = primHtml . stringToHtmlString 

-- | This converts a string, but keeps spaces as non-line-breakable.
lineToHtml :: String -> Html
lineToHtml = primHtml . concatMap htmlizeChar2 . stringToHtmlString 
   where 
      htmlizeChar2 ' ' = " "
      htmlizeChar2 c   = [c]

-- | This converts a string, but keeps spaces as non-line-breakable,
--   and adds line breaks between each of the strings in the input list.
linesToHtml :: [String] -> Html
linesToHtml []     = noHtml
linesToHtml (x:[]) = lineToHtml x
linesToHtml (x:xs) = lineToHtml x +++ br +++ linesToHtml xs

--
-- * Html abbreviations
--

primHtmlChar  :: String -> Html

-- | Copyright sign.
copyright     :: Html

-- | Non-breaking space.
spaceHtml     :: Html
bullet        :: Html


primHtmlChar  = \ x -> primHtml ("&" ++ x ++ ";")
copyright     = primHtmlChar "copy"
spaceHtml     = primHtmlChar "nbsp"
bullet        = primHtmlChar "#149"

-- | Same as 'paragraph'.
p :: Html -> Html
p =  paragraph

--
-- * Hotlinks
--

type URL = String

data HotLink = HotLink {
      hotLinkURL        :: URL,
      hotLinkContents   :: Html,
      hotLinkAttributes :: [HtmlAttr]
      } deriving Show

instance HTML HotLink where
      toHtml hl = anchor ! (href (hotLinkURL hl) : hotLinkAttributes hl)
                      << hotLinkContents hl

instance ADDATTRS HotLink where
      hl ! attr = hl { hotLinkAttributes = hotLinkAttributes hl ++ attr }

hotlink :: URL -> Html -> HotLink
hotlink url h = HotLink {
      hotLinkURL = url,
      hotLinkContents = h,
      hotLinkAttributes = [] }


-- 
-- * Lists
--

-- (Abridged from Erik Meijer's Original Html library)

ordList   :: (HTML a) => [a] -> Html
ordList items = olist << map (li <<) items

unordList :: (HTML a) => [a] -> Html
unordList items = ulist << map (li <<) items

defList   :: (HTML a,HTML b) => [(a,b)] -> Html
defList items
 = dlist << [ [ dterm << dt, ddef << dd ] | (dt,dd) <- items ]

--
-- * Forms
--

widget :: String -> String -> [HtmlAttr] -> Html
widget w n markupAttrs = input ! ([thetype w] ++ ns ++ markupAttrs)
  where ns = if null n then [] else [name n,identifier n]

checkbox :: String -> String -> Html
hidden   :: String -> String -> Html
radio    :: String -> String -> Html
reset    :: String -> String -> Html
submit   :: String -> String -> Html
password :: String           -> Html
textfield :: String          -> Html
afile    :: String           -> Html
clickmap :: String           -> Html

checkbox n v = widget "checkbox" n [value v]
hidden   n v = widget "hidden"   n [value v]
radio    n v = widget "radio"    n [value v]
reset    n v = widget "reset"    n [value v]
submit   n v = widget "submit"   n [value v]
password n   = widget "password" n []
textfield n  = widget "text"     n []
afile    n   = widget "file"     n []
clickmap n   = widget "image"    n []

{-# DEPRECATED menu "menu generates strange XHTML, and is not flexible enough. Roll your own that suits your needs." #-}
menu :: String -> [Html] -> Html
menu n choices
   = select ! [name n] << [ option << p << choice | choice <- choices ]

gui :: String -> Html -> Html
gui act = form ! [action act,method "post"]