ghc-syntax-highlighter 0.0.6.0 → 0.0.7.0
raw patch · 8 files changed
+442/−507 lines, 8 filesdep ~basedep ~ghc-lib-parserPVP ok
version bump matches the API change (PVP)
Dependency ranges changed: base, ghc-lib-parser
API changes (from Hackage documentation)
Files
- CHANGELOG.md +4/−0
- GHC/SyntaxHighlighter.hs +191/−177
- README.md +6/−92
- data/LambdaCase.hs +1/−1
- data/Main.hs +0/−1
- data/TypeFamily.hs +1/−1
- ghc-syntax-highlighter.cabal +54/−48
- tests/GHC/SyntaxHighlighterSpec.hs +185/−187
CHANGELOG.md view
@@ -1,3 +1,7 @@+## GHC syntax highlighter 0.0.7.0++* Uses `ghc-lib-parser-9.0.1.x`.+ ## GHC syntax highlighter 0.0.6.0 * Uses `ghc-lib-parser-8.10.x`.
GHC/SyntaxHighlighter.hs view
@@ -1,3 +1,9 @@+{-# LANGUAGE LambdaCase #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE RecordWildCards #-}+{-# LANGUAGE TupleSections #-}+{-# OPTIONS_GHC -fno-warn-missing-fields #-}+ -- | -- Module : GHC.SyntaxHighlighter -- Copyright : © 2018–present Mark Karpov@@ -12,54 +18,61 @@ -- -- This library uses GHC's lexer, so the result is guaranteed to be 100% -- correct, as if it was parsed by GHC itself.--{-# LANGUAGE LambdaCase #-}-{-# LANGUAGE OverloadedStrings #-}-{-# LANGUAGE TupleSections #-}-{-# OPTIONS_GHC -fno-warn-missing-fields #-}- module GHC.SyntaxHighlighter- ( Token (..)- , Loc (..)- , tokenizeHaskell- , tokenizeHaskellLoc )+ ( Token (..),+ Loc (..),+ tokenizeHaskell,+ tokenizeHaskellLoc,+ ) where import Control.Monad import Data.List (foldl', unfoldr) import Data.Maybe (isJust) import Data.Text (Text)-import DynFlags-import FastString (mkFastString)-import Fingerprint (fingerprint0)+import qualified Data.Text as T+import qualified GHC.Data.EnumSet as ES+import GHC.Data.FastString (mkFastString)+import GHC.Data.StringBuffer+import GHC.Driver.Session as DynFlags import GHC.LanguageExtensions+import qualified GHC.Parser.Lexer as L+import GHC.Settings+import GHC.Types.SrcLoc+import GHC.Utils.Fingerprint (fingerprint0) import GHC.Version (cProjectVersion)-import SrcLoc-import StringBuffer-import ToolSettings-import qualified Data.Text as T-import qualified EnumSet as ES-import qualified Lexer as L ---------------------------------------------------------------------------- -- Data types -- | Token types that are used as tags to mark spans of source code.- data Token- = KeywordTok -- ^ Keyword- | PragmaTok -- ^ Pragmas- | SymbolTok -- ^ Symbols (punctuation that is not an operator)- | VariableTok -- ^ Variable name (term level)- | ConstructorTok -- ^ Data\/type constructor- | OperatorTok -- ^ Operator- | CharTok -- ^ Character- | StringTok -- ^ String- | IntegerTok -- ^ Integer- | RationalTok -- ^ Rational number- | CommentTok -- ^ Comment (including Haddocks)- | SpaceTok -- ^ Space filling- | OtherTok -- ^ Something else?+ = -- | Keyword+ KeywordTok+ | -- | Pragmas+ PragmaTok+ | -- | Symbols (punctuation that is not an operator)+ SymbolTok+ | -- | Variable name (term level)+ VariableTok+ | -- | Data\/type constructor+ ConstructorTok+ | -- | Operator+ OperatorTok+ | -- | Character+ CharTok+ | -- | String+ StringTok+ | -- | Integer+ IntegerTok+ | -- | Rational number+ RationalTok+ | -- | Comment (including Haddocks)+ CommentTok+ | -- | Space filling+ SpaceTok+ | -- | Something else?+ OtherTok deriving (Eq, Ord, Enum, Bounded, Show) -- | Start and end positions of a span. The arguments of the data@@ -71,7 +84,6 @@ -- * Column number of end position of a span -- -- @since 0.0.2.0- data Loc = Loc !Int !Int !Int !Int deriving (Eq, Ord, Show) @@ -80,32 +92,33 @@ -- | Tokenize Haskell source code. If the code cannot be parsed, return -- 'Nothing'. Otherwise return the original input tagged by 'Token's.+-- 'Nothing' is rarely returned if ever, because it looks like the lexer is+-- capable of interpreting almost any text as a stream of GHC tokens. -- -- The parser does not require the input source code to form a valid Haskell -- program, so as long as the lexer can decompose your input (most of the -- time), it'll return something in 'Just'.- tokenizeHaskell :: Text -> Maybe [(Token, Text)] tokenizeHaskell input = sliceInputStream input <$> tokenizeHaskellLoc input -- | Replace 'Loc' locations with actual chunks of input 'Text'.- sliceInputStream :: Text -> [(Token, Loc)] -> [(Token, Text)] sliceInputStream input toks = unfoldr sliceOnce (initText' input, toks) where sliceOnce (txt, []) = do (txt', chunk) <- tryFetchRest txt return ((SpaceTok, chunk), (txt', []))- sliceOnce (txt, tss@((t, l):ts)) =+ sliceOnce (txt, tss@((t, l) : ts)) = case tryFetchSpace txt l of Nothing -> let (txt', chunk) = fetchSpan txt l t' = case t of- CommentTok -> if isHeaderPragma chunk- then PragmaTok- else CommentTok+ CommentTok ->+ if isHeaderPragma chunk+ then PragmaTok+ else CommentTok tok -> tok- in Just ((t', chunk), (txt', ts))+ in Just ((t', chunk), (txt', ts)) Just (txt', chunk) -> Just ((SpaceTok, chunk), (txt', tss)) @@ -113,41 +126,43 @@ -- locations of corresponding spans in the given input stream. -- -- @since 0.0.2.0- tokenizeHaskellLoc :: Text -> Maybe [(Token, Loc)] tokenizeHaskellLoc input = case L.unP pLexer parseState of L.PFailed {} -> Nothing- L.POk _ x -> Just x+ L.POk _ x -> Just x where location = mkRealSrcLoc (mkFastString "") 1 1 buffer = stringToStringBuffer (T.unpack input) parseState = L.mkPStatePure parserFlags buffer location parserFlags = L.mkParserFlags (foldl' xopt_set initialDynFlags enabledExts)- initialDynFlags = DynFlags- { warningFlags = ES.empty- , generalFlags = ES.fromList- [ Opt_Haddock- , Opt_KeepRawTokenStream- ]- , extensions = []- , extensionFlags = ES.empty- , safeHaskell = Sf_Safe- , language = Just Haskell2010- , ghcNameVersion = GhcNameVersion- { ghcNameVersion_programName = "ghc"- , ghcNameVersion_projectVersion = cProjectVersion+ initialDynFlags =+ DynFlags+ { warningFlags = ES.empty,+ generalFlags =+ ES.fromList+ [ Opt_Haddock,+ Opt_KeepRawTokenStream+ ],+ extensions = [],+ extensionFlags = ES.empty,+ safeHaskell = Sf_Safe,+ language = Just Haskell2010,+ ghcNameVersion =+ GhcNameVersion+ { ghcNameVersion_programName = "ghc",+ ghcNameVersion_projectVersion = cProjectVersion+ },+ fileSettings = FileSettings {},+ toolSettings =+ ToolSettings+ { toolSettings_opt_P_fingerprint = fingerprint0,+ toolSettings_pgm_F = ""+ },+ platformMisc = PlatformMisc {} }- , fileSettings = FileSettings {}- , toolSettings = ToolSettings- { toolSettings_opt_P_fingerprint = fingerprint0- , toolSettings_pgm_F = ""- }- , platformMisc = PlatformMisc {}- } -- | Haskell lexer.- pLexer :: L.P [(Token, Loc)] pLexer = go where@@ -155,89 +170,93 @@ r <- L.lexer False return case r of L _ L.ITeof -> return []- _ ->+ _ -> case fixupToken r of Nothing -> go- Just x -> (x:) <$> go+ Just x -> (x :) <$> go -- | Convert @'Located' 'L.Token'@ representation to a more convenient for -- us form.- fixupToken :: Located L.Token -> Maybe (Token, Loc) fixupToken (L srcSpan tok) = (classifyToken tok,) <$> srcSpanToLoc srcSpan -- | Convert 'SrcSpan' to 'Loc'.- srcSpanToLoc :: SrcSpan -> Maybe Loc-srcSpanToLoc (RealSrcSpan rss) =- let start = realSrcSpanStart rss- end = realSrcSpanEnd rss- in if start == end- then Nothing -- NOTE Some magic auto-generated tokens that do not- -- actually appear in the input stream. Drop them.- else Just $ Loc (srcLocLine start)- (srcLocCol start)- (srcLocLine end)- (srcLocCol end)+srcSpanToLoc (RealSrcSpan s _) =+ let srcSpanSLine = srcSpanStartLine s+ srcSpanSCol = srcSpanStartCol s+ srcSpanELine = srcSpanEndLine s+ srcSpanECol = srcSpanEndCol s+ start = (srcSpanSLine, srcSpanSCol)+ end = (srcSpanELine, srcSpanECol)+ in if start == end+ then Nothing -- NOTE Some magic auto-generated tokens that do not+ -- actually appear in the input stream. Drop them.+ else+ Just $+ Loc+ srcSpanSLine+ srcSpanSCol+ srcSpanELine+ srcSpanECol srcSpanToLoc _ = Nothing -- | Classify a 'L.Token' in terms of 'Token'.- classifyToken :: L.Token -> Token classifyToken = \case -- Keywords- L.ITas -> KeywordTok- L.ITcase -> KeywordTok- L.ITclass -> KeywordTok- L.ITdata -> KeywordTok- L.ITdefault -> KeywordTok- L.ITderiving -> KeywordTok- L.ITdo -> KeywordTok- L.ITelse -> KeywordTok- L.IThiding -> KeywordTok- L.ITforeign -> KeywordTok- L.ITif -> KeywordTok- L.ITimport -> KeywordTok- L.ITin -> KeywordTok- L.ITinfix -> KeywordTok- L.ITinfixl -> KeywordTok- L.ITinfixr -> KeywordTok- L.ITinstance -> KeywordTok- L.ITlet -> KeywordTok- L.ITmodule -> KeywordTok- L.ITnewtype -> KeywordTok- L.ITof -> KeywordTok+ L.ITas -> KeywordTok+ L.ITcase -> KeywordTok+ L.ITclass -> KeywordTok+ L.ITdata -> KeywordTok+ L.ITdefault -> KeywordTok+ L.ITderiving -> KeywordTok+ L.ITdo _ -> KeywordTok+ L.ITelse -> KeywordTok+ L.IThiding -> KeywordTok+ L.ITforeign -> KeywordTok+ L.ITif -> KeywordTok+ L.ITimport -> KeywordTok+ L.ITin -> KeywordTok+ L.ITinfix -> KeywordTok+ L.ITinfixl -> KeywordTok+ L.ITinfixr -> KeywordTok+ L.ITinstance -> KeywordTok+ L.ITlet -> KeywordTok+ L.ITmodule -> KeywordTok+ L.ITnewtype -> KeywordTok+ L.ITof -> KeywordTok L.ITqualified -> KeywordTok- L.ITthen -> KeywordTok- L.ITtype -> KeywordTok- L.ITwhere -> KeywordTok- L.ITforall _ -> KeywordTok- L.ITexport -> KeywordTok- L.ITlabel -> KeywordTok- L.ITdynamic -> KeywordTok- L.ITsafe -> KeywordTok+ L.ITthen -> KeywordTok+ L.ITtype -> KeywordTok+ L.ITwhere -> KeywordTok+ L.ITforall _ -> KeywordTok+ L.ITexport -> KeywordTok+ L.ITlabel -> KeywordTok+ L.ITdynamic -> KeywordTok+ L.ITsafe -> KeywordTok L.ITinterruptible -> KeywordTok- L.ITunsafe -> KeywordTok+ L.ITunsafe -> KeywordTok L.ITstdcallconv -> KeywordTok L.ITccallconv -> KeywordTok- L.ITcapiconv -> KeywordTok+ L.ITcapiconv -> KeywordTok L.ITprimcallconv -> KeywordTok L.ITjavascriptcallconv -> KeywordTok- L.ITmdo -> KeywordTok- L.ITfamily -> KeywordTok- L.ITrole -> KeywordTok- L.ITgroup -> KeywordTok- L.ITby -> KeywordTok- L.ITusing -> KeywordTok- L.ITpattern -> KeywordTok- L.ITstatic -> KeywordTok- L.ITstock -> KeywordTok- L.ITanyclass -> KeywordTok- L.ITvia -> KeywordTok- L.ITunit -> KeywordTok+ L.ITmdo _ -> KeywordTok+ L.ITfamily -> KeywordTok+ L.ITrole -> KeywordTok+ L.ITgroup -> KeywordTok+ L.ITby -> KeywordTok+ L.ITusing -> KeywordTok+ L.ITpattern -> KeywordTok+ L.ITstatic -> KeywordTok+ L.ITstock -> KeywordTok+ L.ITanyclass -> KeywordTok+ L.ITvia -> KeywordTok+ L.ITunit -> KeywordTok L.ITsignature -> KeywordTok L.ITdependency -> KeywordTok- L.ITrequires -> KeywordTok+ L.ITrequires -> KeywordTok -- Pragmas L.ITinline_prag {} -> PragmaTok L.ITspec_prag _ -> PragmaTok@@ -250,7 +269,6 @@ L.ITcolumn_prag _ -> PragmaTok L.ITscc_prag _ -> PragmaTok L.ITgenerated_prag _ -> PragmaTok- L.ITcore_prag _ -> PragmaTok L.ITunpack_prag _ -> PragmaTok L.ITnounpack_prag _ -> PragmaTok L.ITann_prag _ -> PragmaTok@@ -276,6 +294,7 @@ L.ITvbar -> SymbolTok L.ITlarrow _ -> SymbolTok L.ITrarrow _ -> SymbolTok+ L.ITlolly -> SymbolTok L.ITat -> SymbolTok L.ITtilde -> SymbolTok L.ITdarrow _ -> SymbolTok@@ -299,9 +318,11 @@ L.ITunderscore -> SymbolTok L.ITbackquote -> SymbolTok L.ITsimpleQuote -> SymbolTok+ L.ITpercent -> SymbolTok -- NOTE GHC thinks these are reserved symbols, but I classify them as -- operators. L.ITminus -> OperatorTok+ L.ITprefixminus -> OperatorTok L.ITdot -> OperatorTok -- Identifiers L.ITvarid _ -> VariableTok@@ -333,13 +354,11 @@ L.ITcloseQuote _ -> SymbolTok L.ITopenTExpQuote _ -> SymbolTok L.ITcloseTExpQuote -> SymbolTok- L.ITidEscape _ -> SymbolTok- L.ITparenEscape -> SymbolTok- L.ITidTyEscape _ -> SymbolTok- L.ITparenTyEscape -> SymbolTok L.ITtyQuote -> SymbolTok L.ITquasiQuote _ -> SymbolTok L.ITqQuasiQuote _ -> SymbolTok+ L.ITdollar -> SymbolTok+ L.ITdollardollar -> SymbolTok -- Arrow notation L.ITproc -> KeywordTok L.ITrec -> KeywordTok@@ -367,29 +386,26 @@ -- Text traversing -- | A type for 'Text' with line\/column location attached.--data Text' = Text'- {-# UNPACK #-} !Int- {-# UNPACK #-} !Int- {-# UNPACK #-} !Text+data Text'+ = Text'+ {-# UNPACK #-} !Int+ {-# UNPACK #-} !Int+ {-# UNPACK #-} !Text deriving (Show) -- | Create 'Text'' from 'Text'.- initText' :: Text -> Text' initText' = Text' 1 1 -- | Try to fetch white space before start of span at 'Loc'.- tryFetchSpace :: Text' -> Loc -> Maybe (Text', Text) tryFetchSpace txt (Loc sl sc _ _) = let (txt', r) = reachLoc txt sl sc- in if T.null r- then Nothing- else Just (txt', r)+ in if T.null r+ then Nothing+ else Just (txt', r) -- | Try to fetch the rest of 'Text'' stream.- tryFetchRest :: Text' -> Maybe (Text', Text) tryFetchRest (Text' l c txt) = if T.null txt@@ -397,18 +413,18 @@ else Just (Text' l c "", txt) -- | Fetch a span at 'Loc'.- fetchSpan :: Text' -> Loc -> (Text', Text) fetchSpan txt (Loc _ _ el ec) = reachLoc txt el ec -- | Reach given line\/column location and return 'Text' that has been -- traversed.--reachLoc- :: Text'- -> Int -- ^ Line number to reach- -> Int -- ^ Column number to reach- -> (Text', Text)+reachLoc ::+ Text' ->+ -- | Line number to reach+ Int ->+ -- | Column number to reach+ Int ->+ (Text', Text) reachLoc txt@(Text' _ _ original) l c = let chunk = T.unfoldr f txt f (Text' l' c' s) = do@@ -417,15 +433,14 @@ let (l'', c'') = case ch of '\n' -> (l' + 1, 1) '\t' -> (l', c' + 8 - ((c' - 1) `rem` 8))- _ -> (l', c' + 1)+ _ -> (l', c' + 1) return (ch, Text' l'' c'' s')- in (Text' l c (T.drop (T.length chunk) original), chunk)+ in (Text' l c (T.drop (T.length chunk) original), chunk) ---------------------------------------------------------------------------- -- Pragmas detection -- | Detect file header pragma.- isHeaderPragma :: Text -> Bool isHeaderPragma txt0 = isJust $ do txt1 <- T.stripStart <$> T.stripPrefix "{-#" txt0@@ -435,34 +450,33 @@ -- Language extensions -- | Language extensions we enable by default.- enabledExts :: [Extension] enabledExts =- [ ForeignFunctionInterface- , InterruptibleFFI- , CApiFFI- , Arrows- , TemplateHaskell- , TemplateHaskellQuotes- , ImplicitParams- , OverloadedLabels- , ExplicitForAll- , BangPatterns- , PatternSynonyms- , MagicHash- , RecursiveDo- , UnicodeSyntax- , UnboxedTuples- , UnboxedSums- , DatatypeContexts- , TransformListComp- , QuasiQuotes- , LambdaCase- , BinaryLiterals- , NegativeLiterals- , HexFloatLiterals- , TypeApplications- , StaticPointers- , NumericUnderscores- , StarIsType+ [ ForeignFunctionInterface,+ InterruptibleFFI,+ CApiFFI,+ Arrows,+ TemplateHaskell,+ TemplateHaskellQuotes,+ ImplicitParams,+ OverloadedLabels,+ ExplicitForAll,+ BangPatterns,+ PatternSynonyms,+ MagicHash,+ RecursiveDo,+ UnicodeSyntax,+ UnboxedTuples,+ UnboxedSums,+ DatatypeContexts,+ TransformListComp,+ QuasiQuotes,+ LambdaCase,+ BinaryLiterals,+ NegativeLiterals,+ HexFloatLiterals,+ TypeApplications,+ StaticPointers,+ NumericUnderscores,+ StarIsType ]
README.md view
@@ -4,7 +4,7 @@ [](https://hackage.haskell.org/package/ghc-syntax-highlighter) [](http://stackage.org/nightly/package/ghc-syntax-highlighter) [](http://stackage.org/lts/package/ghc-syntax-highlighter)-[](https://travis-ci.org/mrkkrp/ghc-syntax-highlighter)+ This is a syntax highlighter library for Haskell using lexer of GHC itself. @@ -25,97 +25,6 @@ precision so that many tokens end up combined and the end result is typically still hard to read. -## API--The API is extremely simple:--```haskell--- | Token types that are used as tags to mark spans of source code.--data Token- = KeywordTok -- ^ Keyword- | PragmaTok -- ^ Pragmas- | SymbolTok -- ^ Symbols (punctuation that is not an operator)- | VariableTok -- ^ Variable name (term level)- | ConstructorTok -- ^ Data\/type constructor- | OperatorTok -- ^ Operator- | CharTok -- ^ Character- | StringTok -- ^ String- | IntegerTok -- ^ Integer- | RationalTok -- ^ Rational number- | CommentTok -- ^ Comment (including Haddocks)- | SpaceTok -- ^ Space filling- | OtherTok -- ^ Something else?- deriving (Eq, Ord, Enum, Bounded, Show)---- | Tokenize Haskell source code. If the code cannot be parsed, return--- 'Nothing'. Otherwise return the original input tagged by 'Token's.------ The parser does not require the input source code to form a valid Haskell--- program, so as long as the lexer can decompose your input (most of the--- time), it'll return something in 'Just'.--tokenizeHaskell :: Text -> Maybe [(Token, Text)]-```--So given a simple program:--```haskell-module Main (main) where--import Data.Bits---- | Program's entry point.--main :: IO ()-main = return ()-```--It outputs something like this:--```haskell-basicModule :: [(Token, Text)]-basicModule =- [ (KeywordTok,"module")- , (SpaceTok," ")- , (ConstructorTok,"Main")- , (SpaceTok," ")- , (SymbolTok,"(")- , (VariableTok,"main")- , (SymbolTok,")")- , (SpaceTok," ")- , (KeywordTok,"where")- , (SpaceTok,"\n\n")- , (KeywordTok,"import")- , (SpaceTok," ")- , (ConstructorTok,"Data.Bits")- , (SpaceTok,"\n\n")- , (CommentTok,"-- | Program's entry point.")- , (SpaceTok,"\n\n")- , (VariableTok,"main")- , (SpaceTok," ")- , (SymbolTok,"::")- , (SpaceTok," ")- , (ConstructorTok,"IO")- , (SpaceTok," ")- , (SymbolTok,"(")- , (SymbolTok,")")- , (SpaceTok,"\n")- , (VariableTok,"main")- , (SpaceTok," ")- , (SymbolTok,"=")- , (SpaceTok," ")- , (VariableTok,"return")- , (SpaceTok," ")- , (SymbolTok,"(")- , (SymbolTok,")")- , (SpaceTok,"\n")- ]-```--`Nothing` is rarely returned if ever, because it looks like the lexer is-capable of interpreting almost any text as a stream of GHC tokens.- ## How to use it in your blog Depends on your markdown processor. If you're an [`mmark`][mmark] user, good@@ -128,6 +37,11 @@ [skylighting][skylighting] is what Pandoc uses. And from what I can tell it's hardcoded to use only that library for highlighting, so some creativity may be necessary to get it work.++## Limitations++CPP directives are not lexed correctly, because the GHC parser is not+designed to parse them. ## Contribution
data/LambdaCase.hs view
@@ -1,4 +1,4 @@ foo :: Foo -> Maybe Bar foo = \case Foo -> Just Bar- _ -> Nothing+ _ -> Nothing
data/Main.hs view
@@ -3,6 +3,5 @@ import Data.Bits -- | Program's entry point.- main :: IO () main = return ()
data/TypeFamily.hs view
@@ -1,3 +1,3 @@ type family All (c :: k -> Constraint) (xs :: [k]) :: Constraint where- All c '[] = ()+ All c '[] = () All c (x ': xs) = (c x, All c xs)
ghc-syntax-highlighter.cabal view
@@ -1,56 +1,62 @@-name: ghc-syntax-highlighter-version: 0.0.6.0-cabal-version: 1.18-tested-with: GHC==8.6.5, GHC==8.8.3, GHC==8.10.1-license: BSD3-license-file: LICENSE.md-author: Mark Karpov <markkarpov92@gmail.com>-maintainer: Mark Karpov <markkarpov92@gmail.com>-homepage: https://github.com/mrkkrp/ghc-syntax-highlighter-bug-reports: https://github.com/mrkkrp/ghc-syntax-highlighter/issues-category: Text-synopsis: Syntax highlighter for Haskell using lexer of GHC itself-build-type: Simple-description: Syntax highlighter for Haskell using lexer of GHC itself.-extra-doc-files: CHANGELOG.md- , README.md-data-files: data/*.hs+cabal-version: 1.18+name: ghc-syntax-highlighter+version: 0.0.7.0+license: BSD3+license-file: LICENSE.md+maintainer: Mark Karpov <markkarpov92@gmail.com>+author: Mark Karpov <markkarpov92@gmail.com>+tested-with: ghc ==8.8.4 ghc ==8.10.4 ghc ==9.0.1+homepage: https://github.com/mrkkrp/ghc-syntax-highlighter+bug-reports: https://github.com/mrkkrp/ghc-syntax-highlighter/issues+synopsis: Syntax highlighter for Haskell using lexer of GHC itself+description: Syntax highlighter for Haskell using lexer of GHC itself.+category: Text+build-type: Simple+data-files: data/*.hs+extra-doc-files:+ CHANGELOG.md+ README.md source-repository head- type: git- location: https://github.com/mrkkrp/ghc-syntax-highlighter.git+ type: git+ location: https://github.com/mrkkrp/ghc-syntax-highlighter.git flag dev- description: Turn on development settings.- manual: True- default: False+ description: Turn on development settings.+ default: False+ manual: True library- build-depends: base >= 4.12 && < 5.0- , ghc-lib-parser >= 8.10 && < 8.11- , text >= 0.2 && < 1.3- exposed-modules: GHC.SyntaxHighlighter- if flag(dev)- ghc-options: -Wall -Werror -Wcompat- -Wincomplete-record-updates- -Wincomplete-uni-patterns- -Wnoncanonical-monad-instances- else- ghc-options: -O2 -Wall- default-language: Haskell2010+ exposed-modules: GHC.SyntaxHighlighter+ default-language: Haskell2010+ build-depends:+ base >=4.13 && <5.0,+ ghc-lib-parser >=9.0 && <9.1,+ text >=0.2 && <1.3 + if flag(dev)+ ghc-options:+ -Wall -Werror -Wcompat -Wincomplete-record-updates+ -Wincomplete-uni-patterns -Wnoncanonical-monad-instances++ else+ ghc-options: -O2 -Wall+ test-suite tests- main-is: Spec.hs- hs-source-dirs: tests- type: exitcode-stdio-1.0- build-depends: base >= 4.12 && < 5.0- , ghc-syntax-highlighter- , text >= 0.2 && < 1.3- , hspec >= 2.0 && < 3.0- other-modules: GHC.SyntaxHighlighterSpec- build-tools: hspec-discover >= 2.0 && < 3.0- if flag(dev)- ghc-options: -Wall -Werror- else- ghc-options: -O2 -Wall- default-language: Haskell2010+ type: exitcode-stdio-1.0+ main-is: Spec.hs+ build-tools: hspec-discover >=2.0 && <3.0+ hs-source-dirs: tests+ other-modules: GHC.SyntaxHighlighterSpec+ default-language: Haskell2010+ build-depends:+ base >=4.13 && <5.0,+ ghc-syntax-highlighter,+ text >=0.2 && <1.3,+ hspec >=2.0 && <3.0++ if flag(dev)+ ghc-options: -Wall -Werror++ else+ ghc-options: -O2 -Wall
tests/GHC/SyntaxHighlighterSpec.hs view
@@ -1,13 +1,11 @@ {-# LANGUAGE OverloadedStrings #-} -module GHC.SyntaxHighlighterSpec- ( spec )-where+module GHC.SyntaxHighlighterSpec (spec) where import Data.Text (Text)+import qualified Data.Text.IO as T import GHC.SyntaxHighlighter import Test.Hspec-import qualified Data.Text.IO as T spec :: Spec spec = describe "tokenizeHaskell" $ do@@ -19,209 +17,209 @@ withFile :: FilePath -> [(Token, Text)] -> Expectation withFile path toks = do- txt <- T.readFile path- tokenizeHaskell txt `shouldBe` Just toks+ txt <- T.readFile path+ tokenizeHaskell txt `shouldBe` Just toks ---------------------------------------------------------------------------- -- Expected token streams basicModule :: [(Token, Text)] basicModule =- [ (KeywordTok,"module")- , (SpaceTok," ")- , (ConstructorTok,"Main")- , (SpaceTok," ")- , (SymbolTok,"(")- , (VariableTok,"main")- , (SymbolTok,")")- , (SpaceTok," ")- , (KeywordTok,"where")- , (SpaceTok,"\n\n")- , (KeywordTok,"import")- , (SpaceTok," ")- , (ConstructorTok,"Data.Bits")- , (SpaceTok,"\n\n")- , (CommentTok,"-- | Program's entry point.")- , (SpaceTok,"\n\n")- , (VariableTok,"main")- , (SpaceTok," ")- , (SymbolTok,"::")- , (SpaceTok," ")- , (ConstructorTok,"IO")- , (SpaceTok," ")- , (SymbolTok,"(")- , (SymbolTok,")")- , (SpaceTok,"\n")- , (VariableTok,"main")- , (SpaceTok," ")- , (SymbolTok,"=")- , (SpaceTok," ")- , (VariableTok,"return")- , (SpaceTok," ")- , (SymbolTok,"(")- , (SymbolTok,")")- , (SpaceTok,"\n")+ [ (KeywordTok, "module"),+ (SpaceTok, " "),+ (ConstructorTok, "Main"),+ (SpaceTok, " "),+ (SymbolTok, "("),+ (VariableTok, "main"),+ (SymbolTok, ")"),+ (SpaceTok, " "),+ (KeywordTok, "where"),+ (SpaceTok, "\n\n"),+ (KeywordTok, "import"),+ (SpaceTok, " "),+ (ConstructorTok, "Data.Bits"),+ (SpaceTok, "\n\n"),+ (CommentTok, "-- | Program's entry point."),+ (SpaceTok, "\n"),+ (VariableTok, "main"),+ (SpaceTok, " "),+ (SymbolTok, "::"),+ (SpaceTok, " "),+ (ConstructorTok, "IO"),+ (SpaceTok, " "),+ (SymbolTok, "("),+ (SymbolTok, ")"),+ (SpaceTok, "\n"),+ (VariableTok, "main"),+ (SpaceTok, " "),+ (SymbolTok, "="),+ (SpaceTok, " "),+ (VariableTok, "return"),+ (SpaceTok, " "),+ (SymbolTok, "("),+ (SymbolTok, ")"),+ (SpaceTok, "\n") ] typeFamily :: [(Token, Text)] typeFamily =- [ (KeywordTok,"type")- , (SpaceTok," ")- , (KeywordTok,"family")- , (SpaceTok," ")- , (ConstructorTok,"All")- , (SpaceTok," ")- , (SymbolTok,"(")- , (VariableTok,"c")- , (SpaceTok," ")- , (SymbolTok,"::")- , (SpaceTok," ")- , (VariableTok,"k")- , (SpaceTok," ")- , (SymbolTok,"->")- , (SpaceTok," ")- , (ConstructorTok,"Constraint")- , (SymbolTok,")")- , (SpaceTok," ")- , (SymbolTok,"(")- , (VariableTok,"xs")- , (SpaceTok," ")- , (SymbolTok,"::")- , (SpaceTok," ")- , (SymbolTok,"[")- , (VariableTok,"k")- , (SymbolTok,"]")- , (SymbolTok,")")- , (SpaceTok," ")- , (SymbolTok,"::")- , (SpaceTok," ")- , (ConstructorTok,"Constraint")- , (SpaceTok," ")- , (KeywordTok,"where")- , (SpaceTok,"\n ")- , (ConstructorTok,"All")- , (SpaceTok," ")- , (VariableTok,"c")- , (SpaceTok," ")- , (SymbolTok,"'")- , (SymbolTok,"[")- , (SymbolTok,"]")- , (SpaceTok," ")- , (SymbolTok,"=")- , (SpaceTok," ")- , (SymbolTok,"(")- , (SymbolTok,")")- , (SpaceTok,"\n ")- , (ConstructorTok,"All")- , (SpaceTok," ")- , (VariableTok,"c")- , (SpaceTok," ")- , (SymbolTok,"(")- , (VariableTok,"x")- , (SpaceTok," ")- , (SymbolTok,"'")- , (SymbolTok,":")- , (SpaceTok," ")- , (VariableTok,"xs")- , (SymbolTok,")")- , (SpaceTok," ")- , (SymbolTok,"=")- , (SpaceTok," ")- , (SymbolTok,"(")- , (VariableTok,"c")- , (SpaceTok," ")- , (VariableTok,"x")- , (SymbolTok,",")- , (SpaceTok," ")- , (ConstructorTok,"All")- , (SpaceTok," ")- , (VariableTok,"c")- , (SpaceTok," ")- , (VariableTok,"xs")- , (SymbolTok,")")- , (SpaceTok,"\n")+ [ (KeywordTok, "type"),+ (SpaceTok, " "),+ (KeywordTok, "family"),+ (SpaceTok, " "),+ (ConstructorTok, "All"),+ (SpaceTok, " "),+ (SymbolTok, "("),+ (VariableTok, "c"),+ (SpaceTok, " "),+ (SymbolTok, "::"),+ (SpaceTok, " "),+ (VariableTok, "k"),+ (SpaceTok, " "),+ (SymbolTok, "->"),+ (SpaceTok, " "),+ (ConstructorTok, "Constraint"),+ (SymbolTok, ")"),+ (SpaceTok, " "),+ (SymbolTok, "("),+ (VariableTok, "xs"),+ (SpaceTok, " "),+ (SymbolTok, "::"),+ (SpaceTok, " "),+ (SymbolTok, "["),+ (VariableTok, "k"),+ (SymbolTok, "]"),+ (SymbolTok, ")"),+ (SpaceTok, " "),+ (SymbolTok, "::"),+ (SpaceTok, " "),+ (ConstructorTok, "Constraint"),+ (SpaceTok, " "),+ (KeywordTok, "where"),+ (SpaceTok, "\n "),+ (ConstructorTok, "All"),+ (SpaceTok, " "),+ (VariableTok, "c"),+ (SpaceTok, " "),+ (SymbolTok, "'"),+ (SymbolTok, "["),+ (SymbolTok, "]"),+ (SpaceTok, " "),+ (SymbolTok, "="),+ (SpaceTok, " "),+ (SymbolTok, "("),+ (SymbolTok, ")"),+ (SpaceTok, "\n "),+ (ConstructorTok, "All"),+ (SpaceTok, " "),+ (VariableTok, "c"),+ (SpaceTok, " "),+ (SymbolTok, "("),+ (VariableTok, "x"),+ (SpaceTok, " "),+ (SymbolTok, "'"),+ (SymbolTok, ":"),+ (SpaceTok, " "),+ (VariableTok, "xs"),+ (SymbolTok, ")"),+ (SpaceTok, " "),+ (SymbolTok, "="),+ (SpaceTok, " "),+ (SymbolTok, "("),+ (VariableTok, "c"),+ (SpaceTok, " "),+ (VariableTok, "x"),+ (SymbolTok, ","),+ (SpaceTok, " "),+ (ConstructorTok, "All"),+ (SpaceTok, " "),+ (VariableTok, "c"),+ (SpaceTok, " "),+ (VariableTok, "xs"),+ (SymbolTok, ")"),+ (SpaceTok, "\n") ] explicitForall :: [(Token, Text)] explicitForall =- [ (VariableTok,"x")- , (SpaceTok," ")- , (SymbolTok,"::")- , (SpaceTok," ")- , (KeywordTok,"forall")- , (SpaceTok," ")- , (VariableTok,"a")- , (OperatorTok,".")- , (SpaceTok," ")- , (VariableTok,"a")- , (SpaceTok,"\n")- , (VariableTok,"x")- , (SpaceTok," ")- , (SymbolTok,"=")- , (SpaceTok," ")- , (VariableTok,"undefined")- , (SpaceTok,"\n")+ [ (VariableTok, "x"),+ (SpaceTok, " "),+ (SymbolTok, "::"),+ (SpaceTok, " "),+ (KeywordTok, "forall"),+ (SpaceTok, " "),+ (VariableTok, "a"),+ (OperatorTok, "."),+ (SpaceTok, " "),+ (VariableTok, "a"),+ (SpaceTok, "\n"),+ (VariableTok, "x"),+ (SpaceTok, " "),+ (SymbolTok, "="),+ (SpaceTok, " "),+ (VariableTok, "undefined"),+ (SpaceTok, "\n") ] lambdaCase :: [(Token, Text)] lambdaCase =- [ (VariableTok,"foo")- , (SpaceTok," ")- , (SymbolTok,"::")- , (SpaceTok," ")- , (ConstructorTok,"Foo")- , (SpaceTok," ")- , (SymbolTok,"->")- , (SpaceTok," ")- , (ConstructorTok,"Maybe")- , (SpaceTok," ")- , (ConstructorTok,"Bar")- , (SpaceTok,"\n")- , (VariableTok,"foo")- , (SpaceTok," ")- , (SymbolTok,"=")- , (SpaceTok," ")- , (SymbolTok,"\\")- , (SymbolTok,"case")- , (SpaceTok,"\n ")- , (ConstructorTok,"Foo")- , (SpaceTok," ")- , (SymbolTok,"->")- , (SpaceTok," ")- , (ConstructorTok,"Just")- , (SpaceTok," ")- , (ConstructorTok,"Bar")- , (SpaceTok,"\n ")- , (SymbolTok,"_")- , (SpaceTok," ")- , (SymbolTok,"->")- , (SpaceTok," ")- , (ConstructorTok,"Nothing")- , (SpaceTok,"\n")+ [ (VariableTok, "foo"),+ (SpaceTok, " "),+ (SymbolTok, "::"),+ (SpaceTok, " "),+ (ConstructorTok, "Foo"),+ (SpaceTok, " "),+ (SymbolTok, "->"),+ (SpaceTok, " "),+ (ConstructorTok, "Maybe"),+ (SpaceTok, " "),+ (ConstructorTok, "Bar"),+ (SpaceTok, "\n"),+ (VariableTok, "foo"),+ (SpaceTok, " "),+ (SymbolTok, "="),+ (SpaceTok, " "),+ (SymbolTok, "\\"),+ (SymbolTok, "case"),+ (SpaceTok, "\n "),+ (ConstructorTok, "Foo"),+ (SpaceTok, " "),+ (SymbolTok, "->"),+ (SpaceTok, " "),+ (ConstructorTok, "Just"),+ (SpaceTok, " "),+ (ConstructorTok, "Bar"),+ (SpaceTok, "\n "),+ (SymbolTok, "_"),+ (SpaceTok, " "),+ (SymbolTok, "->"),+ (SpaceTok, " "),+ (ConstructorTok, "Nothing"),+ (SpaceTok, "\n") ] pragmas :: [(Token, Text)] pragmas =- [ (PragmaTok,"{-# LANGUAGE OverloadedStrings #-}")- , (SpaceTok,"\n")- , (PragmaTok,"{-# OPTIONS_GHC -fno-warn-unused-matches #-}")- , (SpaceTok,"\n\n")- , (VariableTok,"main")- , (SpaceTok," ")- , (SymbolTok,"::")- , (SpaceTok," ")- , (ConstructorTok,"IO")- , (SpaceTok," ")- , (SymbolTok,"(")- , (SymbolTok,")")- , (SpaceTok,"\n")- , (VariableTok,"main")- , (SpaceTok," ")- , (SymbolTok,"=")- , (SpaceTok," ")- , (VariableTok,"return")- , (SpaceTok," ")- , (SymbolTok,"(")- , (SymbolTok,")")- , (SpaceTok,"\n")+ [ (PragmaTok, "{-# LANGUAGE OverloadedStrings #-}"),+ (SpaceTok, "\n"),+ (PragmaTok, "{-# OPTIONS_GHC -fno-warn-unused-matches #-}"),+ (SpaceTok, "\n\n"),+ (VariableTok, "main"),+ (SpaceTok, " "),+ (SymbolTok, "::"),+ (SpaceTok, " "),+ (ConstructorTok, "IO"),+ (SpaceTok, " "),+ (SymbolTok, "("),+ (SymbolTok, ")"),+ (SpaceTok, "\n"),+ (VariableTok, "main"),+ (SpaceTok, " "),+ (SymbolTok, "="),+ (SpaceTok, " "),+ (VariableTok, "return"),+ (SpaceTok, " "),+ (SymbolTok, "("),+ (SymbolTok, ")"),+ (SpaceTok, "\n") ]