pandoc-filter-indent 0.3.1.0 → 0.3.2.0
raw patch · 7 files changed
+132/−50 lines, 7 filesdep ~blaze-htmldep ~ghc-syntax-highlighterdep ~text
Dependency ranges changed: blaze-html, ghc-syntax-highlighter, text
Files
- ChangeLog.md +10/−2
- app/Main.hs +43/−11
- pandoc-filter-indent.cabal +11/−11
- src/Filter.hs +4/−3
- src/Render/Latex.hs +43/−16
- src/Token/Haskell.hs +2/−0
- test/Spec.hs +19/−7
ChangeLog.md view
@@ -1,8 +1,16 @@ # Changelog for pandoc-filter-indent ## Unreleased changes-## Unreleased changes +## Release history++0.3.2.0 Sep 29 2021+ - stacked subscripts+ - lambda in Haskell tokenizer+ - greek letters for special variable names: eps, pi, rho+ - automatically append required LaTeX packages (broken for Beamer output)+ - Mapsto for |=>+ 0.3.1.0 Jan 15 2021 - Slightly improved formatting with SkyLighting and LaTeX @@ -15,7 +23,7 @@ 0.2.2.0 Jan 12 2021 - Fixed problem with declaring too few columns in LaTeX - Inline code formatting- - Removed indent marks from parenthesised operators: "`(+)"+ - Removed indent marks from parenthesised operators: "(+)" - Removed indent marks from functions promoted to operators like "`mappend`" - Fixed rendering of indent mark at the start of the column
app/Main.hs view
@@ -12,13 +12,15 @@ import qualified Data.Map as Map import Data.Text(Text) import qualified Data.Text as T- + import qualified Token.Haskell (tokenizer) import qualified Token.Skylighting import Filter (renderBlock, renderInline) import FindColumns (findColumns) import Alignment (Processed)-import System.IO+import Render.Latex (latexPackages)+import System.IO+import Debug.Trace(trace) data Options = Options { inlineSyntax :: Text@@ -27,20 +29,50 @@ main :: IO () main = toJSONFilter runner +-- https://www.logicmatters.net/latex-for-logicians/symbols/+-- Just (MetaList [MetaBlocks [RawBlock (Format "tex") "\\usepackage{scalerel}"]])+ -- | Main body of Pandoc filter. -- Reads format option, metadata, -- and calls `walk` with `blockFormatter`. runner :: Maybe Format -> Pandoc -> IO Pandoc-runner (fromMaybe (Format "text") -> format) input@(Pandoc (Meta meta) _) = do- hPutStrLn stderr (show opts)- return $ walk (blockFormatter opts format) input+runner (fromMaybe (Format "text") -> format) input@(Pandoc (Meta meta) ast) = do+ hPutStrLn stderr $ show opts+ hPutStrLn stderr $ show $ Map.lookup "header-includes" meta+ let top = if format `elem` [Format "latex", Format "tex"]+ then Pandoc (Meta $ Map.alter modifyIncludes "header-includes" meta) ast+ else input+ return $ walk (blockFormatter opts format) top where+ -- | Check default syntax for inline code opts = case Map.lookup "inline-code" meta of Nothing -> Options "haskell" -- default- Just (MetaString s) -> Options s -- never needed?- Just (MetaInlines [Str s]) -> Options s+ Just (MetaString s ) -> Options s -- never needed?+ Just (MetaInlines [Str s]) -> Options s Just otherValue -> error $ "inline-code: meta should be a string but is: " <> show otherValue +-- | Add package dependencies to the meta "header-includes".+modifyIncludes :: Maybe MetaValue -> Maybe MetaValue+modifyIncludes = Just+ . addTeXPackages latexPackages+ . fromMaybe (MetaList [])+ -- Just (MetaBlocks [RawBlock (Format "tex") s])+ where+ addTeXPackages :: [Text] -> MetaValue -> MetaValue+ addTeXPackages = addTeXInclude+ . T.unlines + . fmap (\name -> "\\usepackage{" <> name <> "}")+ addTeXInclude :: Text -> MetaValue -> MetaValue+ addTeXInclude rawTeX (MetaList ls) = -- this variant is invalid for std templates+ MetaList $ MetaBlocks [RawBlock (Format "tex") rawTeX]:ls+ addTeXInclude rawTeX (MetaBlocks [RawBlock "tex" s]) = -- pandoc-types>=1.22+ -- trace ("adding pandoc-types<1.20 (" <> T.unpack rawTeX <> ")") $+ MetaBlocks [RawBlock "tex" $ mconcat [s, "\n", rawTeX]]+ addTeXInclude rawTeX (MetaBlocks [RawBlock "latex" s]) = -- old pandoc-types+ -- trace ("adding pandoc-types<1.20 (" <> T.unpack rawTeX <> ")") $+ MetaBlocks [RawBlock "tex" $ mconcat [s, "\n", rawTeX]]+ addTeXInclude rawTeX other = error $ "Add a new case for addTeXInclude " <> show other+ -- | Select the desired format output then process it. -- Run tokenizer, analysis, and formatter. --@@ -74,13 +106,13 @@ discardLoc (a, _, b) = (a, b) addClass (a, classes, b) | inlineSyntax /= "" = (a, inlineSyntax:classes, b) addClass o = o-inlineFormatter _opts _ x = x+inlineFormatter _opts _ x = x -- | Pick tokenizer depending on options. getTokenizer attrs | isHaskell attrs = Token.Haskell.tokenizer-getTokenizer (_,classes,_) = case Token.Skylighting.lookupTokenizer classes of- Just syntax -> Token.Skylighting.tokenizer syntax- Nothing -> \_ -> Nothing+getTokenizer (_,classes,_) = case Token.Skylighting.lookupTokenizer classes of+ Just syntax -> Token.Skylighting.tokenizer syntax+ Nothing -> \_ -> Nothing -- | Check if the code block is tagged as Haskell. isHaskell :: (Foldable t, Eq a1, IsString a1) =>
pandoc-filter-indent.cabal view
@@ -4,10 +4,10 @@ -- -- see: https://github.com/sol/hpack ----- hash: 6e1538de590d6fe1a3833c723678f5325ccaba06a7fd8be199cc2b56ffa6d038+-- hash: 1d8f275838382e4b48fbe6b67fb6036026bdfd772402682271ab1034e1ae5201 name: pandoc-filter-indent-version: 0.3.1.0+version: 0.3.2.0 synopsis: Pandoc filter formatting Haskell code fragments using GHC lexer. description: Formats marked code fragments, and allows `pandoc` to safely process rest of your literate program: .@@ -68,14 +68,14 @@ build-depends: HaTeX , base >=4.7 && <5- , blaze-html ==0.9.1.2+ , blaze-html , blaze-markup- , ghc-syntax-highlighter ==0.0.5.0+ , ghc-syntax-highlighter , optics-core , optics-th , pandoc-types , skylighting- , text ==1.2.4.0+ , text default-language: Haskell2010 executable pandoc-filter-indent@@ -88,17 +88,17 @@ build-depends: HaTeX , base >=4.7 && <5- , blaze-html ==0.9.1.2+ , blaze-html , blaze-markup , containers- , ghc-syntax-highlighter ==0.0.5.0+ , ghc-syntax-highlighter , optics-core , optics-th , optparse-applicative , pandoc-filter-indent , pandoc-types , skylighting- , text ==1.2.4.0+ , text default-language: Haskell2010 test-suite pandoc-filter-indent-test@@ -113,14 +113,14 @@ HaTeX , QuickCheck , base >=4.7 && <5- , blaze-html ==0.9.1.2+ , blaze-html , blaze-markup- , ghc-syntax-highlighter ==0.0.5.0+ , ghc-syntax-highlighter , optics-core , optics-th , pandoc-filter-indent , pandoc-types , quickcheck-text , skylighting- , text ==1.2.4.0+ , text default-language: Haskell2010
src/Filter.hs view
@@ -26,9 +26,10 @@ -> [Processed] -- ^ Data about alignment -> Block --renderBlock (Format "text" ) _attrs = RawBlock (Format "html" ) . T.pack . show . colspans-renderBlock (Format "text" ) attrs = CodeBlock attrs . Render.Debug.render-renderBlock (Format "latex") _attrs = RawBlock (Format "latex") . processLatex-renderBlock (Format "html" ) _attrs = RawBlock (Format "html" ) . processHTML+renderBlock (Format "text" ) attrs = CodeBlock attrs . Render.Debug.render+renderBlock (Format "latex") _attrs = RawBlock (Format "latex") . processLatex+renderBlock (Format "beamer") _attrs = RawBlock (Format "latex") . processLatex+renderBlock (Format "html" ) _attrs = RawBlock (Format "html" ) . processHTML -- Debugging option renderBlock other attrs = CodeBlock attrs . T.pack . (show other <>) . show
src/Render/Latex.hs view
@@ -1,17 +1,19 @@ {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE ViewPatterns #-} -- | Render analyzed input into LaTeX table.-module Render.Latex(latexFromColSpans, latexInline) where+module Render.Latex(latexFromColSpans, latexInline, latexPackages, subscripts) where -import Data.Text(Text)+import Data.Text(Text) import qualified Data.Text as T-import Text.LaTeX.Base.Syntax(protectText)+import Data.Char(isAlpha) -import Alignment ( Align(..) )-import Render.Common(TokensWithColSpan)-import Token(MyTok(..))-import Util(unbrace)+import Text.LaTeX.Base.Syntax(protectText) +import Alignment ( Align(..) )+import Render.Common(TokensWithColSpan)+import Token(MyTok(..))+import Util(unbrace)+ -- | Given a number of table columns, -- and a list of lists of colspans for each table row, -- return raw LaTeX code.@@ -69,6 +71,18 @@ . fmap formatToken . preformatTokens +-- | Add subscripts and superscripts to variable names.+-- `_` is subscript, and `__` is superscript.vim +subscripts :: Text -> Text+subscripts "" = " "+subscripts "_" = "\\_"+subscripts t = segments t+ where+ segments = foldr1 addSubscript . T.splitOn "_"+ -- | Tags the second argument with superscript "^" or subscript "_"+ addSubscript :: Text -> Text -> Text+ addSubscript t tsub = mconcat [t, "\\textsubscript{", tsub, "}"]+ -- Workaround with joinEscapedOperators til w consider spaces only. -- | Render a simple token. formatToken :: (MyTok, Text) -> Text@@ -90,8 +104,9 @@ formatToken (TOperator,"\\||/" ) = mathop "Downarrow" formatToken (TOperator,"~>" ) = mathop "leadsto" formatToken (TOperator,"|=" ) = mathop "models"-formatToken (TCons ,"Natural") = mathop "N"-formatToken (TOperator,"|" ) = mathop "vert"+formatToken (TCons ,"Natural") = "\\mathbb{N}"+formatToken (TCons ,"Integer") = "\\mathbb{Z}"+formatToken (TOperator,"|" ) = mathop "alt" formatToken (TOperator,"||" ) = mathop "parallel" formatToken (TOperator,"|>" ) = mathop "triangleright" --formatToken (TOperator,">>" ) = mathop "mathbin{>\\!\\!\\!>}" -- gg@@ -100,6 +115,7 @@ formatToken (TOperator,">>>" ) = mathop "ggg" formatToken (TOperator,"<<" ) = mathop "ll" formatToken (TOperator,"<<<" ) = mathop "lll"+formatToken (TOther, "λ" ) = mathop "lambda" -- Haskell only? --formatToken (TOperator,"-<" ) = mathop "prec" formatToken (TOther, "-<" ) = mathop "prec" formatToken (TOther, ">-" ) = mathop "succ"@@ -114,7 +130,7 @@ formatToken (TOther, "=>" ) = mathop "Rightarrow" formatToken (TOperator,"==>" ) = mathop "implies" formatToken (TOperator,"|->" ) = mathop "mapsto"---formatToken (TOperator,"|=>" ) = mathop "Mapsto" -- not in amssymb+formatToken (TOperator,"|=>" ) = mathop "Mapsto" -- requires stmaryrd formatToken (TOperator,"<>" ) = mathop "diamond" formatToken (TOperator,"<$>" ) = mathop "mathbin{\\ooalign{\\raise.29ex\\hbox{$\\scriptscriptstyle\\$$}\\cr\\hss$\\!\\lozenge$\\hss}}" formatToken (TOperator,"<*>" ) = mathop "mathbin{\\ooalign{\\raise.37ex\\hbox{$\\scriptscriptstyle{*}$}\\cr\\hss$\\!\\lozenge$\\hss}}"@@ -126,11 +142,20 @@ formatToken (TVar, "c" ) = mathop "gamma" formatToken (TVar, "d" ) = mathop "delta" formatToken (TVar, "eps" ) = mathop "epsilon"-formatToken (TVar , kwd ) = "\\emph{" <> protectText kwd <> "}"+formatToken (TVar, "k" ) = mathop "kappa"+formatToken (TVar, "n" ) = mathop "nu"+formatToken (TVar, "m" ) = mathop "mu"+formatToken (TVar, "s" ) = mathop "sigma"+formatToken (TVar, "o" ) = mathop "omega"+formatToken (TVar, "pi" ) = mathop "pi"+formatToken (TVar, "tau" ) = mathop "tau"+formatToken (TVar, "rho" ) = mathop "rho"+formatToken (TVar , txt ) | T.any isAlpha txt = "\\textit{" <> subscripts txt <> "}"+formatToken (TVar, txt ) = "\\textit{" <> protectText txt <> "}" formatToken (TNum , kwd ) = protectText kwd formatToken (TKeyword, kwd ) = "\\textbf{" <> protectText kwd <> "}"-formatToken (TCons, cons ) = "\\textsc{" <> protectText cons <> "}"-formatToken (TOperator,"\\" ) = mathop "lambda"+formatToken (TCons, cons ) = "\\textsc{" <> subscripts cons <> "}"+--formatToken (TOperator,"\\" ) = mathop "lambda" formatToken (TTikz mark,_ ) = mathop $ "tikzMark{" <> mark <> "}" --formatToken (TOther, "`" ) = mathop "textasciigrave" formatToken (TOther, "`" ) = protectText "`"@@ -142,12 +167,14 @@ formatToken (TOther, "[" ) = protectText "[" formatToken (TOther, "}" ) = protectText "}" formatToken (TOther, "{" ) = protectText "{"--- formatToken (TBlank, txt ) = "\\textit{\\textcolor{gray}{" <> protectText txt <> "}}"-formatToken (TVar, txt ) = "\\textit{" <> protectText txt <> "}"-formatToken (_, txt ) = "\\textrm{" <> protectText txt <> "}"+-- formatToken (TBlank, txt ) = "\\textit{\\textcolor{gray}{" <> protectText txt <> "}}"+formatToken (_, txt ) = "\\textrm{" <> protectText txt <> "}" mathop :: Text -> Text mathop code = "\\" <> code prologue :: Text prologue = T.concat ["\\usepackage{amssymb}"]++latexPackages :: [Text]+latexPackages = ["amssymb", "amsmath", "stmaryrd"]
src/Token/Haskell.hs view
@@ -37,6 +37,8 @@ -- and text content. -- Only TikZ marks are recognized by looking up text content. recognizeToken :: (Token, Text) -> (MyTok, Text)+recognizeToken (SymbolTok, "\\") = -- special treatment for lambda+ (TOther, "λ" ) recognizeToken (CommentTok, tokText@(unTikzMark -> Just mark)) = (TTikz mark, tokText) recognizeToken (tokType, tokText) =
test/Spec.hs view
@@ -2,6 +2,7 @@ -- | Test suite module Main where +import Control.Exception(assert) import Data.Text.Arbitrary import Test.QuickCheck import qualified Data.Text as T@@ -13,10 +14,12 @@ ,MyLoc(..) ,Tokenized) import Token.Haskell(tokenizer)+import Render.Latex(subscripts) import qualified Render.Debug import FindColumns import Render.ColSpan import Alignment(Processed)+import GHC.Stack prop_tokenizer str = case tokenizer str of Nothing -> label "cannot lex" $ True@@ -67,15 +70,24 @@ sameNumber [] = True sameNumber (n:ns) = all (n==) ns +shouldBe :: (HasCallStack, Eq a) => a -> a -> IO ()+a `shouldBe` b = do+ if a /= b + then error "Inequal"+ else return ()+ main :: IO () main = do- problem " a\na"- problem "--"- problem "a\n a"- quickCheck prop_tokenizer- quickCheck prop_debug_renderer_text_length- quickCheck $ withMaxSuccess 10000 prop_colspans -- is it sufficient?- quickCheck $ withMaxSuccess 100000 prop_tableColumns -- is it sufficient?+ (subscripts "alpha_beta") `shouldBe` ("alpha\\textsubscript{beta}")+ (subscripts "alpha__beta") `shouldBe` ("alpha\\textsuperscript{beta}")+ (subscripts "alpha__gamma_beta") `shouldBe` ("alpha\\textsuperscript{gamma\\textsubscript{beta}}")+ problem " a\na"+ problem "--"+ problem "a\n a"+ quickCheck prop_tokenizer+ quickCheck prop_debug_renderer_text_length+ quickCheck $ withMaxSuccess 10000 prop_colspans -- is it sufficient?+ quickCheck $ withMaxSuccess 100000 prop_tableColumns -- is it sufficient? where problem example = do putStrLn $ "Example: " <> show example