1{-# LANGUAGE PatternGuards #-} 2{-# LANGUAGE OverloadedStrings #-} 3{- | 4Module : Text.Pandoc.Writers.FB2 5Copyright : Copyright (C) 2011-2012 Sergey Astanin 6 2012-2021 John MacFarlane 7License : GNU GPL, version 2 or above 8 9Maintainer : John MacFarlane 10Stability : alpha 11Portability : portable 12 13Conversion of 'Pandoc' documents to FB2 (FictionBook2) format. 14 15FictionBook is an XML-based e-book format. For more information see: 16<http://www.fictionbook.org/index.php/Eng:XML_Schema_Fictionbook_2.1> 17 18-} 19module Text.Pandoc.Writers.FB2 (writeFB2) where 20 21import Control.Monad (zipWithM) 22import Control.Monad.Except (catchError) 23import Control.Monad.State.Strict (StateT, evalStateT, get, gets, lift, liftM, modify) 24import Data.ByteString.Base64 (encode) 25import Data.Char (isAscii, isControl, isSpace) 26import Data.Either (lefts, rights) 27import Data.List (intercalate) 28import Data.Text (Text, pack) 29import qualified Data.Text as T 30import qualified Data.Text.Encoding as TE 31import Network.HTTP (urlEncode) 32import Text.XML.Light 33import qualified Text.XML.Light as X 34import qualified Text.XML.Light.Cursor as XC 35import qualified Text.XML.Light.Input as XI 36 37import Text.Pandoc.Class.PandocMonad (PandocMonad, report) 38import qualified Text.Pandoc.Class.PandocMonad as P 39import Text.Pandoc.Definition 40import Text.Pandoc.Logging 41import Text.Pandoc.Options (HTMLMathMethod (..), WriterOptions (..), def) 42import Text.Pandoc.Shared (capitalize, isURI, orderedListMarkers, 43 makeSections, tshow, stringify) 44import Text.Pandoc.Writers.Shared (lookupMetaString, toLegacyTable) 45 46-- | Data to be written at the end of the document: 47-- (foot)notes, URLs, references, images. 48data FbRenderState = FbRenderState 49 { footnotes :: [ (Int, Text, [Content]) ] -- ^ #, ID, text 50 , imagesToFetch :: [ (Text, Text) ] -- ^ filename, URL or path 51 , parentListMarker :: Text -- ^ list marker of the parent ordered list 52 , writerOptions :: WriterOptions 53 } deriving (Show) 54 55-- | FictionBook building monad. 56type FBM m = StateT FbRenderState m 57 58newFB :: FbRenderState 59newFB = FbRenderState { footnotes = [], imagesToFetch = [] 60 , parentListMarker = "" 61 , writerOptions = def } 62 63data ImageMode = NormalImage | InlineImage deriving (Eq) 64instance Show ImageMode where 65 show NormalImage = "imageType" 66 show InlineImage = "inlineImageType" 67 68-- | Produce an FB2 document from a 'Pandoc' document. 69writeFB2 :: PandocMonad m 70 => WriterOptions -- ^ conversion options 71 -> Pandoc -- ^ document to convert 72 -> m Text -- ^ FictionBook2 document (not encoded yet) 73writeFB2 opts doc = flip evalStateT newFB $ pandocToFB2 opts doc 74 75pandocToFB2 :: PandocMonad m 76 => WriterOptions 77 -> Pandoc 78 -> FBM m Text 79pandocToFB2 opts (Pandoc meta blocks) = do 80 modify (\s -> s { writerOptions = opts }) 81 desc <- description meta 82 title <- cMapM toXml . docTitle $ meta 83 secs <- renderSections 1 blocks 84 let body = el "body" $ el "title" (el "p" title) : secs 85 notes <- renderFootnotes 86 (imgs,missing) <- get >>= (lift . fetchImages . imagesToFetch) 87 let body' = replaceImagesWithAlt missing body 88 let fb2_xml = el "FictionBook" (fb2_attrs, [desc, body'] ++ notes ++ imgs) 89 return $ pack $ xml_head ++ showContent fb2_xml ++ "\n" 90 where 91 xml_head = "<?xml version=\"1.0\" encoding=\"UTF-8\"?>\n" 92 fb2_attrs = 93 let xmlns = "http://www.gribuser.ru/xml/fictionbook/2.0" 94 xlink = "http://www.w3.org/1999/xlink" 95 in [ uattr "xmlns" xmlns 96 , attr ("xmlns", "l") xlink ] 97 98description :: PandocMonad m => Meta -> FBM m Content 99description meta' = do 100 let genre = case lookupMetaString "genre" meta' of 101 "" -> el "genre" ("unrecognised" :: String) 102 s -> el "genre" (T.unpack s) 103 bt <- booktitle meta' 104 let as = authors meta' 105 dd <- docdate meta' 106 annotation <- case lookupMeta "abstract" meta' of 107 Just (MetaBlocks bs) -> list . el "annotation" <$> cMapM blockToXml (map unPlain bs) 108 _ -> pure mempty 109 let lang = case lookupMeta "lang" meta' of 110 Just (MetaInlines [Str s]) -> [el "lang" $ iso639 s] 111 Just (MetaString s) -> [el "lang" $ iso639 s] 112 _ -> [] 113 where iso639 = T.unpack . T.takeWhile (/= '-') -- Convert BCP 47 to ISO 639 114 let coverimage url = do 115 let img = Image nullAttr mempty (url, "") 116 im <- insertImage InlineImage img 117 return [el "coverpage" im] 118 coverpage <- case lookupMeta "cover-image" meta' of 119 Just (MetaInlines ils) -> coverimage (stringify ils) 120 Just (MetaString s) -> coverimage s 121 _ -> return [] 122 return $ el "description" 123 [ el "title-info" (genre : 124 (as ++ bt ++ annotation ++ dd ++ coverpage ++ lang)) 125 , el "document-info" [el "program-used" ("pandoc" :: String)] 126 ] 127 128booktitle :: PandocMonad m => Meta -> FBM m [Content] 129booktitle meta' = do 130 t <- cMapM toXml . docTitle $ meta' 131 return $ [el "book-title" t | not (null t)] 132 133authors :: Meta -> [Content] 134authors meta' = cMap author (docAuthors meta') 135 136author :: [Inline] -> [Content] 137author ss = 138 let ws = words . cMap plain $ ss 139 email = el "email" <$> take 1 (filter ('@' `elem`) ws) 140 ws' = filter ('@' `notElem`) ws 141 names = case ws' of 142 [nickname] -> [ el "nickname" nickname ] 143 [fname, lname] -> [ el "first-name" fname 144 , el "last-name" lname ] 145 (fname:rest) -> [ el "first-name" fname 146 , el "middle-name" (concat . init $ rest) 147 , el "last-name" (last rest) ] 148 [] -> [] 149 in list $ el "author" (names ++ email) 150 151docdate :: PandocMonad m => Meta -> FBM m [Content] 152docdate meta' = do 153 let ss = docDate meta' 154 d <- cMapM toXml ss 155 return $ [el "date" d | not (null d)] 156 157-- | Divide the stream of blocks into sections and convert to XML 158-- representation. 159renderSections :: PandocMonad m => Int -> [Block] -> FBM m [Content] 160renderSections level blocks = do 161 let blocks' = makeSections False Nothing blocks 162 let isSection (Div (_,"section":_,_) (Header{}:_)) = True 163 isSection _ = False 164 let (initialBlocks, secs) = break isSection blocks' 165 let blocks'' = if null initialBlocks 166 then blocks' 167 else Div ("",["section"],[]) 168 (Header 1 nullAttr mempty : initialBlocks) : secs 169 cMapM (renderSection level) blocks'' 170 171renderSection :: PandocMonad m => Int -> Block -> FBM m [Content] 172renderSection lvl (Div (id',"section":_,_) (Header _ _ title : xs)) = do 173 title' <- if null title 174 then return [] 175 else list . el "title" <$> formatTitle title 176 content <- cMapM (renderSection (lvl + 1)) xs 177 let sectionContent = if T.null id' 178 then el "section" (title' ++ content) 179 else el "section" ([uattr "id" id'], title' ++ content) 180 return [sectionContent] 181renderSection _ b = blockToXml b 182 183-- | Only <p> and <empty-line> are allowed within <title> in FB2. 184formatTitle :: PandocMonad m => [Inline] -> FBM m [Content] 185formatTitle inlines = 186 cMapM (blockToXml . Para) $ split (== LineBreak) inlines 187 188split :: (a -> Bool) -> [a] -> [[a]] 189split _ [] = [] 190split cond xs = let (b,a) = break cond xs 191 in (b:split cond (drop 1 a)) 192 193isLineBreak :: Inline -> Bool 194isLineBreak LineBreak = True 195isLineBreak _ = False 196 197-- | Make another FictionBook body with footnotes. 198renderFootnotes :: PandocMonad m => FBM m [Content] 199renderFootnotes = do 200 fns <- footnotes `liftM` get 201 if null fns 202 then return [] -- no footnotes 203 else return . list $ 204 el "body" ([uattr "name" "notes"], map renderFN (reverse fns)) 205 where 206 renderFN (n, idstr, cs) = 207 let fn_texts = el "title" (el "p" (show n)) : cs 208 in el "section" ([uattr "id" idstr], fn_texts) 209 210-- | Fetch images and encode them for the FictionBook XML. 211-- Return image data and a list of hrefs of the missing images. 212fetchImages :: PandocMonad m => [(Text,Text)] -> m ([Content],[Text]) 213fetchImages links = do 214 imgs <- mapM (uncurry fetchImage) links 215 return (rights imgs, lefts imgs) 216 217-- | Fetch image data from disk or from network and make a <binary> XML section. 218-- Return either (Left hrefOfMissingImage) or (Right xmlContent). 219fetchImage :: PandocMonad m => Text -> Text -> m (Either Text Content) 220fetchImage href link = do 221 mbimg <- 222 case (isURI link, readDataURI link) of 223 (True, Just (mime,_,True,base64)) -> 224 let mime' = T.toLower mime 225 in if mime' == "image/png" || mime' == "image/jpeg" 226 then return (Just (mime',base64)) 227 else return Nothing 228 (True, Just _) -> return Nothing -- not base64-encoded 229 _ -> 230 catchError (do (bs, mbmime) <- P.fetchItem link 231 case mbmime of 232 Nothing -> do 233 report $ CouldNotDetermineMimeType link 234 return Nothing 235 Just mime -> return $ Just (mime, 236 TE.decodeUtf8 $ encode bs)) 237 (\e -> 238 do report $ CouldNotFetchResource link (tshow e) 239 return Nothing) 240 case mbimg of 241 Just (imgtype, imgdata) -> 242 return . Right $ el "binary" 243 ( [uattr "id" href 244 , uattr "content-type" imgtype] 245 , txt imgdata ) 246 _ -> return (Left ("#" <> href)) 247 248 249-- | Extract mime type and encoded data from the Data URI. 250readDataURI :: Text -- ^ URI 251 -> Maybe (Text,Text,Bool,Text) 252 -- ^ Maybe (mime,charset,isBase64,data) 253readDataURI uri = 254 case T.stripPrefix "data:" uri of 255 Nothing -> Nothing 256 Just rest -> 257 let meta = T.takeWhile (/= ',') rest -- without trailing ',' 258 uridata = T.drop (T.length meta + 1) rest 259 parts = T.split (== ';') meta 260 (mime,cs,enc)=foldr upd ("text/plain","US-ASCII",False) parts 261 in Just (mime,cs,enc,uridata) 262 263 where 264 upd str m@(mime,cs,enc) 265 | isMimeType str = (str,cs,enc) 266 | Just str' <- T.stripPrefix "charset=" str = (mime,str',enc) 267 | str == "base64" = (mime,cs,True) 268 | otherwise = m 269 270-- Without parameters like ;charset=...; see RFC 2045, 5.1 271isMimeType :: Text -> Bool 272isMimeType s = 273 case T.split (=='/') s of 274 [mtype,msubtype] -> 275 (T.toLower mtype `elem` types 276 || "x-" `T.isPrefixOf` T.toLower mtype) 277 && T.all valid mtype 278 && T.all valid msubtype 279 _ -> False 280 where 281 types = ["text","image","audio","video","application","message","multipart"] 282 valid c = isAscii c && not (isControl c) && not (isSpace c) && 283 c `notElem` ("()<>@,;:\\\"/[]?=" :: String) 284 285footnoteID :: Int -> Text 286footnoteID i = "n" <> tshow i 287 288mkitem :: PandocMonad m => Text -> [Block] -> FBM m [Content] 289mkitem mrk bs = do 290 pmrk <- gets parentListMarker 291 let nmrk = pmrk <> mrk <> " " 292 modify (\s -> s { parentListMarker = nmrk}) 293 item <- cMapM blockToXml $ plainToPara $ indentBlocks nmrk bs 294 modify (\s -> s { parentListMarker = pmrk }) -- old parent marker 295 return item 296 297-- | Convert a block-level Pandoc's element to FictionBook XML representation. 298blockToXml :: PandocMonad m => Block -> FBM m [Content] 299blockToXml (Plain ss) = cMapM toXml ss -- FIXME: can lead to malformed FB2 300blockToXml (Para [Math DisplayMath formula]) = insertMath NormalImage formula 301-- title beginning with fig: indicates that the image is a figure 302blockToXml (Para [Image atr alt (src,tgt)]) 303 | Just tit <- T.stripPrefix "fig:" tgt 304 = insertImage NormalImage (Image atr alt (src,tit)) 305blockToXml (Para ss) = list . el "p" <$> cMapM toXml ss 306blockToXml (CodeBlock _ s) = return . spaceBeforeAfter . 307 map (el "p" . el "code" . T.unpack) . T.lines $ s 308blockToXml (RawBlock f str) = 309 if f == Format "fb2" 310 then return $ XI.parseXML str 311 else return [] 312blockToXml (Div _ bs) = cMapM blockToXml bs 313blockToXml (BlockQuote bs) = list . el "cite" <$> cMapM blockToXml bs 314blockToXml (LineBlock lns) = 315 list . el "poem" <$> mapM stanza (split null lns) 316 where 317 v xs = el "v" <$> cMapM toXml xs 318 stanza xs = el "stanza" <$> mapM v xs 319blockToXml (OrderedList a bss) = 320 concat <$> zipWithM mkitem markers bss 321 where 322 markers = orderedListMarkers a 323blockToXml (BulletList bss) = 324 cMapM (mkitem "•") bss 325blockToXml (DefinitionList defs) = 326 cMapM mkdef defs 327 where 328 mkdef (term, bss) = do 329 items <- cMapM (cMapM blockToXml . plainToPara . indentBlocks (T.replicate 4 " ")) bss 330 t <- wrap "strong" term 331 return (el "p" t : items) 332blockToXml h@Header{} = do 333 -- should not occur after makeSections, except inside lists/blockquotes 334 report $ BlockNotRendered h 335 return [] 336blockToXml HorizontalRule = return [ el "empty-line" () ] 337blockToXml (Table _ blkCapt specs thead tbody tfoot) = do 338 let (caption, aligns, _, headers, rows) = toLegacyTable blkCapt specs thead tbody tfoot 339 hd <- if null headers then pure [] else (:[]) <$> mkrow "th" headers aligns 340 bd <- mapM (\r -> mkrow "td" r aligns) rows 341 c <- el "emphasis" <$> cMapM toXml caption 342 return [el "table" (hd <> bd), el "p" c] 343 where 344 mkrow :: PandocMonad m => String -> [[Block]] -> [Alignment] -> FBM m Content 345 mkrow tag cells aligns' = 346 el "tr" <$> mapM (mkcell tag) (zip cells aligns') 347 -- 348 mkcell :: PandocMonad m => String -> ([Block], Alignment) -> FBM m Content 349 mkcell tag (cell, align) = do 350 cblocks <- cMapM blockToXml cell 351 return $ el tag ([align_attr align], cblocks) 352 -- 353 align_attr a = Attr (QName "align" Nothing Nothing) (align_str a) 354 align_str AlignLeft = "left" 355 align_str AlignCenter = "center" 356 align_str AlignRight = "right" 357 align_str AlignDefault = "left" 358blockToXml Null = return [] 359 360-- Replace plain text with paragraphs and add line break after paragraphs. 361-- It is used to convert plain text from tight list items to paragraphs. 362plainToPara :: [Block] -> [Block] 363plainToPara [] = [] 364plainToPara (Plain inlines : rest) = 365 Para inlines : plainToPara rest 366plainToPara (Para inlines : rest) = 367 Para inlines : HorizontalRule : plainToPara rest -- HorizontalRule will be converted to <empty-line /> 368plainToPara (p:rest) = p : plainToPara rest 369 370-- Replace plain text with paragraphs 371unPlain :: Block -> Block 372unPlain (Plain inlines) = Para inlines 373unPlain x = x 374 375-- Simulate increased indentation level. Will not really work 376-- for multi-line paragraphs. 377indentPrefix :: Text -> Block -> Block 378indentPrefix spacer = indentBlock 379 where 380 indentBlock (Plain ins) = Plain (Str spacer:ins) 381 indentBlock (Para ins) = Para (Str spacer:ins) 382 indentBlock (CodeBlock a s) = 383 let s' = T.unlines . map (spacer<>) . T.lines $ s 384 in CodeBlock a s' 385 indentBlock (BlockQuote bs) = BlockQuote (map indent bs) 386 indentBlock (Header l attr' ins) = Header l attr' (indentLines ins) 387 indentBlock everythingElse = everythingElse 388 -- indent every (explicit) line 389 indentLines :: [Inline] -> [Inline] 390 indentLines ins = let lns = split isLineBreak ins :: [[Inline]] 391 in intercalate [LineBreak] $ map (Str spacer:) lns 392 393indent :: Block -> Block 394indent = indentPrefix spacer 395 where 396 -- indentation space 397 spacer :: Text 398 spacer = T.replicate 4 " " 399 400indentBlocks :: Text -> [Block] -> [Block] 401indentBlocks _ [] = [] 402indentBlocks prefix (x:xs) = indentPrefix prefix x : map (indentPrefix $ T.replicate (T.length prefix) " ") xs 403 404-- | Convert a Pandoc's Inline element to FictionBook XML representation. 405toXml :: PandocMonad m => Inline -> FBM m [Content] 406toXml (Str s) = return [txt s] 407toXml (Span _ ils) = cMapM toXml ils 408toXml (Emph ss) = list `liftM` wrap "emphasis" ss 409toXml (Underline ss) = list `liftM` wrap "underline" ss 410toXml (Strong ss) = list `liftM` wrap "strong" ss 411toXml (Strikeout ss) = list `liftM` wrap "strikethrough" ss 412toXml (Superscript ss) = list `liftM` wrap "sup" ss 413toXml (Subscript ss) = list `liftM` wrap "sub" ss 414toXml (SmallCaps ss) = cMapM toXml $ capitalize ss 415toXml (Quoted SingleQuote ss) = do -- FIXME: should be language-specific 416 inner <- cMapM toXml ss 417 return $ [txt "‘"] ++ inner ++ [txt "’"] 418toXml (Quoted DoubleQuote ss) = do 419 inner <- cMapM toXml ss 420 return $ [txt "“"] ++ inner ++ [txt "”"] 421toXml (Cite _ ss) = cMapM toXml ss -- FIXME: support citation styles 422toXml (Code _ s) = return [el "code" $ T.unpack s] 423toXml Space = return [txt " "] 424toXml SoftBreak = return [txt "\n"] 425toXml LineBreak = return [txt "\n"] 426toXml (Math _ formula) = insertMath InlineImage formula 427toXml il@(RawInline _ _) = do 428 report $ InlineNotRendered il 429 return [] -- raw TeX and raw HTML are suppressed 430toXml (Link _ text (url,_)) = do 431 ln_text <- cMapM toXml text 432 return [ el "a" ( [ attr ("l","href") url ], ln_text) ] 433toXml img@Image{} = insertImage InlineImage img 434toXml (Note bs) = do 435 fns <- footnotes `liftM` get 436 let n = 1 + length fns 437 let fn_id = footnoteID n 438 fn_desc <- cMapM blockToXml bs 439 modify (\s -> s { footnotes = (n, fn_id, fn_desc) : fns }) 440 let fn_ref = txt $ "[" <> tshow n <> "]" 441 return . list $ el "a" ( [ attr ("l","href") ("#" <> fn_id) 442 , uattr "type" "note" ] 443 , fn_ref ) 444 445insertMath :: PandocMonad m => ImageMode -> Text -> FBM m [Content] 446insertMath immode formula = do 447 htmlMath <- fmap (writerHTMLMathMethod . writerOptions) get 448 case htmlMath of 449 WebTeX url -> do 450 let alt = [Code nullAttr formula] 451 let imgurl = url <> T.pack (urlEncode $ T.unpack formula) 452 let img = Image nullAttr alt (imgurl, "") 453 insertImage immode img 454 _ -> return [el "code" $ T.unpack formula] 455 456insertImage :: PandocMonad m => ImageMode -> Inline -> FBM m [Content] 457insertImage immode (Image _ alt (url,ttl)) = do 458 images <- imagesToFetch `liftM` get 459 let n = 1 + length images 460 let fname = "image" <> tshow n 461 modify (\s -> s { imagesToFetch = (fname, url) : images }) 462 let ttlattr = case (immode, T.null ttl) of 463 (NormalImage, False) -> [ uattr "title" ttl ] 464 _ -> [] 465 return . list $ 466 el "image" $ 467 [ attr ("l","href") ("#" <> fname) 468 , attr ("l","type") (tshow immode) 469 , uattr "alt" (T.pack $ cMap plain alt) ] 470 ++ ttlattr 471insertImage _ _ = error "unexpected inline instead of image" 472 473replaceImagesWithAlt :: [Text] -> Content -> Content 474replaceImagesWithAlt missingHrefs body = 475 let cur = XC.fromContent body 476 cur' = replaceAll cur 477 in XC.toTree . XC.root $ cur' 478 where 479 -- 480 replaceAll :: XC.Cursor -> XC.Cursor 481 replaceAll c = 482 let n = XC.current c 483 c' = if isImage n && isMissing n 484 then XC.modifyContent replaceNode c 485 else c 486 in case XC.nextDF c' of 487 (Just cnext) -> replaceAll cnext 488 Nothing -> c' -- end of document 489 -- 490 isImage :: Content -> Bool 491 isImage (Elem e) = elName e == uname "image" 492 isImage _ = False 493 -- 494 isMissing (Elem img@Element{}) = 495 let imgAttrs = elAttribs img 496 badAttrs = map (attr ("l","href")) missingHrefs 497 in any (`elem` imgAttrs) badAttrs 498 isMissing _ = False 499 -- 500 replaceNode :: Content -> Content 501 replaceNode n@(Elem img@Element{}) = 502 let attrs = elAttribs img 503 alt = getAttrVal attrs (uname "alt") 504 imtype = getAttrVal attrs (qname "l" "type") 505 in case (alt, imtype) of 506 (Just alt', Just imtype') -> 507 if imtype' == show NormalImage 508 then el "p" alt' 509 else txt $ T.pack alt' 510 (Just alt', Nothing) -> txt $ T.pack alt' -- no type attribute 511 _ -> n -- don't replace if alt text is not found 512 replaceNode n = n 513 -- 514 getAttrVal :: [X.Attr] -> QName -> Maybe String 515 getAttrVal attrs name = 516 case filter ((name ==) . attrKey) attrs of 517 (a:_) -> Just (attrVal a) 518 _ -> Nothing 519 520 521-- | Wrap all inlines with an XML tag (given its unqualified name). 522wrap :: PandocMonad m => String -> [Inline] -> FBM m Content 523wrap tagname inlines = el tagname `liftM` cMapM toXml inlines 524 525-- " Create a singleton list. 526list :: a -> [a] 527list = (:[]) 528 529-- | Convert an 'Inline' to plaintext. 530plain :: Inline -> String 531plain (Str s) = T.unpack s 532plain (Emph ss) = cMap plain ss 533plain (Underline ss) = cMap plain ss 534plain (Span _ ss) = cMap plain ss 535plain (Strong ss) = cMap plain ss 536plain (Strikeout ss) = cMap plain ss 537plain (Superscript ss) = cMap plain ss 538plain (Subscript ss) = cMap plain ss 539plain (SmallCaps ss) = cMap plain ss 540plain (Quoted _ ss) = cMap plain ss 541plain (Cite _ ss) = cMap plain ss -- FIXME 542plain (Code _ s) = T.unpack s 543plain Space = " " 544plain SoftBreak = " " 545plain LineBreak = "\n" 546plain (Math _ s) = T.unpack s 547plain (RawInline _ _) = "" 548plain (Link _ text (url,_)) = concat (map plain text ++ [" <", T.unpack url, ">"]) 549plain (Image _ alt _) = cMap plain alt 550plain (Note _) = "" -- FIXME 551 552-- | Create an XML element. 553el :: (Node t) 554 => String -- ^ unqualified element name 555 -> t -- ^ node contents 556 -> Content -- ^ XML content 557el name cs = Elem $ unode name cs 558 559-- | Put empty lines around content 560spaceBeforeAfter :: [Content] -> [Content] 561spaceBeforeAfter cs = 562 let emptyline = el "empty-line" () 563 in [emptyline] ++ cs ++ [emptyline] 564 565-- | Create a plain-text XML content. 566txt :: Text -> Content 567txt s = Text $ CData CDataText (T.unpack s) Nothing 568 569-- | Create an XML attribute with an unqualified name. 570uattr :: String -> Text -> Text.XML.Light.Attr 571uattr name = Attr (uname name) . T.unpack 572 573-- | Create an XML attribute with a qualified name from given namespace. 574attr :: (String, String) -> Text -> Text.XML.Light.Attr 575attr (ns, name) = Attr (qname ns name) . T.unpack 576 577-- | Unqualified name 578uname :: String -> QName 579uname name = QName name Nothing Nothing 580 581-- | Qualified name 582qname :: String -> String -> QName 583qname ns name = QName name Nothing (Just ns) 584 585-- | Abbreviation for 'concatMap'. 586cMap :: (a -> [b]) -> [a] -> [b] 587cMap = concatMap 588 589-- | Monadic equivalent of 'concatMap'. 590cMapM :: (Monad m) => (a -> m [b]) -> [a] -> m [b] 591cMapM f xs = concat `liftM` mapM f xs 592