From fb8a2540bdb91eee0ecf620b4e9d7acf3d78042f Mon Sep 17 00:00:00 2001 From: John MacFarlane Date: Wed, 30 Nov 2016 15:34:58 +0100 Subject: Options: Removed writerStandalone, made writerTemplate a Maybe. Previously setting writerStandalone = True did nothing unless a template was provided in writerTemplate. Now a fragment will be generated if writerTemplate is Nothing; otherwise, the specified template will be used and standalone output generated. [API change] --- src/Text/Pandoc/Options.hs | 6 ++---- src/Text/Pandoc/Writers/AsciiDoc.hs | 9 +++++---- src/Text/Pandoc/Writers/CommonMark.hs | 6 +++--- src/Text/Pandoc/Writers/ConTeXt.hs | 6 +++--- src/Text/Pandoc/Writers/Custom.hs | 8 +++----- src/Text/Pandoc/Writers/Docbook.hs | 9 +++++---- src/Text/Pandoc/Writers/DokuWiki.hs | 7 +++---- src/Text/Pandoc/Writers/EPUB.hs | 1 - src/Text/Pandoc/Writers/FB2.hs | 2 +- src/Text/Pandoc/Writers/HTML.hs | 22 ++++++++-------------- src/Text/Pandoc/Writers/Haddock.hs | 6 +++--- src/Text/Pandoc/Writers/ICML.hs | 6 +++--- src/Text/Pandoc/Writers/LaTeX.hs | 8 ++++---- src/Text/Pandoc/Writers/Man.hs | 6 +++--- src/Text/Pandoc/Writers/Markdown.hs | 28 ++++++++++++++-------------- src/Text/Pandoc/Writers/MediaWiki.hs | 6 +++--- src/Text/Pandoc/Writers/Native.hs | 10 +++------- src/Text/Pandoc/Writers/OPML.hs | 6 +++--- src/Text/Pandoc/Writers/OpenDocument.hs | 6 +++--- src/Text/Pandoc/Writers/Org.hs | 6 +++--- src/Text/Pandoc/Writers/RST.hs | 12 ++++++------ src/Text/Pandoc/Writers/RTF.hs | 10 +++++----- src/Text/Pandoc/Writers/Shared.hs | 3 ++- src/Text/Pandoc/Writers/TEI.hs | 6 +++--- src/Text/Pandoc/Writers/Texinfo.hs | 6 +++--- src/Text/Pandoc/Writers/Textile.hs | 6 +++--- src/Text/Pandoc/Writers/ZimWiki.hs | 8 ++++---- 27 files changed, 101 insertions(+), 114 deletions(-) (limited to 'src') diff --git a/src/Text/Pandoc/Options.hs b/src/Text/Pandoc/Options.hs index b02a5181f..48bc5f4eb 100644 --- a/src/Text/Pandoc/Options.hs +++ b/src/Text/Pandoc/Options.hs @@ -356,8 +356,7 @@ data ReferenceLocation = EndOfBlock -- ^ End of block -- | Options for writers data WriterOptions = WriterOptions - { writerStandalone :: Bool -- ^ Include header and footer - , writerTemplate :: String -- ^ Template to use in standalone mode + { writerTemplate :: Maybe String -- ^ Template to use , writerVariables :: [(String, String)] -- ^ Variables to set in template , writerTabStop :: Int -- ^ Tabstop for conversion btw spaces and tabs , writerTableOfContents :: Bool -- ^ Include table of contents @@ -405,8 +404,7 @@ data WriterOptions = WriterOptions } deriving (Show, Data, Typeable, Generic) instance Default WriterOptions where - def = WriterOptions { writerStandalone = False - , writerTemplate = "" + def = WriterOptions { writerTemplate = Nothing , writerVariables = [] , writerTabStop = 4 , writerTableOfContents = False diff --git a/src/Text/Pandoc/Writers/AsciiDoc.hs b/src/Text/Pandoc/Writers/AsciiDoc.hs index c7097c368..e9d3dccf1 100644 --- a/src/Text/Pandoc/Writers/AsciiDoc.hs +++ b/src/Text/Pandoc/Writers/AsciiDoc.hs @@ -92,12 +92,13 @@ pandocToAsciiDoc opts (Pandoc meta blocks) = do let main = render colwidth body let context = defField "body" main $ defField "toc" - (writerTableOfContents opts && writerStandalone opts) + (writerTableOfContents opts && + writerTemplate opts /= Nothing) $ defField "titleblock" titleblock $ metadata' - if writerStandalone opts - then return $ renderTemplate' (writerTemplate opts) context - else return main + case writerTemplate opts of + Nothing -> return main + Just tpl -> return $ renderTemplate' tpl context -- | Escape special characters for AsciiDoc. escapeString :: String -> String diff --git a/src/Text/Pandoc/Writers/CommonMark.hs b/src/Text/Pandoc/Writers/CommonMark.hs index c6509fe92..88a92eb47 100644 --- a/src/Text/Pandoc/Writers/CommonMark.hs +++ b/src/Text/Pandoc/Writers/CommonMark.hs @@ -56,9 +56,9 @@ writeCommonMark opts (Pandoc meta blocks) = rendered (inlinesToCommonMark opts) meta context = defField "body" main $ metadata - rendered = if writerStandalone opts - then renderTemplate' (writerTemplate opts) context - else main + rendered = case writerTemplate opts of + Nothing -> main + Just tpl -> renderTemplate' tpl context processNotes :: Inline -> State [[Block]] Inline processNotes (Note bs) = do diff --git a/src/Text/Pandoc/Writers/ConTeXt.hs b/src/Text/Pandoc/Writers/ConTeXt.hs index 70bed4961..c663c75ce 100644 --- a/src/Text/Pandoc/Writers/ConTeXt.hs +++ b/src/Text/Pandoc/Writers/ConTeXt.hs @@ -98,9 +98,9 @@ pandocToConTeXt options (Pandoc meta blocks) = do getField "lang" context) $ defField "context-dir" (toContextDir $ getField "dir" context) $ context - return $ if writerStandalone options - then renderTemplate' (writerTemplate options) context' - else main + return $ case writerTemplate options of + Nothing -> main + Just tpl -> renderTemplate' tpl context' toContextDir :: Maybe String -> String toContextDir (Just "rtl") = "r2l" diff --git a/src/Text/Pandoc/Writers/Custom.hs b/src/Text/Pandoc/Writers/Custom.hs index 631241724..cf641dcd6 100644 --- a/src/Text/Pandoc/Writers/Custom.hs +++ b/src/Text/Pandoc/Writers/Custom.hs @@ -202,11 +202,9 @@ writeCustom luaFile opts doc@(Pandoc meta _) = do Lua.close lua setForeignEncoding enc let body = rendered - if writerStandalone opts - then do - let context' = setField "body" body context - return $ renderTemplate' (writerTemplate opts) context' - else return body + case writerTemplate opts of + Nothing -> return body + Just tpl -> return $ renderTemplate' tpl $ setField "body" body context docToCustom :: LuaState -> WriterOptions -> Pandoc -> IO String docToCustom lua opts (Pandoc (Meta metamap) blocks) = do diff --git a/src/Text/Pandoc/Writers/Docbook.hs b/src/Text/Pandoc/Writers/Docbook.hs index 278bbdcc8..5321d46df 100644 --- a/src/Text/Pandoc/Writers/Docbook.hs +++ b/src/Text/Pandoc/Writers/Docbook.hs @@ -80,7 +80,8 @@ writeDocbook opts (Pandoc meta blocks) = then Just $ writerColumns opts else Nothing render' = render colwidth - opts' = if ("/book>" `isSuffixOf` (trimr $ writerTemplate opts) && + opts' = if (maybe False (("/book>" `isSuffixOf`) . trimr) + (writerTemplate opts) && TopLevelDefault == writerTopLevelDivision opts) then opts{ writerTopLevelDivision = TopLevelChapter } else opts @@ -103,9 +104,9 @@ writeDocbook opts (Pandoc meta blocks) = MathML _ -> True _ -> False) $ metadata - in if writerStandalone opts - then renderTemplate' (writerTemplate opts) context - else main + in case writerTemplate opts of + Nothing -> main + Just tpl -> renderTemplate' tpl context -- | Convert an Element to Docbook. elementToDocbook :: WriterOptions -> Int -> Element -> Doc diff --git a/src/Text/Pandoc/Writers/DokuWiki.hs b/src/Text/Pandoc/Writers/DokuWiki.hs index 402b74bc3..7459f1b42 100644 --- a/src/Text/Pandoc/Writers/DokuWiki.hs +++ b/src/Text/Pandoc/Writers/DokuWiki.hs @@ -42,7 +42,6 @@ module Text.Pandoc.Writers.DokuWiki ( writeDokuWiki ) where import Text.Pandoc.Definition import Text.Pandoc.Options ( WriterOptions( writerTableOfContents - , writerStandalone , writerTemplate , writerWrapText), WrapOption(..) ) import Text.Pandoc.Shared ( escapeURI, linesToPara, removeFormatting @@ -102,9 +101,9 @@ pandocToDokuWiki opts (Pandoc meta blocks) = do let context = defField "body" main $ defField "toc" (writerTableOfContents opts) $ metadata - if writerStandalone opts - then return $ renderTemplate' (writerTemplate opts) context - else return main + case writerTemplate opts of + Nothing -> return main + Just tpl -> return $ renderTemplate' tpl context -- | Escape special characters for DokuWiki. escapeString :: String -> String diff --git a/src/Text/Pandoc/Writers/EPUB.hs b/src/Text/Pandoc/Writers/EPUB.hs index c73155088..00bf4a81c 100644 --- a/src/Text/Pandoc/Writers/EPUB.hs +++ b/src/Text/Pandoc/Writers/EPUB.hs @@ -342,7 +342,6 @@ writeEPUB opts doc@(Pandoc meta _) = do : ("css", "stylesheet.css") : writerVariables opts let opts' = opts{ writerEmailObfuscation = NoObfuscation - , writerStandalone = True , writerSectionDivs = True , writerHtml5 = epub3 , writerVariables = vars diff --git a/src/Text/Pandoc/Writers/FB2.hs b/src/Text/Pandoc/Writers/FB2.hs index 6f47dbcd2..5538ca061 100644 --- a/src/Text/Pandoc/Writers/FB2.hs +++ b/src/Text/Pandoc/Writers/FB2.hs @@ -77,7 +77,7 @@ writeFB2 :: WriterOptions -- ^ conversion options -> Pandoc -- ^ document to convert -> IO String -- ^ FictionBook2 document (not encoded yet) writeFB2 opts (Pandoc meta blocks) = flip evalStateT newFB $ do - modify (\s -> s { writerOptions = opts { writerStandalone = True } }) + modify (\s -> s { writerOptions = opts }) desc <- description meta fp <- frontpage meta secs <- renderSections 1 blocks diff --git a/src/Text/Pandoc/Writers/HTML.hs b/src/Text/Pandoc/Writers/HTML.hs index 358017fd4..9581702a7 100644 --- a/src/Text/Pandoc/Writers/HTML.hs +++ b/src/Text/Pandoc/Writers/HTML.hs @@ -102,17 +102,19 @@ nl opts = if writerWrapText opts == WrapNone writeHtmlString :: WriterOptions -> Pandoc -> String writeHtmlString opts d = let (body, context) = evalState (pandocToHtml opts d) defaultWriterState - in if writerStandalone opts - then inTemplate opts context body - else renderHtml body + in case writerTemplate opts of + Nothing -> renderHtml body + Just tpl -> renderTemplate' tpl $ + defField "body" (renderHtml body) context -- | Convert Pandoc document to Html structure. writeHtml :: WriterOptions -> Pandoc -> Html writeHtml opts d = let (body, context) = evalState (pandocToHtml opts d) defaultWriterState - in if writerStandalone opts - then inTemplate opts context body - else body + in case writerTemplate opts of + Nothing -> body + Just tpl -> renderTemplate' tpl $ + defField "body" (renderHtml body) context -- result is (title, authors, date, toc, body, new variables) pandocToHtml :: WriterOptions @@ -194,14 +196,6 @@ pandocToHtml opts (Pandoc meta blocks) = do metadata return (thebody, context) -inTemplate :: TemplateTarget a - => WriterOptions - -> Value - -> Html - -> a -inTemplate opts context body = renderTemplate' (writerTemplate opts) - $ defField "body" (renderHtml body) context - -- | Like Text.XHtml's identifier, but adds the writerIdentifierPrefix prefixedId :: WriterOptions -> String -> Attribute prefixedId opts s = diff --git a/src/Text/Pandoc/Writers/Haddock.hs b/src/Text/Pandoc/Writers/Haddock.hs index caf549916..29fdafe15 100644 --- a/src/Text/Pandoc/Writers/Haddock.hs +++ b/src/Text/Pandoc/Writers/Haddock.hs @@ -73,9 +73,9 @@ pandocToHaddock opts (Pandoc meta blocks) = do meta let context = defField "body" main $ metadata - if writerStandalone opts - then return $ renderTemplate' (writerTemplate opts) context - else return main + case writerTemplate opts of + Nothing -> return main + Just tpl -> return $ renderTemplate' tpl context -- | Return haddock representation of notes. notesToHaddock :: WriterOptions -> [[Block]] -> State WriterState Doc diff --git a/src/Text/Pandoc/Writers/ICML.hs b/src/Text/Pandoc/Writers/ICML.hs index 09d1a9c79..8f0d21cf5 100644 --- a/src/Text/Pandoc/Writers/ICML.hs +++ b/src/Text/Pandoc/Writers/ICML.hs @@ -141,9 +141,9 @@ writeICML opts (Pandoc meta blocks) = do $ defField "parStyles" (render' $ parStylesToDoc st) $ defField "hyperlinks" (render' $ hyperlinksToDoc $ links st) $ metadata - return $ if writerStandalone opts - then renderTemplate' (writerTemplate opts) context - else main + return $ case writerTemplate opts of + Nothing -> main + Just tpl -> renderTemplate' tpl context -- | Auxilary functions for parStylesToDoc and charStylesToDoc. contains :: String -> (String, (String, String)) -> [(String, String)] diff --git a/src/Text/Pandoc/Writers/LaTeX.hs b/src/Text/Pandoc/Writers/LaTeX.hs index d9c9e3621..afadbcb67 100644 --- a/src/Text/Pandoc/Writers/LaTeX.hs +++ b/src/Text/Pandoc/Writers/LaTeX.hs @@ -109,7 +109,7 @@ pandocToLaTeX options (Pandoc meta blocks) = do let isInternalLink (Link _ _ ('#':xs,_)) = [xs] isInternalLink _ = [] modify $ \s -> s{ stInternalLinks = query isInternalLink blocks' } - let template = writerTemplate options + let template = maybe "" id $ writerTemplate options -- set stBook depending on documentclass let colwidth = if writerWrapText options == WrapAuto then Just $ writerColumns options @@ -246,9 +246,9 @@ pandocToLaTeX options (Pandoc meta blocks) = do Just "rtl" -> True _ -> False) $ context - return $ if writerStandalone options - then renderTemplate' template context' - else main + return $ case writerTemplate options of + Nothing -> main + Just tpl -> renderTemplate' tpl context' -- | Convert Elements to LaTeX elementToLaTeX :: WriterOptions -> Element -> State WriterState Doc diff --git a/src/Text/Pandoc/Writers/Man.hs b/src/Text/Pandoc/Writers/Man.hs index 159e89308..3dd89f17e 100644 --- a/src/Text/Pandoc/Writers/Man.hs +++ b/src/Text/Pandoc/Writers/Man.hs @@ -88,9 +88,9 @@ pandocToMan opts (Pandoc meta blocks) = do $ defField "hyphenate" True $ defField "pandoc-version" pandocVersion $ metadata - if writerStandalone opts - then return $ renderTemplate' (writerTemplate opts) context - else return main + case writerTemplate opts of + Nothing -> return main + Just tpl -> return $ renderTemplate' tpl context -- | Return man representation of notes. notesToMan :: WriterOptions -> [[Block]] -> State WriterState Doc diff --git a/src/Text/Pandoc/Writers/Markdown.hs b/src/Text/Pandoc/Writers/Markdown.hs index 0e4ddc5b6..3a6ea77ac 100644 --- a/src/Text/Pandoc/Writers/Markdown.hs +++ b/src/Text/Pandoc/Writers/Markdown.hs @@ -184,17 +184,17 @@ pandocToMarkdown opts (Pandoc meta blocks) = do let title' = maybe empty text $ getField "title" metadata let authors' = maybe [] (map text) $ getField "author" metadata let date' = maybe empty text $ getField "date" metadata - let titleblock = case writerStandalone opts of - True | isPlain -> - plainTitleBlock title' authors' date' - | isEnabled Ext_yaml_metadata_block opts -> - yamlMetadataBlock metadata - | isEnabled Ext_pandoc_title_block opts -> - pandocTitleBlock title' authors' date' - | isEnabled Ext_mmd_title_block opts -> - mmdTitleBlock metadata - | otherwise -> empty - False -> empty + let titleblock = case writerTemplate opts of + Just _ | isPlain -> + plainTitleBlock title' authors' date' + | isEnabled Ext_yaml_metadata_block opts -> + yamlMetadataBlock metadata + | isEnabled Ext_pandoc_title_block opts -> + pandocTitleBlock title' authors' date' + | isEnabled Ext_mmd_title_block opts -> + mmdTitleBlock metadata + | otherwise -> empty + Nothing -> empty let headerBlocks = filter isHeaderBlock blocks let toc = if writerTableOfContents opts then tableOfContents opts headerBlocks @@ -216,9 +216,9 @@ pandocToMarkdown opts (Pandoc meta blocks) = do then id else defField "titleblock" (render' titleblock)) $ metadata - if writerStandalone opts - then return $ renderTemplate' (writerTemplate opts) context - else return main + case writerTemplate opts of + Nothing -> return main + Just tpl -> return $ renderTemplate' tpl context -- | Return markdown representation of reference key table. refsToMarkdown :: WriterOptions -> Refs -> MD Doc diff --git a/src/Text/Pandoc/Writers/MediaWiki.hs b/src/Text/Pandoc/Writers/MediaWiki.hs index 3b2028997..78d4651e7 100644 --- a/src/Text/Pandoc/Writers/MediaWiki.hs +++ b/src/Text/Pandoc/Writers/MediaWiki.hs @@ -79,9 +79,9 @@ pandocToMediaWiki (Pandoc meta blocks) = do let main = body ++ notes let context = defField "body" main $ defField "toc" (writerTableOfContents opts) metadata - return $ if writerStandalone opts - then renderTemplate' (writerTemplate opts) context - else main + return $ case writerTemplate opts of + Nothing -> main + Just tpl -> renderTemplate' tpl context -- | Escape special characters for MediaWiki. escapeString :: String -> String diff --git a/src/Text/Pandoc/Writers/Native.hs b/src/Text/Pandoc/Writers/Native.hs index 2a9bc5138..87e23aeeb 100644 --- a/src/Text/Pandoc/Writers/Native.hs +++ b/src/Text/Pandoc/Writers/Native.hs @@ -27,10 +27,6 @@ Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA Portability : portable Conversion of a 'Pandoc' document to a string representation. - -Note: If @writerStandalone@ is @False@, only the document body -is represented; otherwise, the full 'Pandoc' document, including the -metadata. -} module Text.Pandoc.Writers.Native ( writeNative ) where @@ -75,8 +71,8 @@ writeNative opts (Pandoc meta blocks) = let colwidth = if writerWrapText opts == WrapAuto then Just $ writerColumns opts else Nothing - withHead = if writerStandalone opts - then \bs -> text ("Pandoc (" ++ show meta ++ ")") $$ + withHead = case writerTemplate opts of + Just _ -> \bs -> text ("Pandoc (" ++ show meta ++ ")") $$ bs $$ cr - else id + Nothing -> id in render colwidth $ withHead $ prettyList $ map prettyBlock blocks diff --git a/src/Text/Pandoc/Writers/OPML.hs b/src/Text/Pandoc/Writers/OPML.hs index 5770c3c6f..20c2c5cbc 100644 --- a/src/Text/Pandoc/Writers/OPML.hs +++ b/src/Text/Pandoc/Writers/OPML.hs @@ -56,9 +56,9 @@ writeOPML opts (Pandoc meta blocks) = meta' main = render colwidth $ vcat (map (elementToOPML opts) elements) context = defField "body" main metadata - in if writerStandalone opts - then renderTemplate' (writerTemplate opts) context - else main + in case writerTemplate opts of + Nothing -> main + Just tpl -> renderTemplate' tpl context writeHtmlInlines :: [Inline] -> String writeHtmlInlines ils = trim $ writeHtmlString def diff --git a/src/Text/Pandoc/Writers/OpenDocument.hs b/src/Text/Pandoc/Writers/OpenDocument.hs index 8bd0f469e..dec394797 100644 --- a/src/Text/Pandoc/Writers/OpenDocument.hs +++ b/src/Text/Pandoc/Writers/OpenDocument.hs @@ -196,9 +196,9 @@ writeOpenDocument opts (Pandoc meta blocks) = context = defField "body" body $ defField "automatic-styles" (render' automaticStyles) $ metadata - in if writerStandalone opts - then renderTemplate' (writerTemplate opts) context - else body + in case writerTemplate opts of + Nothing -> body + Just tpl -> renderTemplate' tpl context withParagraphStyle :: WriterOptions -> String -> [Block] -> State WriterState Doc withParagraphStyle o s (b:bs) diff --git a/src/Text/Pandoc/Writers/Org.hs b/src/Text/Pandoc/Writers/Org.hs index 18a820f2e..a2f20d830 100644 --- a/src/Text/Pandoc/Writers/Org.hs +++ b/src/Text/Pandoc/Writers/Org.hs @@ -78,9 +78,9 @@ pandocToOrg (Pandoc meta blocks) = do let context = defField "body" main $ defField "math" hasMath $ metadata - if writerStandalone opts - then return $ renderTemplate' (writerTemplate opts) context - else return main + case writerTemplate opts of + Nothing -> return main + Just tpl -> return $ renderTemplate' tpl context -- | Return Org representation of notes. notesToOrg :: [[Block]] -> State WriterState Doc diff --git a/src/Text/Pandoc/Writers/RST.hs b/src/Text/Pandoc/Writers/RST.hs index c438cb322..064434483 100644 --- a/src/Text/Pandoc/Writers/RST.hs +++ b/src/Text/Pandoc/Writers/RST.hs @@ -81,9 +81,9 @@ pandocToRST (Pandoc meta blocks) = do (fmap (render colwidth) . blockListToRST) (fmap (trimr . render colwidth) . inlineListToRST) $ deleteMeta "title" $ deleteMeta "subtitle" meta - body <- blockListToRST' True $ if writerStandalone opts - then normalizeHeadings 1 blocks - else blocks + body <- blockListToRST' True $ case writerTemplate opts of + Just _ -> normalizeHeadings 1 blocks + Nothing -> blocks notes <- liftM (reverse . stNotes) get >>= notesToRST -- note that the notes may contain refs, so we do them first refs <- liftM (reverse . stLinks) get >>= refsToRST @@ -99,9 +99,9 @@ pandocToRST (Pandoc meta blocks) = do $ defField "math" hasMath $ defField "rawtex" rawTeX $ metadata - if writerStandalone opts - then return $ renderTemplate' (writerTemplate opts) context - else return main + case writerTemplate opts of + Nothing -> return main + Just tpl -> return $ renderTemplate' tpl context where normalizeHeadings lev (Header l a i:bs) = Header lev a i:normalizeHeadings (lev+1) cont ++ normalizeHeadings lev bs' diff --git a/src/Text/Pandoc/Writers/RTF.hs b/src/Text/Pandoc/Writers/RTF.hs index b87ef0fd3..8f942b4d0 100644 --- a/src/Text/Pandoc/Writers/RTF.hs +++ b/src/Text/Pandoc/Writers/RTF.hs @@ -107,11 +107,11 @@ writeRTF options (Pandoc meta@(Meta metamap) blocks) = (tableOfContents $ filter isTOCHeader blocks) else id) $ metadata - in if writerStandalone options - then renderTemplate' (writerTemplate options) context - else case reverse body of - ('\n':_) -> body - _ -> body ++ "\n" + in case writerTemplate options of + Just tpl -> renderTemplate' tpl context + Nothing -> case reverse body of + ('\n':_) -> body + _ -> body ++ "\n" -- | Construct table of contents from list of header blocks. tableOfContents :: [Block] -> String diff --git a/src/Text/Pandoc/Writers/Shared.hs b/src/Text/Pandoc/Writers/Shared.hs index 0f0edbbd1..845d22077 100644 --- a/src/Text/Pandoc/Writers/Shared.hs +++ b/src/Text/Pandoc/Writers/Shared.hs @@ -49,6 +49,7 @@ import Data.Aeson (FromJSON(..), fromJSON, ToJSON (..), Value(Object), Result(.. import Text.Pandoc.UTF8 (toStringLazy) import qualified Data.Traversable as Traversable import Data.List ( groupBy ) +import Data.Maybe ( isJust ) -- | Create JSON value for template from a 'Meta' and an association list -- of variables, specified at the command line or in the writer. @@ -62,7 +63,7 @@ metaToJSON :: Monad m -> Meta -> m Value metaToJSON opts blockWriter inlineWriter (Meta metamap) - | writerStandalone opts = do + | isJust (writerTemplate opts) = do let baseContext = foldl (\acc (x,y) -> setField x y acc) (Object H.empty) $ writerVariables opts renderedMap <- Traversable.mapM diff --git a/src/Text/Pandoc/Writers/TEI.hs b/src/Text/Pandoc/Writers/TEI.hs index 27f6898c3..9bd23ac3b 100644 --- a/src/Text/Pandoc/Writers/TEI.hs +++ b/src/Text/Pandoc/Writers/TEI.hs @@ -78,9 +78,9 @@ writeTEI opts (Pandoc meta blocks) = MathML _ -> True _ -> False) $ metadata - in if writerStandalone opts - then renderTemplate' (writerTemplate opts) context - else main + in case writerTemplate opts of + Nothing -> main + Just tpl -> renderTemplate' tpl context -- | Convert an Element to TEI. elementToTEI :: WriterOptions -> Int -> Element -> Doc diff --git a/src/Text/Pandoc/Writers/Texinfo.hs b/src/Text/Pandoc/Writers/Texinfo.hs index b94229943..f2b9aa15f 100644 --- a/src/Text/Pandoc/Writers/Texinfo.hs +++ b/src/Text/Pandoc/Writers/Texinfo.hs @@ -93,9 +93,9 @@ pandocToTexinfo options (Pandoc meta blocks) = do $ defField "superscript" (stSuperscript st) $ defField "strikeout" (stStrikeout st) $ metadata - if writerStandalone options - then return $ renderTemplate' (writerTemplate options) context - else return body + case writerTemplate options of + Nothing -> return body + Just tpl -> return $ renderTemplate' tpl context -- | Escape things as needed for Texinfo. stringToTexinfo :: String -> String diff --git a/src/Text/Pandoc/Writers/Textile.hs b/src/Text/Pandoc/Writers/Textile.hs index ec70f3072..f73876fd2 100644 --- a/src/Text/Pandoc/Writers/Textile.hs +++ b/src/Text/Pandoc/Writers/Textile.hs @@ -65,9 +65,9 @@ pandocToTextile opts (Pandoc meta blocks) = do notes <- liftM (unlines . reverse . stNotes) get let main = body ++ if null notes then "" else ("\n\n" ++ notes) let context = defField "body" main metadata - if writerStandalone opts - then return $ renderTemplate' (writerTemplate opts) context - else return main + case writerTemplate opts of + Nothing -> return main + Just tpl -> return $ renderTemplate' tpl context withUseTags :: State WriterState a -> State WriterState a withUseTags action = do diff --git a/src/Text/Pandoc/Writers/ZimWiki.hs b/src/Text/Pandoc/Writers/ZimWiki.hs index 8afbfef92..423928c8a 100644 --- a/src/Text/Pandoc/Writers/ZimWiki.hs +++ b/src/Text/Pandoc/Writers/ZimWiki.hs @@ -32,7 +32,7 @@ http://zim-wiki.org/manual/Help/Wiki_Syntax.html module Text.Pandoc.Writers.ZimWiki ( writeZimWiki ) where import Text.Pandoc.Definition -import Text.Pandoc.Options ( WriterOptions(writerTableOfContents, writerStandalone, writerTemplate, writerWrapText), WrapOption(..) ) +import Text.Pandoc.Options ( WriterOptions(writerTableOfContents, writerTemplate, writerWrapText), WrapOption(..) ) import Text.Pandoc.Shared ( escapeURI, linesToPara, removeFormatting, trimr , substitute ) import Text.Pandoc.Writers.Shared ( defField, metaToJSON ) @@ -71,9 +71,9 @@ pandocToZimWiki opts (Pandoc meta blocks) = do let context = defField "body" main $ defField "toc" (writerTableOfContents opts) $ metadata - if writerStandalone opts - then return $ renderTemplate' (writerTemplate opts) context - else return main + case writerTemplate opts of + Just tpl -> return $ renderTemplate' tpl context + Nothing -> return main -- | Escape special characters for ZimWiki. escapeString :: String -> String -- cgit v1.2.3