module Text.XML.HaXml.Html.Generate
(
html
, hhead
, htitle
, hbody
, h1, h2, h3, h4
, hpara
, hdiv, hspan, margin
, anchor, makehref, anchorname
, hpre
, hcentre
, hem, htt, hbold
, parens, bullet
, htable, hrow, hcol
, hbr, hhr
, showattr, (!), (?)
, 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
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 "html"
hhead :: [CFilter i] -> CFilter i
hhead = String -> [CFilter i] -> CFilter i
forall i. String -> [CFilter i] -> CFilter i
mkElem "head"
htitle :: [CFilter i] -> CFilter i
htitle = String -> [CFilter i] -> CFilter i
forall i. String -> [CFilter i] -> CFilter i
mkElem "title"
hbody :: [CFilter i] -> CFilter i
hbody = String -> [CFilter i] -> CFilter i
forall i. String -> [CFilter i] -> CFilter i
mkElem "body"
h1 :: [CFilter i] -> CFilter i
h1 = String -> [CFilter i] -> CFilter i
forall i. String -> [CFilter i] -> CFilter i
mkElem "h1"
h2 :: [CFilter i] -> CFilter i
h2 = String -> [CFilter i] -> CFilter i
forall i. String -> [CFilter i] -> CFilter i
mkElem "h2"
h3 :: [CFilter i] -> CFilter i
h3 = String -> [CFilter i] -> CFilter i
forall i. String -> [CFilter i] -> CFilter i
mkElem "h3"
h4 :: [CFilter i] -> CFilter i
h4 = String -> [CFilter i] -> CFilter i
forall i. String -> [CFilter i] -> CFilter i
mkElem "h4"
hpara :: [CFilter i] -> CFilter i
hpara = String -> [CFilter i] -> CFilter i
forall i. String -> [CFilter i] -> CFilter i
mkElem "p"
hpre :: [CFilter i] -> CFilter i
hpre = String -> [CFilter i] -> CFilter i
forall i. String -> [CFilter i] -> CFilter i
mkElem "pre"
hcentre :: [CFilter i] -> CFilter i
hcentre = String -> [CFilter i] -> CFilter i
forall i. String -> [CFilter i] -> CFilter i
mkElem "center"
hem :: [CFilter i] -> CFilter i
hem = String -> [CFilter i] -> CFilter i
forall i. String -> [CFilter i] -> CFilter i
mkElem "em"
htt :: [CFilter i] -> CFilter i
htt = String -> [CFilter i] -> CFilter i
forall i. String -> [CFilter i] -> CFilter i
mkElem "tt"
hbold :: [CFilter i] -> CFilter i
hbold = String -> [CFilter i] -> CFilter i
forall i. String -> [CFilter i] -> CFilter i
mkElem "b"
htable :: [CFilter i] -> CFilter i
htable = String -> [CFilter i] -> CFilter i
forall i. String -> [CFilter i] -> CFilter i
mkElem "table"
hrow :: [CFilter i] -> CFilter i
hrow = String -> [CFilter i] -> CFilter i
forall i. String -> [CFilter i] -> CFilter i
mkElem "tr"
hcol :: [CFilter i] -> CFilter i
hcol = String -> [CFilter i] -> CFilter i
forall i. String -> [CFilter i] -> CFilter i
mkElem "td"
hdiv :: [CFilter i] -> CFilter i
hdiv = String -> [CFilter i] -> CFilter i
forall i. String -> [CFilter i] -> CFilter i
mkElem "div"
hspan :: [CFilter i] -> CFilter i
hspan = String -> [CFilter i] -> CFilter i
forall i. String -> [CFilter i] -> CFilter i
mkElem "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 "div" [("margin-left",("2em"String -> CFilter i
forall i. String -> CFilter i
!)),
("margin-top", ("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 "a"
makehref, anchorname :: CFilter i -> [CFilter i] -> CFilter i
makehref :: CFilter i -> [CFilter i] -> CFilter i
makehref r :: CFilter i
r = [(String, CFilter i)] -> [CFilter i] -> CFilter i
forall i. [(String, CFilter i)] -> [CFilter i] -> CFilter i
anchor [ ("href",CFilter i
r) ]
anchorname :: CFilter i -> [CFilter i] -> CFilter i
anchorname n :: CFilter i
n = [(String, CFilter i)] -> [CFilter i] -> CFilter i
forall i. [(String, CFilter i)] -> [CFilter i] -> CFilter i
anchor [ ("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 "br" []
hhr :: CFilter i
hhr = String -> [CFilter i] -> CFilter i
forall i. String -> [CFilter i] -> CFilter i
mkElem "hr" []
showattr, (!), (?) :: String -> CFilter i
showattr :: String -> CFilter i
showattr n :: 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 f :: CFilter i
f = [CFilter i] -> CFilter i
forall a b. [a -> [b]] -> a -> [b]
cat [ String -> CFilter i
forall i. String -> CFilter i
literal "(", CFilter i
f, String -> CFilter i
forall i. String -> CFilter i
literal ")" ]
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 "M-^U"CFilter i -> [CFilter i] -> [CFilter i]
forall a. a -> [a] -> [a]
:)
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 ws :: Bool
ws s1 :: String
s1 i :: i
i:CRef r :: Reference
r _:CString _ s2 :: String
s2 _:cs :: [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
forall a. [a] -> [a] -> [a]
++Reference -> String
ref Reference
rString -> String -> String
forall a. [a] -> [a] -> [a]
++";"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 (c :: Content i
c:cs :: [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 :: Reference -> String
ref (RefEntity n :: String
n) = String
n
ref (RefChar s :: CharRef
s) = CharRef -> String
forall a. Show a => a -> String
show CharRef
s
cprint :: Content i -> Doc
cprint (CElem e :: Element i
e _) = Element i -> Doc
forall i. Element i -> Doc
element Element i
e
cprint (CString ws :: Bool
ws s :: String
s _) = [Doc] -> Doc
Pretty.cat ((String -> Doc) -> [String] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map String -> Doc
Pretty.text (CharRef -> String -> [String]
fmt 60
((if Bool
ws then String -> String
forall a. a -> a
id else String -> String
deSpace) String
s)))
cprint (CRef r :: Reference
r _) = String -> Doc
Pretty.text ("&"String -> String -> String
forall a. [a] -> [a] -> [a]
++Reference -> String
ref Reference
rString -> String -> String
forall a. [a] -> [a] -> [a]
++";")
cprint (CMisc _ _) = Doc
Pretty.empty
element :: Element i -> Doc
element (Elem n :: QName
n as :: [Attribute]
as []) = String -> Doc
Pretty.text "<" 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 " />"
element (Elem n :: QName
n as :: [Attribute]
as cs :: [Content i]
cs) =
[Doc] -> Doc
Pretty.fcat [ ( String -> Doc
Pretty.text "<" 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 ">")
, CharRef -> Doc -> Doc
Pretty.nest 4 ([Content i] -> Doc
forall i. [Content i] -> Doc
htmlprint [Content i]
cs)
, ( String -> Doc
Pretty.text "</" Doc -> Doc -> Doc
Pretty.<>
String -> Doc
Pretty.text (QName -> String
printableName QName
n) Doc -> Doc -> Doc
Pretty.<>
String -> Doc
Pretty.text ">" )
]
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 (n :: QName
n,v :: AttValue
v@(AttValue _)) =
String -> Doc
Pretty.text " " Doc -> Doc -> Doc
Pretty.<>
String -> Doc
Pretty.text (QName -> String
printableName QName
n) Doc -> Doc -> Doc
Pretty.<>
String -> Doc
Pretty.text "='" 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 "'"
fmt :: CharRef -> String -> [String]
fmt _ [] = []
fmt n :: CharRef
n s :: String
s = let (top :: String
top,bot :: String
bot) = CharRef -> String -> (String, String)
forall a. CharRef -> [a] -> ([a], [a])
splitAt CharRef
n String
s
(word :: String
word,left :: 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 (big :: String
big,rest :: 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 (c :: Char
c:cs :: String
cs) | Char
cChar -> Char -> Bool
forall a. Eq a => a -> a -> Bool
=='\n' = String -> String
deSpace (' '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 p :: a -> Bool
p xs :: [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 _ (ls :: [a]
ls,[]) = ([a]
ls,[])
select q :: a -> Bool
q (ls :: [a]
ls,(y :: a
y:ys :: [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)