Use walk, walkM in place of bottomUp, bottomUpM when possible.

They are significantly faster.
This commit is contained in:
John MacFarlane 2013-08-10 18:45:00 -07:00
parent 9152fa1a95
commit 02a125d0aa
11 changed files with 31 additions and 27 deletions

View file

@ -44,7 +44,7 @@ import Data.List (isInfixOf)
import qualified Data.ByteString.Base64 as B64
import qualified Text.Pandoc.UTF8 as UTF8
import Text.Pandoc.Definition
import Text.Pandoc.Generic (bottomUpM)
import Text.Pandoc.Walk (walkM)
import Text.Pandoc.Shared (fetchItem, warn)
import Text.Pandoc.Options (WriterOptions(..))
import Text.Pandoc.MIME (extensionFromMimeType)
@ -73,7 +73,7 @@ handleImages :: String -- ^ source directory/base URL
-> FilePath -- ^ temp dir to store images
-> Pandoc -- ^ document
-> IO Pandoc
handleImages baseURL tmpdir = bottomUpM (handleImage' baseURL tmpdir)
handleImages baseURL tmpdir = walkM (handleImage' baseURL tmpdir)
handleImage' :: String
-> FilePath

View file

@ -35,7 +35,7 @@ module Text.Pandoc.Readers.LaTeX ( readLaTeX,
) where
import Text.Pandoc.Definition
import Text.Pandoc.Generic
import Text.Pandoc.Walk
import Text.Pandoc.Shared
import Text.Pandoc.Options
import Text.Pandoc.Biblio (processBiblio)
@ -815,7 +815,7 @@ keyvals :: LP [(String, String)]
keyvals = try $ char '[' *> manyTill keyval (char ']')
alltt :: String -> LP Blocks
alltt t = bottomUp strToCode <$> parseFromString blocks
alltt t = walk strToCode <$> parseFromString blocks
(substitute " " "\\ " $ substitute "%" "\\%" $
concat $ intersperse "\\\\\n" $ lines t)
where strToCode (Str s) = Code nullAttr s

View file

@ -42,7 +42,7 @@ import Text.Pandoc.Options
import Text.Pandoc.Readers.HTML ( htmlTag, isBlockTag, isCommentTag )
import Text.Pandoc.XML ( fromEntities )
import Text.Pandoc.Parsing hiding ( nested )
import Text.Pandoc.Generic ( bottomUp )
import Text.Pandoc.Walk ( walk )
import Text.Pandoc.Shared ( stripTrailingNewlines, safeRead )
import Data.Monoid (mconcat, mempty)
import Control.Applicative ((<$>), (<*), (*>), (<$))
@ -342,7 +342,7 @@ preformatted = try $ do
spacesStr _ = False
if F.all spacesStr contents
then return mempty
else return $ B.para $ bottomUp strToCode contents
else return $ B.para $ walk strToCode contents
header :: MWParser Blocks
header = try $ do

View file

@ -518,7 +518,7 @@ isHeaderBlock _ = False
-- | Shift header levels up or down.
headerShift :: Int -> Pandoc -> Pandoc
headerShift n = bottomUp shift
headerShift n = walk shift
where shift :: Block -> Block
shift (Header level attr inner) = Header (level + n) attr inner
shift x = x

View file

@ -45,6 +45,7 @@ import Text.Pandoc.Shared hiding (Element)
import Text.Pandoc.Options
import Text.Pandoc.Readers.TeXMath
import Text.Pandoc.Highlighting ( highlight )
import Text.Pandoc.Walk
import Text.Highlighting.Kate.Types ()
import Text.XML.Light
import Text.TeXMath
@ -108,7 +109,7 @@ writeDocx :: WriterOptions -- ^ Writer options
-> IO BL.ByteString
writeDocx opts doc@(Pandoc meta _) = do
let datadir = writerUserDataDir opts
let doc' = bottomUp (concatMap fixDisplayMath) doc
let doc' = walk fixDisplayMath doc
refArchive <- liftM (toArchive . toLazy) $
case writerReferenceDocx opts of
Just f -> B.readFile f
@ -810,17 +811,17 @@ stripLeadingTrailingSpace = go . reverse . go . reverse
where go (Space:xs) = xs
go xs = xs
fixDisplayMath :: Block -> [Block]
fixDisplayMath :: Block -> Block
fixDisplayMath (Plain lst)
| any isDisplayMath lst && not (all isDisplayMath lst) =
-- chop into several paragraphs so each displaymath is its own
map (Plain . stripLeadingTrailingSpace) $
Div ("",["math"],[]) $ map (Plain . stripLeadingTrailingSpace) $
groupBy (\x y -> (isDisplayMath x && isDisplayMath y) ||
not (isDisplayMath x || isDisplayMath y)) lst
fixDisplayMath (Para lst)
| any isDisplayMath lst && not (all isDisplayMath lst) =
-- chop into several paragraphs so each displaymath is its own
map (Para . stripLeadingTrailingSpace) $
Div ("",["math"],[]) $ map (Para . stripLeadingTrailingSpace) $
groupBy (\x y -> (isDisplayMath x && isDisplayMath y) ||
not (isDisplayMath x || isDisplayMath y)) lst
fixDisplayMath x = [x]
fixDisplayMath x = x

View file

@ -48,7 +48,7 @@ import qualified Text.Pandoc.Shared as Shared
import Text.Pandoc.Builder (fromList, setMeta)
import Text.Pandoc.Options
import Text.Pandoc.Definition
import Text.Pandoc.Generic
import Text.Pandoc.Walk
import Control.Monad.State
import Text.XML.Light hiding (ppTopElement)
import Text.Pandoc.UUID
@ -116,7 +116,7 @@ writeEPUB opts doc@(Pandoc meta _) = do
-- handle pictures
picsRef <- newIORef []
Pandoc _ blocks <- bottomUpM
Pandoc _ blocks <- walkM
(transformInline opts' sourceDir picsRef) doc
pics <- readIORef picsRef
let readPicEntry entries (oldsrc, newsrc) = do
@ -520,7 +520,7 @@ correlateRefs chapterHeaderLevel bs =
-- Replace internal link references using the table produced
-- by correlateRefs.
replaceRefs :: [(String,String)] -> [Block] -> [Block]
replaceRefs refTable = bottomUp replaceOneRef
replaceRefs refTable = walk replaceOneRef
where replaceOneRef x@(Link lab ('#':xs,tit)) =
case lookup xs refTable of
Just url -> Link lab (url,tit)

View file

@ -45,7 +45,7 @@ import qualified Text.XML.Light.Cursor as XC
import Text.Pandoc.Definition
import Text.Pandoc.Options (WriterOptions(..), HTMLMathMethod(..), def)
import Text.Pandoc.Shared (orderedListMarkers)
import Text.Pandoc.Generic (bottomUp)
import Text.Pandoc.Walk
-- | Data to be written at the end of the document:
-- (foot)notes, URLs, references, images.
@ -423,6 +423,10 @@ indent = indentBlock
indentLines ins = let lns = split isLineBreak ins :: [[Inline]]
in intercalate [LineBreak] $ map ((Str spacer):) lns
capitalize :: Inline -> Inline
capitalize (Str xs) = Str $ map toUpper xs
capitalize x = x
-- | Convert a Pandoc's Inline element to FictionBook XML representation.
toXml :: Inline -> FBM [Content]
toXml (Str s) = return [txt s]
@ -432,7 +436,7 @@ toXml (Strong ss) = list `liftM` wrap "strong" ss
toXml (Strikeout ss) = list `liftM` wrap "strikethrough" ss
toXml (Superscript ss) = list `liftM` wrap "sup" ss
toXml (Subscript ss) = list `liftM` wrap "sub" ss
toXml (SmallCaps ss) = cMapM toXml $ bottomUp (map toUpper) ss
toXml (SmallCaps ss) = cMapM toXml $ walk capitalize ss
toXml (Quoted SingleQuote ss) = do -- FIXME: should be language-specific
inner <- cMapM toXml ss
return $ [txt ""] ++ inner ++ [txt ""]

View file

@ -31,7 +31,6 @@ Conversion of 'Pandoc' format into LaTeX.
module Text.Pandoc.Writers.LaTeX ( writeLaTeX ) where
import Text.Pandoc.Definition
import Text.Pandoc.Walk
import Text.Pandoc.Generic
import Text.Pandoc.Shared
import Text.Pandoc.Writers.Shared
import Text.Pandoc.Options
@ -498,7 +497,7 @@ sectionHeader unnumbered ref level lst = do
txt <- inlineListToLaTeX lst
let noNote (Note _) = Str ""
noNote x = x
let lstNoNotes = bottomUp noNote lst
let lstNoNotes = walk noNote lst
let star = if unnumbered then text "*" else empty
-- footnotes in sections don't work unless you specify an optional
-- argument: \section[mysec]{mysec\footnote{blah}}

View file

@ -32,7 +32,7 @@ Markdown: <http://daringfireball.net/projects/markdown/>
-}
module Text.Pandoc.Writers.Markdown (writeMarkdown, writePlain) where
import Text.Pandoc.Definition
import Text.Pandoc.Generic
import Text.Pandoc.Walk
import Text.Pandoc.Templates (renderTemplate')
import Text.Pandoc.Shared
import Text.Pandoc.Writers.Shared
@ -82,7 +82,7 @@ writePlain opts document =
where document' = plainify document
plainify :: Pandoc -> Pandoc
plainify = bottomUp go
plainify = walk go
where go :: Inline -> Inline
go (Emph xs) = SmallCaps xs
go (Strong xs) = SmallCaps xs
@ -643,13 +643,13 @@ inlineToMarkdown opts (Strikeout lst) = do
then "~~" <> contents <> "~~"
else "<s>" <> contents <> "</s>"
inlineToMarkdown opts (Superscript lst) = do
let lst' = bottomUp escapeSpaces lst
let lst' = walk escapeSpaces lst
contents <- inlineListToMarkdown opts lst'
return $ if isEnabled Ext_superscript opts
then "^" <> contents <> "^"
else "<sup>" <> contents <> "</sup>"
inlineToMarkdown opts (Subscript lst) = do
let lst' = bottomUp escapeSpaces lst
let lst' = walk escapeSpaces lst
contents <- inlineListToMarkdown opts lst'
return $ if isEnabled Ext_subscript opts
then "~" <> contents <> "~"

View file

@ -39,7 +39,7 @@ import Text.Pandoc.Shared ( stringify, readDataFile, fetchItem, warn )
import Text.Pandoc.ImageSize ( imageSize, sizeInPoints )
import Text.Pandoc.MIME ( getMimeType )
import Text.Pandoc.Definition
import Text.Pandoc.Generic
import Text.Pandoc.Walk
import Text.Pandoc.Writers.OpenDocument ( writeOpenDocument )
import Control.Monad (liftM)
import Text.Pandoc.XML
@ -63,7 +63,7 @@ writeODT opts doc@(Pandoc meta _) = do
-- handle pictures
picEntriesRef <- newIORef ([] :: [Entry])
let sourceDir = writerSourceDirectory opts
doc' <- bottomUpM (transformPic sourceDir picEntriesRef) doc
doc' <- walkM (transformPic sourceDir picEntriesRef) doc
let newContents = writeOpenDocument opts{writerWrapText = False} doc'
epochtime <- floor `fmap` getPOSIXTime
let contentEntry = toEntry "content.xml" epochtime $ fromStringLazy newContents

View file

@ -34,7 +34,7 @@ import Text.Pandoc.Shared
import Text.Pandoc.Writers.Shared
import Text.Pandoc.Readers.TeXMath
import Text.Pandoc.Templates (renderTemplate')
import Text.Pandoc.Generic (bottomUpM)
import Text.Pandoc.Walk
import Data.List ( isSuffixOf, intercalate )
import Data.Char ( ord, chr, isDigit, toLower )
import System.FilePath ( takeExtension )
@ -70,7 +70,7 @@ rtfEmbedImage x = return x
-- images embedded as encoded binary data.
writeRTFWithEmbeddedImages :: WriterOptions -> Pandoc -> IO String
writeRTFWithEmbeddedImages options doc =
writeRTF options `fmap` bottomUpM rtfEmbedImage doc
writeRTF options `fmap` walkM rtfEmbedImage doc
-- | Convert Pandoc to a string in rich text format.
writeRTF :: WriterOptions -> Pandoc -> String