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]
This commit is contained in:
John MacFarlane 2016-11-30 15:34:58 +01:00
parent ac312caabd
commit fb8a2540bd
33 changed files with 117 additions and 133 deletions

View file

@ -1292,18 +1292,18 @@ convertWithOpts opts args = do
let standalone' = standalone || not (isTextFormat format) || pdfOutput
templ <- case templatePath of
_ | not standalone' -> return ""
_ | not standalone' -> return Nothing
Nothing -> do
deftemp <- getDefaultTemplate datadir format
case deftemp of
Left e -> throwIO e
Right t -> return t
Right t -> return (Just t)
Just tp -> do
-- strip off extensions
let tp' = case takeExtension tp of
"" -> tp <.> format
_ -> tp
E.catch (UTF8.readFile tp')
Just <$> E.catch (UTF8.readFile tp')
(\e -> if isDoesNotExistError e
then E.catch
(readDataFileUTF8 datadir
@ -1416,8 +1416,7 @@ convertWithOpts opts args = do
_ -> do pairs <- mapM (\s -> sourceToDoc [s]) sources
return (mconcat $ map fst pairs, mconcat $ map snd pairs)
let writerOptions = def { writerStandalone = standalone',
writerTemplate = templ,
let writerOptions = def { writerTemplate = templ,
writerVariables = variables'',
writerTabStop = tabStop,
writerTableOfContents = toc,

View file

@ -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

View file

@ -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

View file

@ -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

View file

@ -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"

View file

@ -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

View file

@ -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

View file

@ -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

View file

@ -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

View file

@ -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

View file

@ -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 =

View file

@ -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

View file

@ -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)]

View file

@ -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

View file

@ -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

View file

@ -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

View file

@ -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

View file

@ -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

View file

@ -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

View file

@ -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)

View file

@ -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

View file

@ -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'

View file

@ -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

View file

@ -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

View file

@ -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

View file

@ -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

View file

@ -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

View file

@ -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

View file

@ -57,11 +57,11 @@ class ToString a where
toString :: a -> String
instance ToString Pandoc where
toString d = writeNative def{ writerStandalone = s } $ toPandoc d
toString d = writeNative def{ writerTemplate = s } $ toPandoc d
where s = case d of
(Pandoc (Meta m) _)
| M.null m -> False
| otherwise -> True
| M.null m -> Nothing
| otherwise -> Just "" -- need this to get meta output
instance ToString Blocks where
toString = writeNative def . toPandoc

View file

@ -26,11 +26,11 @@ noNorm :: Pandoc -> NoNormPandoc
noNorm = NoNormPandoc
instance ToString NoNormPandoc where
toString d = writeNative def{ writerStandalone = s } $ toPandoc d
toString d = writeNative def{ writerTemplate = s } $ toPandoc d
where s = case d of
NoNormPandoc (Pandoc (Meta m) _)
| M.null m -> False
| otherwise -> True
| M.null m -> Nothing
| otherwise -> Just "" -- need this to get meta output
instance ToPandoc NoNormPandoc where
toPandoc = unNoNorm

View file

@ -41,11 +41,11 @@ newtype NoNormPandoc = NoNormPandoc {unNoNorm :: Pandoc}
deriving ( Show )
instance ToString NoNormPandoc where
toString d = writeNative def{ writerStandalone = s } $ toPandoc d
toString d = writeNative def{ writerTemplate = s } $ toPandoc d
where s = case d of
NoNormPandoc (Pandoc (Meta m) _)
| M.null m -> False
| otherwise -> True
| M.null m -> Nothing
| otherwise -> Just "" -- need this for Meta output
instance ToPandoc NoNormPandoc where
toPandoc = unNoNorm

View file

@ -8,7 +8,7 @@ import Text.Pandoc.Arbitrary()
p_write_rt :: Pandoc -> Bool
p_write_rt d =
read (writeNative def{ writerStandalone = True } d) == d
read (writeNative def{ writerTemplate = Just "" } d) == d
p_write_blocks_rt :: [Block] -> Bool
p_write_blocks_rt bs = length bs > 20 ||

View file

@ -47,8 +47,7 @@ tests = [ testGroup "rubrics"
[ "foo"
, "==="]
-- note: heading normalization is only done in standalone mode
, test (writeRST def{ writerStandalone = True,
writerTemplate = "$body$\n" } . toPandoc)
, test (writeRST def{ writerTemplate = Just "$body$\n" } . toPandoc)
"heading levels" $
header 1 (text "Header 1") <>
header 3 (text "Header 2") <>
@ -78,8 +77,7 @@ tests = [ testGroup "rubrics"
, ""
, "Header 2"
, "--------"]
, test (writeRST def{ writerStandalone = True,
writerTemplate = "$body$\n" } . toPandoc)
, test (writeRST def{ writerTemplate = Just "$body$\n" } . toPandoc)
"minimal heading levels" $
header 2 (text "Header 1") <>
header 3 (text "Header 2") <>