@@ -1,8 +1,10 @@
1module Text.Pandoc.Readers.DocBook ( readDocBook ) where
1module Text.Pandoc.Readers.DocBook ( readDocBook ) where
2+import Data.Char (toUpper)
2import Text.Pandoc.Parsing (ParserState(..))
3import Text.Pandoc.Parsing (ParserState(..))
3import Text.Pandoc.Definition
4import Text.Pandoc.Definition
4import Text.Pandoc.Builder
5import Text.Pandoc.Builder
5import Text.XML.Light
6import Text.XML.Light
7+import Text.HTML.TagSoup.Entity (lookupEntity)
6import Data.Monoid
8import Data.Monoid
7import Data.Char (isSpace)
9import Data.Char (isSpace)
8import Control.Monad.State
10import Control.Monad.State
@@ -81,8 +83,8 @@ List of all DocBook tags, with [x] indicating implemented,
81[ ] cmdsynopsis - A syntax summary for a software command
83[ ] cmdsynopsis - A syntax summary for a software command
82[ ] co - The location of a callout embedded in text
84[ ] co - The location of a callout embedded in text
83[x] code - An inline code fragment
85[x] code - An inline code fragment
84−[ ] col - Specifications for a column in an HTML table
86+[x] col - Specifications for a column in an HTML table
85−[ ] colgroup - A group of columns in an HTML table
87+[x] colgroup - A group of columns in an HTML table
86[ ] collab - Identifies a collaborator
88[ ] collab - Identifies a collaborator
87[ ] collabname - The name of a collaborator
89[ ] collabname - The name of a collaborator
88[ ] colophon - Text at the back of a book describing facts about its production
90[ ] colophon - Text at the back of a book describing facts about its production
@@ -116,7 +118,7 @@ List of all DocBook tags, with [x] indicating implemented,
116[ ] editor - The name of the editor of a document
118[ ] editor - The name of the editor of a document
117[x] email - An email address
119[x] email - An email address
118[x] emphasis - Emphasized text
120[x] emphasis - Emphasized text
119−[ ] entry - A cell in a table
121+[x] entry - A cell in a table
120[ ] entrytbl - A subtable appearing in place of an Entry in a table
122[ ] entrytbl - A subtable appearing in place of an Entry in a table
121[ ] envar - A software environment variable
123[ ] envar - A software environment variable
122[ ] epigraph - A short inscription at the beginning of a document or component
124[ ] epigraph - A short inscription at the beginning of a document or component
@@ -258,7 +260,7 @@ List of all DocBook tags, with [x] indicating implemented,
258[ ] ooclass - A class in an object-oriented programming language
260[ ] ooclass - A class in an object-oriented programming language
259[ ] ooexception - An exception in an object-oriented programming language
261[ ] ooexception - An exception in an object-oriented programming language
260[ ] oointerface - An interface in an object-oriented programming language
262[ ] oointerface - An interface in an object-oriented programming language
261−[ ] option - An option for a software command
263+[x] option - An option for a software command
262[ ] optional - Optional information
264[ ] optional - Optional information
263[x] orderedlist - A list in which each entry is marked with a sequentially
265[x] orderedlist - A list in which each entry is marked with a sequentially
264 incremented label
266 incremented label
@@ -296,7 +298,7 @@ List of all DocBook tags, with [x] indicating implemented,
296[ ] productionset - A set of EBNF productions
298[ ] productionset - A set of EBNF productions
297[ ] productname - The formal name of a product
299[ ] productname - The formal name of a product
298[ ] productnumber - A number assigned to a product
300[ ] productnumber - A number assigned to a product
299−[ ] programlisting - A literal listing of all or part of a program
301+[x] programlisting - A literal listing of all or part of a program
300[ ] programlistingco - A program listing with associated areas used in callouts
302[ ] programlistingco - A program listing with associated areas used in callouts
301[ ] prompt - A character or string indicating the start of an input field in
303[ ] prompt - A character or string indicating the start of an input field in
302 a computer display
304 a computer display
@@ -348,7 +350,7 @@ List of all DocBook tags, with [x] indicating implemented,
348[ ] revnumber - A document revision number
350[ ] revnumber - A document revision number
349[ ] revremark - A description of a revision to a document
351[ ] revremark - A description of a revision to a document
350[ ] rhs - The right-hand side of an EBNF production
352[ ] rhs - The right-hand side of an EBNF production
351−[ ] row - A row in a table
353+[x] row - A row in a table
352[ ] sbr - An explicit line break in a command synopsis
354[ ] sbr - An explicit line break in a command synopsis
353[x] screen - Text that a user sees or might see on a computer screen
355[x] screen - Text that a user sees or might see on a computer screen
354[o] screenco - A screen with associated areas used in callouts
356[o] screenco - A screen with associated areas used in callouts
@@ -427,8 +429,8 @@ List of all DocBook tags, with [x] indicating implemented,
427[ ] taskprerequisites - The prerequisites for a task
429[ ] taskprerequisites - The prerequisites for a task
428[ ] taskrelated - Information related to a task
430[ ] taskrelated - Information related to a task
429[ ] tasksummary - A summary of a task
431[ ] tasksummary - A summary of a task
430−[ ] tbody - A wrapper for the rows of a table or informal table
432+[x] tbody - A wrapper for the rows of a table or informal table
431−[ ] td - A table entry in an HTML table
433+[x] td - A table entry in an HTML table
432[x] term - The word or phrase being defined or described in a variable list
434[x] term - The word or phrase being defined or described in a variable list
433[ ] termdef - An inline term definition
435[ ] termdef - An inline term definition
434[ ] tertiary - A tertiary word or phrase in an index term
436[ ] tertiary - A tertiary word or phrase in an index term
@@ -437,9 +439,9 @@ List of all DocBook tags, with [x] indicating implemented,
437[ ] textobject - A wrapper for a text description of an object and its
439[ ] textobject - A wrapper for a text description of an object and its
438 associated meta-information
440 associated meta-information
439[ ] tfoot - A table footer consisting of one or more rows
441[ ] tfoot - A table footer consisting of one or more rows
440−[ ] tgroup - A wrapper for the main content of a table, or part of a table
442+[x] tgroup - A wrapper for the main content of a table, or part of a table
441−[ ] th - A table header entry in an HTML table
443+[x] th - A table header entry in an HTML table
442−[ ] thead - A table header consisting of one or more rows
444+[x] thead - A table header consisting of one or more rows
443[x] tip - A suggestion to the user, set off from the text
445[x] tip - A suggestion to the user, set off from the text
444[x] title - The text of the title of a section of a document or of a formal
446[x] title - The text of the title of a section of a document or of a formal
445 block-level element
447 block-level element
@@ -462,7 +464,7 @@ List of all DocBook tags, with [x] indicating implemented,
462 chapter-like component
464 chapter-like component
463[ ] tocpart - An entry in a table of contents for a part of a book
465[ ] tocpart - An entry in a table of contents for a part of a book
464[ ] token - A unit of information
466[ ] token - A unit of information
465−[ ] tr - A row in an HTML table
467+[x] tr - A row in an HTML table
466[ ] trademark - A trademark
468[ ] trademark - A trademark
467[ ] type - The classification of a value
469[ ] type - The classification of a value
468[x] ulink - A link that addresses its target by means of a URL
470[x] ulink - A link that addresses its target by means of a URL
@@ -552,6 +554,7 @@ parseBlock (Text (CData CDataRaw _ _)) = return mempty -- DOCTYPE
552parseBlock (Text (CData _ s _)) = if all isSpace s
554parseBlock (Text (CData _ s _)) = if all isSpace s
553 then return mempty
555 then return mempty
554 else return $ plain $ text s
556 else return $ plain $ text s
557+parseBlock (CRef _) = return mempty -- TODO need something better here
555parseBlock (Elem e) =
558parseBlock (Elem e) =
556 case qName (elName e) of
559 case qName (elName e) of
557 "para" -> para <$> getInlines e
560 "para" -> para <$> getInlines e
@@ -605,13 +608,13 @@ parseBlock (Elem e) =
605 "article" -> modify (\st -> st{ dbBook = False }) >>
608 "article" -> modify (\st -> st{ dbBook = False }) >>
606 getTitle >> getBlocks e
609 getTitle >> getBlocks e
607 "book" -> modify (\st -> st{ dbBook = True }) >> getTitle >> getBlocks e
610 "book" -> modify (\st -> st{ dbBook = True }) >> getTitle >> getBlocks e
611+ "table" -> parseTable
612+ "informaltable" -> parseTable
608 "screen" -> return $ codeBlock $ strContent e -- TODO attrs
613 "screen" -> return $ codeBlock $ strContent e -- TODO attrs
609 "programlisting" -> return $ codeBlock $ strContent e -- TODO attrs
614 "programlisting" -> return $ codeBlock $ strContent e -- TODO attrs
610 "?xml" -> return mempty
615 "?xml" -> return mempty
611 _ -> getBlocks e
616 _ -> getBlocks e
612 where getBlocks e' = mconcat <$> (mapM parseBlock $ elContent e')
617 where getBlocks e' = mconcat <$> (mapM parseBlock $ elContent e')
613− getInlines e' = (trimInlines . mconcat) <$>
614− (mapM parseInline $ elContent e')
615 skipWhite (Text (CData _ s _):xs) | all isSpace s = skipWhite xs
618 skipWhite (Text (CData _ s _):xs) | all isSpace s = skipWhite xs
616 | otherwise = xs
619 | otherwise = xs
617 skipWhite xs = xs
620 skipWhite xs = xs
@@ -626,20 +629,56 @@ parseBlock (Elem e) =
626 items' <- mapM ((mconcat <$>) . mapM parseBlock)
629 items' <- mapM ((mconcat <$>) . mapM parseBlock)
627 $ map elContent items
630 $ map elContent items
628 return (mconcat $ intersperse (str "; ") defs', items')
631 return (mconcat $ intersperse (str "; ") defs', items')
629− getTitle = case findChild (unqual "title") e of
632+ getTitle = case filterChild (named "title") e of
630 Just t -> do
633 Just t -> do
631 tit <- getInlines t
634 tit <- getInlines t
632 modify $ \st -> st{dbDocTitle = tit}
635 modify $ \st -> st{dbDocTitle = tit}
633 Nothing -> return ()
636 Nothing -> return ()
634 getAuthors = do
637 getAuthors = do
635 auths <- mapM getInlines
638 auths <- mapM getInlines
636− $ findChildren (unqual "author") e
639+ $ filterChildren (named "author") e
637 modify $ \st -> st{dbDocAuthors = auths}
640 modify $ \st -> st{dbDocAuthors = auths}
638− getDate = case findChild (unqual "date") e of
641+ getDate = case filterChild (named "date") e of
639 Just t -> do
642 Just t -> do
640 dat <- getInlines t
643 dat <- getInlines t
641 modify $ \st -> st{dbDocDate = dat}
644 modify $ \st -> st{dbDocDate = dat}
642 Nothing -> return ()
645 Nothing -> return ()
647+ let isCaption x = named "title" x || named "caption" x
648+ caption <- case filterChild isCaption e of
649+ Just t -> getInlines t
650+ Nothing -> return mempty
651+ let e' = maybe e id $ filterChild (named "tgroup") e
652+ let isColspec x = named "colspec" x || named "col" x
653+ let colspecs = case filterChild (named "colgroup") e' of
654+ Just c -> filterChildren isColspec c
655+ _ -> filterChildren isColspec e'
656+ let isRow x = named "row" x || named "tr" x
657+ headrows <- case filterChild (named "thead") e' of
658+ Just h -> case filterChild isRow h of
659+ Just x -> parseRow x
660+ Nothing -> return []
661+ Nothing -> return []
662+ bodyrows <- case filterChild (named "tbody") e' of
663+ Just b -> mapM parseRow
664+ $ filterChildren isRow b
665+ Nothing -> mapM parseRow
666+ $ filterChildren isRow e'
667+ let toAlignment c = case findAttr (unqual "align") c of
668+ Just "left" -> AlignLeft
669+ Just "right" -> AlignRight
670+ Just "center" -> AlignCenter
672+ let aligns = case colspecs of
674+ (maximum $ map length bodyrows)
676+ cs -> map toAlignment cs
677+ return $ table caption
678+ (zip aligns (repeat 0))
680+ isEntry x = named "entry" x || named "td" x || named "th" x
681+ parseRow = mapM getBlocks . filterChildren isEntry
643 sect n = do isbook <- gets dbBook
682 sect n = do isbook <- gets dbBook
644 let n' = if isbook then n + 1 else n
683 let n' = if isbook then n + 1 else n
645 case skipWhite (elContent e) of
684 case skipWhite (elContent e) of
@@ -655,10 +694,14 @@ parseBlock (Elem e) =
655 b <- mconcat <$> (mapM parseBlock body)
694 b <- mconcat <$> (mapM parseBlock body)
656 modify $ \st -> st{ dbSectionLevel = n - 1 }
695 modify $ \st -> st{ dbSectionLevel = n - 1 }
657 return $ h <> b
696 return $ h <> b
658−parseBlock (CRef _) = return mempty
697+
698+getInlines :: Element -> DB Inlines
699+getInlines e' = (trimInlines . mconcat) <$> (mapM parseInline $ elContent e')
660parseInline :: Content -> DB Inlines
701parseInline :: Content -> DB Inlines
661parseInline (Text (CData _ s _)) = return $ text s
702parseInline (Text (CData _ s _)) = return $ text s
703+parseInline (CRef ref) =
704+ return $ maybe (text $ map toUpper ref) (text . (:[])) $ lookupEntity ref
662parseInline (Elem e) =
705parseInline (Elem e) =
663 case qName (elName e) of
706 case qName (elName e) of
664 "subscript" -> subscript <$> innerInlines
707 "subscript" -> subscript <$> innerInlines
@@ -676,6 +719,7 @@ parseInline (Elem e) =
676 "code" -> return $ code $ strContent e -- TODO attrs
719 "code" -> return $ code $ strContent e -- TODO attrs
677 "filename" -> return $ code $ strContent e -- TODO attrs
720 "filename" -> return $ code $ strContent e -- TODO attrs
678 "literal" -> return $ code $ strContent e -- TODO attrs
721 "literal" -> return $ code $ strContent e -- TODO attrs
722+ "option" -> return $ code $ strContent e -- TODO attrs
679 "markup" -> return $ code $ strContent e -- TODO attrs
723 "markup" -> return $ code $ strContent e -- TODO attrs
680 "wordasword" -> emph <$> innerInlines
724 "wordasword" -> emph <$> innerInlines
681 "varname" -> return $ codeWith ("",["varname"],[]) $ strContent e
725 "varname" -> return $ codeWith ("",["varname"],[]) $ strContent e
@@ -700,4 +744,3 @@ parseInline (Elem e) =
700 _ -> innerInlines
744 _ -> innerInlines
701 where innerInlines = (trimInlines . mconcat) <$>
745 where innerInlines = (trimInlines . mconcat) <$>
702 (mapM parseInline $ elContent e)
746 (mapM parseInline $ elContent e)
703−parseInline (CRef _) = return mempty