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