pandoc-stylefrommeta (empty) → 0.1.0.0

raw patch · 4 files changed

+221/−0 lines, 4 filesdep +HaTeXdep +MissingHdep +basesetup-changed

Dependencies added: HaTeX, MissingH, base, containers, pandoc, pandoc-types

Files

LICENSE +25/−0
Setup.hs +3/−0
pandoc-stylefrommeta.cabal +25/−0
styleFromMeta.hs +168/−0

+ LICENSE view

@@ -0,0 +1,25 @@+The following license covers this documentation, and the source code, except+where otherwise indicated.++Copyright 2016, Alexey Radkov. All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:++* Redistributions of source code must retain the above copyright notice, this+  list of conditions and the following disclaimer.++* Redistributions in binary form must reproduce the above copyright notice,+  this list of conditions and the following disclaimer in the documentation+  and/or other materials provided with the distribution.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS "AS IS" AND ANY EXPRESS OR+IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF+MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO+EVENT SHALL THE COPYRIGHT HOLDERS BE LIABLE FOR ANY DIRECT, INDIRECT,+INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT+NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA,+OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF+LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE+OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF+ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.

+ Setup.hs view

@@ -0,0 +1,3 @@+import Distribution.Simple+main = defaultMain+

+ pandoc-stylefrommeta.cabal view

@@ -0,0 +1,25 @@+name:                pandoc-stylefrommeta+version:             0.1.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.+homepage:            http://github.com/lyokha/styleFromMeta+license:             BSD3+license-file:        LICENSE+author:              Alexey Radkov <alexey.radkov@gmail.com>+maintainer:          Alexey Radkov <alexey.radkov@gmail.com>+copyright:           2016 Alexey Radkov+category:            Text+build-type:          Simple+cabal-version:       >= 1.8++executable styleFromMeta+  build-depends:       base >= 4.7 && < 5+                     , pandoc >= 1.12+                     , pandoc-types >= 1.12+                     , containers >= 0.2+                     , MissingH >= 1.0.0+                     , HaTeX >= 3.3+  main-is:             styleFromMeta.hs+

+ styleFromMeta.hs view

@@ -0,0 +1,168 @@+-- styleFromMeta.hs++{-# OPTIONS_HADDOCK prune, ignore-exports #-}+{-# LANGUAGE CPP, ViewPatterns, PatternGuards #-}+#if __GLASGOW_HASKELL__ >= 708+{-# LANGUAGE PatternSynonyms #-}+#endif++import Text.Pandoc.JSON+import Text.Pandoc.Walk (walk)+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 __GLASGOW_HASKELL__ >= 708+pattern Style x <- Math InlineMath x+pattern Alt x <- (dropWhile (==Space) -> x)+#else+#define Style Math InlineMath+#define Alt(x) (dropWhile (==Space) -> x)+#endif++type MMap = M.Map String MetaValue+type PureInlineParams = ([Inline], Target)          -- style:(alt, target)+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 : |+-- >     <div style="clear: both; text-align: center; margin-bottom: 16px">+-- >     <a href="$SRC$" style="margin-left: 10em;" alt="$ALT$">+-- >     <img border="0" src="$SRC$" /></a></div>+-- >   latex : |+-- >     \begin{center}+-- >     \includegraphics{$SRC$}+-- >     \end{center}+-- > link_style :+-- >   html : |+-- >     <a href="$SRC$" style="margin-left: 1em; margin-right: 1em;">$ALT$</a>+-- >   latex : |+-- >     \href{$SRC$}{\colorbox{green}{$ALT$}}+-- > para_style :+-- >   html : |+-- >     <span style="display: block; margin-bottom: 16px;"></span>+-- > ...+--+-- 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 _ 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)+    | Just (MetaMap mm) <- M.lookup "para_style" m+    , Just (MetaBlocks [Para [Span attr _]]) <- M.lookup fmt mm =+        walk (substInlineStyle fm m) $ Plain [Span attr cnt]+substStyle fm m b = walk (substInlineStyle fm m) 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 [Para (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+            substInlineStyle' Nothing = cons alt tgt+            substInlineStyle' _ = i+        in substInlineStyle' $ M.lookup fmt mm+substInlineStyle _ _ i = i++toInlineParams :: Inline -> Maybe (InlineParams, InlineCons)+toInlineParams (Image attr (style@(Style _) : Alt (alt)) tgt) =+    Just ((style, alt, tgt), Image attr)+toInlineParams (Link attr (style@(Style _) : Alt (alt)) tgt) =+    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)]++escape :: Format -> String -> String+escape (Format "latex") = protectString+escape (Format "html") = escapeStringForXML+-- TODO: properly escape other formats+escape _ = id++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) = "<em>" ++ stringify' fm x ++ "</em>"+          subst (Strong x) = "<strong>" ++ stringify' fm x ++ "</strong>"+          subst (Strikeout x) = "<del>" ++ stringify' fm x ++ "</del>"+          subst (Superscript x) = "<sup>" ++ stringify' fm x ++ "</sup>"+          subst (Subscript x) = "<sub>" ++ stringify' fm x ++ "</sub>"+          subst (RawInline fmt x) = x+          subst (Str x) = escape fm x+          subst x = stringify x+-- TODO: properly stringify' other formats+stringify' _ = stringify++main :: IO ()+main = toJSONFilter styleFromMeta+