pandoc-filter-indent 0.2.1.0 → 0.2.2.0
raw patch · 14 files changed
+388/−137 lines, 14 filesdep +QuickCheckdep +containersdep +optparse-applicative
Dependencies added: QuickCheck, containers, optparse-applicative, quickcheck-text
Files
- ChangeLog.md +9/−0
- README.md +8/−2
- app/Main.hs +62/−26
- pandoc-filter-indent.cabal +12/−6
- src/Alignment.hs +9/−1
- src/Filter.hs +32/−18
- src/FindColumns.hs +31/−16
- src/Render/ColSpan.hs +11/−1
- src/Render/Debug.hs +7/−4
- src/Render/HTML.hs +22/−4
- src/Render/Latex.hs +32/−14
- src/Token.hs +10/−8
- src/Token/Haskell.hs +56/−36
- test/Spec.hs +87/−1
ChangeLog.md view
@@ -1,6 +1,15 @@ # Changelog for pandoc-filter-indent ## Unreleased changes+## Unreleased changes++0.2.2.0 Jan 12 2020+ - Fixed problem with declaring too few columns in LaTeX+ - Inline code formatting+ - Removed indent marks from parenthesised operators: "`(+)"+ - Removed indent marks from functions promoted to operators like "`mappend`"+ - Fixed rendering of indent mark at the start of the column+ 0.1.0.0 Dec 1 2020 - Initial release supporting LaTeX and HTML output
README.md view
@@ -371,8 +371,8 @@ - and operators in standard type classes: * `Control.Monad`: `>>=`, `>>`, `>=>` * `Control.Alternative`: `<|>`- * `Control.Functor`: `<*>`- * `Control.Applicative`: `<*>`, `<*`, and `*>`+ * `Control.Functor`: `<$>`+ * `Control.Applicative`: `<*>`, `<$>`, `<*`, and `*>` * `Data.Semigroup.<>` shown as $\diamond$ * `Data.Ord`: `/=`, `>=`, `<=`, `>`, `<` * `Num`: `+`, `-`, `*`, `/`,@@ -401,6 +401,12 @@ 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!_++## Formatting inline code++To format inline code we lookup `inline-code` in YAML metadata,+and append it to attributes of each inline code fragment.+By default it is `haskell`. ## Safe escaping
app/Main.hs view
@@ -1,44 +1,80 @@ {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE ViewPatterns #-}+{-# LANGUAGE RecordWildCards #-}+{-# LANGUAGE NamedFieldPuns #-} module Main where import Text.Pandoc.JSON+import Text.Pandoc.Walk (walk) import Text.Pandoc.Definition ()-import Data.String (fromString, IsString)-import Data.Maybe (fromMaybe)-import Data.Text (Text)+import Data.String (IsString)+import Data.Maybe (fromMaybe)+import qualified Data.Map as Map+import Data.Text(Text) import qualified Data.Text as T--import Debug.Trace(trace)+ +import qualified Token.Haskell (tokenizer)+import Filter (renderBlock, renderInline)+import FindColumns (findColumns)+import Alignment (Processed) -import Token.Haskell-import GHC.SyntaxHighlighter-import Filter-import FindColumns+data Options = Options {+ inlineSyntax :: Text+ } main :: IO ()-main = toJSONFilter blockFormatter+main = toJSONFilter runner +-- | Main body of Pandoc filter.+-- Reads format option, metadata,+-- and calls `walk` with `blockFormatter`.+runner :: Maybe Format -> Pandoc -> Pandoc+runner (fromMaybe (Format "text") -> format) input@(Pandoc (Meta meta) _) =+ walk (blockFormatter opts format) input+ where+ opts = case Map.lookup "inline-code" meta of+ Nothing -> Options "haskell" -- default+ Just (MetaString s) -> Options s -- never needed?+ Just (MetaInlines [Str s]) -> Options s+ Just otherValue -> error $ "inline-code: meta should be a string but is: " <> show otherValue+ -- | Select the desired format output then process it.-blockFormatter :: Maybe Format -> Block -> Block-blockFormatter format (CodeBlock attrs content) =- codeFormatter (fromMaybe (Format "text") format) attrs content--- Do not touch other blocks than 'CodeBlock'-blockFormatter _ x = x+-- Run tokenizer, analysis, and formatter.+--+-- For non-CodeBlocks it runs `inlineFormatter`.+-- Fallback to original input, if failed to tokenize.+blockFormatter :: Options+ -> Format -- ^ Output format, defaults to "plain" if not found+ -> Block+ -> Block+blockFormatter _opts format (CodeBlock attrs content) =+ case fmap findColumns $ getTokenizer attrs content of+ Just processed -> renderBlock format attrs processed+ Nothing -> CodeBlock attrs content -- fallback+-- Do not touch other blocks than 'CodeBock'+blockFormatter opts format x =+ walk (inlineFormatter opts format) x --- | Run tokenizer, analysis, and formatter.+-- | Select the desired format output then process it.+-- Run tokenizer, and inline formatter. -- Fallback to original input, if failed to tokenize.-codeFormatter :: Format -- ^ Output format, defaults to "text" if not found- -> Attr -- ^ Code block attributes- -> Text -- ^ Code block content- -> Block-codeFormatter format attrs content =- case fmap findColumns $ aTokenizer content of- Just processed -> render format attrs processed- Nothing -> CodeBlock attrs content -- fallback+inlineFormatter :: Options+ -> Format -- ^ Output format, defaults to "plain" if not found+ -> Inline+ -> Inline+inlineFormatter Options {inlineSyntax} format (Code attrs txt) =+ case getTokenizer attrs txt of+ Just processed -> renderInline format attrs $ map discardLoc processed+ Nothing -> Code attrs txt -- fallback where- aTokenizer | isHaskell attrs = Token.Haskell.tokenizer- | otherwise = \_ -> Nothing+ discardLoc (a, _, b) = (a, b)+ addClass (a, classes, b) | inlineSyntax /= "" = (a, inlineSyntax:classes, b)+ addClass o = o+inlineFormatter _opts _ x = x++-- | Pick tokenizer depending on options.+getTokenizer attrs | isHaskell attrs = Token.Haskell.tokenizer+ | otherwise = \_ -> Nothing -- | Check if the code block is tagged as Haskell. isHaskell :: (Foldable t, Eq a1, IsString a1) =>
pandoc-filter-indent.cabal view
@@ -4,16 +4,18 @@ -- -- see: https://github.com/sol/hpack ----- hash: 556363e65a61ebed2e66c3756278177ca371c24b119a21fbad59d9b26059d56e+-- hash: 506b1106212a197e0660fa32faa540c66b93cd8f032fb5b7863977a230d9ebd9 name: pandoc-filter-indent-version: 0.2.1.0+version: 0.2.2.0 synopsis: Pandoc filter formatting Haskell code fragments using GHC lexer. description: Formats marked code fragments, and allows `pandoc` to safely process rest of your literate program: . > ```{.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@@ -26,10 +28,10 @@ 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>+ Please see the README on GitHub at <https://github.com/mgajda/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+homepage: https://github.com/mgajda/pandoc-filter-indent#readme+bug-reports: https://github.com/mgajda/pandoc-filter-indent/issues author: Michał J. Gajda maintainer: mjgajda@migamake.com copyright: AllRightsReserved@@ -42,7 +44,7 @@ source-repository head type: git- location: https://github.com/mjgajda/pandoc-filter-indent+ location: https://github.com/mgajda/pandoc-filter-indent library exposed-modules:@@ -86,9 +88,11 @@ , base >=4.7 && <5 , blaze-html ==0.9.1.2 , blaze-markup+ , containers , ghc-syntax-highlighter ==0.0.5.0 , optics-core , optics-th+ , optparse-applicative , pandoc-filter-indent , pandoc-types , text ==1.2.4.0@@ -104,6 +108,7 @@ ghc-options: -threaded -rtsopts -with-rtsopts=-N build-depends: HaTeX+ , QuickCheck , base >=4.7 && <5 , blaze-html ==0.9.1.2 , blaze-markup@@ -112,5 +117,6 @@ , optics-th , pandoc-filter-indent , pandoc-types+ , quickcheck-text , text ==1.2.4.0 default-language: Haskell2010
src/Alignment.hs view
@@ -18,7 +18,15 @@ deriving (Eq, Ord, Show) -- | Records tokenized and converted to common token format.-type Processed = (MyTok, MyLoc, Text, Maybe Int, Maybe (Align, Int))+type Processed = (MyTok -- ^ Token type+ ,MyLoc -- ^ Token location+ ,Text -- ^ Text content+ ,Maybe Int -- ^ Indent column+ ,Maybe (Align -- ^ Alignment mark+ ,Int) -- ^ Alignment column+ )++ -- | Access text content. tokenType :: Field1 a a MyTok MyTok => Lens' a MyTok
src/Filter.hs view
@@ -5,39 +5,53 @@ {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE FlexibleContexts #-} -- | Filtering a single code block.-module Filter where+module Filter(renderBlock, renderInline) 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 FindColumns ( tableColumns )+import Alignment ( Processed )+import Token ( MyTok )+import Render.ColSpan ( colspans, numColSpans )+import qualified Render.Debug import qualified Render.Latex import qualified Render.HTML- import Debug.Trace(trace) -- | Render a list of `Processed` token records into the target output format.-render :: Format -- ^ Format string- -> Attr -- ^ Attributes- -> [Processed] -- ^ Data about alignment- -> Block+renderBlock :: Format -- ^ Format string+ -> Attr -- ^ Attributes+ -> [Processed] -- ^ Data about alignment+ -> Block+renderBlock (Format "text" ) _attrs = RawBlock (Format "html" ) . T.pack . show . map (sum . map (\(_,c,_) -> c)) . colspans+--renderBlock (Format "text" ) attrs = CodeBlock attrs . Render.Debug.render+renderBlock (Format "latex") _attrs = RawBlock (Format "latex") . processLatex+renderBlock (Format "html" ) _attrs = RawBlock (Format "html" ) . processHTML+-- Debugging option+renderBlock other attrs = CodeBlock attrs . T.pack . (show other <>) . show ++sumColSpans = map (sum . map (\(_,c,_) -> c)) . colspans++-- TODO: inline should strip colspans, and ignore table+-- | Render a list of `Processed` token records into the target output format.+renderInline :: Format -- ^ Format string+ -> Attr -- ^ Attributes+ -> [(MyTok, T.Text)] -- ^ Data about alignment+ -> Inline --render "text" attrs aligned = RawBlock (Format "latex") $ processLatex aligned -- debug-render (Format "text" ) attrs = CodeBlock attrs . Render.Debug.render-render (Format "latex") attrs = RawBlock (Format "latex") . processLatex-render (Format "html" ) attrs = RawBlock (Format "html" ) . processHTML+renderInline (Format "text" ) attrs = Code attrs . Render.Debug.renderInline+renderInline (Format "latex") _attrs = RawInline (Format "latex") . Render.Latex.latexInline+renderInline (Format "html" ) _attrs = RawInline (Format "html" ) . Render.HTML.htmlInline -- Debugging option-render other attrs = CodeBlock attrs . T.pack . show+renderInline other attrs = Code attrs . T.pack . show -- | Convert a list of input token records to raw LaTeX. processLatex :: [Processed] -> T.Text-processLatex processed = Render.Latex.latexFromColSpans (length $ tableColumns processed)- $ colspans processed+processLatex processed = Render.Latex.latexFromColSpans (numColSpans processed) cs+ where+ cs = colspans processed -- | Convert a list of input token records to raw HTML. processHTML :: [Processed] -> T.Text
src/FindColumns.hs view
@@ -25,14 +25,16 @@ import Debug.Trace -- | Records tokenized and converted to common token format.-type Unanalyzed = (MyTok, MyLoc, Text, Maybe Int )+type Unanalyzed = (MyTok, MyLoc, Text+ , Maybe Int -- ^ Indent for entire line+ ) -- | 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+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@@ -61,6 +63,7 @@ . grouping getLine -- | Extract both line and column where a token starts.+getLineCol :: Field2 a a MyLoc MyLoc => a -> (Int, Int) getLineCol x = (getLine x, getCol x) -- | Mark alignment boundaries.@@ -73,14 +76,15 @@ . blocks . sortBy (compare `on` getLine) where- getLine (tok, MyLoc line col, _, _) = line+ getLine (tok, MyLoc line col _, _, _) = line -- | If first indented token is yet unmarked, mark it as boundary.+-- FIXME: remove boundaries from not `mark`s. markIndent :: Aligned -> Aligned-markIndent (TBlank, myLoc@(MyLoc _ 1 ), txt, Just indent, _) =+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 (myTok, myLoc@(MyLoc _ col True), txt, Just indent, _) | indent == col =+ (myTok, myLoc , txt, Just indent, Just ALeft) markIndent other = other -- | Append alignment option to unanalyzed token record.@@ -91,12 +95,21 @@ -- check the alignment option that applies to this column. alignBlock :: [Unanalyzed] -> [Aligned] alignBlock [a] = withAlign Nothing <$> [a]-alignBlock opList | all isOperator opList = withAlign (Just ACenter) <$> opList+alignBlock opList | all isOperator (filter isMarked opList) =+ withMarked (withAlign $ Just ACenter) opList where isOperator (TOperator, _, _, _) = True isOperator _ = False-alignBlock aList = withAlign (Just ALeft ) <$> aList+ isMarked (_, MyLoc _ _ True, _, _) = True+ isMarked (_, _, _, _) = False+alignBlock aList =+ withMarked (withAlign $ Just ALeft ) aList +withMarked f aList = apply <$> aList+ where+ apply entry@(view _2 -> MyLoc _ _ True) = f entry+ apply entry = entry `annex` Nothing+ -- | 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)@@ -114,6 +127,7 @@ -- | Compute all alignment columns existing and their positions in the text column space. -- TEST: check that we always have correct number of columns+-- FIXME: known bug that may be caused by this one tableColumns :: Field2 a a MyLoc MyLoc => Field5 a a (Maybe b) (Maybe b) => [a]@@ -153,10 +167,11 @@ where indentColumn :: Maybe Int indentColumn = extractColumn $ filter notBlank aLine- notBlank (TBlank, _, _) = False- notBlank _ = True- extractColumn [] = Nothing- extractColumn ((_, MyLoc line col, _):_) = Just col+ notBlank (TBlank, _, _) = False+ notBlank _ = True+ extractColumn [] = Nothing+ extractColumn ((_, MyLoc line col _, _):_) = Just col+ -- FIXME: is it only for `mark` columns? -- | Given a list of aligned records, and a list of marker columns, -- add table column indices to each record.
src/Render/ColSpan.hs view
@@ -12,6 +12,7 @@ import Data.List(groupBy, sortBy) import Prelude hiding(getLine) import Optics.Core ( Field1(_1), Field2(_2), view, (%))+import Control.Exception(assert) import Alignment ( textContent, tokenType, Align(ALeft), Processed )@@ -44,10 +45,19 @@ where nextCol = getAlignCol $ head c getAlign :: Processed -> Align- getAlign = view (alignPos % maybeLens (ALeft, 0) % _1)+ getAlign = view (alignPos % maybeLens (ALeft, 1) % _1) extractTokens (a,b,c) = (extractToken <$> a, b, c) extractToken tok = (view tokenType tok, view textContent tok) -- FIXME: split lines before colspans!++numColSpans :: [Processed] -> Int+numColSpans ps = case colspansPerLine of+ [] -> 1+ n:ns -> assert (all (n==) ns)+ $ n+ where+ colspansPerLine :: [Int]+ colspansPerLine = map (sum . map (\(_,c,_) -> c)) . colspans $ ps -- | Given a `Processed` record, extract number of table columns. getAlignCol :: Processed -> Int
src/Render/Debug.hs view
@@ -5,12 +5,12 @@ {-# LANGUAGE FlexibleContexts #-} -- | Renders alignment to text with alignment markers, -- for debugging purposes.-module Render.Debug(render) where+module Render.Debug(render, renderInline) where import Data.Text (Text) import qualified Data.Text as T import Prelude hiding(getLine)-import Optics.Core ( view )+import Optics.Core ( view, Field2(..)) import FindColumns ( alignPos, getCol, tableColumns ) import Alignment ( textContent, Align(..), Processed )@@ -26,7 +26,7 @@ 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+maybeInsertAt _ _ [] = Nothing -- | Render text of code blocks -- with marker columns inserted@@ -49,7 +49,7 @@ alignMarker :: Text alignMarker = case view alignPos tok of Just (ACenter, _) -> "^"- Just (ALeft, _) -> "|"+ Just _ -> "|" otherwise -> "" -- | Text content with markers for markers inside it.@@ -67,3 +67,6 @@ | otherwise = id columnsBetween :: Int -> Int -> [Int] columnsBetween colA colB = filter (\c -> c >= colA && c < colB) tColumns++renderInline :: Field2 a a Text Text => [a] -> Text+renderInline = mconcat . map (view _2)
src/Render/HTML.hs view
@@ -1,13 +1,25 @@ {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE ViewPatterns #-} -- | Render analyzed tokens into HTML table.-module Render.HTML(htmlFromColSpans) where+module Render.HTML(htmlFromColSpans, htmlInline) where import Prelude hiding(span, id) import Data.Text(Text) import qualified Data.Text as T import qualified Data.Text.Lazy as LT-import Text.Blaze.Html5 hiding(style)+import Text.Blaze.Html5+ ( toHtml,+ Html,+ ToValue(toValue),+ (!),+ b,+ html,+ i,+ span,+ table,+ tbody,+ td,+ tr ) import Text.Blaze.Html5.Attributes(colspan, style, id) import Text.Blaze.Html.Renderer.Text(renderHtml) @@ -47,12 +59,18 @@ alignStyle = "text-align: " <> alignMark alignment alignMark ACenter = "center" alignMark ALeft = "left"+ alignMark AIndent = "left" -- TODO: braced operators -- | Given a list of tokens in a colspan, render HTML fragment.+htmlInline :: [(MyTok, Text)] -> Text+htmlInline = LT.toStrict+ . renderHtml+ . formatTokens+ formatTokens :: [(MyTok, Text)] -> Html-formatTokens = mapM_ formatToken- . preformatTokens+formatTokens = mapM_ formatToken+ . preformatTokens -- | Format a single token as HTML fragment. formatToken :: (MyTok, Text) -> Html
src/Render/Latex.hs view
@@ -1,13 +1,13 @@ {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE ViewPatterns #-} -- | Render analyzed input into LaTeX table.-module Render.Latex(latexFromColSpans) where+module Render.Latex(latexFromColSpans, latexInline) where import Data.Text(Text) import qualified Data.Text as T import Text.LaTeX.Base.Syntax(protectText) -import Alignment+import Alignment ( Align(..) ) import Render.Common(TokensWithColSpan) import Token(MyTok(..)) import Util(unbrace)@@ -33,11 +33,12 @@ renderColSpan (toks, colSpan, alignment) = T.concat [ "\\multicolumn{", T.pack $ show colSpan , "}{", alignMark alignment- , "}{$", formatTokens toks+ , "}{$", latexInline toks , "$}" ] where alignMark ACenter = "c" alignMark ALeft = "l"+ alignMark AIndent = "l" -- | Wrap a LaTeX table content into \begin{tabular} environment. wrapTable :: Int -> Text -> Text@@ -46,7 +47,7 @@ -- ,"\\setlength{\\tabcolsepBACKUP}{\\tabcolsep}" "\\setlength{\\tabcolsep}{1pt}\n" , "\\begin{tabular}{"- , T.replicate (cols+3) "l" -- FIXME: tests for correct number of columns+ , T.replicate (cols+1) "l" -- FIXME: tests for correct number of columns , "}\n" , txt, "\n\\end{tabular}" --,"\\setlength{\\tabcolsep}{\\tabcolsepBACKUP}"@@ -60,10 +61,11 @@ preformatTokens ((TOperator,"`"):(TVar, "elem"):(TOperator, "`"):rest) = (TOperator, "elem"):preformatTokens rest preformatTokens (a :rest) = a :preformatTokens rest + -- | Format a list of tokens within a colspan. -- Preprocesses then and calls `formatToken` for each.-formatTokens :: [(MyTok, Text)] -> Text-formatTokens = T.concat+latexInline :: [(MyTok, Text)] -> Text+latexInline = T.concat . fmap formatToken . preformatTokens -- . (\t -> trace ("Tokens: " <> show t) t) -- debug@@ -73,12 +75,13 @@ formatToken :: (MyTok, Text) -> Text formatToken (TOperator,unbrace -> Just op) = "(" <> formatToken (TOperator, op) <> ")" formatToken (TKeyword, "forall") = mathop "forall"-formatToken (TVar, "mempty") = mathop "emptyset"+--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{\\gg\\!\\!=}" -- from lhs2TeX, Neil Mitchell's formatToken (TOperator,"=<<" ) = mathop "mathbin{=\\!\\!<\\!\\!\\!<}" -- from lhs2TeX, Neil Mitchell's formatToken (TOperator,">=>" ) = mathop "mathbin{>\\!\\!=\\!\\!\\!>}" formatToken (TOperator,"|-" ) = mathop "vdash"@@ -92,21 +95,24 @@ 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 "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 "prec"+formatToken (TOther, "-<" ) = mathop "prec"+formatToken (TOther, ">-" ) = mathop "succ" formatToken (TOperator,"\\\\" ) = mathop "setminus"-formatToken (TOperator,"<-" ) = mathop "gets"+formatToken (TOther ,"<-" ) = 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 "to"+formatToken (TOther, "->" ) = mathop "to"+formatToken (TOther, "=>" ) = mathop "Rightarrow" formatToken (TOperator,"==>" ) = mathop "implies" formatToken (TOperator,"|->" ) = mathop "mapsto" --formatToken (TOperator,"|=>" ) = mathop "Mapsto" -- not in amssymb@@ -127,8 +133,20 @@ formatToken (TCons, cons ) = "\\textsc{" <> protectText cons <> "}" formatToken (TOperator,"\\" ) = mathop "lambda" formatToken (TTikz mark,_ ) = mathop $ "tikzMark{" <> mark <> "}"+--formatToken (TOther, "`" ) = mathop "textasciigrave"+formatToken (TOther, "`" ) = protectText "`"+formatToken (TOther, "'" ) = mathop "prime"+formatToken (TOther, "\"" ) = protectText "\""+formatToken (TOther, "(" ) = protectText "("+formatToken (TOther, ")" ) = protectText ")"+formatToken (TOther, "]" ) = protectText "]"+formatToken (TOther, "[" ) = protectText "["+formatToken (TOther, "}" ) = protectText "}"+formatToken (TOther, "{" ) = protectText "{" formatToken (_, txt ) = "\\textit{" <> protectText txt <> "}" +mathop :: Text -> Text mathop code = "\\" <> code +prologue :: Text prologue = T.concat ["\\usepackage{amssymb}"]
src/Token.hs view
@@ -4,19 +4,18 @@ {-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE ViewPatterns #-} -- | Common token representation used.-module Token(MyTok(..), MyLoc(..), Tokenized, line, col, unwrap, unTikzMark) where+module Token(MyTok(..), MyLoc(..), Tokenized, line, col, mark, unwrap, unTikzMark) where -import Data.Maybe(fromMaybe) import Data.Text(Text) import qualified Data.Text as T-import Data.Tuple.Optics import Optics.TH -- * Common tokens and locations -- We keep them here, so we can translate output from tokenizers to common format. -- | Location is just line and column (not a slice.)-data MyLoc = MyLoc { _line :: Int -- ^ Line number starting from 1- , _col :: Int -- ^ Column number starting from 1+data MyLoc = MyLoc { _line :: Int -- ^ Line number starting from 1+ , _col :: Int -- ^ Column number starting from 1+ , _mark :: Bool -- ^ Is this a valid indent mark? } deriving (Eq, Ord, Show) @@ -35,14 +34,17 @@ deriving (Eq, Ord, Show) -- | Records tokenized and converted to common token format.-type Tokenized = (MyTok, MyLoc, Text)+type Tokenized = (MyTok -- ^ Token type+ ,MyLoc -- ^ Starting location for the token+ ,Text -- ^ text value of the token+ ) -- | Unpack a Haskell comment with a TikZ mark indicator. unTikzMark :: Text -> Maybe Text unTikzMark txt = unwrap "{->" "-}" txt >>= \case- "" -> Nothing- mark -> Just mark+ "" -> Nothing+ aMark -> Just aMark -- | Given opening text, and closing text, -- check that input is "braced" by these, and strip them.
src/Token/Haskell.hs view
@@ -1,24 +1,24 @@ {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE PartialTypeSignatures #-} {-# LANGUAGE ViewPatterns #-}+{-# LANGUAGE FlexibleContexts #-} -- | Haskell code tokenizer module Token.Haskell(tokenizer) where -import Control.Arrow(first)-import Text.Pandoc.JSON+import Text.Pandoc.JSON () import Text.Pandoc.Definition ()-import Data.Function(on)-import Data.Maybe(fromMaybe, isJust)-import Data.String (fromString, IsString)+import Data.String (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 Optics.Core import GHC.SyntaxHighlighter+ ( tokenizeHaskell+ , Loc(..)+ , Token(..) ) -import Token+import Token ( MyLoc(MyLoc), MyTok(..), unTikzMark, mark ) -- * Haskell tokenizer frontend -- | Attempt to tokenize input,@@ -36,12 +36,14 @@ -- | Recognize token using both token type from `ghc-lib`, -- and text content. -- Only TikZ marks are recognized by looking up text content.+recognizeToken :: (Token, Text) -> (MyTok, Text) recognizeToken (CommentTok, tokText@(unTikzMark -> Just mark)) = (TTikz mark, tokText) recognizeToken (tokType, tokText) = (haskellTok tokType, tokText) -- | Convert token type of `ghc-lib` into tokens recognized by the filter.+haskellTok :: Token -> MyTok haskellTok SpaceTok = TBlank haskellTok CommentTok = TBlank haskellTok PragmaTok = TBlank@@ -54,49 +56,27 @@ haskellTok t = TOther -- | Extract line number from `ghc-lib` slice location.+locLine :: Loc -> Int locLine (Loc startLineNo startColNo _ _) = startLineNo -- | Extract column number from `ghc-lib` slice location.+locCol :: Loc -> Int 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 :: [(MyTok, Text)] -> [(MyTok, 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+ (tok, MyLoc line col (isMark tok), txt):go newLine newCol ls where+ isMark TBlank = False+ isMark _ = True newLine = line + lineIncr lineIncr = T.length $ T.filter (=='\n') txt newCol | lineIncr == 0 = col + T.length txt@@ -105,4 +85,44 @@ $ fst $ T.break (=='\n') $ T.reverse txt++-- * Likely common with other tokenizers+-- | 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, set mark True $ loc, l)+ : zipWith mkEntry [line+1..] ls+ mkEntry :: Int -> Text -> (MyTok, MyLoc, Text)+ mkEntry i t = (TBlank, MyLoc i 1 True, t)+ splitter other@(_, loc@(MyLoc line 1 x), txt) = [set (_2 % mark) True other]+ splitter other = [other]+++unmark :: Field2 a a MyLoc MyLoc => a -> a+unmark = set (_2 % mark) False++-- FIXME: use no-indent-mark instead.+joinEscapedOperators :: (Eq c, IsString c, Semigroup c) => [(MyTok, MyLoc, c)] -> [(MyTok, MyLoc, c)]+joinEscapedOperators (a@(_, _, "("):b@(_, _, _):c@(_, _, ")"):rest) =+ a:unmark b:unmark c:joinEscapedOperators rest+joinEscapedOperators (a@(_, loc, "`"):b@(_, _, _):c@(_, _, "`"):rest) =+ a:unmark b:unmark c:joinEscapedOperators rest+joinEscapedOperators (a@(_, _, "("):b@(TOperator, _, _):rest) =+ a:unmark b:joinEscapedOperators rest+joinEscapedOperators (a@(_, _, _):b@(_, _, ")"):rest) =+ a:unmark b:joinEscapedOperators rest+joinEscapedOperators (tok:rest) = tok:joinEscapedOperators rest+joinEscapedOperators [] = []
test/Spec.hs view
@@ -1,2 +1,88 @@+{-# LANGUAGE OverloadedStrings #-}+-- | Test suite+module Main where++import Data.Text.Arbitrary+import Test.QuickCheck+import qualified Data.Text as T+import Data.Char+import Optics.Core (view, Field1(_1))+++import Token(MyTok(..)+ ,MyLoc(..)+ ,Tokenized)+import Token.Haskell(tokenizer)+import qualified Render.Debug+import FindColumns+import Render.ColSpan+import Alignment(Processed)++prop_tokenizer str = case tokenizer str of+ Nothing -> label "cannot lex" $ True+ Just t -> label "lexed" $ length t <= T.length str++prop_debug_renderer_text_length input =+ case debug of+ Nothing -> label "cannot lex" $ True+ Just t -> label "lexed"+ $ all (uncurry (<=))+ $ zip (extract input)+ (extract t)+ where+ extract :: T.Text -> [Int]+ extract = fmap T.length . T.lines+ debug :: Maybe T.Text+ debug = tokenizer input >>= (return . Render.Debug.render . findColumns)++prop_colspans input =+ case debug of+ Nothing -> label "cannot lex" $ True+ Just t -> label "lexed" $+ sameNumber t+ where+ extract :: T.Text -> [Int]+ extract = fmap T.length . T.lines+ debug :: Maybe [Int]+ debug = tokenizer input >>= (return . sumColSpans . findColumns)+ sameNumber [] = True+ sameNumber (n:ns) = all (n==) ns++prop_tableColumns input = T.any (not . Data.Char.isSpace) input ==>+ case tokenizer input of+ Nothing -> label "cannot lex" $ True+ Just tokens | all ((TBlank==) . view _1) tokens+ -> label "only blanks" $ True+ Just tokens -> + case findColumns tokens of+ [] -> label "empty" $ True+ t -> case sumColSpans t of+ [] -> label "no colspans" $ True+ c:_ -> label "tableColumns" $ c == length (tableColumns t)+ where+ extract :: T.Text -> [Int]+ extract = fmap T.length . T.lines+ debug :: Maybe [Processed]+ debug = tokenizer input >>= (return . findColumns)+ sameNumber [] = True+ sameNumber (n:ns) = all (n==) ns+ main :: IO ()-main = putStrLn "Test suite not yet implemented"+main = do+ problem " a\na"+ problem "--"+ problem "a\n a"+ quickCheck prop_tokenizer+ quickCheck prop_debug_renderer_text_length+ quickCheck $ withMaxSuccess 10000 prop_colspans -- is it sufficient?+ quickCheck $ withMaxSuccess 100000 prop_tableColumns -- is it sufficient?+ where+ problem example = do+ putStrLn $ "Example: " <> show example+ print $ tokenizer example >>= (return . tableColumns . findColumns)+ print $ tokenizer example >>= (return . sumColSpans . findColumns)+ print $ tokenizer example >>= (return . findColumns)+ print $ tokenizer example++sumColSpans = map (sum . map (\(_,c,_) -> c)) . colspans+