b1c865c · typeable/pandoc

git.iko.soy/typeable/pandoc

Converted current meta information parsing in DocBook to a more extensible version which is aware of the more recent meta representation.

b1c865cMatthew Pickering13 years ago

src/Text/Pandoc/Readers/DocBook.hs+48−34

compare with master

unifiedsplit

@@ -499,24 +499,19 @@ type DB = State DBState

499

500data DBState = DBState{ dbSectionLevel :: Int

501 , dbQuoteType :: QuoteType

502− , dbDocTitle :: Inlines

502+ , dbMeta :: Meta

503− , dbDocAuthors :: [Inlines]

503+ , dbAcceptsMeta :: Bool

504− , dbDocDate :: Inlines

505 , dbBook :: Bool

504 , dbBook :: Bool

506 , dbFigureTitle :: Inlines

505 , dbFigureTitle :: Inlines

507 } deriving Show

506 } deriving Show

508

507

509readDocBook :: ReaderOptions -> String -> Pandoc

508readDocBook :: ReaderOptions -> String -> Pandoc

510−readDocBook _ inp = setTitle (dbDocTitle st')

509+readDocBook _ inp = Pandoc (dbMeta st') (toList $ mconcat bs)

511− $ setAuthors (dbDocAuthors st')

512− $ setDate (dbDocDate st')

513− $ doc $ mconcat bs

514 where (bs, st') = runState (mapM parseBlock $ normalizeTree $ parseXML inp)

510 where (bs, st') = runState (mapM parseBlock $ normalizeTree $ parseXML inp)

515 DBState{ dbSectionLevel = 0

511 DBState{ dbSectionLevel = 0

516 , dbQuoteType = DoubleQuote

512 , dbQuoteType = DoubleQuote

517− , dbDocTitle = mempty

513+ , dbMeta = mempty

518− , dbDocAuthors = []

514+ , dbAcceptsMeta = False

519− , dbDocDate = mempty

520 , dbBook = False

515 , dbBook = False

521 , dbFigureTitle = mempty

516 , dbFigureTitle = mempty

522 }

517 }

@@ -560,6 +555,29 @@ attrValue attr elt =

560named :: String -> Element -> Bool

555named :: String -> Element -> Bool

561named s e = qName (elName e) == s

556named s e = qName (elName e) == s

562

557

558+--

559+

560+acceptingMetadata :: DB a -> DB a

561+acceptingMetadata p = do

562+ modify (\s -> s { dbAcceptsMeta = True } )

563+ res <- p

564+ modify (\s -> s { dbAcceptsMeta = False })

565+ return res

566+

567+checkInMeta :: Monoid a => DB a -> DB a

568+checkInMeta p = do

569+ accepts <- dbAcceptsMeta <$> get

570+ if accepts then p else return mempty

571+

572+

573+

574+addMeta :: ToMetaValue a => String -> a -> DB ()

575+addMeta field val = modify (setMeta field val)

576+

577+instance HasMeta DBState where

578+ setMeta str v s = s {dbMeta = setMeta str v (dbMeta s)}

579+

580+

563isBlockElement :: Content -> Bool

581isBlockElement :: Content -> Bool

564isBlockElement (Elem e) = qName (elName e) `elem` blocktags

582isBlockElement (Elem e) = qName (elName e) `elem` blocktags

565 where blocktags = ["toc","index","para","formalpara","simpara",

583 where blocktags = ["toc","index","para","formalpara","simpara",

@@ -606,6 +624,7 @@ getImage e = do

606getBlocks :: Element -> DB Blocks

624getBlocks :: Element -> DB Blocks

607getBlocks e = mconcat <$> (mapM parseBlock $ elContent e)

625getBlocks e = mconcat <$> (mapM parseBlock $ elContent e)

608

626

627+

609parseBlock :: Content -> DB Blocks

628parseBlock :: Content -> DB Blocks

610parseBlock (Text (CData CDataRaw _ _)) = return mempty -- DOCTYPE

629parseBlock (Text (CData CDataRaw _ _)) = return mempty -- DOCTYPE

611parseBlock (Text (CData _ s _)) = if all isSpace s

630parseBlock (Text (CData _ s _)) = if all isSpace s

@@ -630,7 +649,9 @@ parseBlock (Elem e) =

630 "attribution" -> return mempty

649 "attribution" -> return mempty

631 "titleabbrev" -> return mempty

650 "titleabbrev" -> return mempty

632 "authorinitials" -> return mempty

651 "authorinitials" -> return mempty

633− "title" -> return mempty -- handled by getTitle or sect or figure

652+ "title" -> checkInMeta getTitle >> return mempty -- handled by getTitle or sect or figure

653+ "author" -> checkInMeta getAuthor >> return mempty

654+ "date" -> checkInMeta getDate >> return mempty

634 "bibliography" -> sect 0

655 "bibliography" -> sect 0

635 "bibliodiv" -> sect 1

656 "bibliodiv" -> sect 1

636 "biblioentry" -> parseMixed para (elContent e)

657 "biblioentry" -> parseMixed para (elContent e)

@@ -693,8 +714,8 @@ parseBlock (Elem e) =

693 "figure" -> getFigure e

714 "figure" -> getFigure e

694 "mediaobject" -> para <$> getImage e

715 "mediaobject" -> para <$> getImage e

695 "caption" -> return mempty

716 "caption" -> return mempty

696− "info" -> getTitle >> getAuthors >> getDate >> return mempty

717+ "info" -> metaBlock

697− "articleinfo" -> getTitle >> getAuthors >> getDate >> return mempty

718+ "articleinfo" -> metaBlock

698 "sectioninfo" -> return mempty -- keywords & other metadata

719 "sectioninfo" -> return mempty -- keywords & other metadata

699 "refsectioninfo" -> return mempty -- keywords & other metadata

720 "refsectioninfo" -> return mempty -- keywords & other metadata

700 "refsect1info" -> return mempty -- keywords & other metadata

721 "refsect1info" -> return mempty -- keywords & other metadata

@@ -708,10 +729,10 @@ parseBlock (Elem e) =

708 "chapterinfo" -> return mempty -- keywords & other metadata

729 "chapterinfo" -> return mempty -- keywords & other metadata

709 "glossaryinfo" -> return mempty -- keywords & other metadata

730 "glossaryinfo" -> return mempty -- keywords & other metadata

710 "appendixinfo" -> return mempty -- keywords & other metadata

731 "appendixinfo" -> return mempty -- keywords & other metadata

711− "bookinfo" -> getTitle >> getAuthors >> getDate >> return mempty

732+ "bookinfo" -> metaBlock

712 "article" -> modify (\st -> st{ dbBook = False }) >>

733 "article" -> modify (\st -> st{ dbBook = False }) >>

713− getTitle >> getBlocks e

734+ getBlocks e

714− "book" -> modify (\st -> st{ dbBook = True }) >> getTitle >> getBlocks e

735+ "book" -> modify (\st -> st{ dbBook = True }) >> getBlocks e

715 "table" -> parseTable

736 "table" -> parseTable

716 "informaltable" -> parseTable

737 "informaltable" -> parseTable

717 "literallayout" -> codeBlockWithLang

738 "literallayout" -> codeBlockWithLang

@@ -757,24 +778,16 @@ parseBlock (Elem e) =

757 terms' <- mapM getInlines terms

778 terms' <- mapM getInlines terms

758 items' <- mapM getBlocks items

779 items' <- mapM getBlocks items

759 return (mconcat $ intersperse (str "; ") terms', items')

780 return (mconcat $ intersperse (str "; ") terms', items')

760− getTitle = case filterChild (named "title") e of

781+ getTitle = do

761− Just t -> do

762− tit <- getInlines t

782+ tit <- getInlines e

763− subtit <- case filterChild (named "subtitle") e of

783+ subtit <- case filterChild (named "subtitle") e of

764− Just s -> (text ": " <>) <$>

784+ Just s -> (text ": " <>) <$>

765− getInlines s

785+ getInlines s

766− Nothing -> return mempty

786+ Nothing -> return mempty

767− modify $ \st -> st{dbDocTitle = tit <> subtit}

787+ addMeta "title" (tit <> subtit)

768− Nothing -> return ()

788+

769− getAuthors = do

789+ getAuthor = getInlines e >>= addMeta "author"

770− auths <- mapM getInlines

790+ getDate = getInlines e >>= addMeta "date"

771− $ filterChildren (named "author") e

772− modify $ \st -> st{dbDocAuthors = auths}

773− getDate = case filterChild (named "date") e of

774− Just t -> do

775− dat <- getInlines t

776− modify $ \st -> st{dbDocDate = dat}

777− Nothing -> return ()

778 parseTable = do

791 parseTable = do

779 let isCaption x = named "title" x || named "caption" x

792 let isCaption x = named "title" x || named "caption" x

780 caption <- case filterChild isCaption e of

793 caption <- case filterChild isCaption e of

@@ -836,6 +849,7 @@ parseBlock (Elem e) =

836 b <- getBlocks e

849 b <- getBlocks e

837 modify $ \st -> st{ dbSectionLevel = n - 1 }

850 modify $ \st -> st{ dbSectionLevel = n - 1 }

838 return $ header n' headerText <> b

851 return $ header n' headerText <> b

852+ metaBlock = acceptingMetadata (getBlocks e)

839

853

840getInlines :: Element -> DB Inlines

854getInlines :: Element -> DB Inlines

841getInlines e' = (trimInlines . mconcat) <$> (mapM parseInline $ elContent e')

855getInlines e' = (trimInlines . mconcat) <$> (mapM parseInline $ elContent e')