9564257 · typeable/pandoc

git.iko.soy/typeable/pandoc

Created Text.Pandoc.Writers.Shared, improved metaToJSON.

* Text.Pandoc.Writers.Shared contains shared functions used only in writers. * metaToJSON now takes a WriterOptions parameter, and will return an empty object if standalone is not specified.

commit956425709d63b01c801ebb91dd867a08bfe76eb0 authorJohn MacFarlane <fiddlosopher@gmail.com> dateMon 1 Jul 2013, 20:47 (13 years ago) parent19ad69b

18 files changed+41−120

compare with master

unifiedsplit

CONTRIBUTING.md+1

@@ -162,6 +162,7 @@ The library is structured as follows:

162162 file "self-contained," by importing remotely linked images, CSS,

163163 and javascript and turning them into `data:` URLs.

164164 - `Text.Pandoc.Shared` is a grab-bag of shared utility functions.

165+ - `Text.Pandoc.Writers.Shared` contains utilities used in writers only.

165166 - `Text.Pandoc.Slides` contains functions for splitting a markdown document

166167 into slides, using the conventions described in the README.

167168 - `Text.Pandoc.Templates` defines pandoc's templating system.

pandoc.cabal+1

@@ -329,6 +329,7 @@ Library

329329 Text.Pandoc.SelfContained

330330 Other-Modules: Text.Pandoc.Readers.Haddock.Lex,

331331 Text.Pandoc.Readers.Haddock.Parse,

332+ Text.Pandoc.Writers.Shared,

332333 Text.Pandoc.Asciify,

333334 Text.Pandoc.MIME,

334335 Text.Pandoc.Parsing,

src/Text/Pandoc/Shared.hs+1−81

@@ -63,10 +63,6 @@ module Text.Pandoc.Shared (

6363 isTightList,

6464 addMetaField,

6565 makeMeta,

66− metaToJSON,

67− getField,

68− setField,

69− defField,

7066 -- * TagSoup HTML handling

7167 renderTags',

7268 -- * File handling

@@ -99,7 +95,7 @@ import Text.Pandoc.MIME (getMimeType)

9995import System.FilePath ( (</>), takeExtension, dropExtension )

10096import Data.Generics (Typeable, Data)

10197import qualified Control.Monad.State as S

102−import Control.Monad (msum, unless, liftM)

98+import Control.Monad (msum, unless)

10399import Text.Pandoc.Pretty (charWidth)

104100import System.Locale (defaultTimeLocale)

105101import Data.Time

@@ -111,10 +107,6 @@ import qualified Data.ByteString.Char8 as B8

111107import Network.HTTP (findHeader, rspBody,

112108 RequestMethod(..), HeaderName(..), mkRequest)

113109import Network.Browser (browse, setAllowRedirects, setOutHandler, request)

114−import qualified Data.Traversable as Traversable

115−import qualified Data.HashMap.Strict as H

116−import qualified Data.Text as T

117−import Data.Aeson (FromJSON(..), fromJSON, ToJSON (..), Value(Object), Result(..))

118110

119111#ifdef EMBED_DATA_FILES

120112import Text.Pandoc.Data (dataFiles)

@@ -524,78 +516,6 @@ makeMeta title authors date =

524516 $ addMetaField "date" (B.fromList date)

525517 $ nullMeta

526518

527−-- | Create JSON value for template from a 'Meta' and an association list

528−-- of variables, specified at the command line or in the writer.

529−-- Variables overwrite metadata fields with the same names.

530−-- If multiple variables are set with the same name, a list is

531−-- assigned.

532−metaToJSON :: Monad m

533− => ([Block] -> m String) -- ^ Writer for output format

534− -> ([Inline] -> m String) -- ^ Writer for output format

535− -> [(String, String)] -- ^ Variables

536− -> Meta -- ^ Metadata

537− -> m Value

538−metaToJSON blockWriter inlineWriter vars (Meta metamap) = do

539− let baseContext = foldl (\acc (x,y) -> setField x y acc) (Object H.empty) vars

540− renderedMap <- Traversable.mapM (metaValueToJSON blockWriter inlineWriter)

541− metamap

542− return $ M.foldWithKey (\key val obj -> defField key val obj)

543− baseContext renderedMap

544−

545−metaValueToJSON :: Monad m

546− => ([Block] -> m String)

547− -> ([Inline] -> m String)

548− -> MetaValue

549− -> m Value

550−metaValueToJSON blockWriter inlineWriter (MetaMap metamap) = liftM toJSON $

551− Traversable.mapM (metaValueToJSON blockWriter inlineWriter) metamap

552−metaValueToJSON blockWriter inlineWriter (MetaList xs) = liftM toJSON $

553− Traversable.mapM (metaValueToJSON blockWriter inlineWriter) xs

554−metaValueToJSON _ _ (MetaString s) = return $ toJSON s

555−metaValueToJSON blockWriter _ (MetaBlocks bs) = liftM toJSON $ blockWriter bs

556−metaValueToJSON _ inlineWriter (MetaInlines bs) = liftM toJSON $ inlineWriter bs

557−

558−-- | Retrieve a field value from a JSON object.

559−getField :: FromJSON a

560− => String

561− -> Value

562− -> Maybe a

563−getField field (Object hashmap) = do

564− result <- H.lookup (T.pack field) hashmap

565− case fromJSON result of

566− Success x -> return x

567− _ -> fail "Could not convert from JSON"

568−getField field _ = fail "Not a JSON object"

569−

570−setField :: ToJSON a

571− => String

572− -> a

573− -> Value

574− -> Value

575−-- | Set a field of a JSON object. If the field already has a value,

576−-- convert it into a list with the new value appended to the old value(s).

577−-- This is a utility function to be used in preparing template contexts.

578−setField field val (Object hashmap) =

579− Object $ H.insertWith combine (T.pack field) (toJSON val) hashmap

580− where combine newval oldval =

581− case fromJSON oldval of

582− Success xs -> toJSON $ xs ++ [newval]

583− _ -> toJSON [oldval, newval]

584−setField _ _ x = x

585−

586−defField :: ToJSON a

587− => String

588− -> a

589− -> Value

590− -> Value

591−-- | Set a field of a JSON object if it currently has no value.

592−-- If it has a value, do nothing.

593−-- This is a utility function to be used in preparing template contexts.

594−defField field val (Object hashmap) =

595− Object $ H.insertWith f (T.pack field) (toJSON val) hashmap

596− where f _newval oldval = oldval

597−defField _ _ x = x

598−

599519--

600520-- TagSoup HTML handling

601521--

src/Text/Pandoc/Writers/AsciiDoc.hs+2−2

@@ -40,6 +40,7 @@ module Text.Pandoc.Writers.AsciiDoc (writeAsciiDoc) where

4040import Text.Pandoc.Definition

4141import Text.Pandoc.Templates (renderTemplate')

4242import Text.Pandoc.Shared

43+import Text.Pandoc.Writers.Shared

4344import Text.Pandoc.Options

4445import Text.Pandoc.Parsing hiding (blankline, space)

4546import Data.List ( isPrefixOf, intersperse, intercalate )

@@ -71,10 +72,9 @@ pandocToAsciiDoc opts (Pandoc meta blocks) = do

7172 let colwidth = if writerWrapText opts

7273 then Just $ writerColumns opts

7374 else Nothing

74− metadata <- metaToJSON

75+ metadata <- metaToJSON opts

7576 (fmap (render colwidth) . blockListToAsciiDoc opts)

7677 (fmap (render colwidth) . inlineListToAsciiDoc opts)

77− (writerVariables opts)

7878 meta

7979 let addTitleLine (String t) = String $

8080 t <> "\n" <> T.replicate (T.length t) "="

src/Text/Pandoc/Writers/ConTeXt.hs+2−2

@@ -31,6 +31,7 @@ Conversion of 'Pandoc' format into ConTeXt.

3131module Text.Pandoc.Writers.ConTeXt ( writeConTeXt ) where

3232import Text.Pandoc.Definition

3333import Text.Pandoc.Shared

34+import Text.Pandoc.Writers.Shared

3435import Text.Pandoc.Options

3536import Text.Pandoc.Generic (queryWith)

3637import Text.Printf ( printf )

@@ -63,10 +64,9 @@ pandocToConTeXt options (Pandoc meta blocks) = do

6364 let colwidth = if writerWrapText options

6465 then Just $ writerColumns options

6566 else Nothing

66− metadata <- metaToJSON

67+ metadata <- metaToJSON options

6768 (fmap (render colwidth) . blockListToConTeXt)

6869 (fmap (render colwidth) . inlineListToConTeXt)

69− (writerVariables options)

7070 meta

7171 body <- mapM (elementToConTeXt options) $ hierarchicalize blocks

7272 let main = (render colwidth . vcat) body

src/Text/Pandoc/Writers/Docbook.hs+2−2

@@ -31,6 +31,7 @@ module Text.Pandoc.Writers.Docbook ( writeDocbook) where

3131import Text.Pandoc.Definition

3232import Text.Pandoc.XML

3333import Text.Pandoc.Shared

34+import Text.Pandoc.Writers.Shared

3435import Text.Pandoc.Options

3536import Text.Pandoc.Templates (renderTemplate')

3637import Text.Pandoc.Readers.TeXMath

@@ -82,10 +83,9 @@ writeDocbook opts (Pandoc meta blocks) =

8283 startLvl = if writerChapters opts' then 0 else 1

8384 auths' = map (authorToDocbook opts) $ docAuthors meta

8485 meta' = B.setMeta "author" auths' meta

85− Just metadata = metaToJSON

86+ Just metadata = metaToJSON opts

8687 (Just . render colwidth . blocksToDocbook opts)

8788 (Just . render colwidth . inlinesToDocbook opts)

88− (writerVariables opts)

8989 meta'

9090 main = render' $ vcat (map (elementToDocbook opts' startLvl) elements)

9191 context = defField "body" main

src/Text/Pandoc/Writers/HTML.hs+2−2

@@ -32,6 +32,7 @@ Conversion of 'Pandoc' documents to HTML.

3232module Text.Pandoc.Writers.HTML ( writeHtml , writeHtmlString ) where

3333import Text.Pandoc.Definition

3434import Text.Pandoc.Shared

35+import Text.Pandoc.Writers.Shared

3536import Text.Pandoc.Options

3637import Text.Pandoc.Templates

3738import Text.Pandoc.Readers.TeXMath

@@ -110,10 +111,9 @@ pandocToHtml :: WriterOptions

110111 -> Pandoc

111112 -> State WriterState (Html, Value)

112113pandocToHtml opts (Pandoc meta blocks) = do

113− metadata <- metaToJSON

114+ metadata <- metaToJSON opts

114115 (fmap renderHtml . blockListToHtml opts)

115116 (fmap renderHtml . inlineListToHtml opts)

116− (writerVariables opts)

117117 meta

118118 let authsMeta = map stringify $ docAuthors meta

119119 let dateMeta = stringify $ docDate meta

src/Text/Pandoc/Writers/LaTeX.hs+2−2

@@ -32,6 +32,7 @@ module Text.Pandoc.Writers.LaTeX ( writeLaTeX ) where

3232import Text.Pandoc.Definition

3333import Text.Pandoc.Generic

3434import Text.Pandoc.Shared

35+import Text.Pandoc.Writers.Shared

3536import Text.Pandoc.Options

3637import Text.Pandoc.Templates

3738import Text.Printf ( printf )

@@ -103,10 +104,9 @@ pandocToLaTeX options (Pandoc meta blocks) = do

103104 let colwidth = if writerWrapText options

104105 then Just $ writerColumns options

105106 else Nothing

106− metadata <- metaToJSON

107+ metadata <- metaToJSON options

107108 (fmap (render colwidth) . blockListToLaTeX)

108109 (fmap (render colwidth) . inlineListToLaTeX)

109− (writerVariables options)

110110 meta

111111 let (blocks', lastHeader) = if writerCiteMethod options == Citeproc then

112112 (blocks, [])

src/Text/Pandoc/Writers/Man.hs+2−2

@@ -32,6 +32,7 @@ module Text.Pandoc.Writers.Man ( writeMan) where

3232import Text.Pandoc.Definition

3333import Text.Pandoc.Templates

3434import Text.Pandoc.Shared

35+import Text.Pandoc.Writers.Shared

3536import Text.Pandoc.Options

3637import Text.Pandoc.Readers.TeXMath

3738import Text.Printf ( printf )

@@ -71,10 +72,9 @@ pandocToMan opts (Pandoc meta blocks) = do

7172 (trim $ concat hds)

7273 [] -> id

7374 _ -> defField "title" title'

74− metadata <- metaToJSON

75+ metadata <- metaToJSON opts

7576 (fmap (render colwidth) . blockListToMan opts)

7677 (fmap (render colwidth) . inlineListToMan opts)

77− (writerVariables opts)

7878 $ deleteMeta "title" meta

7979 body <- blockListToMan opts blocks

8080 notes <- liftM stNotes get

src/Text/Pandoc/Writers/Markdown.hs+5−7

@@ -35,6 +35,7 @@ import Text.Pandoc.Definition

3535import Text.Pandoc.Generic

3636import Text.Pandoc.Templates (renderTemplate')

3737import Text.Pandoc.Shared

38+import Text.Pandoc.Writers.Shared

3839import Text.Pandoc.Options

3940import Text.Pandoc.Parsing hiding (blankline, char, space)

4041import Data.List ( group, isPrefixOf, find, intersperse, transpose )

@@ -145,13 +146,10 @@ pandocToMarkdown opts (Pandoc meta blocks) = do

145146 let colwidth = if writerWrapText opts

146147 then Just $ writerColumns opts

147148 else Nothing

148− metadata <- if writerStandalone opts

149− then metaToJSON

150− (fmap (render colwidth) . blockListToMarkdown opts)

151− (fmap (render colwidth) . inlineListToMarkdown opts)

152− (writerVariables opts)

153− meta

154− else return $ Object H.empty

149+ metadata <- metaToJSON opts

150+ (fmap (render colwidth) . blockListToMarkdown opts)

151+ (fmap (render colwidth) . inlineListToMarkdown opts)

152+ meta

155153 let title' = maybe empty text $ getField "title" metadata

156154 let authors' = maybe [] (map text) $ getField "author" metadata

157155 let date' = maybe empty text $ getField "date" metadata

src/Text/Pandoc/Writers/MediaWiki.hs+2−2

@@ -33,6 +33,7 @@ module Text.Pandoc.Writers.MediaWiki ( writeMediaWiki ) where

3333import Text.Pandoc.Definition

3434import Text.Pandoc.Options

3535import Text.Pandoc.Shared

36+import Text.Pandoc.Writers.Shared

3637import Text.Pandoc.Templates (renderTemplate')

3738import Text.Pandoc.XML ( escapeStringForXML )

3839import Data.List ( intersect, intercalate )

@@ -54,10 +55,9 @@ writeMediaWiki opts document =

5455-- | Return MediaWiki representation of document.

5556pandocToMediaWiki :: WriterOptions -> Pandoc -> State WriterState String

5657pandocToMediaWiki opts (Pandoc meta blocks) = do

57− metadata <- metaToJSON

58+ metadata <- metaToJSON opts

5859 (fmap trimr . blockListToMediaWiki opts)

5960 (inlineListToMediaWiki opts)

60− (writerVariables opts)

6161 meta

6262 body <- blockListToMediaWiki opts blocks

6363 notesExist <- get >>= return . stNotes

src/Text/Pandoc/Writers/OPML.hs+2−2

@@ -30,6 +30,7 @@ Conversion of 'Pandoc' documents to OPML XML.

3030module Text.Pandoc.Writers.OPML ( writeOPML) where

3131import Text.Pandoc.Definition

3232import Text.Pandoc.XML

33+import Text.Pandoc.Writers.Shared

3334import Text.Pandoc.Shared

3435import Text.Pandoc.Options

3536import Text.Pandoc.Templates (renderTemplate')

@@ -48,11 +49,10 @@ writeOPML opts (Pandoc meta blocks) =

4849 then Just $ writerColumns opts

4950 else Nothing

5051 meta' = B.setMeta "date" (B.str $ convertDate $ docDate meta) meta

51− Just metadata = metaToJSON

52+ Just metadata = metaToJSON opts

5253 (Just . writeMarkdown def . Pandoc nullMeta)

5354 (Just . trimr . writeMarkdown def . Pandoc nullMeta .

5455 (\ils -> [Plain ils]))

55− (writerVariables opts)

5656 meta'

5757 main = render colwidth $ vcat (map (elementToOPML opts) elements)

5858 context = defField "body" main metadata

src/Text/Pandoc/Writers/OpenDocument.hs+2−3

@@ -42,7 +42,7 @@ import Control.Arrow ( (***), (>>>) )

4242import Control.Monad.State hiding ( when )

4343import Data.Char (chr, isDigit)

4444import qualified Data.Map as Map

45−import Text.Pandoc.Shared (metaToJSON, defField)

45+import Text.Pandoc.Writers.Shared

4646

4747-- | Auxiliary function to convert Plain block to Para.

4848plainToPara :: Block -> Block

@@ -180,10 +180,9 @@ writeOpenDocument opts (Pandoc meta blocks) =

180180 render' = render colwidth

181181 ((body, metadata),s) = flip runState

182182 defaultWriterState $ do

183− m <- metaToJSON

183+ m <- metaToJSON opts

184184 (fmap (render colwidth) . blocksToOpenDocument opts)

185185 (fmap (render colwidth) . inlinesToOpenDocument opts)

186− (writerVariables opts)

187186 meta

188187 b <- render' `fmap` blocksToOpenDocument opts blocks

189188 return (b, m)

src/Text/Pandoc/Writers/Org.hs+2−2

@@ -34,6 +34,7 @@ module Text.Pandoc.Writers.Org ( writeOrg) where

3434import Text.Pandoc.Definition

3535import Text.Pandoc.Options

3636import Text.Pandoc.Shared

37+import Text.Pandoc.Writers.Shared

3738import Text.Pandoc.Pretty

3839import Text.Pandoc.Templates (renderTemplate')

3940import Data.List ( intersect, intersperse, transpose )

@@ -63,10 +64,9 @@ pandocToOrg (Pandoc meta blocks) = do

6364 let colwidth = if writerWrapText opts

6465 then Just $ writerColumns opts

6566 else Nothing

66− metadata <- metaToJSON

67+ metadata <- metaToJSON opts

6768 (fmap (render colwidth) . blockListToOrg)

6869 (fmap (render colwidth) . inlineListToOrg)

69− (writerVariables opts)

7070 meta

7171 body <- blockListToOrg blocks

7272 notes <- liftM (reverse . stNotes) get >>= notesToOrg

src/Text/Pandoc/Writers/RST.hs+5−4

@@ -34,6 +34,7 @@ module Text.Pandoc.Writers.RST ( writeRST ) where

3434import Text.Pandoc.Definition

3535import Text.Pandoc.Options

3636import Text.Pandoc.Shared

37+import Text.Pandoc.Writers.Shared

3738import Text.Pandoc.Templates (renderTemplate')

3839import Text.Pandoc.Builder (deleteMeta)

3940import Data.List ( isPrefixOf, intersperse, transpose )

@@ -72,10 +73,10 @@ pandocToRST (Pandoc meta blocks) = do

7273 Just (MetaBlocks [Plain xs]) -> xs

7374 _ -> []

7475 title <- titleToRST (docTitle meta) subtit

75− metadata <- metaToJSON (fmap (render colwidth) . blockListToRST)

76− (fmap (trimr . render colwidth) . inlineListToRST)

77− (writerVariables opts)

78− $ deleteMeta "title" $ deleteMeta "subtitle" meta

76+ metadata <- metaToJSON opts

77+ (fmap (render colwidth) . blockListToRST)

78+ (fmap (trimr . render colwidth) . inlineListToRST)

79+ $ deleteMeta "title" $ deleteMeta "subtitle" meta

7980 body <- blockListToRST blocks

8081 notes <- liftM (reverse . stNotes) get >>= notesToRST

8182 -- note that the notes may contain refs, so we do them first

src/Text/Pandoc/Writers/RTF.hs+2−2

@@ -31,6 +31,7 @@ module Text.Pandoc.Writers.RTF ( writeRTF, writeRTFWithEmbeddedImages ) where

3131import Text.Pandoc.Definition

3232import Text.Pandoc.Options

3333import Text.Pandoc.Shared

34+import Text.Pandoc.Writers.Shared

3435import Text.Pandoc.Readers.TeXMath

3536import Text.Pandoc.Templates (renderTemplate')

3637import Text.Pandoc.Generic (bottomUpM)

@@ -75,10 +76,9 @@ writeRTFWithEmbeddedImages options doc =

7576writeRTF :: WriterOptions -> Pandoc -> String

7677writeRTF options (Pandoc meta blocks) =

7778 let spacer = not $ all null $ docTitle meta : docDate meta : docAuthors meta

78− Just metadata = metaToJSON

79+ Just metadata = metaToJSON options

7980 (Just . concatMap (blockToRTF 0 AlignDefault))

8081 (Just . inlineListToRTF)

81− (writerVariables options)

8282 meta

8383 body = concatMap (blockToRTF 0 AlignDefault) blocks

8484 isTOCHeader (Header lev _ _) = lev <= writerTOCDepth options

src/Text/Pandoc/Writers/Texinfo.hs+3−2

@@ -31,6 +31,7 @@ module Text.Pandoc.Writers.Texinfo ( writeTexinfo ) where

3131import Text.Pandoc.Definition

3232import Text.Pandoc.Options

3333import Text.Pandoc.Shared

34+import Text.Pandoc.Writers.Shared

3435import Text.Pandoc.Templates (renderTemplate')

3536import Text.Printf ( printf )

3637import Data.List ( transpose, maximumBy )

@@ -73,10 +74,10 @@ pandocToTexinfo options (Pandoc meta blocks) = do

7374 let colwidth = if writerWrapText options

7475 then Just $ writerColumns options

7576 else Nothing

76− metadata <- metaToJSON

77+ metadata <- metaToJSON options

7778 (fmap (render colwidth) . blockListToTexinfo)

7879 (fmap (render colwidth) . inlineListToTexinfo)

79− (writerVariables options) meta

80+ meta

8081 main <- blockListToTexinfo blocks

8182 st <- get

8283 let body = render colwidth main

src/Text/Pandoc/Writers/Textile.hs+3−3

@@ -33,6 +33,7 @@ module Text.Pandoc.Writers.Textile ( writeTextile ) where

3333import Text.Pandoc.Definition

3434import Text.Pandoc.Options

3535import Text.Pandoc.Shared

36+import Text.Pandoc.Writers.Shared

3637import Text.Pandoc.Templates (renderTemplate')

3738import Text.Pandoc.XML ( escapeStringForXML )

3839import Data.List ( intercalate )

@@ -54,9 +55,8 @@ writeTextile opts document =

5455-- | Return Textile representation of document.

5556pandocToTextile :: WriterOptions -> Pandoc -> State WriterState String

5657pandocToTextile opts (Pandoc meta blocks) = do

57− metadata <- metaToJSON

58− (blockListToTextile opts) (inlineListToTextile opts)

59− (writerVariables opts) meta

58+ metadata <- metaToJSON opts (blockListToTextile opts)

59+ (inlineListToTextile opts) meta

6060 body <- blockListToTextile opts blocks

6161 notes <- liftM (unlines . reverse . stNotes) get

6262 let main = body ++ if null notes then "" else ("\n\n" ++ notes)