packages feed

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 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 @@ [![Hackage](https://img.shields.io/hackage/v/ghc-syntax-highlighter.svg?style=flat)](https://hackage.haskell.org/package/ghc-syntax-highlighter) [![Stackage Nightly](http://stackage.org/package/ghc-syntax-highlighter/badge/nightly)](http://stackage.org/nightly/package/ghc-syntax-highlighter) [![Stackage LTS](http://stackage.org/package/ghc-syntax-highlighter/badge/lts)](http://stackage.org/lts/package/ghc-syntax-highlighter)-[![Build Status](https://travis-ci.org/mrkkrp/ghc-syntax-highlighter.svg?branch=master)](https://travis-ci.org/mrkkrp/ghc-syntax-highlighter)+![CI](https://github.com/mrkkrp/ghc-syntax-highlighter/workflows/CI/badge.svg?branch=master)  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")   ]