From 10d85f8b0b31f117f79e53d2c50cf20d0fd0fab1 Mon Sep 17 00:00:00 2001 From: John MacFarlane Date: Fri, 24 Dec 2010 13:39:27 -0800 Subject: Use functions from Text.Pandoc.Generic instead of processWith(M). --- src/Text/Pandoc/Biblio.hs | 11 ++++++----- src/Text/Pandoc/Parsing.hs | 3 ++- src/Text/Pandoc/Readers/Markdown.hs | 3 ++- src/Text/Pandoc/Shared.hs | 9 +++++---- src/Text/Pandoc/Writers/EPUB.hs | 3 ++- src/Text/Pandoc/Writers/LaTeX.hs | 3 ++- src/Text/Pandoc/Writers/Markdown.hs | 7 ++++--- src/Text/Pandoc/Writers/ODT.hs | 3 ++- 8 files changed, 25 insertions(+), 17 deletions(-) (limited to 'src/Text/Pandoc') diff --git a/src/Text/Pandoc/Biblio.hs b/src/Text/Pandoc/Biblio.hs index a6c87fcbc..b9c3b6c81 100644 --- a/src/Text/Pandoc/Biblio.hs +++ b/src/Text/Pandoc/Biblio.hs @@ -36,6 +36,7 @@ import qualified Data.Map as M import Text.CSL hiding ( Cite(..), Citation(..) ) import qualified Text.CSL as CSL ( Cite(..) ) import Text.Pandoc.Definition +import Text.Pandoc.Generic import Text.Pandoc.Shared (stringify) import Text.ParserCombinators.Parsec import Control.Monad @@ -47,7 +48,7 @@ processBiblio cslfile r p = if null r then return p else do csl <- readCSLFile cslfile - p' <- processWithM setHash p + p' <- bottomUpM setHash p let (nts,grps) = if styleClass csl == "note" then let cits = queryWith getCite p' ncits = map (queryWith getCite) $ queryWith getNote p' @@ -58,7 +59,7 @@ processBiblio cslfile r p map (map toCslCite) grps) cits_map = M.fromList $ zip grps (citations result) biblioList = map (renderPandoc' csl) (bibliography result) - Pandoc m b = processWith (procInlines $ processCite csl cits_map) p' + Pandoc m b = bottomUp (procInlines $ processCite csl cits_map) p' return . generateNotes nts . Pandoc m $ b ++ biblioList -- | Substitute 'Cite' elements with formatted citations. @@ -99,7 +100,7 @@ getCite i | Cite _ _ <- i = [i] getNoteCitations :: [Inline] -> Pandoc -> [[Citation]] getNoteCitations needNote = let mvCite i = if i `elem` needNote then Note [Para [i]] else i - setNote = processWith mvCite + setNote = bottomUp mvCite getCits = concat . flip (zipWith $ setCiteNoteNum) [1..] . map (queryWith getCite) . queryWith getNote . setNote in queryWith getCitation . getCits @@ -109,7 +110,7 @@ setHash (Citation i p s cm nn _) = hashUnique `fmap` newUnique >>= return . Citation i p s cm nn generateNotes :: [Inline] -> Pandoc -> Pandoc -generateNotes needNote = processWith (mvCiteInNote needNote) +generateNotes needNote = bottomUp (mvCiteInNote needNote) procInlines :: ([Inline] -> [Inline]) -> Block -> Block procInlines f b @@ -147,7 +148,7 @@ mvCiteInNote is = procInlines mvCite , endWithPunct o = Cite c (initInline o) : checkPt xs | x:xs <- i = x : checkPt xs | otherwise = [] - checkNt = processWith $ procInlines checkPt + checkNt = bottomUp $ procInlines checkPt setCiteNoteNum :: [Inline] -> Int -> [Inline] setCiteNoteNum ((Cite cs o):xs) n = Cite (setCitationNoteNum n cs) o : setCiteNoteNum xs n diff --git a/src/Text/Pandoc/Parsing.hs b/src/Text/Pandoc/Parsing.hs index a49f464c8..d8cd7cd7c 100644 --- a/src/Text/Pandoc/Parsing.hs +++ b/src/Text/Pandoc/Parsing.hs @@ -72,6 +72,7 @@ module Text.Pandoc.Parsing ( (>>~), where import Text.Pandoc.Definition +import Text.Pandoc.Generic import qualified Text.Pandoc.UTF8 as UTF8 (putStrLn) import Text.ParserCombinators.Parsec import Text.Pandoc.CharacterReferences ( characterReference ) @@ -655,7 +656,7 @@ type NoteTable = [(String, String)] newtype Key = Key [Inline] deriving (Show, Read, Eq, Ord) toKey :: [Inline] -> Key -toKey = Key . processWith lowercase +toKey = Key . bottomUp lowercase where lowercase :: Inline -> Inline lowercase (Str xs) = Str (map toLower xs) lowercase (Math t xs) = Math t (map toLower xs) diff --git a/src/Text/Pandoc/Readers/Markdown.hs b/src/Text/Pandoc/Readers/Markdown.hs index be1fdc5d0..c262a9a90 100644 --- a/src/Text/Pandoc/Readers/Markdown.hs +++ b/src/Text/Pandoc/Readers/Markdown.hs @@ -35,6 +35,7 @@ import Data.Ord ( comparing ) import Data.Char ( isAlphaNum ) import Data.Maybe import Text.Pandoc.Definition +import Text.Pandoc.Generic import Text.Pandoc.Shared import Text.Pandoc.Parsing import Text.Pandoc.Readers.LaTeX ( rawLaTeXInline, rawLaTeXEnvironment' ) @@ -189,7 +190,7 @@ parseMarkdown = do handleExampleRef z = z if M.null examples then return doc - else return $ processWith handleExampleRef doc + else return $ bottomUp handleExampleRef doc -- -- initial pass for references and notes diff --git a/src/Text/Pandoc/Shared.hs b/src/Text/Pandoc/Shared.hs index 401d6bb05..ca60a706f 100644 --- a/src/Text/Pandoc/Shared.hs +++ b/src/Text/Pandoc/Shared.hs @@ -71,6 +71,7 @@ module Text.Pandoc.Shared ( ) where import Text.Pandoc.Definition +import Text.Pandoc.Generic import qualified Text.Pandoc.UTF8 as UTF8 (readFile) import Data.Char ( toLower, isLower, isUpper, isAlpha, isAscii, isLetter, isDigit ) @@ -79,7 +80,7 @@ import Network.URI ( isAllowedInURI, escapeURIString, unEscapeString ) import Codec.Binary.UTF8.String ( encodeString, decodeString ) import System.Directory import System.FilePath ( () ) -import Data.Generics (Typeable, Data, everywhere', mkT) +import Data.Generics (Typeable, Data) import qualified Control.Monad.State as S import Paths_pandoc (getDataFileName) @@ -257,8 +258,8 @@ normalizeSpaces = cleanup . dropWhile isSpaceOrEmpty -- combining adjacent 'Str's and 'Emph's, remove 'Null's and -- empty elements, etc. normalize :: Pandoc -> Pandoc -normalize = everywhere' (mkT normalizeInlines) . - everywhere' (mkT normalizeBlocks) +normalize = topDown normalizeInlines . + topDown normalizeBlocks normalizeBlocks :: [Block] -> [Block] normalizeBlocks (Null : xs) = normalizeBlocks xs @@ -404,7 +405,7 @@ isHeaderBlock _ = False -- | Shift header levels up or down. headerShift :: Int -> Pandoc -> Pandoc -headerShift n = processWith shift +headerShift n = bottomUp shift where shift :: Block -> Block shift (Header level inner) = Header (level + n) inner shift x = x diff --git a/src/Text/Pandoc/Writers/EPUB.hs b/src/Text/Pandoc/Writers/EPUB.hs index deaa2fe33..c2038a3c1 100644 --- a/src/Text/Pandoc/Writers/EPUB.hs +++ b/src/Text/Pandoc/Writers/EPUB.hs @@ -39,6 +39,7 @@ import Codec.Archive.Zip import System.Time import Text.Pandoc.Shared hiding ( Element ) import Text.Pandoc.Definition +import Text.Pandoc.Generic import Control.Monad (liftM) import Text.XML.Light hiding (ppTopElement) import Text.Pandoc.UUID @@ -69,7 +70,7 @@ writeEPUB mbStylesheet opts doc@(Pandoc meta _) = do -- handle pictures picsRef <- newIORef [] - Pandoc _ blocks <- liftM (processWith transformBlock) $ processWithM + Pandoc _ blocks <- liftM (bottomUp transformBlock) $ bottomUpM (transformInlines (writerHTMLMathMethod opts) sourceDir picsRef) doc pics <- readIORef picsRef let readPicEntry (oldsrc, newsrc) = readEntry [] oldsrc >>= \e -> diff --git a/src/Text/Pandoc/Writers/LaTeX.hs b/src/Text/Pandoc/Writers/LaTeX.hs index c6882f91e..6ed605a05 100644 --- a/src/Text/Pandoc/Writers/LaTeX.hs +++ b/src/Text/Pandoc/Writers/LaTeX.hs @@ -30,6 +30,7 @@ Conversion of 'Pandoc' format into LaTeX. -} module Text.Pandoc.Writers.LaTeX ( writeLaTeX ) where import Text.Pandoc.Definition +import Text.Pandoc.Generic import Text.Pandoc.Shared import Text.Pandoc.Templates import Text.Printf ( printf ) @@ -217,7 +218,7 @@ blockToLaTeX (Header level lst) = do txt <- inlineListToLaTeX lst' let noNote (Note _) = Str "" noNote x = x - let lstNoNotes = processWith noNote lst' + let lstNoNotes = bottomUp noNote lst' -- footnotes in sections don't work unless you specify an optional -- argument: \section[mysec]{mysec\footnote{blah}} optional <- if lstNoNotes == lst' diff --git a/src/Text/Pandoc/Writers/Markdown.hs b/src/Text/Pandoc/Writers/Markdown.hs index 78666fdfe..1e74dd470 100644 --- a/src/Text/Pandoc/Writers/Markdown.hs +++ b/src/Text/Pandoc/Writers/Markdown.hs @@ -32,6 +32,7 @@ Markdown: -} module Text.Pandoc.Writers.Markdown (writeMarkdown, writePlain) where import Text.Pandoc.Definition +import Text.Pandoc.Generic import Text.Pandoc.Templates (renderTemplate) import Text.Pandoc.Shared import Text.Pandoc.Parsing hiding (blankline) @@ -64,7 +65,7 @@ writePlain opts document = where document' = plainify document plainify :: Pandoc -> Pandoc -plainify = processWith go +plainify = bottomUp go where go :: Inline -> Inline go (Emph xs) = SmallCaps xs go (Strong xs) = SmallCaps xs @@ -402,11 +403,11 @@ inlineToMarkdown opts (Strikeout lst) = do contents <- inlineListToMarkdown opts lst return $ "~~" <> contents <> "~~" inlineToMarkdown opts (Superscript lst) = do - let lst' = processWith escapeSpaces lst + let lst' = bottomUp escapeSpaces lst contents <- inlineListToMarkdown opts lst' return $ "^" <> contents <> "^" inlineToMarkdown opts (Subscript lst) = do - let lst' = processWith escapeSpaces lst + let lst' = bottomUp escapeSpaces lst contents <- inlineListToMarkdown opts lst' return $ "~" <> contents <> "~" inlineToMarkdown opts (SmallCaps lst) = inlineListToMarkdown opts lst diff --git a/src/Text/Pandoc/Writers/ODT.hs b/src/Text/Pandoc/Writers/ODT.hs index e4230a8a9..cf1be8755 100644 --- a/src/Text/Pandoc/Writers/ODT.hs +++ b/src/Text/Pandoc/Writers/ODT.hs @@ -37,6 +37,7 @@ import System.Time import Paths_pandoc ( getDataFileName ) import Text.Pandoc.Shared ( WriterOptions(..) ) import Text.Pandoc.Definition +import Text.Pandoc.Generic import Text.Pandoc.Writers.OpenDocument ( writeOpenDocument ) import System.Directory import Control.Monad (liftM) @@ -63,7 +64,7 @@ writeODT mbRefOdt opts doc = do -- handle pictures picEntriesRef <- newIORef ([] :: [Entry]) let sourceDir = writerSourceDirectory opts - doc' <- processWithM (transformPic sourceDir picEntriesRef) doc + doc' <- bottomUpM (transformPic sourceDir picEntriesRef) doc let newContents = writeOpenDocument opts{writerWrapText = False} doc' (TOD epochtime _) <- getClockTime let contentEntry = toEntry "content.xml" epochtime $ fromString newContents -- cgit v1.2.3