diff --git a/ChangeLog.md b/ChangeLog.md new file mode 100644 --- /dev/null +++ b/ChangeLog.md @@ -0,0 +1,5 @@ +# Changelog for pandoc-filter-indent + +## Unreleased changes +0.0.1 Dec 1 2020 + - Initial release supporting LaTeX and HTML output diff --git a/LICENSE b/LICENSE new file mode 100644 --- /dev/null +++ b/LICENSE @@ -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. diff --git a/README.md b/README.md new file mode 100644 --- /dev/null +++ b/README.md @@ -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: +``` +class +Eq +a +``` +## 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`. diff --git a/Setup.hs b/Setup.hs new file mode 100644 --- /dev/null +++ b/Setup.hs @@ -0,0 +1,2 @@ +import Distribution.Simple +main = defaultMain diff --git a/app/Main.hs b/app/Main.hs new file mode 100644 --- /dev/null +++ b/app/Main.hs @@ -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 diff --git a/pandoc-filter-indent.cabal b/pandoc-filter-indent.cabal new file mode 100644 --- /dev/null +++ b/pandoc-filter-indent.cabal @@ -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 +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 diff --git a/src/Alignment.hs b/src/Alignment.hs new file mode 100644 --- /dev/null +++ b/src/Alignment.hs @@ -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 + + diff --git a/src/Filter.hs b/src/Filter.hs new file mode 100644 --- /dev/null +++ b/src/Filter.hs @@ -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 diff --git a/src/FindColumns.hs b/src/FindColumns.hs new file mode 100644 --- /dev/null +++ b/src/FindColumns.hs @@ -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 + diff --git a/src/Render/ColSpan.hs b/src/Render/ColSpan.hs new file mode 100644 --- /dev/null +++ b/src/Render/ColSpan.hs @@ -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) + diff --git a/src/Render/Common.hs b/src/Render/Common.hs new file mode 100644 --- /dev/null +++ b/src/Render/Common.hs @@ -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) diff --git a/src/Render/Debug.hs b/src/Render/Debug.hs new file mode 100644 --- /dev/null +++ b/src/Render/Debug.hs @@ -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 diff --git a/src/Render/HTML.hs b/src/Render/HTML.hs new file mode 100644 --- /dev/null +++ b/src/Render/HTML.hs @@ -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 + diff --git a/src/Render/Latex.hs b/src/Render/Latex.hs new file mode 100644 --- /dev/null +++ b/src/Render/Latex.hs @@ -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}"] diff --git a/src/Token.hs b/src/Token.hs new file mode 100644 --- /dev/null +++ b/src/Token.hs @@ -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) + diff --git a/src/Token/Haskell.hs b/src/Token/Haskell.hs new file mode 100644 --- /dev/null +++ b/src/Token/Haskell.hs @@ -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 + diff --git a/src/Tuples.hs b/src/Tuples.hs new file mode 100644 --- /dev/null +++ b/src/Tuples.hs @@ -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) diff --git a/src/Util.hs b/src/Util.hs new file mode 100644 --- /dev/null +++ b/src/Util.hs @@ -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 + diff --git a/test/Spec.hs b/test/Spec.hs new file mode 100644 --- /dev/null +++ b/test/Spec.hs @@ -0,0 +1,2 @@ +main :: IO () +main = putStrLn "Test suite not yet implemented"