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 :: String -> Html
stringToHtml = String -> Html
primHtml (String -> Html) -> (String -> String) -> String -> Html
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String
stringToHtmlString 

-- | This converts a string, but keeps spaces as non-line-breakable.
lineToHtml :: String -> Html
lineToHtml :: String -> Html
lineToHtml = String -> Html
primHtml (String -> Html) -> (String -> String) -> String -> Html
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> String) -> String -> String
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Char -> String
htmlizeChar2 (String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String
stringToHtmlString 
   where 
      htmlizeChar2 :: Char -> String
htmlizeChar2 Char
' ' = String
" "
      htmlizeChar2 Char
c   = [Char
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 :: [String] -> Html
linesToHtml []     = Html
noHtml
linesToHtml (String
x:[]) = String -> Html
lineToHtml String
x
linesToHtml (String
x:[String]
xs) = String -> Html
lineToHtml String
x Html -> Html -> Html
forall a b. (HTML a, HTML b) => a -> b -> Html
+++ Html
br Html -> Html -> Html
forall a b. (HTML a, HTML b) => a -> b -> Html
+++ [String] -> Html
linesToHtml [String]
xs

--
-- * Html abbreviations
--

primHtmlChar  :: String -> Html

-- | Copyright sign.
copyright     :: Html

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


primHtmlChar :: String -> Html
primHtmlChar  = \ String
x -> String -> Html
primHtml (String
"&" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
x String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
";")
copyright :: Html
copyright     = String -> Html
primHtmlChar String
"copy"
spaceHtml :: Html
spaceHtml     = String -> Html
primHtmlChar String
"nbsp"
bullet :: Html
bullet        = String -> Html
primHtmlChar String
"#149"

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

--
-- * Hotlinks
--

type URL = String

data HotLink = HotLink {
      HotLink -> String
hotLinkURL        :: URL,
      HotLink -> Html
hotLinkContents   :: Html,
      HotLink -> [HtmlAttr]
hotLinkAttributes :: [HtmlAttr]
      } deriving Int -> HotLink -> String -> String
[HotLink] -> String -> String
HotLink -> String
(Int -> HotLink -> String -> String)
-> (HotLink -> String)
-> ([HotLink] -> String -> String)
-> Show HotLink
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
$cshowsPrec :: Int -> HotLink -> String -> String
showsPrec :: Int -> HotLink -> String -> String
$cshow :: HotLink -> String
show :: HotLink -> String
$cshowList :: [HotLink] -> String -> String
showList :: [HotLink] -> String -> String
Show

instance HTML HotLink where
      toHtml :: HotLink -> Html
toHtml HotLink
hl = Html -> Html
anchor (Html -> Html) -> [HtmlAttr] -> Html -> Html
forall a. ADDATTRS a => a -> [HtmlAttr] -> a
! (String -> HtmlAttr
href (HotLink -> String
hotLinkURL HotLink
hl) HtmlAttr -> [HtmlAttr] -> [HtmlAttr]
forall a. a -> [a] -> [a]
: HotLink -> [HtmlAttr]
hotLinkAttributes HotLink
hl)
                      (Html -> Html) -> Html -> Html
forall a b. HTML a => (Html -> b) -> a -> b
<< HotLink -> Html
hotLinkContents HotLink
hl

instance ADDATTRS HotLink where
      HotLink
hl ! :: HotLink -> [HtmlAttr] -> HotLink
! [HtmlAttr]
attr = HotLink
hl { hotLinkAttributes :: [HtmlAttr]
hotLinkAttributes = HotLink -> [HtmlAttr]
hotLinkAttributes HotLink
hl [HtmlAttr] -> [HtmlAttr] -> [HtmlAttr]
forall a. [a] -> [a] -> [a]
++ [HtmlAttr]
attr }

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


-- 
-- * Lists
--

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

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

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

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

--
-- * Forms
--

widget :: String -> String -> [HtmlAttr] -> Html
widget :: String -> String -> [HtmlAttr] -> Html
widget String
w String
n [HtmlAttr]
attrs = Html
input Html -> [HtmlAttr] -> Html
forall a. ADDATTRS a => a -> [HtmlAttr] -> a
! ([String -> HtmlAttr
thetype String
w] [HtmlAttr] -> [HtmlAttr] -> [HtmlAttr]
forall a. [a] -> [a] -> [a]
++ [HtmlAttr]
ns [HtmlAttr] -> [HtmlAttr] -> [HtmlAttr]
forall a. [a] -> [a] -> [a]
++ [HtmlAttr]
attrs)
  where ns :: [HtmlAttr]
ns = if String -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
n then [] else [String -> HtmlAttr
name String
n,String -> HtmlAttr
identifier String
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 :: String -> String -> Html
checkbox String
n String
v = String -> String -> [HtmlAttr] -> Html
widget String
"checkbox" String
n [String -> HtmlAttr
value String
v]
hidden :: String -> String -> Html
hidden   String
n String
v = String -> String -> [HtmlAttr] -> Html
widget String
"hidden"   String
n [String -> HtmlAttr
value String
v]
radio :: String -> String -> Html
radio    String
n String
v = String -> String -> [HtmlAttr] -> Html
widget String
"radio"    String
n [String -> HtmlAttr
value String
v]
reset :: String -> String -> Html
reset    String
n String
v = String -> String -> [HtmlAttr] -> Html
widget String
"reset"    String
n [String -> HtmlAttr
value String
v]
submit :: String -> String -> Html
submit   String
n String
v = String -> String -> [HtmlAttr] -> Html
widget String
"submit"   String
n [String -> HtmlAttr
value String
v]
password :: String -> Html
password String
n   = String -> String -> [HtmlAttr] -> Html
widget String
"password" String
n []
textfield :: String -> Html
textfield String
n  = String -> String -> [HtmlAttr] -> Html
widget String
"text"     String
n []
afile :: String -> Html
afile    String
n   = String -> String -> [HtmlAttr] -> Html
widget String
"file"     String
n []
clickmap :: String -> Html
clickmap String
n   = String -> String -> [HtmlAttr] -> Html
widget String
"image"    String
n []

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

gui :: String -> Html -> Html
gui :: String -> Html -> Html
gui String
act = Html -> Html
form (Html -> Html) -> [HtmlAttr] -> Html -> Html
forall a. ADDATTRS a => a -> [HtmlAttr] -> a
! [String -> HtmlAttr
action String
act,String -> HtmlAttr
method String
"post"]