98d26c2 · typeable/pandoc

git.iko.soy/typeable/pandoc

DocBook, JATS, OPML readers: performance optimization.

With the new XML parser, we can avoid the expensive tree normalization step we used to do. This gives a significant speed boost in docbook and JATS parsing (e.g. 9.7 to 6 ms).

commit98d26c234579a06446a5bef1992ed77bac48a4ac authorJohn MacFarlane <jgm@berkeley.edu> dateThu 18 Feb 2021, 21:24 (6 years ago) parentef642e2

3 files changed+8−64

compare with master

unifiedsplit

src/Text/Pandoc/Readers/DocBook.hs+4−22 src/Text/Pandoc/Readers/JATS.hs+3−21 src/Text/Pandoc/Readers/OPML.hs+1−21

src/Text/Pandoc/Readers/DocBook.hs+4−22

@@ -12,7 +12,7 @@ Conversion of DocBook XML to 'Pandoc' document.

1212-}

1313module Text.Pandoc.Readers.DocBook ( readDocBook ) where

1414import Control.Monad.State.Strict

15−import Data.Char (isSpace, toUpper, isLetter)

15+import Data.Char (isSpace, isLetter)

1616import Data.Default

1717import Data.Either (rights)

1818import Data.Foldable (asum)

@@ -540,8 +540,9 @@ instance Default DBState where

540540

541541readDocBook :: PandocMonad m => ReaderOptions -> Text -> m Pandoc

542542readDocBook _ inp = do

543− tree <- either (throwError . PandocXMLError "") (return . normalizeTree) $

544− parseXMLContents (TL.fromStrict . handleInstructions $ crFilter inp)

543+ tree <- either (throwError . PandocXMLError "") return $

544+ parseXMLContents

545+ (TL.fromStrict . handleInstructions $ crFilter inp)

545546 (bs, st') <- flip runStateT (def{ dbContent = tree }) $ mapM parseBlock tree

546547 return $ Pandoc (dbMeta st') (toList . mconcat $ bs)

547548

@@ -571,25 +572,6 @@ getFigure e = do

571572 modify $ \st -> st{ dbFigureTitle = mempty, dbFigureId = mempty }

572573 return res

573574

574−-- normalize input, consolidating adjacent Text and CRef elements

575−normalizeTree :: [Content] -> [Content]

576−normalizeTree = everywhere (mkT go)

577− where go :: [Content] -> [Content]

578− go (Text (CData CDataRaw _ _):xs) = xs

579− go (Text (CData CDataText s1 z):Text (CData CDataText s2 _):xs) =

580− Text (CData CDataText (s1 <> s2) z):xs

581− go (Text (CData CDataText s1 z):CRef r:xs) =

582− Text (CData CDataText (s1 <> convertEntity r) z):xs

583− go (CRef r:Text (CData CDataText s1 z):xs) =

584− Text (CData CDataText (convertEntity r <> s1) z):xs

585− go (CRef r1:CRef r2:xs) =

586− Text (CData CDataText (convertEntity r1 <>

587− convertEntity r2) Nothing):xs

588− go xs = xs

589−

590−convertEntity :: Text -> Text

591−convertEntity e = maybe (T.map toUpper e) T.pack (lookupEntity $ T.unpack e)

592−

593575-- convenience function to get an attribute value, defaulting to ""

594576attrValue :: Text -> Element -> Text

595577attrValue attr elt =

src/Text/Pandoc/Readers/JATS.hs+3−21

@@ -54,30 +54,11 @@ instance Default JATSState where

5454

5555readJATS :: PandocMonad m => ReaderOptions -> Text -> m Pandoc

5656readJATS _ inp = do

57− tree <- either (throwError . PandocXMLError "")

58− (return . normalizeTree) $

57+ tree <- either (throwError . PandocXMLError "") return $

5958 parseXMLContents (TL.fromStrict $ crFilter inp)

6059 (bs, st') <- flip runStateT (def{ jatsContent = tree }) $ mapM parseBlock tree

6160 return $ Pandoc (jatsMeta st') (toList . mconcat $ bs)

6261

63−-- normalize input, consolidating adjacent Text and CRef elements

64−normalizeTree :: [Content] -> [Content]

65−normalizeTree = everywhere (mkT go)

66− where go :: [Content] -> [Content]

67− go (Text (CData CDataRaw _ _):xs) = xs

68− go (Text (CData CDataText s1 z):Text (CData CDataText s2 _):xs) =

69− Text (CData CDataText (s1 <> s2) z):xs

70− go (Text (CData CDataText s1 z):CRef r:xs) =

71− Text (CData CDataText (s1 <> convertEntity r) z):xs

72− go (CRef r:Text (CData CDataText s1 z):xs) =

73− Text (CData CDataText (convertEntity r <> s1) z):xs

74− go (CRef r1:CRef r2:xs) =

75− Text (CData CDataText (convertEntity r1 <> convertEntity r2) Nothing):xs

76− go xs = xs

77−

78−convertEntity :: Text -> Text

79−convertEntity e = maybe (T.toUpper e) T.pack (lookupEntity $ T.unpack e)

80−

8162-- convenience function to get an attribute value, defaulting to ""

8263attrValue :: Text -> Element -> Text

8364attrValue attr =

@@ -454,7 +435,8 @@ elementToStr x = x

454435

455436parseInline :: PandocMonad m => Content -> JATS m Inlines

456437parseInline (Text (CData _ s _)) = return $ text s

457−parseInline (CRef ref) = return . text . convertEntity $ ref

438+parseInline (CRef ref) = return $ maybe (text $ T.toUpper ref) (text . T.pack)

439+ $ lookupEntity (T.unpack ref)

458440parseInline (Elem e) =

459441 case qName (elName e) of

460442 "italic" -> innerInlines emph

src/Text/Pandoc/Readers/OPML.hs+1−21

@@ -14,12 +14,10 @@ Conversion of OPML to 'Pandoc' document.

1414module Text.Pandoc.Readers.OPML ( readOPML ) where

1515import Control.Monad.State.Strict

1616import Data.Default

17−import Data.Generics

1817import Data.Maybe (fromMaybe)

1918import Data.Text (Text)

2019import qualified Data.Text as T

2120import qualified Data.Text.Lazy as TL

22−import Text.HTML.TagSoup.Entity (lookupEntity)

2321import Text.Pandoc.Builder

2422import Text.Pandoc.Class.PandocMonad (PandocMonad)

2523import Text.Pandoc.Options

@@ -53,7 +51,7 @@ readOPML opts inp = do

5351 (bs, st') <- runStateT

5452 (case parseXMLContents (TL.fromStrict (crFilter inp)) of

5553 Left msg -> throwError $ PandocXMLError "" msg

56− Right ns -> mapM parseBlock $ normalizeTree ns)

54+ Right ns -> mapM parseBlock ns)

5755 def{ opmlOptions = opts }

5856 return $

5957 setTitle (opmlDocTitle st') $

@@ -61,24 +59,6 @@ readOPML opts inp = do

6159 setDate (opmlDocDate st') $

6260 doc $ mconcat bs

6361

64−-- normalize input, consolidating adjacent Text and CRef elements

65−normalizeTree :: [Content] -> [Content]

66−normalizeTree = everywhere (mkT go)

67− where go :: [Content] -> [Content]

68− go (Text (CData CDataRaw _ _):xs) = xs

69− go (Text (CData CDataText s1 z):Text (CData CDataText s2 _):xs) =

70− Text (CData CDataText (s1 <> s2) z):xs

71− go (Text (CData CDataText s1 z):CRef r:xs) =

72− Text (CData CDataText (s1 <> convertEntity r) z):xs

73− go (CRef r:Text (CData CDataText s1 z):xs) =

74− Text (CData CDataText (convertEntity r <> s1) z):xs

75− go (CRef r1:CRef r2:xs) =

76− Text (CData CDataText (convertEntity r1 <> convertEntity r2) Nothing):xs

77− go xs = xs

78−

79−convertEntity :: Text -> Text

80−convertEntity e = maybe (T.toUpper e) T.pack (lookupEntity (T.unpack e))

81−

8262-- convenience function to get an attribute value, defaulting to ""

8363attrValue :: Text -> Element -> Text

8464attrValue attr elt =