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.

CONTRIBUTING.md

@@ -162,6 +162,7 @@ The library is structured as follows:
     file "self-contained," by importing remotely linked images, CSS,
     and javascript and turning them into `data:` URLs.
   - `Text.Pandoc.Shared` is a grab-bag of shared utility functions.
+  - `Text.Pandoc.Writers.Shared` contains utilities used in writers only.
   - `Text.Pandoc.Slides` contains functions for splitting a markdown document
     into slides, using the conventions described in the README.
   - `Text.Pandoc.Templates` defines pandoc's templating system.

pandoc.cabal

@@ -329,6 +329,7 @@ Library
                    Text.Pandoc.SelfContained
   Other-Modules:   Text.Pandoc.Readers.Haddock.Lex,
                    Text.Pandoc.Readers.Haddock.Parse,
+                   Text.Pandoc.Writers.Shared,
                    Text.Pandoc.Asciify,
                    Text.Pandoc.MIME,
                    Text.Pandoc.Parsing,

src/Text/Pandoc/Shared.hs

@@ -63,10 +63,6 @@ module Text.Pandoc.Shared (
                      isTightList,
                      addMetaField,
                      makeMeta,
-                     metaToJSON,
-                     getField,
-                     setField,
-                     defField,
                      -- * TagSoup HTML handling
                      renderTags',
                      -- * File handling
@@ -99,7 +95,7 @@ import Text.Pandoc.MIME (getMimeType)
 import System.FilePath ( (</>), takeExtension, dropExtension )
 import Data.Generics (Typeable, Data)
 import qualified Control.Monad.State as S
-import Control.Monad (msum, unless, liftM)
+import Control.Monad (msum, unless)
 import Text.Pandoc.Pretty (charWidth)
 import System.Locale (defaultTimeLocale)
 import Data.Time
@@ -111,10 +107,6 @@ import qualified Data.ByteString.Char8 as B8
 import Network.HTTP (findHeader, rspBody,
                      RequestMethod(..), HeaderName(..), mkRequest)
 import Network.Browser (browse, setAllowRedirects, setOutHandler, request)
-import qualified Data.Traversable as Traversable
-import qualified Data.HashMap.Strict as H
-import qualified Data.Text as T
-import Data.Aeson (FromJSON(..), fromJSON, ToJSON (..), Value(Object), Result(..))
 
 #ifdef EMBED_DATA_FILES
 import Text.Pandoc.Data (dataFiles)
@@ -524,78 +516,6 @@ makeMeta title authors date =
     $ addMetaField "date" (B.fromList date)
     $ nullMeta
 
--- | Create JSON value for template from a 'Meta' and an association list
--- of variables, specified at the command line or in the writer.
--- Variables overwrite metadata fields with the same names.
--- If multiple variables are set with the same name, a list is
--- assigned.
-metaToJSON :: Monad m
-           => ([Block] -> m String) -- ^ Writer for output format
-           -> ([Inline] -> m String) -- ^ Writer for output format
-           -> [(String, String)]    -- ^ Variables
-           -> Meta                  -- ^ Metadata
-           -> m Value
-metaToJSON blockWriter inlineWriter vars (Meta metamap) = do
-  let baseContext = foldl (\acc (x,y) -> setField x y acc) (Object H.empty) vars
-  renderedMap <- Traversable.mapM (metaValueToJSON blockWriter inlineWriter)
-                  metamap
-  return $ M.foldWithKey (\key val obj -> defField key val obj)
-                 baseContext renderedMap
-
-metaValueToJSON :: Monad m
-                => ([Block] -> m String)
-                -> ([Inline] -> m String)
-                -> MetaValue
-                -> m Value
-metaValueToJSON blockWriter inlineWriter (MetaMap metamap) = liftM toJSON $
-  Traversable.mapM (metaValueToJSON blockWriter inlineWriter) metamap
-metaValueToJSON blockWriter inlineWriter (MetaList xs) = liftM toJSON $
-  Traversable.mapM (metaValueToJSON blockWriter inlineWriter) xs
-metaValueToJSON _ _ (MetaString s) = return $ toJSON s
-metaValueToJSON blockWriter _ (MetaBlocks bs) = liftM toJSON $ blockWriter bs
-metaValueToJSON _ inlineWriter (MetaInlines bs) = liftM toJSON $ inlineWriter bs
-
--- | Retrieve a field value from a JSON object.
-getField :: FromJSON a
-         => String
-         -> Value
-         -> Maybe a
-getField field (Object hashmap) = do
-  result <- H.lookup (T.pack field) hashmap
-  case fromJSON result of
-       Success x -> return x
-       _         -> fail "Could not convert from JSON"
-getField field _ = fail "Not a JSON object"
-
-setField :: ToJSON a
-         => String
-         -> a
-         -> Value
-         -> Value
--- | Set a field of a JSON object.  If the field already has a value,
--- convert it into a list with the new value appended to the old value(s).
--- This is a utility function to be used in preparing template contexts.
-setField field val (Object hashmap) =
-  Object $ H.insertWith combine (T.pack field) (toJSON val) hashmap
-  where combine newval oldval =
-          case fromJSON oldval of
-                Success xs  -> toJSON $ xs ++ [newval]
-                _           -> toJSON [oldval, newval]
-setField _ _  x = x
-
-defField :: ToJSON a
-         => String
-         -> a
-         -> Value
-         -> Value
--- | Set a field of a JSON object if it currently has no value.
--- If it has a value, do nothing.
--- This is a utility function to be used in preparing template contexts.
-defField field val (Object hashmap) =
-  Object $ H.insertWith f (T.pack field) (toJSON val) hashmap
-    where f _newval oldval = oldval
-defField _ _  x = x
-
 --
 -- TagSoup HTML handling
 --

src/Text/Pandoc/Writers/AsciiDoc.hs

@@ -40,6 +40,7 @@ module Text.Pandoc.Writers.AsciiDoc (writeAsciiDoc) where
 import Text.Pandoc.Definition
 import Text.Pandoc.Templates (renderTemplate')
 import Text.Pandoc.Shared
+import Text.Pandoc.Writers.Shared
 import Text.Pandoc.Options
 import Text.Pandoc.Parsing hiding (blankline, space)
 import Data.List ( isPrefixOf, intersperse, intercalate )
@@ -71,10 +72,9 @@ pandocToAsciiDoc opts (Pandoc meta blocks) = do
   let colwidth = if writerWrapText opts
                     then Just $ writerColumns opts
                     else Nothing
-  metadata <- metaToJSON
+  metadata <- metaToJSON opts
               (fmap (render colwidth) . blockListToAsciiDoc opts)
               (fmap (render colwidth) . inlineListToAsciiDoc opts)
-              (writerVariables opts)
               meta
   let addTitleLine (String t) = String $
          t <> "\n" <> T.replicate (T.length t) "="

src/Text/Pandoc/Writers/ConTeXt.hs

@@ -31,6 +31,7 @@ Conversion of 'Pandoc' format into ConTeXt.
 module Text.Pandoc.Writers.ConTeXt ( writeConTeXt ) where
 import Text.Pandoc.Definition
 import Text.Pandoc.Shared
+import Text.Pandoc.Writers.Shared
 import Text.Pandoc.Options
 import Text.Pandoc.Generic (queryWith)
 import Text.Printf ( printf )
@@ -63,10 +64,9 @@ pandocToConTeXt options (Pandoc meta blocks) = do
   let colwidth = if writerWrapText options
                     then Just $ writerColumns options
                     else Nothing
-  metadata <- metaToJSON
+  metadata <- metaToJSON options
               (fmap (render colwidth) . blockListToConTeXt)
               (fmap (render colwidth) . inlineListToConTeXt)
-              (writerVariables options)
               meta
   body <- mapM (elementToConTeXt options) $ hierarchicalize blocks
   let main = (render colwidth . vcat) body

src/Text/Pandoc/Writers/Docbook.hs

@@ -31,6 +31,7 @@ module Text.Pandoc.Writers.Docbook ( writeDocbook) where
 import Text.Pandoc.Definition
 import Text.Pandoc.XML
 import Text.Pandoc.Shared
+import Text.Pandoc.Writers.Shared
 import Text.Pandoc.Options
 import Text.Pandoc.Templates (renderTemplate')
 import Text.Pandoc.Readers.TeXMath
@@ -82,10 +83,9 @@ writeDocbook opts (Pandoc meta blocks) =
       startLvl = if writerChapters opts' then 0 else 1
       auths'   = map (authorToDocbook opts) $ docAuthors meta
       meta'    = B.setMeta "author" auths' meta
-      Just metadata = metaToJSON
+      Just metadata = metaToJSON opts
                  (Just . render colwidth . blocksToDocbook opts)
                  (Just . render colwidth . inlinesToDocbook opts)
-                 (writerVariables opts)
                  meta'
       main     = render' $ vcat (map (elementToDocbook opts' startLvl) elements)
       context = defField "body" main

src/Text/Pandoc/Writers/HTML.hs

@@ -32,6 +32,7 @@ Conversion of 'Pandoc' documents to HTML.
 module Text.Pandoc.Writers.HTML ( writeHtml , writeHtmlString ) where
 import Text.Pandoc.Definition
 import Text.Pandoc.Shared
+import Text.Pandoc.Writers.Shared
 import Text.Pandoc.Options
 import Text.Pandoc.Templates
 import Text.Pandoc.Readers.TeXMath
@@ -110,10 +111,9 @@ pandocToHtml :: WriterOptions
              -> Pandoc
              -> State WriterState (Html, Value)
 pandocToHtml opts (Pandoc meta blocks) = do
-  metadata <- metaToJSON
+  metadata <- metaToJSON opts
               (fmap renderHtml . blockListToHtml opts)
               (fmap renderHtml . inlineListToHtml opts)
-              (writerVariables opts)
               meta
   let authsMeta = map stringify $ docAuthors meta
   let dateMeta  = stringify $ docDate meta

src/Text/Pandoc/Writers/LaTeX.hs

@@ -32,6 +32,7 @@ module Text.Pandoc.Writers.LaTeX ( writeLaTeX ) where
 import Text.Pandoc.Definition
 import Text.Pandoc.Generic
 import Text.Pandoc.Shared
+import Text.Pandoc.Writers.Shared
 import Text.Pandoc.Options
 import Text.Pandoc.Templates
 import Text.Printf ( printf )
@@ -103,10 +104,9 @@ pandocToLaTeX options (Pandoc meta blocks) = do
   let colwidth = if writerWrapText options
                     then Just $ writerColumns options
                     else Nothing
-  metadata <- metaToJSON
+  metadata <- metaToJSON options
               (fmap (render colwidth) . blockListToLaTeX)
               (fmap (render colwidth) . inlineListToLaTeX)
-              (writerVariables options)
               meta
   let (blocks', lastHeader) = if writerCiteMethod options == Citeproc then
                                 (blocks, [])

src/Text/Pandoc/Writers/Man.hs

@@ -32,6 +32,7 @@ module Text.Pandoc.Writers.Man ( writeMan) where
 import Text.Pandoc.Definition
 import Text.Pandoc.Templates
 import Text.Pandoc.Shared
+import Text.Pandoc.Writers.Shared
 import Text.Pandoc.Options
 import Text.Pandoc.Readers.TeXMath
 import Text.Printf ( printf )
@@ -71,10 +72,9 @@ pandocToMan opts (Pandoc meta blocks) = do
                                                (trim $ concat hds)
                                           [] -> id
                                    _  -> defField "title" title'
-  metadata <- metaToJSON
+  metadata <- metaToJSON opts
               (fmap (render colwidth) . blockListToMan opts)
               (fmap (render colwidth) . inlineListToMan opts)
-              (writerVariables opts)
               $ deleteMeta "title" meta
   body <- blockListToMan opts blocks
   notes <- liftM stNotes get

src/Text/Pandoc/Writers/Markdown.hs

@@ -35,6 +35,7 @@ import Text.Pandoc.Definition
 import Text.Pandoc.Generic
 import Text.Pandoc.Templates (renderTemplate')
 import Text.Pandoc.Shared
+import Text.Pandoc.Writers.Shared
 import Text.Pandoc.Options
 import Text.Pandoc.Parsing hiding (blankline, char, space)
 import Data.List ( group, isPrefixOf, find, intersperse, transpose )
@@ -145,13 +146,10 @@ pandocToMarkdown opts (Pandoc meta blocks) = do
   let colwidth = if writerWrapText opts
                     then Just $ writerColumns opts
                     else Nothing
-  metadata <- if writerStandalone opts
+  metadata <- metaToJSON opts
-                 then metaToJSON
+               (fmap (render colwidth) . blockListToMarkdown opts)
-                       (fmap (render colwidth) . blockListToMarkdown opts)
+               (fmap (render colwidth) . inlineListToMarkdown opts)
-                       (fmap (render colwidth) . inlineListToMarkdown opts)
+               meta
-                       (writerVariables opts)
-                       meta
-                 else return $ Object H.empty
   let title' = maybe empty text $ getField "title" metadata
   let authors' = maybe [] (map text) $ getField "author" metadata
   let date' = maybe empty text $ getField "date" metadata

src/Text/Pandoc/Writers/MediaWiki.hs

@@ -33,6 +33,7 @@ module Text.Pandoc.Writers.MediaWiki ( writeMediaWiki ) where
 import Text.Pandoc.Definition
 import Text.Pandoc.Options
 import Text.Pandoc.Shared
+import Text.Pandoc.Writers.Shared
 import Text.Pandoc.Templates (renderTemplate')
 import Text.Pandoc.XML ( escapeStringForXML )
 import Data.List ( intersect, intercalate )
@@ -54,10 +55,9 @@ writeMediaWiki opts document =
 -- | Return MediaWiki representation of document.
 pandocToMediaWiki :: WriterOptions -> Pandoc -> State WriterState String
 pandocToMediaWiki opts (Pandoc meta blocks) = do
-  metadata <- metaToJSON
+  metadata <- metaToJSON opts
               (fmap trimr . blockListToMediaWiki opts)
               (inlineListToMediaWiki opts)
-              (writerVariables opts)
               meta
   body <- blockListToMediaWiki opts blocks
   notesExist <- get >>= return . stNotes

src/Text/Pandoc/Writers/OPML.hs

@@ -30,6 +30,7 @@ Conversion of 'Pandoc' documents to OPML XML.
 module Text.Pandoc.Writers.OPML ( writeOPML) where
 import Text.Pandoc.Definition
 import Text.Pandoc.XML
+import Text.Pandoc.Writers.Shared
 import Text.Pandoc.Shared
 import Text.Pandoc.Options
 import Text.Pandoc.Templates (renderTemplate')
@@ -48,11 +49,10 @@ writeOPML opts (Pandoc meta blocks) =
                     then Just $ writerColumns opts
                     else Nothing
       meta' = B.setMeta "date" (B.str $ convertDate $ docDate meta) meta
-      Just metadata = metaToJSON
+      Just metadata = metaToJSON opts
                       (Just . writeMarkdown def . Pandoc nullMeta)
                       (Just . trimr . writeMarkdown def . Pandoc nullMeta .
                          (\ils -> [Plain ils]))
-                      (writerVariables opts)
                       meta'
       main     = render colwidth $ vcat (map (elementToOPML opts) elements)
       context = defField "body" main metadata

src/Text/Pandoc/Writers/OpenDocument.hs

@@ -42,7 +42,7 @@ import Control.Arrow ( (***), (>>>) )
 import Control.Monad.State hiding ( when )
 import Data.Char (chr, isDigit)
 import qualified Data.Map as Map
-import Text.Pandoc.Shared (metaToJSON, defField)
+import Text.Pandoc.Writers.Shared
 
 -- | Auxiliary function to convert Plain block to Para.
 plainToPara :: Block -> Block
@@ -180,10 +180,9 @@ writeOpenDocument opts (Pandoc meta blocks) =
       render' = render colwidth
       ((body, metadata),s) = flip runState
         defaultWriterState $ do
-           m <- metaToJSON
+           m <- metaToJSON opts
                   (fmap (render colwidth) . blocksToOpenDocument opts)
                   (fmap (render colwidth) . inlinesToOpenDocument opts)
-                  (writerVariables opts)
                   meta
            b <- render' `fmap` blocksToOpenDocument opts blocks
            return (b, m)

src/Text/Pandoc/Writers/Org.hs

@@ -34,6 +34,7 @@ module Text.Pandoc.Writers.Org ( writeOrg) where
 import Text.Pandoc.Definition
 import Text.Pandoc.Options
 import Text.Pandoc.Shared
+import Text.Pandoc.Writers.Shared
 import Text.Pandoc.Pretty
 import Text.Pandoc.Templates (renderTemplate')
 import Data.List ( intersect, intersperse, transpose )
@@ -63,10 +64,9 @@ pandocToOrg (Pandoc meta blocks) = do
   let colwidth = if writerWrapText opts
                     then Just $ writerColumns opts
                     else Nothing
-  metadata <- metaToJSON
+  metadata <- metaToJSON opts
                (fmap (render colwidth) . blockListToOrg)
                (fmap (render colwidth) . inlineListToOrg)
-               (writerVariables opts)
                meta
   body <- blockListToOrg blocks
   notes <- liftM (reverse . stNotes) get >>= notesToOrg

src/Text/Pandoc/Writers/RST.hs

@@ -34,6 +34,7 @@ module Text.Pandoc.Writers.RST ( writeRST ) where
 import Text.Pandoc.Definition
 import Text.Pandoc.Options
 import Text.Pandoc.Shared
+import Text.Pandoc.Writers.Shared
 import Text.Pandoc.Templates (renderTemplate')
 import Text.Pandoc.Builder (deleteMeta)
 import Data.List ( isPrefixOf, intersperse, transpose )
@@ -72,10 +73,10 @@ pandocToRST (Pandoc meta blocks) = do
                     Just (MetaBlocks [Plain xs]) -> xs
                     _ -> []
   title <- titleToRST (docTitle meta) subtit
-  metadata <- metaToJSON (fmap (render colwidth) . blockListToRST)
+  metadata <- metaToJSON opts
-                         (fmap (trimr . render colwidth) . inlineListToRST)
+                (fmap (render colwidth) . blockListToRST)
-              (writerVariables opts)
+                (fmap (trimr . render colwidth) . inlineListToRST)
-              $ deleteMeta "title" $ deleteMeta "subtitle" meta
+                $ deleteMeta "title" $ deleteMeta "subtitle" meta
   body <- blockListToRST blocks
   notes <- liftM (reverse . stNotes) get >>= notesToRST
   -- note that the notes may contain refs, so we do them first

src/Text/Pandoc/Writers/RTF.hs

@@ -31,6 +31,7 @@ module Text.Pandoc.Writers.RTF ( writeRTF, writeRTFWithEmbeddedImages ) where
 import Text.Pandoc.Definition
 import Text.Pandoc.Options
 import Text.Pandoc.Shared
+import Text.Pandoc.Writers.Shared
 import Text.Pandoc.Readers.TeXMath
 import Text.Pandoc.Templates (renderTemplate')
 import Text.Pandoc.Generic (bottomUpM)
@@ -75,10 +76,9 @@ writeRTFWithEmbeddedImages options doc =
 writeRTF :: WriterOptions -> Pandoc -> String
 writeRTF options (Pandoc meta blocks) =
   let spacer = not $ all null $ docTitle meta : docDate meta : docAuthors meta
-      Just metadata = metaToJSON
+      Just metadata = metaToJSON options
               (Just . concatMap (blockToRTF 0 AlignDefault))
               (Just . inlineListToRTF)
-              (writerVariables options)
               meta
       body = concatMap (blockToRTF 0 AlignDefault) blocks
       isTOCHeader (Header lev _ _) = lev <= writerTOCDepth options

src/Text/Pandoc/Writers/Texinfo.hs

@@ -31,6 +31,7 @@ module Text.Pandoc.Writers.Texinfo ( writeTexinfo ) where
 import Text.Pandoc.Definition
 import Text.Pandoc.Options
 import Text.Pandoc.Shared
+import Text.Pandoc.Writers.Shared
 import Text.Pandoc.Templates (renderTemplate')
 import Text.Printf ( printf )
 import Data.List ( transpose, maximumBy )
@@ -73,10 +74,10 @@ pandocToTexinfo options (Pandoc meta blocks) = do
   let colwidth = if writerWrapText options
                     then Just $ writerColumns options
                     else Nothing
-  metadata <- metaToJSON
+  metadata <- metaToJSON options
               (fmap (render colwidth) . blockListToTexinfo)
               (fmap (render colwidth) . inlineListToTexinfo)
-              (writerVariables options) meta
+              meta
   main <- blockListToTexinfo blocks
   st <- get
   let body = render colwidth main

src/Text/Pandoc/Writers/Textile.hs

@@ -33,6 +33,7 @@ module Text.Pandoc.Writers.Textile ( writeTextile ) where
 import Text.Pandoc.Definition
 import Text.Pandoc.Options
 import Text.Pandoc.Shared
+import Text.Pandoc.Writers.Shared
 import Text.Pandoc.Templates (renderTemplate')
 import Text.Pandoc.XML ( escapeStringForXML )
 import Data.List ( intercalate )
@@ -54,9 +55,8 @@ writeTextile opts document =
 -- | Return Textile representation of document.
 pandocToTextile :: WriterOptions -> Pandoc -> State WriterState String
 pandocToTextile opts (Pandoc meta blocks) = do
-  metadata <- metaToJSON
+  metadata <- metaToJSON opts (blockListToTextile opts)
-               (blockListToTextile opts) (inlineListToTextile opts)
+                 (inlineListToTextile opts) meta
-               (writerVariables opts) meta
   body <- blockListToTextile opts blocks
   notes <- liftM (unlines . reverse . stNotes) get
   let main = body ++ if null notes then "" else ("\n\n" ++ notes)