pandoc-filter-indent (empty) → 0.1.0.0
raw patch · 19 files changed
+1555/−0 lines, 19 filesdep +HaTeXdep +basedep +blaze-htmlsetup-changed
Dependencies added: HaTeX, base, blaze-html, blaze-markup, ghc-syntax-highlighter, optics-core, optics-th, pandoc-filter-indent, pandoc-types, text
Files
- ChangeLog.md +5/−0
- LICENSE +30/−0
- README.md +541/−0
- Setup.hs +2/−0
- app/Main.hs +49/−0
- pandoc-filter-indent.cabal +116/−0
- src/Alignment.hs +34/−0
- src/Filter.hs +48/−0
- src/FindColumns.hs +167/−0
- src/Render/ColSpan.hs +63/−0
- src/Render/Common.hs +8/−0
- src/Render/Debug.hs +70/−0
- src/Render/HTML.hs +94/−0
- src/Render/Latex.hs +124/−0
- src/Token.hs +32/−0
- src/Token/Haskell.hs +92/−0
- src/Tuples.hs +18/−0
- src/Util.hs +60/−0
- test/Spec.hs +2/−0
+ ChangeLog.md view
@@ -0,0 +1,5 @@+# Changelog for pandoc-filter-indent++## Unreleased changes+0.0.1 Dec 1 2020+ - Initial release supporting LaTeX and HTML output
+ LICENSE view
@@ -0,0 +1,30 @@+Copyright Michał J. Gajda (c) 2020++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.++ * Neither the name of Michał J. Gajda nor the names of other+ contributors may be used to endorse or promote products derived+ from this software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS+"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+OWNER OR CONTRIBUTORS 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.
+ README.md view
@@ -0,0 +1,541 @@+---+title: "Code typesetting made simple"+subtitle: "Project description"+author: "Michał J. Gajda"+date: |+ `\today`{=latex}+abstract: |+ Program code has become a prime medium for communicating important algorithmic and mathematical ideas, as+ indicated by unwavering popularity of functional pearls and multitude blog posts using literate programming style+ to illustrate key ideas. However the literate programming systems are either appallingly complex or provide+ only limited functionality to emphasise code structure. We propose extremely simple code typesetting tool that+ is also a Pandoc filter, and can thus be used to improve comprehensibility of the code. It is also simple enough+ to be provided as a literate program within this submission. While it is processing Haskell code, we show how it+ can be easily adapted to typeset Python, Java or C/C++.+author:+ - name: Michał J. Gajda+ email: mjgajda@migamake.com+ orcid: "0000-0001-7820-3906"+ affiliation: 1+affiliation:+ institution: "Migamake Pte Ltd"+ email: mjgajda@migamake.com+ url: "https://migamake.com"+review: true+numbersections: true+header-includes:+ - |+ \usepackage{amssymb}+ \usepackage{graphicx}+ \DeclareUnicodeCharacter{03B1}{\ensuremath{\alpha{}}}+ \newcommand{\longeq}{\scalebox{1.7}[1]{=}}+prologue: |+ \usepackage{amssymb}+ \usepackage{graphicx}+ \DeclareUnicodeCharacter{03B1}{\ensuremath{\alpha{}}}+ \newcommand{\longeq}{\scalebox{1.7}[1]{=}}+---++# Introduction++Program code has become a prime medium for communicating important algorithmic and mathematical ideas, as+indicated by unwavering popularity of functional pearls and multitude blog posts using literate programming style+to illustrate key ideas. However the literate code typesetting systems like lhs2TEX[@lhs2tex]+are either appallingly complex, language-specific, or provide only limited functionality to emphasise code structure.++We propose a simple approach that can be used not just for code in languages with syntax defined by indentation-defined+(like Haskell or Python), but also for code that has been formatted by indentation (like many Java and C/C++ projects mandate).++# Algorithm++We use `pandoc` to process only code fragments in otherwise unprocessed literate program+or article with code excerpts.++We detect layout boundaries from tokens: (1) we note an column indent for each line[^This step is implemented using GHC API.],+then (2) mark a start of each operator (like `::`, `=`, or `>>=`) by column.+Our second step is that of transposing a list of `Line = [(Column, Token)]`+into per-column list of indentations `[(Line, Token)]`.+(3) If any token is present after more than a single space, we also mark its beginning+as indentation boundary.+(4) After sorting columns by line number, we mark these columns that have a consistent+presence along consecutive lines as indentation anchors.+(5) Additionally we mark the leftmost indent as a same indentation barrier+as long as it follows the nesting order.+(6) For postprocessing, we escape the text according to target text processing+engine syntax, translate common operators to their ligatures (see appendix),+and output the text with layout boundaries.+We also plan to implement support for pointing to code fragments+with TikZ target marks[@tikz] at this stage^[With syntax of `{->p1-}` standing for `\tikzmark{p1}`].++We also give user an option to align code fragments without regards for operators,+in case the source programming language is not yet supported.++## Integration++This solution is provided as a `pandoc`[@pandoc] filter so that it is integrated+into standard Markdown-based processing engines with its numerous plugins+that allow inclusion of GraphViz graphs, tables from `.csv` content+or citation referencing.++# Examples++## Layout++The example input is here:+```{.haskell}+class Eq a+ => Compare a where+ compare :: a -> a -> Ordering+ (>=) :: a -> a -> Bool+```++After splitting input sections into separated code blocks+and further by `\n\n` markers, we get the following layout boundaries+detected.++```+cl.ass |Eq . . |a.+ . => |Comp.are. |a. wh.er.e+ |comp.are |:: |a. |-> |a |-> |Ordering+ |(>=). |:: |a. |-> |a |-> |Bool+```+Here `|` marks an indentation boundary in a given line and column, whereas `.` is filler (no marker) to keep the columns indented.++First you sort by column (`Data.List.sortBy`), then within each column (`Data.List.groupBy`)+you compare token type that starts there.+As a result we see the following list of column boundaries^[Counting from column 1 and line 1.]:+```{.haskell}+[(3 -- column+ ,[3,4]) -- lines where it applies+ (7, -- column+ ,[1,2]) -- lines where it applies+,(11+ ,[3,4])+,(14+ ,[3,4])+,(15+ ,[1,2])+,(16,+ [3,4])+,(18,+ [3,4])+,(21,+ [3,4])+]+```++Another example input follows, to illustrate that we only take account+of tokens that start after at least one space:++```haskell+(\x -> x)+```+The following detection would be **wrong**:+```+|(|\|x |-|> |x)+```+Instead we detect layout boundaries as follows:+```+(\x |-> |x)+```++## Generating \LaTeX or HTML output++When generating \LaTeX or HTML output, we simply+assign a list of columns to each span of code tex in line.+This can be implemented using multicolumn marking in both output languages.+Consider the above example with columns numbered at starting character:++```+cl.ass |Eq . . |a.+ . => |Comp.are. |a. wh.er.e+ |comp.are |:: |a. |-> |a |-> |Ordering+ |(>=). |:: |a. |-> |a |-> |Bool+ 1 2 3 4 5 6 7 8 9+```+Alignment assignment is here:+```+cl.ass >Eq . . |a.+ . => >Comp.are. |a. wh.er.e+ |comp.are |:: |a. |-> |a |-> ^Ordering+ |(>=). |:: |a. |-> |a |-> ^Bool+```+Note the use of `>` instead of `|` at the boundary of right aligned block.+We also use `^` at the right boundary of center-aligned.++That means that we produce code like this for the first line:+```latex+\multicolumn{2}{r}{class}+\multicolumn{2}{l}{Eq}+\multicolumn{6}{l}{a}+```+General syntax of+`\multicolumn`^[See [Overleaf tutorial](https://www.overleaf.com/learn/latex/tables#Combining_rows_and_columns)+if you do not know how \LaTeX tables work.] has three arguments, each enclosed with braces (`{}`):+1. Number of columns in the cell, for example `{2}` or `{6}`.+2. Alignment of text in the cell:+ - `{l}` for left,+ - `{r}` right,+ - `{c}` for centered.+3. The text in the cell. For example `{class}`++First two columns end at `>`. So `\multicolumn` has parameter `{2}` to indicate that the cell spans two columns (just like [`colspan="2"` in HTML](https://www.w3schools.com/tags/att_td_colspan.asp).)+`Eq ` spans another two columns (3rd and 4th column) so again it is parameter `{2}`.++You basically compute column span this way:+* Start a new column with `colspan=1` for other column markers (`<` and `|`)+* Add `+1` to the current column span for every `.`.++The third column would have code like this:+```latex+\multicolumns{1}{l}{ }+\multicolumn{2}{l}{compare}+\multicolumn{1}{c}{::}+\multicolumn{2}{l}{a}+\multicolumn{1}{c}{->}+\multicolumn{1}{l}{a}+\multicolumn{1}{c}{->}+\multicolumn{1}{l}{Ordering}+```+That is the `class` takes columns 0 and 1,+`Eq` takes columns 2 and 3, and `a` goes from column 4 til the end in column 10.++This can be easily converted to HTML table:+```+<td colspan="2" style="text-align:right">class</td>+<td colspan="2" style="text-align:left" >Eq</td>+<td colspan="2" style="text-align:left" >a</td>+```+## Pandoc filter interface++Main executable is a `pandoc` filter.+You get `pandoc` input stream, and replace+[`CodeBlock` blocks](https://hackage.haskell.org/package/pandoc-types-1.20/docs/Text-Pandoc-Definition.html#t:Block)+there with `Raw "latex"` LaTeX blocks. It is these block elements of ADT that should contain the \LaTeX code+Pandoc will build the document for you, and do it better than you would.+Below is a modified [example from `pandoc` documentation](https://texblog.org/2012/12/21/multi-column-and-multi-row-cells-in-latex-tables/)+for making a `pandoc` filter executable:++```{.haskell}+module Main where++import Text.Pandoc.JSON++main :: IO ()+main = toJSONFilter blockFormatter++blockFormatter :: Block -> Block+blockFormatter (CodeBlock attrs content) | isHaskell attrs =+ haskellCodeFormatter :: Text -> Text+ Raw "latex" $ haskellCodeFormatter content+blockFormatter x = x+```++In the executable above, you write `haskellCodeFormatter` function+that takes Haskell code, and returns \LaTeX code _fragment_ like this:++```{.latex}+\begin{array}+\multicol{2}{..}+\end{array}+```++## Deciding between output formats++We need to check Pandoc meta before issuing `walk`+in order to check what is the output format.+In case it is \LaTeX or PDF, then we produce \LaTeX raw code fragments.+In case output format is any other, then we produce HTML table.++## Passing options to the filter++There are three ways that `pandoc` filter should accept the options:++1. On the command line `--debug`.+2. As `pandoc` metadata elements+ ([`YAML`](https://en.wikipedia.org/wiki/YAML)+ [at the start of the document](https://pandoc.org/MANUAL.html#extension-yaml_metadata_block)):+ ` pandoc-filter-indent: debug=true`+3. As attributes of the code block: ` ```{.haskell debug=true}`++All options should be available through all three option channels.+See tutorial on `optparse-applicative` to define CLI options.+To allow `YAML` option definition, add `FromJSON` instance.+For concatenating options from different sources use+this [tutorial on option merging](https://chrispenner.ca/posts/hkd-options).++There are following options that will be processed:++* `lexer` -- select a language lexer:+ - `haskell` -- default lexer, GHC+ - `indent` -- indent only lexer: table column starts when whitespace characters at beginning of the line ends+ - `spaces` -- space-only lexer: table column starts at the end of block of two or more whitespace characters+ - `python3` -- Python lexer (see below in @sec:python-lexer)+* `debug` -- add option that shows table columns (for debugging layout)+* `underbar` -- do not escape `_`, but instead use \LaTeX/HTML subscript til the end of the token:+ `method_agile` becomes `method_{agile}` in \LaTeX, `x_i_j` becomes `x_{i,j}` in \LaTeX+* table alignment (\LaTeX output only):+ - `array` -- use `array` environment, the default+ - `polytable` -- use `polytable` environment+* code alignment:+ - center environment -- default for `array`+ - `left` justify entire code environment -- for convenience when mentioning code inline.+* output mode -- is selected by the `pandoc` metadata only+ - `latex` -- `Raw "latex"` for `tex`, `pdf`, or `beamer` output+ - `html` -- `Raw "html"` for `html`, `slidy`, `slideous`, `s5`, or `revealjs` outputs+ - `table` -- for all other outputs we produce a `Table` block++## Appendix: operator symbol replacement++Code should be given a table of possible token replacements+depending on type of the symbol.++1. We implement greek unicode replacements for single-character type variables:+```+(TypeVar "a") -> α+```+++2. We also replace the common operators with \LaTeX symbols commonly used for this purpose:++| Input token | \LaTeX code | Rendering |+|:-----------------|:--------------|:---------------:|+| `Operator "="` | `\longeq` | $\longeq{}$ |+| `Operator "<>"` | `\diamond` | $\diamond{}$ |+| `Operator ">="` | `\geq` | $\geq{}$ |+| `Operator "<="` | `\geq` | $\leq{}$ |+| `Operator "/="` | `\ne` | $\ne{}$ |+| `Operator "==>"` | `\Rightarrow` | $\Rightarrow{}$ |+| `Operator "\/"` | `\ne` | $\bigvee{}$ |+| `Operator "/\"` | `\ne` | $\bigwedge{}$ |+| `Operator "."` | `\cdot` | $\cdot$ |+| `Operator "elem"`| `\in` | $\in$ |+| `Operator ">>"` | `\gg` | $\gg$ |+| `Operator "<<"` | `\ll` | $\ll$ |+| `Operator "~="` | `\approx` | $\approx$ |+| `Operator "~"` | `\sim` | $\sim$ |+| `Operator "<->"` | `\leftrightarrow` | $\leftrightarrow{}$ |+| `Operator ">>>"` | `\ggg` | $\ggg{}$ |+| `Operator "<<<"` | `\lll` | $\lll{}$ |+| `Operator "||"` | `\parallel` | $\parallel{}$ |+| `Operator ">>="` | `\ne` | $\gg\joinrel=$ |+| `Operator "|>"` | `\triangleright` | $\triangleright{}$ |+| `Operator "-<"` | `\prec` | $\prec{}$ |+| `Operator "<-"` | `\gets` | $\gets{}$ |+| `Operator "|"` | `\vert{}` | $\vert{}$ |+| `Operator "\\"` | `\setminus` | $\setminus{}$ |+| `Var "bottom"` | `\bot` | $\bot$ |+| `Var "top"` | `\top` | $\top$ |+| `Var "not"` | `\neg` | $\neg$ |+| `Var "mempty"` | `\emptyset{}` | $\emptyset{}$ |+| `Var "forall"` | `\forall{}` | $\forall{}$ |++3. For HTML we only replace these with either HTML entities that indicate these symbols:++```+ (Operator ">") -> >+```++*Unreplaced* content should be escaped.++In order to allow easy implementation we will need alternate debugging+executable `lexer` that will just print the output of the lexer+from the code on the input:++```+[Operator "=", Var "mempty", ...]+```++For finding the right symbol replacements use:++1. [Guide to lhs2TeX](https://hackage.haskell.org/package/lhs2tex-1.18/src/doc/Guide2.pdf) is a good reference on how to format Haskell code symbols.+ See code examples laid out in this document. I expect you to find the mapping for the most commonly used operators:+ - lambda sign token: `\` shown as $\lambda$,+ - equals sign `=`,+ - function type `->`,+ - type sign `::`,+ - and operators in standard type classes:+ * `Control.Monad`: `>>=`, `>>`, `>=>` + * `Control.Alternative`: `<|>`+ * `Control.Functor`: `<*>`+ * `Control.Applicative`: `<*>`, `<*`, and `*>`+ * `Data.Semigroup.<>` shown as $\diamond$+ * `Data.Ord`: `/=`, `>=`, `<=`, `>`, `<`+ * `Num`: `+`, `-`, `*`, `/`,+ * `System.FilePath`: `</>`, `<.>`+ * `Test.QuickCheck`: `==>` shown as $\Rightarrow$+ * `Control.Arrow`: `>>>`, `***`, `&&&`, `<+>`, `^<<`, `<<^`, `>>^`, `^>>`+ * `Control.Lens`: `^.`, `^.=`.+ * arrow notation: `-<`, `>-`.+ - convert single-letter type variables (and only type variables) to greek letters:+ * `a` to `\alpha` shown as $\alpha$+ * `b` to `\beta` shown as $\beta$+ * etc.++2. [The Comprehensive LATEX Symbol List](http://tug.ctan.org/info/symbols/comprehensive/symbols-a4.pdf) is a good reference of LaTeX symbol names.+ See section _3. Mathematical symbols_.++## Formatting different token types++Since we want to use `\begin{array}` environment in LaTeX,+we should encompass the token characters with different LaTeX operators.++* variables with `\textrm{var}`+* type variables with `\mathit{tyvar}`+* others with `\textrm{}` as well+* Haskell keywords with `\textit`+This mapping should be easily changed in a single place in code.++_Please let me know if there is a question about any other token types!_++## Safe escaping++In order to safely escape strings, it would be best to+make sure that conversion is done only on parts that are not escaped yet:+```{.haskell}+data Escapable x =+ Literal x+ | Escaped x++conversion :: Escapable Text -> Escapable LaTeX+```++Alternative is to perform the conversion as multistep process, with list of `Either` values:+```{.haskell}+type Input = Either HaskellToken RawTeX+type RawTeX = String++type Intermediate = Either UnescapedString RawTeX++type Output = Either () RawTeX+```++### Pandoc filter connection++Using [`Text.Pandoc.Walk`](https://hackage.haskell.org/package/pandoc-types-1.20/docs/Text-Pandoc-Walk.html)+interface we can easily implement the filter.++Filter main is a function like:+```{.haskell}+import Text.Pandoc.JSON+import Text.Pandoc.Walk++main :: IO ()+main = toJSONFilter (ourPandocWalk :: Walkable [a] Pandoc => ToJSONFilter (a -> IO [a])+```++Then we make `ourPandocWalk` to be a function that:++1. Matches [`Meta`](https://hackage.haskell.org/package/pandoc-types-1.20/docs/Text-Pandoc-Definition.html#t:Meta)+to check if we are targetting LaTeX or HTML.+2. Finds [`CodeBlock`](https://hackage.haskell.org/package/pandoc-types-1.20/docs/Text-Pandoc-Definition.html#t:Block) and leaves everything else as-is.+3. Generates `\table` as [`RawBlock`](https://hackage.haskell.org/package/pandoc-types-1.20/docs/Text-Pandoc-Definition.html#t:Block)+ of LaTeX output.++Options **shall** be parsed **per `CodeBlock`**.+First parameter to each `CodeBlock` are attributes ([`Attr`](https://hackage.haskell.org/package/pandoc-types-1.20/docs/Text-Pandoc-Definition.html#t:Attr)).+These attributes should be parsed as options++#### Option attributes++Per-`CodeBlock` attributes to be handled:+* `lexer=indent` or `lexer=haskell`+* ignore `CodeBlock` that does not have attribute:+ - `lexer=`+ - or `.haskell`++Global `Meta` attributes to be handled:+* output format:+ - LaTeX or PDF -- produce LaTeX `RawBlock`+ - HTML -- produce HTML `RawBlock`+ - or all others -- produce `Table`++### TikZ marks++TikZ marks are useful for marking up things on generated code.++You should just look for comments with syntax:+`{->markName-}` and convert them to a raw+LaTeX string `\tikzmark{markName}`.++### Alternate lexers++Please note that using alternate lexers+disables token replacement!+This is important, since the token replacement+to LaTeX special symbols is language-specific.++#### Indent only++Indent only is simplest to implement,+just start a column after initial whitespace in each line ends.++#### Space only++There should be an option to use alternate lexer.+It is driven solely by indentation.++1. Cell break is delimited by a starting indent.+2. Or column of **consecutive** spaces that occur in more than one line,+ **and** at least one line has at least **one more** space before it.++Example input:+```{.python}+# n is size of heap+def heapify(arr, n, i):+ largest = i # Initialize largest as root+ l = 2 * i + 1 # left = 2*i + 1+ r = 2 * i + 2 # right = 2*i + 2+```++Example column division:+```+# n is size of heap+def |heapify(arr, n, i).:+ |largest = i # Ini.tialize largest as root+ |l = 2 * i + 1 |# left = 2*i + 1+ |r = 2 * i + 2 |# right = 2*i + 2+```++For highlighting we will later connect [`skylighting`](https://hackage.haskell.org/package/skylighting)+like Pandoc does natively.++#### Python3 lexer {#sec:python-lexer}++Very easy to support, just add package [`language-python`](https://hackage.haskell.org/package/language-python-0.5.6/docs/Language-Python-Version3-Lexer.html) to dependencies.+The token type is different, but we only ever compare it by equality. ++# Used tools++## Finding Haskell tokens++https://hackage.haskell.org/package/ghc-syntax-highlighter-0.0.6.0/docs/GHC-SyntaxHighlighter.html+```+tokenizeHaskellLoc :: Text -> Maybe [(Token, Loc)]+```++## LaTeX output+1. For escaping text in TeX:+http://hackage.haskell.org/package/HaTeX-3.5/docs/Text-LaTeX-Base-Render.html#t:Render++`Render Text` in particular++2. For tables:+* https://hackage.haskell.org/package/HaTeX-3.22.2.0/docs/Text-LaTeX-Packages-Multirow.html+* if not:+ - add one to LaTeX:+ * `multicol`+ * `polytable`++## Debugging++The best debugging would be using the filter in different modes.+Pandoc can automatically detect output format:+```sh+pandoc input.md --filter=pandoc-filter-indent -o output.html+pandoc input.md --filter=pandoc-filter-indent -o output.tex+pandoc input.md --filter=pandoc-filter-indent -o output.pdf+```++Note that the filter *does not* touch the text outside code blocks.+It can however add necessary LaTeX headers or HTML styles in meta `headers-include`.
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ app/Main.hs view
@@ -0,0 +1,49 @@+{-# LANGUAGE OverloadedStrings #-}++module Main where++import Text.Pandoc.JSON+import Text.Pandoc.Definition ()+import Data.String (fromString, IsString)+import Data.Text (Text)+import qualified Data.Text as T+import Debug.Trace(trace)++import Token.Haskell+import GHC.SyntaxHighlighter+import Filter+import FindColumns++main :: IO ()+main = toJSONFilter blockFormatter++-- | Select the desired format output then process it.+blockFormatter :: Maybe Format -> Block -> Block+blockFormatter Nothing (CodeBlock attrs content) = -- debugging mode+ trace ("No format given") $+ codeFormatter "text" attrs content+blockFormatter (Just (Format format)) (CodeBlock attrs content)+ | isHaskell attrs = codeFormatter format attrs content+ | otherwise = CodeBlock attrs content+-- Do not touch other blocks than 'CodeBlock'+blockFormatter _ x = x++-- | Select formatter+codeFormatter :: Text -> Attr -> Text -> Block+codeFormatter format attrs content | True =+ trace ("Output format: " <> show format) $+ (render format attrs $ filterCodeBlock content)+ --CodeBlock attrs $ T.pack $ show $ fmap findColumns $ tokenizer content+ --CodeBlock attrs $ T.pack $ show $ tokenizer content+ {-+ | format == (fromString "latex") =+ RawBlock (Format "latex") (renderLatex content)+ | format == (fromString "html") =+ RawBlock (Format "html") (renderHtmlO content)-}+ -- Unknown formats gives the original elem.+ | otherwise = CodeBlock attrs content++-- (Text, [Text], [(Text, Text)])+isHaskell :: (Foldable t, Eq a1, IsString a1) =>+ (a2, t a1, c) -> Bool+isHaskell (_, classes, _) = "haskell" `elem` classes
+ pandoc-filter-indent.cabal view
@@ -0,0 +1,116 @@+cabal-version: 1.12++-- This file has been generated from package.yaml by hpack version 0.33.0.+--+-- see: https://github.com/sol/hpack+--+-- hash: 8fbe8b1245e7e2790a4df85621f625b1ec650eb3b6ade7b2c79f715880e4d926++name: pandoc-filter-indent+version: 0.1.0.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:+ .+ > ```{.haskell}+ .+ Usage:+ > stack install pandoc-filter-indent+ > pandoc --filter pandoc-filter-indent -f input.md -o output.pdf+ > pandoc --filter pandoc-filter-indent -f input.md -o output.html+ .+ Using `lhs2TeX` is somewhat inconvenient on large Markdown documents+ processed with `pandoc`, since it assumes that it can freely redefine everything.+ It is also pretty heavy on learning.+ .+ So instead we have a simple Pandoc filter that is only applied to `CodeFragment`s+ and creates tabular code structures from indentation.+ It uses GHC lexer to assure that latest features are always parsed correctly.+ .+ Please see the README on GitHub at <https://github.com/mjgajda/pandoc-filter-indent#readme>+category: Text+homepage: https://github.com/mjgajda/pandoc-filter-indent#readme+bug-reports: https://github.com/mjgajda/pandoc-filter-indent/issues+author: Michał J. Gajda+maintainer: mjgajda@migamake.com+copyright: AllRightsReserved+license: BSD3+license-file: LICENSE+build-type: Simple+extra-source-files:+ README.md+ ChangeLog.md++source-repository head+ type: git+ location: https://github.com/mjgajda/pandoc-filter-indent++library+ exposed-modules:+ Alignment+ Filter+ FindColumns+ Render.ColSpan+ Render.Common+ Render.Debug+ Render.HTML+ Render.Latex+ Token+ Token.Haskell+ Tuples+ Util+ other-modules:+ Paths_pandoc_filter_indent+ hs-source-dirs:+ src+ build-depends:+ HaTeX+ , base >=4.7 && <5+ , blaze-html ==0.9.1.2+ , blaze-markup+ , ghc-syntax-highlighter ==0.0.5.0+ , optics-core+ , optics-th+ , pandoc-types+ , text ==1.2.4.0+ default-language: Haskell2010++executable pandoc-filter-indent+ main-is: Main.hs+ other-modules:+ Paths_pandoc_filter_indent+ hs-source-dirs:+ app+ ghc-options: -threaded -rtsopts -with-rtsopts=-N+ build-depends:+ HaTeX+ , base >=4.7 && <5+ , blaze-html ==0.9.1.2+ , blaze-markup+ , ghc-syntax-highlighter ==0.0.5.0+ , optics-core+ , optics-th+ , pandoc-filter-indent+ , pandoc-types+ , text ==1.2.4.0+ default-language: Haskell2010++test-suite pandoc-filter-indent-test+ type: exitcode-stdio-1.0+ main-is: Spec.hs+ other-modules:+ Paths_pandoc_filter_indent+ hs-source-dirs:+ test+ ghc-options: -threaded -rtsopts -with-rtsopts=-N+ build-depends:+ HaTeX+ , base >=4.7 && <5+ , blaze-html ==0.9.1.2+ , blaze-markup+ , ghc-syntax-highlighter ==0.0.5.0+ , optics-core+ , optics-th+ , pandoc-filter-indent+ , pandoc-types+ , text ==1.2.4.0+ default-language: Haskell2010
+ src/Alignment.hs view
@@ -0,0 +1,34 @@+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE PartialTypeSignatures #-}+{-# LANGUAGE ViewPatterns #-}+{-# LANGUAGE TypeSynonymInstances #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE FlexibleContexts #-}+module Alignment where++import Data.Text (Text)+import Data.Tuple.Optics+import Optics.Lens++import Token+import Tuples++-- | Datatype to present columns with alignment requirements.+data Align =+ ALeft+ | ACenter+ | AIndent -- indentation spacing+ deriving (Eq, Ord, Show)++-- | Records tokenized and converted to common token format.+type Processed = (MyTok, MyLoc, Text, Maybe Int, Maybe (Align, Int))++-- | Access text content.+tokenType :: Field1 a a MyTok MyTok => Lens' a MyTok+tokenType = _1++-- | Access text content.+textContent :: Field3 a a Text Text => Lens' a Text+textContent = _3++
+ src/Filter.hs view
@@ -0,0 +1,48 @@+{-# LANGUAGE AllowAmbiguousTypes #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE PartialTypeSignatures #-}+{-# LANGUAGE ViewPatterns #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE FlexibleContexts #-}+module Filter where++import Text.Pandoc.JSON+import Data.Text (Text)+import qualified Data.Text as T+import Prelude hiding(getLine)++import Token.Haskell+import FindColumns+import Alignment+import Render.ColSpan+import qualified Render.Debug(render)+import qualified Render.Latex+import qualified Render.HTML++import Debug.Trace(trace)++filterCodeBlock = withTokens findColumns ("haskell", tokenizer)++-- | Apply function if tokenization succeeded, otherwise return same output+withTokens :: Show a => (t -> p) -> (String, a -> Maybe t) -> a -> p+withTokens f (tokenizerName, tokenizer) src@(tokenizer -> Nothing) = error $ mconcat ["Tokenizer ", tokenizerName, " failed for ", show src]+withTokens f (tokenizerName, tokenizer) (tokenizer -> Just tokens) = f tokens++render :: Text -- ^ Format string+ -> Attr -- ^ Attributes+ -> [Processed] -- ^ Data about alignment+ -> Block+--render "text" attrs aligned = RawBlock (Format "latex") $ processLatex aligned -- debug+render "text" attrs = CodeBlock attrs . Render.Debug.render+render "latex" attrs = RawBlock (Format "latex") . processLatex+render "html" attrs = RawBlock (Format "html" ) . processHTML+-- Debugging option+render other attrs = CodeBlock attrs . T.pack . show++processLatex :: [Processed] -> T.Text+processLatex processed = Render.Latex.latexFromColSpans (length $ tableColumns processed)+ $ colspans processed++processHTML :: [Processed] -> T.Text+processHTML processed = Render.HTML.htmlFromColSpans (length $ tableColumns processed)+ $ colspans processed
+ src/FindColumns.hs view
@@ -0,0 +1,167 @@+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE PartialTypeSignatures #-}+{-# LANGUAGE ViewPatterns #-}+{-# LANGUAGE TypeSynonymInstances #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE FlexibleContexts #-}+module FindColumns(findColumns, getLine, getCol, getLineCol, alignPos, tableColumns) where++import Text.Pandoc.JSON+import Text.Pandoc.Definition ()+import Data.Function (on)+import Data.String (fromString, IsString)+import Data.Text (Text)+import Data.List (groupBy, sortBy, sort, group, findIndex)+import Prelude hiding (getLine)+import Optics.Core+import Data.Tuple.Optics++import Token+import Token.Haskell+import Tuples+import Alignment+import Util+import Debug.Trace++-- | Records tokenized and converted to common token format.+type Unanalyzed = (MyTok, MyLoc, Text, Maybe Int )++-- | Records aligned, but without column numbers yet.+type Aligned = (MyTok -- token type+ ,MyLoc -- text start location+ ,Text -- text content+ ,Maybe Int -- indent in this column+ ,Maybe Align -- alignment+ )++-- * Definitions of fields accessible at many stages+getCol, getLine :: Field2 a a MyLoc MyLoc => a -> Int+getCol = view $ _2 % col+getLine = view $ _2 % line++align :: Field5 a a (Maybe b) (Maybe b) => Lens' a (Maybe b)+align = _5++alignPos :: Field5 a a (Maybe (Align, Int)) (Maybe (Align, Int)) => Lens' a (Maybe (Align, Int))+alignPos = _5++-- | Find columns from tokens.+findColumns :: [Tokenized] -> [Processed]+findColumns =+ columnIndices+ . withExtraColumns+ . sortBy (compare `on` getLineCol)+ . concat+ . map markBoundaries+ . grouping getCol+ . concat+ . map addLineIndent+ . grouping getLine++getLineCol x = (getLine x, getCol x)++markBoundaries :: [Unanalyzed] -> [Aligned]+markBoundaries = map markIndent+ . concat+ -- . (\b -> trace ("ALIGNED: " <> show b) b)+ . map alignBlock+ -- . (\b -> trace ("BLOCKS: " <> show b) b)+ . blocks+ . sortBy (compare `on` getLine)+ where+ getLine (tok, MyLoc line col, _, _) = line++-- | If first indented token is yet unmarked, mark it as boundary.+markIndent :: Aligned -> Aligned+markIndent (TBlank, myLoc@(MyLoc _ 1 ), txt, Just indent, _) =+ (TBlank, myLoc , txt, Just indent, Just AIndent)+markIndent (myTok, myLoc@(MyLoc _ col), txt, Just indent, _) | indent == col =+ (myTok, myLoc , txt, Just indent, Just ALeft)+markIndent other = other++withAlign :: Maybe Align -> Unanalyzed -> Aligned+withAlign = flip annex++alignBlock :: [Unanalyzed] -> [Aligned]+alignBlock [a] = withAlign Nothing <$> [a]+alignBlock opList | all isOperator opList = withAlign (Just ACenter) <$> opList+ where+ isOperator (TOperator, _, _, _) = True+ isOperator _ = False+alignBlock aList = withAlign (Just ALeft ) <$> aList++-- | Compute all alignment columns existing and their positions in the text column space.+extraColumns :: Field2 a a MyLoc MyLoc+ => Field5 a a (Maybe Align) (Maybe Align)+ => [a] -> [(Int, Maybe Align)]+extraColumns =+ nubSorted+ . filter hasAlignment+ . map extract+ where+ extract x = (getCol x, view align x)+ hasAlignment (_, Nothing) = False+ hasAlignment (_, Just _) = True++withExtraColumns x = (x, extraColumns x)++-- | Compute all alignment columns existing and their positions in the text column space.+-- TEST: check that we always have correct number of columns+tableColumns :: Field2 a a MyLoc MyLoc+ => Field5 a a (Maybe b) (Maybe b)+ => [a]+ -> [(Int, Maybe b)]+tableColumns =+ nubSortedBy (compare `on` fst)+ . filter hasAlignment+ . map extract+ where+ extract x = (getCol x, view align x)+ hasAlignment (_, Nothing) = False+ hasAlignment (_, Just _) = True++getIndent = view _4++-- | Detect uninterrupted stretches that cover consecutive columns.+-- NOTE: replacing with `groupBy` would not work due to comparison of consecutive only+blocks :: [Unanalyzed] -> [[Unanalyzed]]+blocks (b:bs) = go [b] bs+ where+ go currentBlock@((getIndent -> Nothing):_) (b@(getLine -> nextLine):bs) =+ go (b:currentBlock) bs+ go currentBlock@((getLine -> lastLine):_) (b@(getLine -> nextLine):bs)+ | nextLine - lastLine == 1 = -- add ignoring of unindented (Nothing)+ go (b:currentBlock) bs+ go (c:currentBlock) (blank@(getIndent -> Nothing):bs) =+ go (c:blank:currentBlock) bs+ go currentBlock (b :bs) =+ reverse currentBlock:go [b] bs+ go currentBlock [] =+ [reverse currentBlock]++-- | Add line indent to each token in line.+addLineIndent :: [Tokenized] -> [Unanalyzed]+addLineIndent aLine = (`annex` indentColumn) <$> aLine+ where+ indentColumn :: Maybe Int+ indentColumn = extractColumn $ filter notBlank aLine+ notBlank (TBlank, _, _) = False+ notBlank _ = True+ extractColumn [] = Nothing+ extractColumn ((_, MyLoc line col, _):_) = Just col++columnIndices :: ([Aligned], [(Int, b)]) -> [Processed]+columnIndices (allAligned, map fst -> markerColumns) = map addIndex allAligned+ where+ addIndex :: Aligned -> Processed+ addIndex aligned = (_5 `over` mod) aligned+ where+ mod :: Maybe Align -> Maybe (Align, Int)+ mod Nothing = Nothing+ mod (Just a) =+ Just (a, colIndex)+ where+ colIndex = case findIndex (==getCol aligned) markerColumns of+ Nothing -> error $ "Did not find the index for column " <> show (getCol aligned) <> " within " <> show markerColumns+ Just i -> i+
+ src/Render/ColSpan.hs view
@@ -0,0 +1,63 @@+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE PartialTypeSignatures #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE FlexibleContexts #-}+module Render.ColSpan where++import Data.Function(on)+import Data.String (fromString, IsString)+import Data.Text (Text)+import qualified Data.Text as T+import Data.List(groupBy, sortBy)+import Data.Maybe(fromMaybe)+import Prelude hiding(getLine)+import Optics.Core ( Field1(_1), Field2(_2), view, (%), lens )+import Data.Tuple.Optics ( Field1(_1), Field2(_2) )++import Alignment+import FindColumns+import Token(MyTok)+import Util++type TokensWithColSpan = ([(MyTok, Text)], Int, Align)+--type TextWithColSpan = (Text, Int, [Processed])++--extractTexts :: [[TextWithColSpan]] -> [[_]]+{-extractTexts ps = fmap extractText <$> ps+ where+ maxCol :: Int+ maxCol = maximum $ map getAlignCol $ ps+ extractText (tok:toks, colspan) = (T.concat (view textContent <$> (tok:toks))+ ,colspan+ ,view (alignPos % maybeLens (ALeft,-1) % _1) tok)+ -}++-- | Find colspan parameters+colspans :: [Processed] -> [[TokensWithColSpan]]+colspans ps = fmap ( fmap extractTokens+ . addColSpans+ . groupBy sameColSpan )+ $ groupBy ((==) `on` getLine)+ $ sortBy (compare `on` getLineCol) ps+ where+ maxCol :: Int+ maxCol = maximum $ map getAlignCol $ ps+ sameColSpan :: Processed -> Processed -> Bool+ sameColSpan tok1 tok2 = case view alignPos tok2 of+ Nothing | getLine tok1 == getLine tok2 -> True+ _ -> False+ addColSpans :: [[Processed]] -> [([Processed], Int, Align)]+ addColSpans [] = []+ addColSpans [a] = [(a, maxCol -getAlignCol (head a)+1, getAlign $ head a)]+ addColSpans (b:c:cs) = (b, nextCol-getAlignCol (head b) , getAlign $ head b):addColSpans (c:cs)+ where+ nextCol = getAlignCol $ head c+ getAlign :: Processed -> Align+ getAlign = view (alignPos % maybeLens (ALeft, 0) % _1)+ extractTokens (a,b,c) = (extractToken <$> a, b, c)+ extractToken tok = (view tokenType tok, view textContent tok)+-- FIXME: split lines before colspans!++getAlignCol :: Processed -> Int+getAlignCol = view (alignPos % maybeLens (ALeft, 0) % _2)+
+ src/Render/Common.hs view
@@ -0,0 +1,8 @@+module Render.Common where++import Data.Text(Text)+import Alignment+import Token++type TextWithColSpan = (Text, Int, Align)+type TokensWithColSpan = ([(MyTok,Text)], Int, Align)
+ src/Render/Debug.hs view
@@ -0,0 +1,70 @@+{-# LANGUAGE AllowAmbiguousTypes #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE PartialTypeSignatures #-}+{-# LANGUAGE TupleSections #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE FlexibleContexts #-}+module Render.Debug(render) where++import Data.Function(on)+import Data.String (fromString, IsString)+import Data.Text (Text)+import qualified Data.Text as T+import Data.List(groupBy, sortBy, sort, group)+import Data.Maybe(fromMaybe)+import Prelude hiding(getLine)+import Optics.Core++import FindColumns+import Alignment+import Util++insertAt :: Show a => Int -> a -> [a] -> [a]+insertAt i e ls = case maybeInsertAt i e ls of+ Nothing -> error $ "Failed in insertAt " <> show i <> " " <> show e <> " " <> show ls+ Just r -> r++maybeInsertAt :: Int -> a -> [a] -> Maybe [a]+maybeInsertAt 0 e ls = pure $ e:ls+maybeInsertAt i e (l:ls) = (l:) <$> maybeInsertAt (i-1) e ls+maybeInsertAt i e [] = Nothing++render :: [Processed] -> Text+render ps = T.concat $ go ps+ where+ -- | Table columns between starting point of this segment and the next.+ lastColumn = maximum tColumns + 1+ -- | Translates indices of alignment/table columns to text columns.+ tColumns :: [Int]+ tColumns = fst <$> tableColumns ps+ go [] = []+ go (tok:toks) = alignMarker:textWithMarkers tColumns nextCol tok+ :go toks+ where+ nextCol = case toks of+ [] -> lastColumn+ (next:_) -> getCol next+ alignMarker :: Text+ alignMarker = case view alignPos tok of+ Just (ACenter, _) -> "^"+ Just (ALeft, _) -> "|"+ otherwise -> ""++-- | Text content with markers for markers inside it.+textWithMarkers tColumns nextCol tok = + T.pack $ insertMarkers unaccountedMarkers $ T.unpack $ view textContent tok+ where+ insertMarkers [] txt = txt+ insertMarkers mrks txt = --(\result -> trace ("insertMarkers " <> show mrks <> " " <> show txt <> " => " <> result) result)+ foldr insertMarker txt+ $ -- trace (show unaccountedMarkers)+ mrks++ insertMarker index = insertAt index '.'+ unaccountedMarkers = fmap (-getCol tok+)+ $ withoutKnownMarker+ $ columnsBetween (getCol tok) nextCol+ withoutKnownMarker | Just _ <- view alignPos tok = safeTail+ | otherwise = id+ columnsBetween :: Int -> Int -> [Int]+ columnsBetween colA colB = filter (\c -> c >= colA && c < colB) tColumns
+ src/Render/HTML.hs view
@@ -0,0 +1,94 @@+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE ViewPatterns #-}+module Render.HTML(htmlFromColSpans) where++import Prelude hiding(span)+import Data.Text(Text)+import Data.Char(isSpace)+import qualified Data.Text as T+import qualified Data.Text.Lazy as LT+import Text.Blaze.Html5 hiding(style)+import Text.Blaze.Html5.Attributes(colspan, style)+import Text.Blaze.Html.Renderer.Text(renderHtml)++import Alignment+import Render.Common(TokensWithColSpan)+import Token(MyTok(..))+import Debug.Trace(trace)+import Util++--latexFromColSpans :: Int -> [[TokensWithColSpan]] -> Text+htmlFromColSpans cols =+ LT.toStrict+ . renderHtml+ . table+ . tbody+ . mapM_ renderTr++renderTr colspans = tr (mapM_ renderColSpan colspans)++--renderColSpan :: TokensWithColSpan -> Text+renderColSpan ([(TBlank, txt)], colSpan, AIndent) = -- indentation+ (td $ toHtml txt)+ ! colspan (toValue colSpan)+ ! style widthStyle+ where+ widthStyle = toValue $ "min-width: " <> show (T.length txt) <> "ex"+renderColSpan (toks, colSpan, alignment) =+ (td $ formatTokens toks)+ ! colspan (toValue colSpan)+ ! style alignStyle+ where+ alignStyle = "text-align: " <> alignMark alignment+ alignMark ACenter = "center"+ alignMark ALeft = "left"++-- Decrease column spacing: \\setlength{\\tabcolsep}{1ex}+-- TODO: braced operators+formatTokens :: [(MyTok, Text)] -> Html+formatTokens = mapM_ formatToken+ . preformatTokens++formatToken :: (MyTok, Text) -> Html+formatToken (TOperator,unbrace -> Just op) = do "("+ formatToken (TOperator, op)+ ")"+formatToken (TOperator,"|>" ) = "⊳"+formatToken (TOperator,"<>" ) = "⋄"+formatToken (TOperator,"=>" ) = "⇒"+formatToken (TOperator,"->" ) = "→"+formatToken (TOperator,"|->" ) = "↦"+formatToken (TVar ,"undefined") = "⊥"+formatToken (TVar ,"bot" ) = "⊥"+formatToken (TVar ,"not" ) = "¬"+formatToken (TVar ,"a" ) = "α"+formatToken (TVar ,"b" ) = "β"+formatToken (TVar ,"c" ) = "γ"+formatToken (TVar ,"d" ) = "δ"+formatToken (TVar ,"pi" ) = "π"+formatToken (TVar ,"eps" ) = "ε"+formatToken (TKeyword ,"\\" ) = "λ"+formatToken (TKeyword, "forall" ) = "∀"+formatToken (TOperator,"elem" ) = "∈"+formatToken (TOperator,"<=" ) = "≤"+formatToken (TOperator,">=" ) = "≥"+formatToken (TOperator,"mempty" ) = "∅"+formatToken (TOperator,">>>" ) = "⋙"+formatToken (TOperator,"<<<" ) = "⋘"+formatToken (TOperator,"||" ) = "∥"+formatToken (TOperator,"<->" ) = "↔︎"+formatToken (TOperator,"<-" ) = "←"+formatToken (TOperator,"-<" ) = "≺"+formatToken (TOperator,">-" ) = "≻"+formatToken (TOperator,"!=" ) = "≠"+formatToken (TOperator,"\\/" ) = "⋁"+formatToken (TOperator,"/\\" ) = "⋀"+formatToken (TOperator,"~" ) = "∼"+formatToken (TOperator,"~=" ) = "≈"+formatToken (TVar,"top" ) = "⊤"+formatToken (TKeyword, kwd ) = b $ toHtml kwd+formatToken (TVar, v ) = i $ toHtml v+formatToken (TCons, v ) = span (toHtml v)+ ! style ("font-variant: small-caps;")+formatToken (_, txt) = toHtml txt+
+ src/Render/Latex.hs view
@@ -0,0 +1,124 @@+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE ViewPatterns #-}+module Render.Latex(latexFromColSpans) where++import Data.Text(Text)+import Data.Char(isSpace)+import qualified Data.Text as T+import Text.LaTeX.Base.Syntax(protectText)++import Alignment+import Render.Common(TokensWithColSpan)+import Token(MyTok(..))+import Util(unbrace)++--import Debug.Trace(trace)++latexFromColSpans :: Int -> [[TokensWithColSpan]] -> Text+latexFromColSpans cols =+ wrapTable cols+ . T.unlines+ . fmap ( (<> "\\\\")+ . T.intercalate " & "+ . fmap renderColSpan )++renderColSpan :: TokensWithColSpan -> Text+renderColSpan ([(TBlank, txt)], colSpan, AIndent) = -- indentation+ T.concat [ "\\multicolumn{", T.pack $ show colSpan+ , "}{p{", T.pack $ show $ T.length txt+ , "ex}}{", protectText txt+ , "}" ]+renderColSpan (toks, colSpan, alignment) =+ T.concat [ "\\multicolumn{", T.pack $ show colSpan+ , "}{", alignMark alignment+ , "}{$", formatTokens toks+ , "$}" ]+ where+ alignMark ACenter = "c"+ alignMark ALeft = "l"++wrapTable :: Int -> Text -> Text+wrapTable cols txt =+ mconcat [-- "\\newlength{\\tabcolsepBACKUP}\n"+ -- ,"\\setlength{\\tabcolsepBACKUP}{\\tabcolsep}"+ "\\setlength{\\tabcolsep}{1pt}\n"+ , "\\begin{tabular}{"+ , T.replicate (cols+3) "l" -- FIXME: tests for correct number of columns+ , "}\n"+ , txt, "\n\\end{tabular}"+ --,"\\setlength{\\tabcolsep}{\\tabcolsepBACKUP}"+ ]++-- Decrease column spacing: \\setlength{\\tabcolsep}{1ex}+-- TODO: braced operators+preformatTokens [] = []+preformatTokens ((TOperator,"`"):(TVar, "elem"):(TOperator, "`"):rest) = (TOperator, "elem"):preformatTokens rest+preformatTokens (a :rest) = a :preformatTokens rest++formatTokens :: [(MyTok, Text)] -> Text+formatTokens = T.concat+ . fmap formatToken+ . preformatTokens+ -- . (\t -> trace ("Tokens: " <> show t) t) -- debug++-- Workaround with joinEscapedOperators til w consider spaces only.+formatToken (TOperator,unbrace -> Just op) = "(" <> formatToken (TOperator, op) <> ")"+formatToken (TKeyword, "forall") = mathop "forall"+formatToken (TVar, "mempty") = mathop "emptyset"+formatToken (TVar, "bottom") = mathop "bot"+formatToken (TVar, "undefined") = mathop "perp"+formatToken (TVar, "top" ) = mathop "top"+formatToken (TVar, "not" ) = mathop "neg"+formatToken (TOperator,">>=" ) = mathop "mathbin{>\\!\\!\\!>\\!\\!=}" -- from lhs2TeX, Neil Mitchell's+formatToken (TOperator,"=<<" ) = mathop "mathbin{=\\!\\!<\\!\\!\\!<}" -- from lhs2TeX, Neil Mitchell's+formatToken (TOperator,">=>" ) = mathop "mathbin{>\\!\\!=\\!\\!\\!>}"+formatToken (TOperator,"|-" ) = mathop "vdash"+formatToken (TOperator,"/\\" ) = mathop "lor"+formatToken (TOperator,"\\/" ) = mathop "land"+formatToken (TOperator,"\\|/" ) = mathop "downarrow"+formatToken (TOperator,"\\||/" ) = mathop "Downarrow"+formatToken (TOperator,"~>" ) = mathop "leadsto"+formatToken (TOperator,"|=" ) = mathop "models"+formatToken (TCons ,"Natural") = mathop "N"+formatToken (TOperator,"|" ) = mathop "vert"+formatToken (TOperator,"||" ) = mathop "parallel"+formatToken (TOperator,"|>" ) = mathop "triangleright"+formatToken (TOperator,">>" ) = mathop "mathbin{>\\!\\!\\!>}" -- gg+formatToken (TOperator,">>>" ) = mathop "mathbin{>\\!\\!\\!>\\!\\!\\!>}" -- gg+formatToken (TOperator,">>" ) = mathop "gg"+formatToken (TOperator,">>>" ) = mathop "ggg"+formatToken (TOperator,"<<" ) = mathop "ll"+formatToken (TOperator,"<<<" ) = mathop "lll"+formatToken (TOperator,"-<" ) = mathop "prec"+formatToken (TOperator,"\\\\" ) = mathop "setminus"+formatToken (TOperator,"<-" ) = mathop "gets"+formatToken (TOperator,">=" ) = mathop "geq"+formatToken (TOperator,"<=" ) = mathop "leq"+formatToken (TOperator,"!=" ) = mathop "ne"+formatToken (TOperator,"<->" ) = mathop "leftrightarrow"+formatToken (TOperator,"->" ) = mathop "to"+formatToken (TOperator,"=>" ) = mathop "Rightarrow"+formatToken (TOperator,"==>" ) = mathop "implies"+formatToken (TOperator,"|->" ) = mathop "mapsto"+--formatToken (TOperator,"|=>" ) = mathop "Mapsto" -- not in amssymb+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}}"+formatToken (TOperator,"elem" ) = mathop "in"+formatToken (TOperator,"~" ) = mathop "sim"+formatToken (TOperator,"~=" ) = mathop "approx"+formatToken (TVar, "a" ) = mathop "alpha"+formatToken (TVar, "b" ) = mathop "beta"+formatToken (TVar, "c" ) = mathop "gamma"+formatToken (TVar, "d" ) = mathop "delta"+formatToken (TVar, "eps" ) = mathop "epsilon"+formatToken (TVar , kwd ) = "\\emph{" <> protectText kwd <> "}"+formatToken (TNum , kwd ) = protectText kwd +formatToken (TKeyword, kwd ) = "\\textbf{" <> protectText kwd <> "}"+formatToken (TCons, cons ) = "\\textsc{" <> protectText cons <> "}"+formatToken (TOperator,"\\" ) = mathop "lambda"+formatToken (_, txt ) = "\\textit{" <> protectText txt <> "}"++mathop code = "\\" <> code++prologue = T.concat ["\\usepackage{amssymb}"]
+ src/Token.hs view
@@ -0,0 +1,32 @@+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE PartialTypeSignatures #-}+{-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE ViewPatterns #-}+-- | Common token representation used.+module Token(MyTok(..), MyLoc(..), Tokenized, line, col) where++import Data.Text(Text)+import Data.Tuple.Optics+import Optics.TH++-- * Common tokens and locations+-- Location is just line and column+data MyLoc = MyLoc { _line, _col :: Int }+ deriving (Eq, Ord, Show)++makeLenses ''MyLoc++-- | Token just classifies to blank, operator, and the style class+data MyTok =+ TBlank+ | TOperator+ | TKeyword+ | TCons+ | TVar+ | TNum+ | TOther+ deriving (Eq, Ord, Show)++-- | Records tokenized and converted to common token format.+type Tokenized = (MyTok, MyLoc, Text)+
+ src/Token/Haskell.hs view
@@ -0,0 +1,92 @@+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE PartialTypeSignatures #-}+{-# LANGUAGE ViewPatterns #-}+-- | Haskell code tokenizer+module Token.Haskell(tokenizer) where++import Control.Arrow(first)+import Text.Pandoc.JSON+import Text.Pandoc.Definition ()+import Data.Function(on)+import Data.String (fromString, IsString)+import Data.Text (Text)+import qualified Data.Text as T+import Data.List(groupBy, sortBy)+import Debug.Trace(trace)+import Prelude hiding(getLine)++import GHC.SyntaxHighlighter++import Token++-- * Haskell tokenizer frontend+tokenizer :: Text -> Maybe [(MyTok, MyLoc, Text)]+tokenizer = fmap ( joinEscapedOperators+ . splitTokens+ . restoreLocations+ . fmap (first haskellTok) )+ . tokenizeHaskell++haskellTok SymbolTok = TOperator+haskellTok SpaceTok = TBlank+haskellTok CommentTok = TBlank+haskellTok PragmaTok = TBlank+haskellTok KeywordTok = TKeyword+haskellTok ConstructorTok = TCons+haskellTok VariableTok = TVar+haskellTok OperatorTok = TOperator+haskellTok RationalTok = TNum+haskellTok IntegerTok = TNum+haskellTok t = TOther++locLine (Loc startLineNo startColNo _ _) = startLineNo+locCol (Loc startLineNo startColNo _ _) = startColNo++-- | Split tokens into one blank per line.+-- TESTME: assures that no token has '\n' before the end of text.+splitTokens :: [(MyTok, MyLoc, Text)] -> [(MyTok, MyLoc, Text)]+splitTokens = mconcat+ . fmap splitter+ where+ splitter :: (MyTok, MyLoc, Text) -> [(MyTok, MyLoc, Text)]+ splitter (TBlank, loc@(MyLoc line _), txt) | T.filter (=='\n') txt /= "" =+ withLocs withNewLines+ where+ split, withNewLines :: [Text]+ split = T.lines txt+ withNewLines = fmap (<>"\n") (init split)+ <> [last split]+ withLocs :: [Text] -> [(MyTok, MyLoc, Text)]+ withLocs (l:ls) = (TBlank, loc, l)+ : zipWith mkEntry [line+1..] ls+ mkEntry :: Int -> Text -> (MyTok, MyLoc, Text)+ mkEntry i t = (TBlank, MyLoc i 1, t)+ splitter other = [other]++joinEscapedOperators ((TOperator, loc, "("):(TOperator, _, op):(TOperator, _, ")"):rest) =+ (TOperator, loc, "(" <> op <> ")"):joinEscapedOperators rest+joinEscapedOperators (tok:rest) = tok:joinEscapedOperators rest+joinEscapedOperators [] = []++-- | Restore locations+-- TESTME: test+-- 1. Without newlines should return a list of indices up to length+-- 2. Of the same length as number of tokens+-- 3. With newlines should return line indices up to number of lines.+-- 4. Same for a list of lists of words without newlines joined as lines+restoreLocations :: [(a, Text)] -> [(a, MyLoc, Text)]+restoreLocations = go 1 1+ where+ go line col [] = []+ go line col ((tok, txt):ls) =+ (tok, MyLoc line col, txt):go newLine newCol ls+ where+ newLine = line + lineIncr+ lineIncr = T.length $ T.filter (=='\n') txt+ newCol | lineIncr == 0 = col + T.length txt+ | otherwise = (+1)+ $ T.length+ $ fst+ $ T.break (=='\n')+ $ T.reverse txt+
+ src/Tuples.hs view
@@ -0,0 +1,18 @@+{-# LANGUAGE FunctionalDependencies #-}+{-# LANGUAGE FlexibleInstances #-}+module Tuples where++class Annex c b a | c -> a, c -> b where+ annex :: b -> a -> c++instance Annex (a, b, c) (a, b) c where+ annex (a, b) c = (a, b, c)++instance Annex (a, b, c, d) (a, b, c) d where+ annex (a, b, c) d = (a, b, c, d)++instance Annex (a, b, c, d, e) (a, b, c, d) e where+ annex (a, b, c, d) e = (a, b, c, d, e)++instance Annex (a, b, c, d, e, f) (a, b, c, d, e) f where+ annex (a, b, c, d, e) f = (a, b, c, d, e, f)
+ src/Util.hs view
@@ -0,0 +1,60 @@+{-# LANGUAGE AllowAmbiguousTypes #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE PartialTypeSignatures #-}+{-# LANGUAGE ViewPatterns #-}+{-# LANGUAGE TupleSections #-}+{-# LANGUAGE TypeSynonymInstances #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE FlexibleContexts #-}+module Util where++import Text.Pandoc.JSON+import Text.Pandoc.Definition ()+import Data.Function(on)+import Data.String (fromString, IsString)+import Data.Text (Text)+import qualified Data.Text as T+import Data.List(groupBy, sortBy, sort, group)+import Data.Maybe(fromMaybe)+import Prelude hiding(getLine)+import Optics.Core+import Data.Tuple.Optics+import Data.Tuple.Optics+import Data.Text.Lazy.Builder++import Token(MyTok(..))++-- | Lens with default value.+maybeLens :: a -> Lens (Maybe a) (Maybe a1) a a1+maybeLens dflt = lens (fromMaybe dflt) (\_ a -> Just a)++-- | Sort and group inputs by a given `Ordering`.+grouping :: Ord k+ => ( a -> k)+ -> [a]+ -> [[a]]+grouping key = groupBy ((==) `on` key)+ . sortBy (compare `on` key)++nubSorted :: Ord a => [a] -> [a]+nubSorted = nubSortedBy compare++-- | Given an `Ord`ering, sort and remove duplicates.+nubSortedBy :: (a -> a -> Ordering) -> [a] -> [a]+nubSortedBy comparison = fmap head+ . groupBy equality+ . sortBy comparison+ where+ equality a b = a `comparison` b == EQ++-- | Safe tail function that returns empty list for empty input.+safeTail [] = []+safeTail (_:ls) = ls++unbrace txt | T.head txt == '(' && T.last txt == ')' && T.length txt > 2 = Just $ T.tail $ T.init txt+unbrace _ = Nothing++preformatTokens [] = []+preformatTokens ((TOperator,"`"):(TVar, "elem"):(TOperator, "`"):rest) = (TOperator, "elem"):preformatTokens rest+preformatTokens (a :rest) = a :preformatTokens rest+
+ test/Spec.hs view
@@ -0,0 +1,2 @@+main :: IO ()+main = putStrLn "Test suite not yet implemented"