"
- , Text.dropEnd
- 1
- (Text.unlines (map (foldMap emphasizeChunkHtml) lines'))
- , ""
- , ""
- ]
-
-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
diff --git a/src/Text/Pandoc/Filter/EmphasizeCode/Html.hs b/src/Text/Pandoc/Filter/EmphasizeCode/Html.hs
new file mode 100644
--- /dev/null
+++ b/src/Text/Pandoc/Filter/EmphasizeCode/Html.hs
@@ -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'))
+
diff --git a/src/Text/Pandoc/Filter/EmphasizeCode/Latex.hs b/src/Text/Pandoc/Filter/EmphasizeCode/Latex.hs
new file mode 100644
--- /dev/null
+++ b/src/Text/Pandoc/Filter/EmphasizeCode/Latex.hs
@@ -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"
+ ]
diff --git a/src/Text/Pandoc/Filter/EmphasizeCode/Renderable.hs b/src/Text/Pandoc/Filter/EmphasizeCode/Renderable.hs
new file mode 100644
--- /dev/null
+++ b/src/Text/Pandoc/Filter/EmphasizeCode/Renderable.hs
@@ -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
diff --git a/test/Text/Pandoc/Filter/EmphasizeCodeTest.hs b/test/Text/Pandoc/Filter/EmphasizeCodeTest.hs
--- a/test/Text/Pandoc/Filter/EmphasizeCodeTest.hs
+++ b/test/Text/Pandoc/Filter/EmphasizeCodeTest.hs
@@ -25,9 +25,9 @@
RawBlock
"html"
(mconcat
- [ "hello world\n"
- , "hej världen\n"
- , "hallo welt\n"
+ [ "hello world
"
+ , "hej världen
"
+ , "hallo welt
"
, "hei verden
"
])
it "emphasizes HTML and a single range over multiple lines" $
@@ -35,9 +35,9 @@
RawBlock
"html"
(mconcat
- [ "hello world\n"
- , "hej världen\n"
- , "hallo welt\n"
+ [ "hello world
"
+ , "hej världen
"
+ , "hallo welt
"
, "hei verden
"
])
it "emphasizes HTML and multiple ranges" $
@@ -45,9 +45,9 @@
RawBlock
"html"
(mconcat
- [ "hello world\n"
- , "hej världen\n"
- , "hallo welt\n"
+ [ "hello world
"
+ , "hej världen
"
+ , "hallo welt
"
, "hei verden
"
])
it "emphasizes latex and multiple ranges" $