MD Reader/Templates: writer-dependent rawstr meta

Following proposal in #2139

src/Text/Pandoc/Options.hs

@@ -229,6 +229,7 @@ data ReaderOptions = ReaderOptions{
        , readerDefaultImageExtension :: String -- ^ Default extension for images
        , readerTrace           :: Bool -- ^ Print debugging info
        , readerTrackChanges    :: TrackChanges
+       , readerRawMetaStrings  :: Bool
 } deriving (Show, Read, Data, Typeable)
 
 instance Default ReaderOptions
@@ -245,6 +246,7 @@ instance Default ReaderOptions
                , readerDefaultImageExtension = ""
                , readerTrace                 = False
                , readerTrackChanges          = AcceptChanges
+               , readerRawMetaStrings        = False
                }
 
 --

src/Text/Pandoc/Readers/Markdown.hs

@@ -1,5 +1,5 @@
 {-# LANGUAGE RelaxedPolyRec #-} -- needed for inlinesBetween on GHC < 7
-{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE ScopedTypeVariables, PatternGuards #-}
 {-
 Copyright (C) 2006-2015 John MacFarlane <jgm@berkeley.edu>
 
@@ -303,7 +303,8 @@ toMetaValue opts x = toMeta <$> readMarkdown opts' (T.unpack x)
                              ]
 
 yamlToMeta :: ReaderOptions -> Yaml.Value -> Either PandocError MetaValue
-yamlToMeta opts (Yaml.String t) = toMetaValue opts t
+yamlToMeta opts (Yaml.String t) | readerRawMetaStrings opts = return $ MetaString (T.unpack t)
+                                | otherwise                 = toMetaValue opts t
 yamlToMeta _    (Yaml.Number n)
   -- avoid decimal points for numbers that don't need them:
   | base10Exponent n >= 0     = return $ MetaString $ show
@@ -316,7 +317,12 @@ yamlToMeta opts (Yaml.Object o) = MetaMap <$> H.foldrWithKey (\k v m ->
                                 if ignorable k
                                    then m
                                    else (do
-                                    v' <- yamlToMeta opts v
+                                    let p | not $ null (T.unpack k)
+                                          , head (T.unpack k) == '('
+                                          , last (T.unpack k) == ')'
+                                          = yamlToMeta opts{readerRawMetaStrings=True} v
+                                          | otherwise = yamlToMeta opts v
+                                    v' <- p
                                     m' <- m
                                     return (M.insert (T.unpack k) v' m')))
                                 (return M.empty) o

src/Text/Pandoc/Templates.hs

@@ -1,5 +1,6 @@
 {-# LANGUAGE TypeSynonymInstances, FlexibleInstances, CPP,
-    OverloadedStrings, GeneralizedNewtypeDeriving #-}
+    OverloadedStrings, GeneralizedNewtypeDeriving,
+    DeriveDataTypeable #-}
 {-
 Copyright (C) 2009-2015 John MacFarlane <jgm@berkeley.edu>
 
@@ -86,15 +87,18 @@ example above.
 -}
 
 module Text.Pandoc.Templates ( renderTemplate
+                             , renderTemplateWriter
                              , renderTemplate'
+                             , renderTemplateWriter'
                              , TemplateTarget(..)
                              , varListToJSON
                              , compileTemplate
                              , Template
+                             , WriterType(..)
                              , getDefaultTemplate ) where
 
 import Data.Char (isAlphaNum)
-import Control.Monad (guard, when)
+import Control.Monad (guard, when, mplus)
 import Data.Aeson (ToJSON(..), Value(..))
 import qualified Text.Parsec as P
 import Text.Parsec.Text (Parser)
@@ -118,6 +122,8 @@ import Text.Blaze (preEscapedText, Html)
 import Data.ByteString.Lazy (ByteString, fromChunks)
 import Text.Pandoc.Shared (readDataFileUTF8, ordNub)
 import Data.Vector ((!?))
+import Data.Data (Data,Typeable,toConstr)
+import Data.Maybe (fromJust)
 
 -- | Get default template for the specified writer.
 getDefaultTemplate :: (Maybe FilePath) -- ^ User data directory to search first
@@ -139,9 +145,16 @@ getDefaultTemplate user writer = do
        _        -> let fname = "templates" </> "default" <.> format
                    in  E.try $ readDataFileUTF8 user fname
 
-newtype Template = Template { unTemplate :: Value -> Text }
+newtype Template = Template { unTemplate :: WriterType -> Value -> Text }
                  deriving Monoid
 
+data WriterType = WriterAsciiDoc | WriterCMark | WriterConTeXt | WriterCustom | WriterDocbook |
+                  WriterDokuWiki | WriterEPUB | WriterFB2 | WriterHaddock | WriterHTML | WriterICML |
+                  WriterLaTeX | WriterMan | WriterMediaWiki | WriterMarkdown | WriterOpenDocument |
+                  WriterOPML | WriterOrg | WriterRST | WriterRTF | WriterTexinfo | WriterTextile |
+                  WriterWildcard
+                  deriving (Data,Typeable)
+
 type Variable = [Text]
 
 class TemplateTarget a where
@@ -169,8 +182,28 @@ varListToJSON assoc = toJSON $ M.fromList assoc'
         toVal []  = Null
         toVal xs  = toJSON xs
 
+writerTypeC :: WriterType -> T.Text
+writerTypeC WriterWildcard = "(*)"
+writerTypeC x = "(" `T.append` name `T.append` ")"
+  where name = T.toLower stripped
+        stripped = fromJust $ T.stripPrefix "Writer" constr
+        constr = T.pack $ show (toConstr x)
+
+writerTypeCS :: [WriterType] -> [T.Text]
+writerTypeCS wts = map writerTypeC wts ++ [writerTypeC WriterWildcard]
+
+writerTypeStr :: WriterType -> [T.Text]
+writerTypeStr WriterWildcard = writerTypeCS []
+writerTypeStr WriterCMark    = writerTypeCS [WriterCMark, WriterMarkdown]
+writerTypeStr WriterMarkdown = writerTypeCS [WriterMarkdown, WriterCMark]
+writerTypeStr x = writerTypeCS [x]
+
+
+renderTemplateWriter :: (ToJSON a, TemplateTarget b) => WriterType -> Template -> a -> b
+renderTemplateWriter w (Template f) context = toTarget $ f w $ toJSON context
+
 renderTemplate :: (ToJSON a, TemplateTarget b) => Template -> a -> b
-renderTemplate (Template f) context = toTarget $ f $ toJSON context
+renderTemplate = renderTemplateWriter WriterWildcard
 
 compileTemplate :: Text -> Either String Template
 compileTemplate template =
@@ -180,49 +213,55 @@ compileTemplate template =
 
 -- | Like 'renderTemplate', but compiles the template first,
 -- raising an error if compilation fails.
+renderTemplateWriter' :: (ToJSON a, TemplateTarget b) => WriterType -> String -> a -> b
+renderTemplateWriter' w template =
+  renderTemplateWriter w (either error id $ compileTemplate $ T.pack template)
+
 renderTemplate' :: (ToJSON a, TemplateTarget b) => String -> a -> b
-renderTemplate' template =
-  renderTemplate (either error id $ compileTemplate $ T.pack template)
+renderTemplate' = renderTemplateWriter' WriterWildcard
 
 var :: Variable -> Template
 var = Template . resolveVar
 
-resolveVar :: Variable -> Value -> Text
-resolveVar var' val =
-  case multiLookup var' val of
-       Just (Array vec) -> maybe mempty (resolveVar []) $ vec !? 0
+resolveVar :: Variable -> WriterType -> Value -> Text
+resolveVar var' w val =
+  case multiLookup w var' val of
+       Just (Array vec) -> maybe mempty (resolveVar [] w) $ vec !? 0
        Just (String t)  -> T.stripEnd t
        Just (Number n)  -> T.pack $ show n
        Just (Bool True) -> "true"
        Just (Object _)  -> "true"
        Just _           -> mempty
        Nothing          -> mempty
 
-multiLookup :: [Text] -> Value -> Maybe Value
-multiLookup [] x = Just x
-multiLookup (v:vs) (Object o) = H.lookup v o >>= multiLookup vs
-multiLookup _ _ = Nothing
+multiLookup :: WriterType -> [Text] -> Value -> Maybe Value
+multiLookup w [] x@(Object o)
+  = foldr mplus (Just x) $
+      flip H.lookup o `map` writerTypeStr w
+multiLookup _ [] x = Just x
+multiLookup w (v:vs) (Object o) = H.lookup v o >>= multiLookup w vs
+multiLookup _ _ _ = Nothing
 
 lit :: Text -> Template
-lit = Template . const
+lit = Template . const . const
 
 cond :: Variable -> Template -> Template -> Template
-cond var' (Template ifyes) (Template ifno) = Template $ \val ->
-  case resolveVar var' val of
-       "" -> ifno val
-       _  -> ifyes val
+cond var' (Template ifyes) (Template ifno) = Template $ \w val ->
+  case resolveVar var' w val of
+       "" -> ifno w val
+       _  -> ifyes w val
 
 iter :: Variable -> Template -> Template -> Template
-iter var' template sep = Template $ \val -> unTemplate
-  (case multiLookup var' val of
+iter var' template sep = Template $ \w val -> unTemplate
+  (case multiLookup w var' val of
            Just (Array vec) -> mconcat $ intersperse sep
                                        $ map (setVar template var')
                                        $ toList vec
            Just x           -> cond var' (setVar template var' x) mempty
-           Nothing          -> mempty) val
+           Nothing          -> mempty) w val
 
 setVar :: Template -> Variable -> Value -> Template
-setVar (Template f) var' val = Template $ f . replaceVar var' val
+setVar (Template f) var' val = Template $ \w -> f w . replaceVar var' val
 
 replaceVar :: Variable -> Value -> Value -> Value
 replaceVar []     new _          = new
@@ -324,6 +363,6 @@ pFor = do
 
 indent :: Int -> Template -> Template
 indent 0   x            = x
-indent ind (Template f) = Template $ \val -> indent' (f val)
+indent ind (Template f) = Template $ \w val -> indent' (f w val)
   where indent' t = T.concat
                     $ intersperse ("\n" <> T.replicate ind " ") $ T.lines t

src/Text/Pandoc/Writers/AsciiDoc.hs

@@ -38,7 +38,7 @@ AsciiDoc:  <http://www.methods.co.nz/asciidoc/>
 -}
 module Text.Pandoc.Writers.AsciiDoc (writeAsciiDoc) where
 import Text.Pandoc.Definition
-import Text.Pandoc.Templates (renderTemplate')
+import Text.Pandoc.Templates (renderTemplateWriter',WriterType(..))
 import Text.Pandoc.Shared
 import Text.Pandoc.Writers.Shared
 import Text.Pandoc.Options
@@ -95,7 +95,7 @@ pandocToAsciiDoc opts (Pandoc meta blocks) = do
                $ defField "titleblock" titleblock
                $ metadata'
   if writerStandalone opts
-     then return $ renderTemplate' (writerTemplate opts) context
+     then return $ renderTemplateWriter' WriterAsciiDoc (writerTemplate opts) context
      else return main
 
 -- | Escape special characters for AsciiDoc.

src/Text/Pandoc/Writers/CommonMark.hs

@@ -34,7 +34,7 @@ module Text.Pandoc.Writers.CommonMark (writeCommonMark) where
 import Text.Pandoc.Writers.HTML (writeHtmlString)
 import Text.Pandoc.Definition
 import Text.Pandoc.Shared (isTightList)
-import Text.Pandoc.Templates (renderTemplate')
+import Text.Pandoc.Templates (renderTemplateWriter',WriterType(..))
 import Text.Pandoc.Writers.Shared
 import Text.Pandoc.Options
 import CMark
@@ -57,7 +57,7 @@ writeCommonMark opts (Pandoc meta blocks) = rendered
                      meta
         context = defField "body" main $ metadata
         rendered = if writerStandalone opts
-                      then renderTemplate' (writerTemplate opts) context
+                      then renderTemplateWriter' WriterCMark (writerTemplate opts) context
                       else main
 
 processNotes :: Inline -> State [[Block]] Inline

src/Text/Pandoc/Writers/ConTeXt.hs

@@ -39,7 +39,7 @@ import Data.List ( intercalate )
 import Data.Char ( ord )
 import Control.Monad.State
 import Text.Pandoc.Pretty
-import Text.Pandoc.Templates ( renderTemplate' )
+import Text.Pandoc.Templates ( renderTemplateWriter', WriterType(..) )
 import Network.URI ( isURI, unEscapeString )
 
 data WriterState =
@@ -85,7 +85,7 @@ pandocToConTeXt options (Pandoc meta blocks) = do
                     (lookup "lang" $ writerVariables options))
                 $ metadata
   return $ if writerStandalone options
-              then renderTemplate' (writerTemplate options) context
+              then renderTemplateWriter' WriterConTeXt (writerTemplate options) context
               else main
 
 -- escape things as needed for ConTeXt
@@ -360,4 +360,3 @@ sectionHeader (ident,classes,_) hdrLevel lst = do
                else if level' == 0
                        then char '\\' <> chapter <> braces contents
                        else contents <> blankline
-

src/Text/Pandoc/Writers/Custom.hs

@@ -181,7 +181,7 @@ writeCustom luaFile opts doc@(Pandoc meta _) = do
   if writerStandalone opts
      then do
        let context' = setField "body" body context
-       return $ renderTemplate' (writerTemplate opts) context'
+       return $ renderTemplateWriter' WriterCustom (writerTemplate opts) context'
      else return body
 
 docToCustom :: LuaState -> WriterOptions -> Pandoc -> IO String

src/Text/Pandoc/Writers/Docbook.hs

@@ -35,7 +35,7 @@ import Text.Pandoc.Shared
 import Text.Pandoc.Walk
 import Text.Pandoc.Writers.Shared
 import Text.Pandoc.Options
-import Text.Pandoc.Templates (renderTemplate')
+import Text.Pandoc.Templates (renderTemplateWriter',WriterType(..))
 import Text.Pandoc.Readers.TeXMath
 import Data.List ( stripPrefix, isPrefixOf, intercalate, isSuffixOf )
 import Data.Char ( toLower )
@@ -99,7 +99,7 @@ writeDocbook opts (Pandoc meta blocks) =
                                         _        -> False)
               $ metadata
   in  if writerStandalone opts
-         then renderTemplate' (writerTemplate opts) context
+         then renderTemplateWriter' WriterDocbook (writerTemplate opts) context
          else main
 
 -- | Convert an Element to Docbook.

src/Text/Pandoc/Writers/DokuWiki.hs

@@ -47,7 +47,7 @@ import Text.Pandoc.Options ( WriterOptions(
 import Text.Pandoc.Shared ( escapeURI, removeFormatting, camelCaseToHyphenated
                           , trimr, normalize, substitute  )
 import Text.Pandoc.Writers.Shared ( defField, metaToJSON )
-import Text.Pandoc.Templates ( renderTemplate' )
+import Text.Pandoc.Templates ( renderTemplateWriter', WriterType(..) )
 import Data.List ( intersect, intercalate, isPrefixOf, transpose )
 import Data.Default (Default(..))
 import Network.URI ( isURI )
@@ -102,7 +102,7 @@ pandocToDokuWiki opts (Pandoc meta blocks) = do
                 $ defField "toc" (writerTableOfContents opts)
                 $ metadata
   if writerStandalone opts
-     then return $ renderTemplate' (writerTemplate opts) context
+     then return $ renderTemplateWriter' WriterDokuWiki (writerTemplate opts) context
      else return main
 
 -- | Escape special characters for DokuWiki.

src/Text/Pandoc/Writers/HTML.hs

@@ -202,7 +202,7 @@ inTemplate :: TemplateTarget a
            -> Value
            -> Html
            -> a
-inTemplate opts context body = renderTemplate' (writerTemplate opts)
+inTemplate opts context body = renderTemplateWriter' WriterHTML (writerTemplate opts)
                              $ defField "body" (renderHtml body) context
 
 -- | Like Text.XHtml's identifier, but adds the writerIdentifierPrefix
@@ -769,7 +769,7 @@ inlineToHtml opts inline =
               let brtag = if writerHtml5 opts then H5.br else H.br
               return  $ case t of
                          InlineMath  -> m
-                         DisplayMath -> brtag >> m >> brtag 
+                         DisplayMath -> brtag >> m >> brtag
     (RawInline f str)
       | f == Format "latex" ->
                           case writerHTMLMathMethod opts of

src/Text/Pandoc/Writers/Haddock.hs

@@ -32,7 +32,7 @@ Haddock:  <http://www.haskell.org/haddock/doc/html/>
 -}
 module Text.Pandoc.Writers.Haddock (writeHaddock) where
 import Text.Pandoc.Definition
-import Text.Pandoc.Templates (renderTemplate')
+import Text.Pandoc.Templates (renderTemplateWriter',WriterType(..))
 import Text.Pandoc.Shared
 import Text.Pandoc.Writers.Shared
 import Text.Pandoc.Options
@@ -74,7 +74,7 @@ pandocToHaddock opts (Pandoc meta blocks) = do
   let context  = defField "body" main
                $ metadata
   if writerStandalone opts
-     then return $ renderTemplate' (writerTemplate opts) context
+     then return $ renderTemplateWriter' WriterHaddock (writerTemplate opts) context
      else return main
 
 -- | Return haddock representation of notes.

src/Text/Pandoc/Writers/ICML.hs

@@ -19,7 +19,7 @@ import Text.Pandoc.XML
 import Text.Pandoc.Writers.Shared
 import Text.Pandoc.Shared (splitBy)
 import Text.Pandoc.Options
-import Text.Pandoc.Templates (renderTemplate')
+import Text.Pandoc.Templates (renderTemplateWriter',WriterType(..))
 import Text.Pandoc.Pretty
 import Data.List (isPrefixOf, isInfixOf, stripPrefix)
 import Data.Text as Text (breakOnAll, pack)
@@ -134,7 +134,7 @@ writeICML opts (Pandoc meta blocks) =
               $ defField "hyperlinks" (render' $ hyperlinksToDoc $ links st)
               $ metadata
   in  if writerStandalone opts
-         then renderTemplate' (writerTemplate opts) context
+         then renderTemplateWriter' WriterICML (writerTemplate opts) context
          else main
 
 -- | Auxilary functions for parStylesToDoc and charStylesToDoc.

src/Text/Pandoc/Writers/LaTeX.hs

@@ -175,7 +175,7 @@ pandocToLaTeX options (Pandoc meta blocks) = do
                          _        -> id) $
                   metadata
   return $ if writerStandalone options
-              then renderTemplate' template context
+              then renderTemplateWriter' WriterLaTeX template context
               else main
 
 -- | Convert Elements to LaTeX

src/Text/Pandoc/Writers/Man.hs

@@ -87,7 +87,7 @@ pandocToMan opts (Pandoc meta blocks) = do
               $ defField "has-tables" hasTables
               $ metadata
   if writerStandalone opts
-     then return $ renderTemplate' (writerTemplate opts) context
+     then return $ renderTemplateWriter' WriterMan (writerTemplate opts) context
      else return main
 
 -- | Return man representation of notes.
@@ -363,4 +363,3 @@ inlineToMan _ (Note contents) = do
   notes <- liftM stNotes get
   let ref = show $ (length notes)
   return $ char '[' <> text ref <> char ']'
-