diff --git a/Changelog.md b/Changelog.md --- a/Changelog.md +++ b/Changelog.md @@ -1,3 +1,12 @@ +### 0.2.0.0 + +- Render substitutions using Pandoc's writers. +- Improved matching algorithms in metadata blocks. +- Implemented a new method of substitution using code blocks in metadata. This + method must be preferred for all output formats. +- Added verbatim placeholders `$$SRC$$` and `$$TITLE$$`, and placeholder + `$$ALT$$` in which all formatting is removed. + ### 0.1.1.0 - Added support for Pandoc 2.0. diff --git a/README.md b/README.md --- a/README.md +++ b/README.md @@ -1,44 +1,64 @@ styleFromMeta ============= -Pandoc filter to apply styles found in the metadata of the document for various +Pandoc filter to apply styles found in the metadata of the document to various objects. Styling is supported for following types of objects: -- Standalone images -- Inline images +- Standalone and inlined images - Links - Paragraphs (with restrictions, see below) Styles are read from the metadata of the document: they may reside inside the -document or in a separate YAML file. For example +document or in a separate YAML file. For example, ```yaml --- img_style : html : | + ~~~~~
+ ~~~~~ latex : | + ~~~~~ \begin{center} - \includegraphics{$SRC$} + \includegraphics{$$SRC$$} \end{center} + ~~~~~ + rst: | + ~~~~~ + .. image:: $$SRC$$ + :height: 100px + :width: 200 px + :scale: 50 % + :alt: $$ALT$$ + :align: right + ~~~~~ + haddock: | + ~~~~~ + <<$$SRC$$ An image $ALT$>> + ~~~~~ link_style : html : | + ~~~~~ $ALT$ + ~~~~~ latex : | + ~~~~~ \href{$SRC$}{\colorbox{green}{$ALT$}} + ~~~~~ para_style : html : | ... ``` -declares styles *img\_style*, *link\_style* and *para\_style*. Their names -(except for the last) are arbitrarily chosen and may be referred from the -document, for example +declares styles `img_style`, `link_style` and `para_style`. Their names (except +for the last) are arbitrarily chosen and may be referred from the document, for +example ```markdown ![$img_style$](../images/an_image.png) @@ -46,13 +66,42 @@ ``` Placeholders `$ALT$`, `$SRC$` and `$TITLE$` from style declarations are to be -replaced by concrete data found in the object declaration. In the last example +replaced by corresponding data found in the object declaration. In this example `*here*` corresponds to `$ALT$`, and `http://example.com/` corresponds to -`$SRC$`. +`$SRC$`. Placeholders `$$SRC$$` and `$$TITLE$$` are replaced verbatim, in +`$$ALT$$` all formatting gets removed. In the example `$$SRC$$` is used to keep +underscores unescaped as they may reside in image names. +Notice that all metablocks contents, with the exclusion of `para_style`, are +wrapped inside code blocks. This let the contents be substituted verbatim for +any output format. However, raw HTML and TeX blocks are well supported by +Pandoc, so we could rewrite parts of the example like this: + +```yaml + --- + img_style : + html : | +
+ +
+ latex : | + \begin{center} + \includegraphics{$$SRC$$} + \end{center} + + # ... + + ... +``` + +The filter has support for raw HTML and TeX blocks, but this support is not +complete, and in some cases substitutions may fail. In addition, Pandoc may +re-format substitutions. That's why this method is not recommended to use. + As soon as paragraphs do not have place where to put extra data, style -*para\_style* is applied to all paragraphs in the document. Currently only -transformation to a span block is supported. Any contents found between opening -and closing span tags are ignored: actual paragraph contents will be inserted -inside them. +`para_style` is applied to all paragraphs in the document. Currently, only +transformation to a span block is supported (which is probably useful only in +HTML). Any contents found between opening and closing span tags are ignored: +actual paragraph contents will be inserted inside them. Notice that wrapping +inside code blocks is not allowed in `para_style` block. diff --git a/pandoc-stylefrommeta.cabal b/pandoc-stylefrommeta.cabal --- a/pandoc-stylefrommeta.cabal +++ b/pandoc-stylefrommeta.cabal @@ -1,10 +1,10 @@ name: pandoc-stylefrommeta -version: 0.1.1.0 +version: 0.2.0.0 synopsis: Pandoc filter to customize links, images and paragraphs description: Pandoc filter to customize links, images and paragraphs - (with restrictions). Styles are read from the metadata of the document: - they may reside inside the document or in a separate YAML file. See - details . + (with restrictions) in HTML and LaTeX formats. Styles are read from the + metadata of the document: they may reside inside the document or in a + separate YAML file. homepage: http://github.com/lyokha/styleFromMeta license: BSD3 license-file: LICENSE @@ -22,7 +22,8 @@ , pandoc-types >= 1.12 , containers >= 0.2 , MissingH >= 1.0.0 - , HaTeX >= 3.3 + , text + , bytestring extensions: CPP main-is: styleFromMeta.hs diff --git a/styleFromMeta.hs b/styleFromMeta.hs --- a/styleFromMeta.hs +++ b/styleFromMeta.hs @@ -1,21 +1,36 @@ -{-# OPTIONS_HADDOCK prune, ignore-exports #-} {-# LANGUAGE ViewPatterns, PatternGuards, PatternSynonyms #-} import Text.Pandoc.JSON import Text.Pandoc.Walk (walk) +import Text.Pandoc.Options (def) import Text.Pandoc.Shared (stringify) -import Text.Pandoc.XML (escapeStringForXML) import qualified Data.Map as M import Data.String.Utils (replace) -import Text.LaTeX.Base.Syntax (protectString) #if MIN_VERSION_pandoc(2,0,0) +import Text.Pandoc.Writers (Writer (..), getWriter) +import Text.Pandoc.Class (runPure) +import qualified Data.ByteString.Lazy.Char8 as C8L +import qualified Data.Text as T +import Control.Exception (displayException) + #define MBPLAIN Plain #else +import Text.Pandoc (Writer (..), getWriter) + #define MBPLAIN Para #endif +pattern Style :: String -> Inline pattern Style x <- Math InlineMath x + +pattern Subst :: String -> Inline +pattern Subst x = Math InlineMath x + +pattern SubstVerbatim :: String -> Inline +pattern SubstVerbatim x <- Math DisplayMath x + +pattern Alt :: [Inline] -> [Inline] pattern Alt x <- (dropWhile (== Space) -> x) type MMap = M.Map String MetaValue @@ -23,95 +38,47 @@ type InlineParams = (Inline, [Inline], Target) -- (style:alt, target) type InlineCons = [Inline] -> Target -> Inline -- Image or Link --- | Applies style found in the metadata of the document for various objects --- --- Styling is supported for following types of objects: --- --- * Standalone images --- --- * Inline images --- --- * Links --- --- * Paragraphs (with restrictions, see below) --- --- Styles are read from the metadata of the document: they may reside inside --- the document or in a separate YAML file. For example --- --- > --- --- > img_style : --- > html : | --- >
--- > --- >
--- > latex : | --- > \begin{center} --- > \includegraphics{$SRC$} --- > \end{center} --- > link_style : --- > html : | --- > $ALT$ --- > latex : | --- > \href{$SRC$}{\colorbox{green}{$ALT$}} --- > para_style : --- > html : | --- > --- > ... --- --- declares styles /img_style/, /link_style/ and /para_style/. Their names --- (except for the last) are arbitrarily chosen and may be referred from the --- document, for example --- --- > ![$img_style$](../images/an_image.png) --- > [$link_style$ *here*](http://example.com/) --- --- Placeholders /$ALT$/, /$SRC$/ and /$TITLE$/ from style declarations are --- to be replaced by concrete data found in the object declaration. In the --- last example @*here*@ corresponds to /$ALT$/ and @http:\/\/example.com/@ --- corresponds to /$SRC$/. --- --- As soon as paragraphs do not have place where to put extra data, style --- /para_style/ is applied to all paragraphs in the document. Currently only --- transformation to a span block is supported. Any contents found between --- opening and closing span tags are ignored: actual paragraph contents will --- be inserted inside them. --- styleFromMeta :: Maybe Format -> Pandoc -> IO Pandoc -styleFromMeta (Just fm) (Pandoc m bs) = - return $ Pandoc m $ walk (substStyle fm $ unMeta m) bs +styleFromMeta (Just fm) (Pandoc m bs) = do + let b = unMeta m + return $ Pandoc m $ + walk (substInlineStyle fm b) $ -- apply styles for links and images + walk (substBlockStyle fm b) bs -- apply para_style to paragraphs styleFromMeta _ p = return p -substStyle :: Format -> MMap -> Block -> Block -substStyle fm@(Format fmt) m b@(Para [Image attr (Style style : Alt alt) tgt]) - | Just (MetaMap mm) <- M.lookup style m = - let params = (alt, tgt) - substStyle' (Just (MetaBlocks [RawBlock f s])) = - RawBlock f $ substParams fm params s - substStyle' (Just (MetaBlocks [b])) = walk substParams' b - where substParams' (RawInline f s) = - RawInline f $ substParams fm params s - substParams' i = i - substStyle' Nothing = Para [Image attr alt tgt] - substStyle' _ = b - in substStyle' $ M.lookup fmt mm - | otherwise = b -substStyle fm@(Format fmt) m (Para cnt) +substBlockStyle :: Format -> MMap -> Block -> Block +substBlockStyle _ _ b@(Para is@(Image {} : _)) + | all isImage is = b -- do not apply para_style to standalone images + where isImage Image {} = True + isImage _ = False +substBlockStyle (Format fmt) m (Para cnt) | Just (MetaMap mm) <- M.lookup "para_style" m , Just (MetaBlocks [MBPLAIN [Span attr _]]) <- M.lookup fmt mm = - walk (substInlineStyle fm m) $ Plain [Span attr cnt] -substStyle fm m b = walk (substInlineStyle fm m) b + Plain [Span attr cnt] +substBlockStyle _ _ b = b substInlineStyle :: Format -> MMap -> Inline -> Inline substInlineStyle fm@(Format fmt) m i@(toInlineParams -> Just ((Style style, alt, tgt), cons)) | Just (MetaMap mm) <- M.lookup style m = - let substInlineStyle' (Just (MetaBlocks - [MBPLAIN (RawInline f s : r)])) = - RawInline f $ substParams fm params $ - s ++ stringify' fm (map subst r) - where params = (alt, tgt) - subst (Style "ALT") = RawInline f "$ALT$" - subst i = i + let params = (alt, tgt) + substPlainParams = Span nullAttr . map (substParams fm params) + substInlineStyle' (Just (MetaBlocks [CodeBlock _ vb])) = + RawInline fm $ substParamsInRawBlock fm params vb + substInlineStyle' (Just (MetaBlocks mbs)) = + RawInline fm $ renderInlines fm $ map substInlineStyle'' mbs + where substInlineStyle'' mb = + case mb of + Plain is -> substPlainParams is + Para is -> substPlainParams is + d@Div {} -> + RawInline fm $ + substParamsInRawBlock fm params $ + renderBlocks fm [d] + RawBlock bfm b -> + RawInline bfm $ + substParamsInRawBlock bfm params b + _ -> i substInlineStyle' Nothing = cons alt tgt substInlineStyle' _ = i in substInlineStyle' $ M.lookup fmt mm @@ -124,41 +91,56 @@ Just ((style, alt, tgt), Link attr) toInlineParams _ = Nothing -substParams :: Format -> PureInlineParams -> String -> String -substParams fm (alt, (escape fm -> src, escape fm -> title)) s = - foldr (uncurry replace) s - [("$ALT$", stringify' fm alt), ("$SRC$", src), ("$TITLE$", title)] +substParams :: Format -> PureInlineParams -> Inline -> Inline +substParams _ (alt, _) (Subst "ALT") = Span nullAttr alt +substParams fm params (SubstVerbatim "ALT") = RawInline fm $ + stringify $ substParams fm params $ Subst "ALT" +substParams _ (_, (src, _)) (Subst "SRC") = Str src +substParams fm (_, (src, _)) (SubstVerbatim "SRC") = RawInline fm src +substParams _ (_, (_, title)) (Subst "TITLE") = Str title +substParams fm (_, (_, title)) (SubstVerbatim "TITLE") = RawInline fm title +substParams _ params (RawInline fm s) = RawInline fm $ + substParamsInRawBlock fm params s +substParams _ _ i = i -escape :: Format -> String -> String -escape (Format "latex") = protectString -escape (Format "html") = escapeStringForXML --- TODO: properly escape other formats -escape _ = id +substParamsInRawBlock :: Format -> PureInlineParams -> String -> String +substParamsInRawBlock fm (alt, (src, title)) s = + foldr (\(p, is) -> replace p $ renderInlines fm is) s + [("$ALT$", alt ) + ,("$SRC$", [Str src] ) + ,("$TITLE$", [Str title] ) + ,("$$ALT$$", [RawInline fm $ stringify $ Span nullAttr alt]) + ,("$$SRC$$", [RawInline fm src] ) + ,("$$TITLE$$", [RawInline fm title] ) + ] -stringify' :: Format -> [Inline] -> String -stringify' fm@(Format fmt@("latex")) = - foldr ((++) . subst) "" - where subst (Emph x) = "\\emph{" ++ stringify' fm x ++ "}" - subst (Strong x) = "\\textbf{" ++ stringify' fm x ++ "}" - subst (Strikeout x) = "\\sout{" ++ stringify' fm x ++ "}" - subst (Superscript x) = "\\textsuperscript{" ++ stringify' fm x ++ "}" - subst (Subscript x) = "\\textsubscript{" ++ stringify' fm x ++ "}" - subst (RawInline fmt x) = x - subst (Math _ x) = "$" ++ x ++ "$" - subst (Str x) = escape fm x - subst x = stringify x -stringify' fm@(Format fmt@("html")) = - foldr ((++) . subst) "" - where subst (Emph x) = "" ++ stringify' fm x ++ "" - subst (Strong x) = "" ++ stringify' fm x ++ "" - subst (Strikeout x) = "" ++ stringify' fm x ++ "" - subst (Superscript x) = "" ++ stringify' fm x ++ "" - subst (Subscript x) = "" ++ stringify' fm x ++ "" - subst (RawInline fmt x) = x - subst (Str x) = escape fm x - subst x = stringify x --- TODO: properly stringify' other formats -stringify' _ = stringify +renderBlocks :: Format -> [Block] -> String +renderBlocks fm p = + let fmt = toWriterFormat fm + writer = getWriter fmt + doc = Pandoc (Meta M.empty) p + in case writer of + Left _ -> error $ "Unknown format " ++ fmt +#if MIN_VERSION_pandoc(2,0,0) + Right (TextWriter w, _) -> + case runPure $ w def doc of + Left e -> displayException e + Right r -> T.unpack r + Right (ByteStringWriter w, _) -> + case runPure $ w def doc of + Left e -> displayException e + Right r -> C8L.unpack r +#else + Right (PureStringWriter w) -> w def doc + _ -> error $ "Unsupported format " ++ fmt ++ ", try Pandoc 2.0!" +#endif + +renderInlines :: Format -> [Inline] -> String +renderInlines fm p = renderBlocks fm [Plain p] + +toWriterFormat :: Format -> String +toWriterFormat (Format "tex") = "latex" +toWriterFormat (Format fmt) = fmt main :: IO () main = toJSONFilter styleFromMeta