pandoc-emphasize-code 0.1.1 → 0.2.0

raw patch · 6 files changed

+134/−121 lines, 6 filesdep +lucidPVP ok

version bump matches the API change (PVP)

Dependencies added: lucid

API changes (from Hackage documentation)

Files

• pandoc-emphasize-code.cabal +7/−3
• src/Text/Pandoc/Filter/EmphasizeCode.hs +18/−109
• src/Text/Pandoc/Filter/EmphasizeCode/Html.hs +38/−0
• src/Text/Pandoc/Filter/EmphasizeCode/Latex.hs +54/−0
• src/Text/Pandoc/Filter/EmphasizeCode/Renderable.hs +8/−0
• test/Text/Pandoc/Filter/EmphasizeCodeTest.hs +9/−9

@@ -5,7 +5,7 @@ author:              Oskar Wickström maintainer:          Oskar Wickström homepage:	           https://github.com/owickstrom/pandoc-emphasize-code-version:             0.1.1+version:             0.2.0 cabal-version:       >= 1.8 build-type:          Simple category:            Documentation@@ -19,11 +19,14 @@ library     hs-source-dirs:  src     exposed-modules: Text.Pandoc.Filter.EmphasizeCode-                     Text.Pandoc.Filter.EmphasizeCode.Position-                     Text.Pandoc.Filter.EmphasizeCode.Range                      Text.Pandoc.Filter.EmphasizeCode.Chunking+                     Text.Pandoc.Filter.EmphasizeCode.Html+                     Text.Pandoc.Filter.EmphasizeCode.Latex                      Text.Pandoc.Filter.EmphasizeCode.Parser+                     Text.Pandoc.Filter.EmphasizeCode.Position                      Text.Pandoc.Filter.EmphasizeCode.Pretty+                     Text.Pandoc.Filter.EmphasizeCode.Range+                     Text.Pandoc.Filter.EmphasizeCode.Renderable     build-depends:   base                 >= 4        && < 5                    , unordered-containers >= 0.2      && < 0.3                    , process@@ -32,6 +35,7 @@                    , text                 >= 1.2      && < 1.3                    , mtl                  >= 2.2      && < 3                    , pandoc-types         >= 1.12     && <= 1.19+                   , lucid                >= 2.9      && < 3     ghc-options:     -Wall  

@@ -1,137 +1,46 @@-{-# LANGUAGE CPP               #-}-{-# LANGUAGE FlexibleContexts  #-}-{-# LANGUAGE LambdaCase        #-}-{-# LANGUAGE NamedFieldPuns    #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE ViewPatterns      #-}  module Text.Pandoc.Filter.EmphasizeCode   ( emphasizeCode   ) where-#if MIN_VERSION_base(4,8,0)-import           Data.Semigroup                            ((<>))-#else-import           Control.Applicative-import           Data.Monoid-#endif-import           Data.Char                                 (isSpace)-import qualified Data.HashMap.Strict                       as HM-import           Data.Text                                 (Text)-import qualified Data.Text                                 as Text-import           Text.Pandoc.JSON+import qualified Data.HashMap.Strict                         as HM+import qualified Data.Text                                   as Text+import qualified Text.Pandoc.JSON                            as Pandoc  import           Text.Pandoc.Filter.EmphasizeCode.Chunking+import           Text.Pandoc.Filter.EmphasizeCode.Html+import           Text.Pandoc.Filter.EmphasizeCode.Latex import           Text.Pandoc.Filter.EmphasizeCode.Parser import           Text.Pandoc.Filter.EmphasizeCode.Pretty import           Text.Pandoc.Filter.EmphasizeCode.Range+import           Text.Pandoc.Filter.EmphasizeCode.Renderable  printAndFail :: ParseError -> IO a printAndFail = fail . Text.unpack . printParseError -emphasizeChunkHtml :: LineChunk -> Text-emphasizeChunkHtml chunk =-  case chunk of-    Literal t    -> t-    Emphasized t -> "<em>" <> t <> "</em>"--emphasizeRangeHtml ::-     (String, [String], [(String, String)]) -> EmphasizedLines -> Block-emphasizeRangeHtml (_, classes, _) lines' =-  RawBlock (Format "html") (Text.unpack emphasized)-  where-    classAttr =-      if null classes-        then ""-        else " class=\"" <> Text.pack (unwords classes) <> "\""-    emphasized =-      mconcat-        [ "<pre"-        , classAttr-        , "><code>"-        , Text.dropEnd-            1-            (Text.unlines (map (foldMap emphasizeChunkHtml) lines'))-        , "</code>"-        , "</pre>"-        ]--emphasizeRangeMarkdown ::-     (String, [String], [(String, String)]) -> EmphasizedLines -> Block-emphasizeRangeMarkdown (_, classes, _) lines' =-  RawBlock (Format "html") (Text.unpack emphasized)-  where-    classAttr =-      if null classes-        then ""-        else " class=\"" <> Text.pack (unwords classes) <> "\""-    emphasized =-      mconcat-        [ "<pre"-        , classAttr-        , "><code>"-        , Text.dropEnd-            1-            (Text.unlines (map (foldMap emphasizeChunkHtml) lines'))-        , "</code>"-        , "</pre>"-        ]--emphasizeRangeLatex ::-     (String, [String], [(String, String)]) -> EmphasizedLines -> Block-emphasizeRangeLatex (_, classes, _) lines' =-  RawBlock (Format "latex") (Text.unpack (encloseInVerbatim emphasized))-  where-    languageAttr =-      case classes of-        [lang] -> ",language=" <> Text.pack lang-        _      -> ""-    encloseInTextIt t-      | Text.null t = t-      | otherwise = "£\\CodeEmphasis{" <> t <> "}£"-    emphasizeNonSpace t-      | Text.null t = t-      | otherwise =-        let (nonSpace, rest) = Text.break isSpace t-            (spaces, rest') = Text.span isSpace rest-        in mconcat [encloseInTextIt nonSpace, spaces, emphasizeNonSpace rest']-    emphasizeChunk chunk =-      case chunk of-        Literal t    -> t-        Emphasized t -> emphasizeNonSpace t-    emphasized = Text.unlines (map (foldMap emphasizeChunk) lines')-    encloseInVerbatim t =-      mconcat-        [ "\\begin{lstlisting}[escapechar=£"-        , languageAttr-        , "]\n"-        , t-        , "\\end{lstlisting}\n"-        ]--type Emphasizer-   = (String, [String], [(String, String)]) -> EmphasizedLines -> Block--asEmphasizer :: Format -> Maybe Emphasizer-asEmphasizer f-  | f `elem` ["html", "html5"] = Just emphasizeRangeHtml-  | f == "markdown_github" = Just emphasizeRangeMarkdown-  | f == "latex" = Just emphasizeRangeLatex-  | f == "beamer" = Just emphasizeRangeLatex+toRenderer ::+     Pandoc.Format -> Maybe (Pandoc.Attr -> EmphasizedLines -> Pandoc.Block)+toRenderer f+  | f `elem` ["html", "html5", "markdown_github"] = Just (renderEmphasized Html)+  | f == "latex" = Just (renderEmphasized Latex)+  | f == "beamer" = Just (renderEmphasized Latex)   | otherwise = Nothing  lookupRanges :: HM.HashMap String String -> Maybe Text.Text lookupRanges attrs = Text.pack <$> HM.lookup "emphasize" attrs  -- | A Pandoc filter that emphasizes code blocks.-emphasizeCode :: Maybe Format -> Block -> IO Block-emphasizeCode (Just (asEmphasizer -> Just emphasizer)) cb@(CodeBlock (id', classes, attrs) contents) =+emphasizeCode :: Maybe Pandoc.Format -> Pandoc.Block -> IO Pandoc.Block+emphasizeCode (Just (toRenderer -> Just render)) cb@(Pandoc.CodeBlock (id', classes, attrs) contents) =   case lookupRanges attrs' >>= (runParser . parseRanges) of     Just (Right ranges) ->       let lines' = emphasizeRanges (splitRanges ranges) (Text.pack contents)-      in return-           (emphasizer+          block =+            render               (id', classes, HM.toList (HM.delete "emphasize" attrs'))-              lines')+              lines'+      in return block     Just (Left err) -> printAndFail err     Nothing -> return cb   where

@@ -0,0 +1,38 @@+module Text.Pandoc.Filter.EmphasizeCode.Html+  ( Html(Html)+  ) where++import Data.List (intersperse)+import qualified Data.Text as Text+import qualified Data.Text.Lazy as TextLazy+import qualified Lucid as Html+import qualified Text.Pandoc.Definition as Pandoc++import Text.Pandoc.Filter.EmphasizeCode.Chunking+import Text.Pandoc.Filter.EmphasizeCode.Renderable++data Html =+  Html++emphasizeChunkHtml :: LineChunk -> Html.Html ()+emphasizeChunkHtml chunk =+  case chunk of+    Literal t -> Html.toHtml t+    Emphasized t -> Html.em_ (Html.toHtml t)++instance Renderable Html where+  renderEmphasized _ (_, classes, _) lines' =+    Pandoc.RawBlock+      (Pandoc.Format "html")+      (TextLazy.unpack (Html.renderText emphasized))+    where+      classAttrs =+        if null classes+          then []+          else [Html.class_ (Text.pack (unwords classes))]+      emphasized =+        Html.pre_ classAttrs $+        Html.code_ $+        mconcat+          (intersperse (Html.br_ []) (map (foldMap emphasizeChunkHtml) lines'))+

@@ -0,0 +1,54 @@+{-# LANGUAGE CPP               #-}+{-# LANGUAGE OverloadedStrings #-}++module Text.Pandoc.Filter.EmphasizeCode.Latex+  ( Latex(Latex)+  ) where+#if MIN_VERSION_base(4,8,0)+import           Data.Semigroup                              ((<>))+#else+import           Control.Applicative+import           Data.Monoid+#endif+import           Data.Char                                   (isSpace)+import qualified Data.Text                                   as Text+import qualified Text.Pandoc.Definition                      as Pandoc++import           Text.Pandoc.Filter.EmphasizeCode.Chunking+import           Text.Pandoc.Filter.EmphasizeCode.Renderable++data Latex =+  Latex++instance Renderable Latex where+  renderEmphasized _ (_, classes, _) lines' =+    Pandoc.RawBlock+      (Pandoc.Format "latex")+      (Text.unpack (encloseInVerbatim emphasized))+    where+      languageAttr =+        case classes of+          [lang] -> ",language=" <> Text.pack lang+          _      -> ""+      encloseInTextIt t+        | Text.null t = t+        | otherwise = "£\\CodeEmphasis{" <> t <> "}£"+      emphasizeNonSpace t+        | Text.null t = t+        | otherwise =+          let (nonSpace, rest) = Text.break isSpace t+              (spaces, rest') = Text.span isSpace rest+          in mconcat [encloseInTextIt nonSpace, spaces, emphasizeNonSpace rest']+      emphasizeChunk chunk =+        case chunk of+          Literal t    -> t+          Emphasized t -> emphasizeNonSpace t+      emphasized = Text.unlines (map (foldMap emphasizeChunk) lines')+      encloseInVerbatim t =+        mconcat+          [ "\\begin{lstlisting}[escapechar=£"+          , languageAttr+          , "]\n"+          , t+          , "\\end{lstlisting}\n"+          ]

@@ -0,0 +1,8 @@+module Text.Pandoc.Filter.EmphasizeCode.Renderable where++import           qualified Text.Pandoc.JSON as Pandoc++import           Text.Pandoc.Filter.EmphasizeCode.Chunking++class Renderable r where+  renderEmphasized :: r -> Pandoc.Attr -> EmphasizedLines -> Pandoc.Block

@@ -25,9 +25,9 @@     RawBlock       "html"       (mconcat-         [ "<pre class=\"my-lang\"><code>hello world\n"-         , "hej <em>världen</em>\n"-         , "<em>hallo</em> welt\n"+         [ "<pre class=\"my-lang\"><code>hello world<br>"+         , "hej <em>världen</em><br>"+         , "<em>hallo</em> welt<br>"          , "hei verden</code></pre>"          ])   it "emphasizes HTML and a single range over multiple lines" $@@ -35,9 +35,9 @@     RawBlock       "html"       (mconcat-         [ "<pre class=\"my-lang\"><code>hello world\n"-         , "hej <em>världen</em>\n"-         , "<em>hallo welt</em>\n"+         [ "<pre class=\"my-lang\"><code>hello world<br>"+         , "hej <em>världen</em><br>"+         , "<em>hallo welt</em><br>"          , "<em>hei</em> verden</code></pre>"          ])   it "emphasizes HTML and multiple ranges" $@@ -45,9 +45,9 @@     RawBlock       "html"       (mconcat-         [ "<pre class=\"my-lang\"><code><em>hello</em> world\n"-         , "hej <em>världen</em>\n"-         , "<em>hallo</em> welt\n"+         [ "<pre class=\"my-lang\"><code><em>hello</em> world<br>"+         , "hej <em>världen</em><br>"+         , "<em>hallo</em> welt<br>"          , "hei verden</code></pre>"          ])   it "emphasizes latex and multiple ranges" $