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:
parent
ac312caabd
commit
fb8a2540bd
33 changed files with 117 additions and 133 deletions
|
@ -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,
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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"
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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 =
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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)]
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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)
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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'
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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 ||
|
||||
|
|
|
@ -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") <>
|
||||
|
|
Loading…
Reference in a new issue