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.
2013-07-01 20:47:26 -07:00 · 2013-07-01 20:47:26 -07:00 · 956425709d
commit 956425709d
parent 19ad69b1c6
18 changed files with 41 additions and 120 deletions
--- a/CONTRIBUTING.md
+++ b/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.
--- a/pandoc.cabal
+++ b/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,
--- a/src/Text/Pandoc/Shared.hs
+++ b/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
 --
--- a/src/Text/Pandoc/Writers/AsciiDoc.hs
+++ b/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) "="
--- a/src/Text/Pandoc/Writers/ConTeXt.hs
+++ b/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
--- a/src/Text/Pandoc/Writers/Docbook.hs
+++ b/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
--- a/src/Text/Pandoc/Writers/HTML.hs
+++ b/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
--- a/src/Text/Pandoc/Writers/LaTeX.hs
+++ b/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, [])
--- a/src/Text/Pandoc/Writers/Man.hs
+++ b/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
--- a/src/Text/Pandoc/Writers/Markdown.hs
+++ b/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
-                 then metaToJSON
+  metadata <- metaToJSON opts
               (fmap (render colwidth) . blockListToMarkdown opts)
               (fmap (render colwidth) . inlineListToMarkdown opts)
-                       (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
--- a/src/Text/Pandoc/Writers/MediaWiki.hs
+++ b/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
--- a/src/Text/Pandoc/Writers/OPML.hs
+++ b/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
--- a/src/Text/Pandoc/Writers/OpenDocument.hs
+++ b/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)
--- a/src/Text/Pandoc/Writers/Org.hs
+++ b/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
--- a/src/Text/Pandoc/Writers/RST.hs
+++ b/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,9 +73,9 @@ 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 (render colwidth) . blockListToRST)
                (fmap (trimr . render colwidth) . inlineListToRST)
-              (writerVariables opts)
                $ deleteMeta "title" $ deleteMeta "subtitle" meta
  body <- blockListToRST blocks
  notes <- liftM (reverse . stNotes) get >>= notesToRST
--- a/src/Text/Pandoc/Writers/RTF.hs
+++ b/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
--- a/src/Text/Pandoc/Writers/Texinfo.hs
+++ b/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
--- a/src/Text/Pandoc/Writers/Textile.hs
+++ b/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
-               (blockListToTextile opts) (inlineListToTextile opts)
-               (writerVariables opts) meta
+  metadata <- metaToJSON opts (blockListToTextile opts)
+                 (inlineListToTextile opts) meta
  body <- blockListToTextile opts blocks
  notes <- liftM (unlines . reverse . stNotes) get
  let main = body ++ if null notes then "" else ("\n\n" ++ notes)