-- | These are just some common abbreviations for generating HTML
--   content within the XML transformation framework defined
--   by "Text.Xml.HaXml.Combinators".
module Text.XML.HaXml.Html.Generate
  ( -- * HTML construction filters
  -- ** Containers
    html
  , hhead
  , htitle
  , hbody
  , h1, h2, h3, h4
  , hpara
  , hdiv, hspan, margin
  -- ** Anchors
  , anchor, makehref, anchorname
  -- ** Text style
  , hpre
  , hcentre
  , hem, htt, hbold
  , parens, bullet
  -- ** Tables
  , htable, hrow, hcol
  -- ** Breaks, lines
  , hbr, hhr
  -- ** Attributes
  , showattr, (!), (?)
  -- * A simple HTML pretty-printer
  , htmlprint
  ) where

import Data.Char (isSpace)

import Text.XML.HaXml.Types
import Text.XML.HaXml.Namespaces
import Text.XML.HaXml.Combinators
import qualified Text.PrettyPrint.HughesPJ as Pretty

---- Constructor functions

html, hhead, htitle, hbody, h1, h2, h3, h4, hpara, hpre, hcentre,
    hem, htt, hbold, htable, hrow, hcol, hdiv, hspan, margin
       :: [CFilter i] -> CFilter i
html :: [CFilter i] -> CFilter i
html    = String -> [CFilter i] -> CFilter i
forall i. String -> [CFilter i] -> CFilter i
mkElem String
"html"
hhead :: [CFilter i] -> CFilter i
hhead   = String -> [CFilter i] -> CFilter i
forall i. String -> [CFilter i] -> CFilter i
mkElem String
"head"
htitle :: [CFilter i] -> CFilter i
htitle  = String -> [CFilter i] -> CFilter i
forall i. String -> [CFilter i] -> CFilter i
mkElem String
"title"
hbody :: [CFilter i] -> CFilter i
hbody   = String -> [CFilter i] -> CFilter i
forall i. String -> [CFilter i] -> CFilter i
mkElem String
"body"
h1 :: [CFilter i] -> CFilter i
h1      = String -> [CFilter i] -> CFilter i
forall i. String -> [CFilter i] -> CFilter i
mkElem String
"h1"
h2 :: [CFilter i] -> CFilter i
h2      = String -> [CFilter i] -> CFilter i
forall i. String -> [CFilter i] -> CFilter i
mkElem String
"h2"
h3 :: [CFilter i] -> CFilter i
h3      = String -> [CFilter i] -> CFilter i
forall i. String -> [CFilter i] -> CFilter i
mkElem String
"h3"
h4 :: [CFilter i] -> CFilter i
h4      = String -> [CFilter i] -> CFilter i
forall i. String -> [CFilter i] -> CFilter i
mkElem String
"h4"
hpara :: [CFilter i] -> CFilter i
hpara   = String -> [CFilter i] -> CFilter i
forall i. String -> [CFilter i] -> CFilter i
mkElem String
"p"
hpre :: [CFilter i] -> CFilter i
hpre    = String -> [CFilter i] -> CFilter i
forall i. String -> [CFilter i] -> CFilter i
mkElem String
"pre"
hcentre :: [CFilter i] -> CFilter i
hcentre = String -> [CFilter i] -> CFilter i
forall i. String -> [CFilter i] -> CFilter i
mkElem String
"center"
hem :: [CFilter i] -> CFilter i
hem     = String -> [CFilter i] -> CFilter i
forall i. String -> [CFilter i] -> CFilter i
mkElem String
"em"
htt :: [CFilter i] -> CFilter i
htt     = String -> [CFilter i] -> CFilter i
forall i. String -> [CFilter i] -> CFilter i
mkElem String
"tt"
hbold :: [CFilter i] -> CFilter i
hbold   = String -> [CFilter i] -> CFilter i
forall i. String -> [CFilter i] -> CFilter i
mkElem String
"b"

htable :: [CFilter i] -> CFilter i
htable = String -> [CFilter i] -> CFilter i
forall i. String -> [CFilter i] -> CFilter i
mkElem String
"table"
hrow :: [CFilter i] -> CFilter i
hrow   = String -> [CFilter i] -> CFilter i
forall i. String -> [CFilter i] -> CFilter i
mkElem String
"tr"
hcol :: [CFilter i] -> CFilter i
hcol   = String -> [CFilter i] -> CFilter i
forall i. String -> [CFilter i] -> CFilter i
mkElem String
"td"

hdiv :: [CFilter i] -> CFilter i
hdiv   = String -> [CFilter i] -> CFilter i
forall i. String -> [CFilter i] -> CFilter i
mkElem String
"div"
hspan :: [CFilter i] -> CFilter i
hspan  = String -> [CFilter i] -> CFilter i
forall i. String -> [CFilter i] -> CFilter i
mkElem String
"span"
margin :: [CFilter i] -> CFilter i
margin = String -> [(String, CFilter i)] -> [CFilter i] -> CFilter i
forall i.
String -> [(String, CFilter i)] -> [CFilter i] -> CFilter i
mkElemAttr String
"div" [(String
"margin-left",(String
"2em"String -> CFilter i
forall i. String -> CFilter i
!)),
                           (String
"margin-top", (String
"1em"String -> CFilter i
forall i. String -> CFilter i
!))]

anchor      :: [(String, CFilter i)] -> [CFilter i] -> CFilter  i
anchor :: [(String, CFilter i)] -> [CFilter i] -> CFilter i
anchor       = String -> [(String, CFilter i)] -> [CFilter i] -> CFilter i
forall i.
String -> [(String, CFilter i)] -> [CFilter i] -> CFilter i
mkElemAttr String
"a"

makehref, anchorname :: CFilter i -> [CFilter i] -> CFilter i
makehref :: CFilter i -> [CFilter i] -> CFilter i
makehref CFilter i
r   = [(String, CFilter i)] -> [CFilter i] -> CFilter i
forall i. [(String, CFilter i)] -> [CFilter i] -> CFilter i
anchor [ (String
"href",CFilter i
r) ]
anchorname :: CFilter i -> [CFilter i] -> CFilter i
anchorname CFilter i
n = [(String, CFilter i)] -> [CFilter i] -> CFilter i
forall i. [(String, CFilter i)] -> [CFilter i] -> CFilter i
anchor [ (String
"name",CFilter i
n) ]


hbr, hhr :: CFilter i
hbr :: CFilter i
hbr       = String -> [CFilter i] -> CFilter i
forall i. String -> [CFilter i] -> CFilter i
mkElem String
"br" []
hhr :: CFilter i
hhr       = String -> [CFilter i] -> CFilter i
forall i. String -> [CFilter i] -> CFilter i
mkElem String
"hr" []


showattr, (!), (?) :: String -> CFilter i
showattr :: String -> CFilter i
showattr String
n = String -> (String -> CFilter i) -> CFilter i
forall i. String -> (String -> CFilter i) -> CFilter i
find String
n String -> CFilter i
forall i. String -> CFilter i
literal
(!) = String -> CFilter i
forall i. String -> CFilter i
literal
? :: String -> CFilter i
(?) = String -> CFilter i
forall i. String -> CFilter i
showattr

parens :: CFilter i -> CFilter i
parens :: CFilter i -> CFilter i
parens CFilter i
f = [CFilter i] -> CFilter i
forall a b. [a -> [b]] -> a -> [b]
cat [ String -> CFilter i
forall i. String -> CFilter i
literal String
"(", CFilter i
f, String -> CFilter i
forall i. String -> CFilter i
literal String
")" ]

bullet :: [CFilter i] -> CFilter i
bullet :: [CFilter i] -> CFilter i
bullet = [CFilter i] -> CFilter i
forall a b. [a -> [b]] -> a -> [b]
cat ([CFilter i] -> CFilter i)
-> ([CFilter i] -> [CFilter i]) -> [CFilter i] -> CFilter i
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String -> CFilter i
forall i. String -> CFilter i
literal String
"M-^U"CFilter i -> [CFilter i] -> [CFilter i]
forall a. a -> [a] -> [a]
:)


---- Printing function

-- htmlprint :: [Content] -> String
-- htmlprint = concatMap cprint
--   where
--   cprint (CElem e _) = elem e
--   cprint (CString _ s) = s
--   cprint (CMisc m) = ""
--
--   elem (Elem n as []) = "\n<"++n++attrs as++" />"
--   elem (Elem n as cs) = "\n<"++n++attrs as++">"++htmlprint cs++"\n</"++n++">"
--
--   attrs = concatMap attr
--   attr (n,v) = " "++n++"='"++v++"'"


htmlprint :: [Content i] -> Pretty.Doc
htmlprint :: [Content i] -> Doc
htmlprint = [Doc] -> Doc
Pretty.cat ([Doc] -> Doc) -> ([Content i] -> [Doc]) -> [Content i] -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Content i -> Doc) -> [Content i] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map Content i -> Doc
forall i. Content i -> Doc
cprint ([Content i] -> [Doc])
-> ([Content i] -> [Content i]) -> [Content i] -> [Doc]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Content i] -> [Content i]
forall i. [Content i] -> [Content i]
foldrefs
  where
  foldrefs :: [Content i] -> [Content i]
foldrefs [] = []
  foldrefs (CString Bool
ws String
s1 i
i:CRef Reference
r i
_:CString Bool
_ String
s2 i
_:[Content i]
cs) =
              Bool -> String -> i -> Content i
forall i. Bool -> String -> i -> Content i
CString Bool
ws (String
s1String -> String -> String
forall a. [a] -> [a] -> [a]
++String
"&"String -> String -> String
forall a. [a] -> [a] -> [a]
++Reference -> String
ref Reference
rString -> String -> String
forall a. [a] -> [a] -> [a]
++String
";"String -> String -> String
forall a. [a] -> [a] -> [a]
++String
s2) i
iContent i -> [Content i] -> [Content i]
forall a. a -> [a] -> [a]
: [Content i] -> [Content i]
foldrefs [Content i]
cs
  foldrefs (Content i
c:[Content i]
cs) = Content i
c Content i -> [Content i] -> [Content i]
forall a. a -> [a] -> [a]
: [Content i] -> [Content i]
foldrefs [Content i]
cs

--ref (RefEntity (EntityRef n)) = n     -- Actually, should look-up symtable.
--ref (RefChar (CharRef s)) = s
  ref :: Reference -> String
ref (RefEntity String
n) = String
n -- Actually, should look-up symtable.
  ref (RefChar CharRef
s) = CharRef -> String
forall a. Show a => a -> String
show CharRef
s

  cprint :: Content i -> Doc
cprint (CElem Element i
e i
_)      = Element i -> Doc
forall i. Element i -> Doc
element Element i
e
  cprint (CString Bool
ws String
s i
_) = [Doc] -> Doc
Pretty.cat ((String -> Doc) -> [String] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map String -> Doc
Pretty.text (CharRef -> String -> [String]
fmt CharRef
60
                                             ((if Bool
ws then String -> String
forall a. a -> a
id else String -> String
deSpace) String
s)))
  cprint (CRef Reference
r i
_)       = String -> Doc
Pretty.text (String
"&"String -> String -> String
forall a. [a] -> [a] -> [a]
++Reference -> String
ref Reference
rString -> String -> String
forall a. [a] -> [a] -> [a]
++String
";")
  cprint (CMisc Misc
_ i
_)      = Doc
Pretty.empty

  element :: Element i -> Doc
element (Elem QName
n [Attribute]
as []) = String -> Doc
Pretty.text String
"<"               Doc -> Doc -> Doc
Pretty.<>
                           String -> Doc
Pretty.text (QName -> String
printableName QName
n) Doc -> Doc -> Doc
Pretty.<>
                           [Attribute] -> Doc
attrs [Attribute]
as                      Doc -> Doc -> Doc
Pretty.<>
                           String -> Doc
Pretty.text String
" />"
  element (Elem QName
n [Attribute]
as [Content i]
cs) =
                    --  ( Pretty.text "<"   Pretty.<>
                    --    Pretty.text n     Pretty.<>
                    --    attrs as          Pretty.<>
                    --    Pretty.text ">")  Pretty.$$
                    --  Pretty.nest 6 (htmlprint cs)  Pretty.$$
                    --  ( Pretty.text "</"  Pretty.<>
                    --    Pretty.text n     Pretty.<>
                    --    Pretty.text ">" )
                        [Doc] -> Doc
Pretty.fcat [ ( String -> Doc
Pretty.text String
"<"               Doc -> Doc -> Doc
Pretty.<>
                                        String -> Doc
Pretty.text (QName -> String
printableName QName
n) Doc -> Doc -> Doc
Pretty.<>
                                        [Attribute] -> Doc
attrs [Attribute]
as                      Doc -> Doc -> Doc
Pretty.<>
                                        String -> Doc
Pretty.text String
">")
                                    , CharRef -> Doc -> Doc
Pretty.nest CharRef
4 ([Content i] -> Doc
forall i. [Content i] -> Doc
htmlprint [Content i]
cs)
                                    , ( String -> Doc
Pretty.text String
"</"              Doc -> Doc -> Doc
Pretty.<>
                                        String -> Doc
Pretty.text (QName -> String
printableName QName
n) Doc -> Doc -> Doc
Pretty.<>
                                        String -> Doc
Pretty.text String
">" )
                                    ]

  attrs :: [Attribute] -> Doc
attrs = [Doc] -> Doc
Pretty.cat ([Doc] -> Doc) -> ([Attribute] -> [Doc]) -> [Attribute] -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Attribute -> Doc) -> [Attribute] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map Attribute -> Doc
attribute
  attribute :: Attribute -> Doc
attribute (QName
n,v :: AttValue
v@(AttValue [Either String Reference]
_)) =
               String -> Doc
Pretty.text String
" "               Doc -> Doc -> Doc
Pretty.<>
               String -> Doc
Pretty.text (QName -> String
printableName QName
n) Doc -> Doc -> Doc
Pretty.<>
               String -> Doc
Pretty.text String
"='"              Doc -> Doc -> Doc
Pretty.<>
               String -> Doc
Pretty.text (AttValue -> String
forall a. Show a => a -> String
show AttValue
v)          Doc -> Doc -> Doc
Pretty.<>
               String -> Doc
Pretty.text String
"'"

  fmt :: CharRef -> String -> [String]
fmt CharRef
_ [] = []
  fmt CharRef
n String
s  = let (String
top,String
bot) = CharRef -> String -> (String, String)
forall a. CharRef -> [a] -> ([a], [a])
splitAt CharRef
n String
s
                 (String
word,String
left) = (Char -> Bool) -> String -> (String, String)
forall a. (a -> Bool) -> [a] -> ([a], [a])
keepUntil Char -> Bool
isSpace (String -> String
forall a. [a] -> [a]
reverse String
top)
             in if String -> CharRef
forall (t :: * -> *) a. Foldable t => t a -> CharRef
length String
top CharRef -> CharRef -> Bool
forall a. Ord a => a -> a -> Bool
< CharRef
n then [String
s]
                else if Bool -> Bool
not (String -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
left) then
                     String -> String
forall a. [a] -> [a]
reverse String
leftString -> [String] -> [String]
forall a. a -> [a] -> [a]
: CharRef -> String -> [String]
fmt CharRef
n (String
wordString -> String -> String
forall a. [a] -> [a] -> [a]
++String
bot)
                else let (String
big,String
rest) = (Char -> Bool) -> String -> (String, String)
forall a. (a -> Bool) -> [a] -> ([a], [a])
keepUntil Char -> Bool
isSpace String
s
                     in String -> String
forall a. [a] -> [a]
reverse String
bigString -> [String] -> [String]
forall a. a -> [a] -> [a]
: CharRef -> String -> [String]
fmt CharRef
n String
rest

  deSpace :: String -> String
deSpace []     = []
  deSpace (Char
c:String
cs) | Char
cChar -> Char -> Bool
forall a. Eq a => a -> a -> Bool
==Char
'\n'   = String -> String
deSpace (Char
' 'Char -> String -> String
forall a. a -> [a] -> [a]
:String
cs)
                 | Char -> Bool
isSpace Char
c = Char
c Char -> String -> String
forall a. a -> [a] -> [a]
: String -> String
deSpace ((Char -> Bool) -> String -> String
forall a. (a -> Bool) -> [a] -> [a]
dropWhile Char -> Bool
isSpace String
cs)
                 | Bool
otherwise = Char
c Char -> String -> String
forall a. a -> [a] -> [a]
: String -> String
deSpace String
cs

  keepUntil :: (a -> Bool) -> [a] -> ([a], [a])
keepUntil a -> Bool
p [a]
xs = (a -> Bool) -> ([a], [a]) -> ([a], [a])
forall a. (a -> Bool) -> ([a], [a]) -> ([a], [a])
select a -> Bool
p ([],[a]
xs)
      where select :: (a -> Bool) -> ([a], [a]) -> ([a], [a])
select a -> Bool
_ ([a]
ls,[])     = ([a]
ls,[])
            select a -> Bool
q ([a]
ls,(a
y:[a]
ys)) | a -> Bool
q a
y       = ([a]
ls,a
ya -> [a] -> [a]
forall a. a -> [a] -> [a]
:[a]
ys)
                                 | Bool
otherwise = (a -> Bool) -> ([a], [a]) -> ([a], [a])
select a -> Bool
q (a
ya -> [a] -> [a]
forall a. a -> [a] -> [a]
:[a]
ls,[a]
ys)