packages feed

ghc-syntax-highlighter (empty) → 0.0.1.0

raw patch · 11 files changed

+765/−0 lines, 11 filesdep +basedep +ghcdep +ghc-syntax-highlightersetup-changed

Dependencies added: base, ghc, ghc-syntax-highlighter, hspec, text

Files

+ CHANGELOG.md view
@@ -0,0 +1,3 @@+## GHC syntax highligher 0.0.1.0++* Initial release.
+ GHC/SyntaxHighlighter.hs view
@@ -0,0 +1,480 @@+-- |+-- Module      :  GHC.SyntaxHighlighter+-- Copyright   :  © 2018 Mark Karpov+-- License     :  BSD 3 clause+--+-- Maintainer  :  Mark Karpov <markkarpov92@gmail.com>+-- Stability   :  experimental+-- Portability :  portable+--+-- The module allows you to decompose a 'Text' stream containing Haskell+-- source code into a stream of 'Text' chunks tagged with 'Token'.+--+-- 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-unused-top-binds #-}++module GHC.SyntaxHighlighter+  ( Token (..)+  , tokenizeHaskell )+where++import Control.Monad+import Data.Bits+import Data.List (unfoldr, foldl')+import Data.Text (Text)+import Data.Word (Word64)+import FastString (mkFastString)+import Module (newSimpleUnitId, ComponentId (..))+import SrcLoc+import StringBuffer+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?+  deriving (Eq, Ord, Enum, Bounded, Show)++-- | Internal type containing line\/column combinations for start and end+-- positions of a code span.++data Loc = Loc !Int !Int !Int !Int+  deriving (Show)++----------------------------------------------------------------------------+-- High-level API++-- | 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)]+tokenizeHaskell input =+  case L.unP pLexer parseState of+    L.PFailed {} -> Nothing+    L.POk    _ x -> Just (sliceInputStream input x)+  where+    location = mkRealSrcLoc (mkFastString "") 1 1+    buffer = stringToStringBuffer (T.unpack input)+    parseState = L.mkPStatePure parserFlags buffer location+    parserFlags = L.ParserFlags+      { L.pWarningFlags = ES.empty+      , L.pExtensionFlags = ES.empty+      , L.pThisPackage = newSimpleUnitId (ComponentId (mkFastString ""))+      , L.pExtsBitmap = extsBitmap+      }++-- | Haskell lexer.++pLexer :: L.P [(Token, Loc)]+pLexer = go+  where+    go = do+      r <- L.lexer False return+      case r of+        L _ L.ITeof -> return []+        _           ->+          case fixupToken r of+            Nothing -> go+            Just  x -> (x:) <$> go++-- | 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)) =+      case tryFetchSpace txt l of+        Nothing ->+          let (txt', chunk) = fetchSpan txt l+          in Just ((t, chunk), (txt', ts))+        Just (txt', chunk) ->+          Just ((SpaceTok, chunk), (txt', tss))++-- | 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 _ = 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.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.ITinterruptible -> KeywordTok+  L.ITunsafe    -> KeywordTok+  L.ITstdcallconv -> KeywordTok+  L.ITccallconv -> 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.ITunit      -> KeywordTok+  L.ITsignature -> KeywordTok+  L.ITdependency -> KeywordTok+  L.ITrequires  -> KeywordTok+  -- Pragmas+  L.ITinline_prag {} -> PragmaTok+  L.ITspec_prag _ -> PragmaTok+  L.ITspec_inline_prag {} -> PragmaTok+  L.ITsource_prag _ -> PragmaTok+  L.ITrules_prag _ -> PragmaTok+  L.ITwarning_prag _ -> PragmaTok+  L.ITdeprecated_prag _ -> PragmaTok+  L.ITline_prag _ -> PragmaTok+  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+  L.ITcomplete_prag _ -> PragmaTok+  L.ITclose_prag -> PragmaTok+  L.IToptions_prag _ -> PragmaTok+  L.ITinclude_prag _ -> PragmaTok+  L.ITlanguage_prag -> PragmaTok+  L.ITvect_prag _ -> PragmaTok+  L.ITvect_scalar_prag _ -> PragmaTok+  L.ITnovect_prag _ -> PragmaTok+  L.ITminimal_prag _ -> PragmaTok+  L.IToverlappable_prag _ -> PragmaTok+  L.IToverlapping_prag _ -> PragmaTok+  L.IToverlaps_prag _ -> PragmaTok+  L.ITincoherent_prag _ -> PragmaTok+  L.ITctype _ -> PragmaTok+  -- Reserved symbols+  L.ITdotdot -> SymbolTok+  L.ITcolon -> SymbolTok+  L.ITdcolon _ -> SymbolTok+  L.ITequal -> SymbolTok+  L.ITlam -> SymbolTok+  L.ITlcase -> SymbolTok+  L.ITvbar -> SymbolTok+  L.ITlarrow _ -> SymbolTok+  L.ITrarrow _ -> SymbolTok+  L.ITat -> SymbolTok+  L.ITtilde -> SymbolTok+  L.ITtildehsh -> SymbolTok+  L.ITdarrow _ -> SymbolTok+  L.ITbang -> SymbolTok+  L.ITbiglam -> SymbolTok+  L.ITocurly -> SymbolTok+  L.ITccurly -> SymbolTok+  L.ITvocurly -> SymbolTok+  L.ITvccurly -> SymbolTok+  L.ITobrack -> SymbolTok+  L.ITopabrack -> SymbolTok+  L.ITcpabrack -> SymbolTok+  L.ITcbrack -> SymbolTok+  L.IToparen -> SymbolTok+  L.ITcparen -> SymbolTok+  L.IToubxparen -> SymbolTok+  L.ITcubxparen -> SymbolTok+  L.ITsemi -> SymbolTok+  L.ITcomma -> SymbolTok+  L.ITunderscore -> SymbolTok+  L.ITbackquote -> SymbolTok+  L.ITsimpleQuote -> SymbolTok+  -- NOTE GHC thinks these are reserved symbols, but I classify them as+  -- operators.+  L.ITminus -> OperatorTok+  L.ITdot -> OperatorTok+  -- Identifiers+  L.ITvarid _ -> VariableTok+  L.ITconid _ -> ConstructorTok+  L.ITvarsym _ -> OperatorTok+  L.ITconsym _ -> OperatorTok+  L.ITqvarid _ -> VariableTok+  L.ITqconid _ -> ConstructorTok+  L.ITqvarsym _ -> OperatorTok+  L.ITqconsym _ -> OperatorTok+  L.ITdupipvarid _ -> VariableTok+  L.ITlabelvarid _ -> VariableTok+  -- Basic types+  L.ITchar _ _ -> CharTok+  L.ITstring _ _ -> StringTok+  L.ITinteger _ -> IntegerTok+  L.ITrational _ -> RationalTok+  L.ITprimchar _ _ -> CharTok+  L.ITprimstring _ _ -> StringTok+  L.ITprimint _ _ -> IntegerTok+  L.ITprimword _ _ -> IntegerTok+  L.ITprimfloat _ -> RationalTok+  L.ITprimdouble _ -> RationalTok+  -- Template Haskell extension tokens+  L.ITopenExpQuote _ _ -> SymbolTok+  L.ITopenPatQuote -> SymbolTok+  L.ITopenDecQuote -> SymbolTok+  L.ITopenTypQuote -> SymbolTok+  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+  -- Arrow notation+  L.ITproc -> KeywordTok+  L.ITrec -> KeywordTok+  L.IToparenbar _ -> SymbolTok+  L.ITcparenbar _ -> SymbolTok+  L.ITlarrowtail _ -> SymbolTok+  L.ITrarrowtail _ -> SymbolTok+  L.ITLarrowtail _ -> SymbolTok+  L.ITRarrowtail _ -> SymbolTok+  -- Type application+  L.ITtypeApp -> SymbolTok+  -- Special+  L.ITunknown _ -> OtherTok+  L.ITeof -> OtherTok -- normally is not included in results+  -- Documentation annotations+  L.ITdocCommentNext _ -> CommentTok+  L.ITdocCommentPrev _ -> CommentTok+  L.ITdocCommentNamed _ -> CommentTok+  L.ITdocSection _ _ -> CommentTok+  L.ITdocOptions _ -> CommentTok+  L.ITlineComment _ -> CommentTok+  L.ITblockComment _ -> CommentTok++----------------------------------------------------------------------------+-- Text traversing++-- | A type for 'Text' with line\/column location attached.++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)++-- | Try to fetch the rest of 'Text'' stream.++tryFetchRest :: Text' -> Maybe (Text', Text)+tryFetchRest (Text' l c txt) =+  if T.null txt+    then Nothing+    else Just (Text' l c "", txt)++-- | Fetch 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 txt@(Text' _ _ original) l c =+  let chunk = T.unfoldr f txt+      f (Text' l' c' s) = do+        guard (l' < l || c' < c)+        (ch, s') <- T.uncons s+        let (l'', c'') = case ch of+              '\n' -> (l' + 1, 1)+              '\t' -> (l', c' + 8 - ((c' - 1) `rem` 8))+              _    -> (l', c' + 1)+        return (ch, Text' l'' c'' s')+  in (Text' l c (T.drop (T.length chunk) original), chunk)++----------------------------------------------------------------------------+-- Exts bitmap hack++-- | Extension bitmap we use in this library.++extsBitmap :: Word64+extsBitmap = mkExtsBitmap enabledExts+{-# NOINLINE extsBitmap #-}++-- | Create extension bitmap similarly to how it's done in GHC.++mkExtsBitmap :: [ExtBits] -> Word64+mkExtsBitmap = foldl' f 0+  where+    f w x = bit (fromEnum x) .|. w++-- | Copied from GHC sources that are not yet available in the @ghc@+-- package.++data ExtBits+  = FfiBit+  | InterruptibleFfiBit+  | CApiFfiBit+  | ParrBit+  | ArrowsBit+  | ThBit+  | ThQuotesBit+  | IpBit+  | OverloadedLabelsBit -- #x overloaded labels+  | ExplicitForallBit -- the 'forall' keyword and '.' symbol+  | BangPatBit -- Tells the parser to understand bang-patterns+               -- (doesn't affect the lexer)+  | PatternSynonymsBit -- pattern synonyms+  | HaddockBit-- Lex and parse Haddock comments+  | MagicHashBit -- "#" in both functions and operators+  | RecursiveDoBit -- mdo+  | UnicodeSyntaxBit -- the forall symbol, arrow symbols, etc+  | UnboxedTuplesBit -- (# and #)+  | UnboxedSumsBit -- (# and #)+  | DatatypeContextsBit+  | TransformComprehensionsBit+  | QqBit -- enable quasiquoting+  | InRulePragBit+  | RawTokenStreamBit -- producing a token stream with all comments included+  | SccProfilingOnBit+  | HpcBit+  | AlternativeLayoutRuleBit+  | RelaxedLayoutBit+  | NondecreasingIndentationBit+  | SafeHaskellBit+  | TraditionalRecordSyntaxBit+  | ExplicitNamespacesBit+  | LambdaCaseBit+  | BinaryLiteralsBit+  | NegativeLiteralsBit+  | HexFloatLiteralsBit+  | TypeApplicationsBit+  | StaticPointersBit+  | NumericUnderscoresBit+  deriving Enum++-- | Extension we enable for the best user experience.++enabledExts :: [ExtBits]+enabledExts =+  [ FfiBit+  , InterruptibleFfiBit+  , CApiFfiBit+  , ParrBit+  , ArrowsBit+  , ThBit+  , ThQuotesBit+  , IpBit+  , OverloadedLabelsBit+  , ExplicitForallBit+  , BangPatBit+  , PatternSynonymsBit+  , HaddockBit+  , MagicHashBit+  , RecursiveDoBit+  , UnicodeSyntaxBit+  , UnboxedTuplesBit+  , UnboxedSumsBit+  , DatatypeContextsBit+  , TransformComprehensionsBit+  , QqBit+  , InRulePragBit+  , RawTokenStreamBit+  , SafeHaskellBit+  , LambdaCaseBit+  , BinaryLiteralsBit+  , NegativeLiteralsBit+  , HexFloatLiteralsBit+  , TypeApplicationsBit+  , StaticPointersBit+  , NumericUnderscoresBit+  ]
+ LICENSE.md view
@@ -0,0 +1,28 @@+Copyright © 2018 Mark Karpov++All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:++* Redistributions of source code must retain the above copyright notice,+  this list of conditions and the following disclaimer.++* Redistributions in binary form must reproduce the above copyright+  notice, this list of conditions and the following disclaimer in the+  documentation and/or other materials provided with the distribution.++* Neither the name Mark Karpov nor the names of contributors may be used to+  endorse or promote products derived from this software without specific+  prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS “AS IS” AND ANY EXPRESS+OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES+OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN+NO EVENT SHALL THE COPYRIGHT HOLDERS BE LIABLE FOR ANY DIRECT, INDIRECT,+INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA,+OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF+LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING+NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE,+EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ README.md view
@@ -0,0 +1,15 @@+# GHC syntax highligher++[![License FreeBSD](https://img.shields.io/badge/license-FreeBSD-brightgreen.svg)](http://opensource.org/licenses/BSD-2-Clause)+[![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)++Syntax highlighter for Haskell using GHC itself as a library.++## License++Copyright © 2018 Mark Karpov++Distributed under BSD 3 clause license.
+ Setup.hs view
@@ -0,0 +1,6 @@+module Main (main) where++import Distribution.Simple++main :: IO ()+main = defaultMain
+ data/Forall.hs view
@@ -0,0 +1,2 @@+x :: forall a. a+x = undefined
+ data/Main.hs view
@@ -0,0 +1,8 @@+module Main (main) where++import Data.Bits++-- | Program's entry point.++main :: IO ()+main = return ()
+ data/TypeFamily.hs view
@@ -0,0 +1,3 @@+type family All (c :: k -> Constraint) (xs :: [k]) :: Constraint where+  All c '[]       = ()+  All c (x ': xs) = (c x, All c xs)
+ ghc-syntax-highlighter.cabal view
@@ -0,0 +1,57 @@+name:                 ghc-syntax-highlighter+version:              0.0.1.0+cabal-version:        1.18+tested-with:          GHC==8.4.2+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:             Correct syntax highlighter for Haskell using GHC itself+build-type:           Simple+description:          Correct syntax highlighter for Haskell using GHC itself.+extra-doc-files:      CHANGELOG.md+                    , README.md+data-files:           data/*.hs++source-repository head+  type:               git+  location:           https://github.com/mrkkrp/ghc-syntax-highlighter.git++flag dev+  description:        Turn on development settings.+  manual:             True+  default:            False++library+  build-depends:      base             >= 4.11 && < 5.0+                    , ghc              >= 8.4  && < 8.5+                    , 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+                      -Wnoncanonical-monadfail-instances+  else+    ghc-options:      -O2 -Wall+  default-language:   Haskell2010++test-suite tests+  main-is:            Spec.hs+  hs-source-dirs:     tests+  type:               exitcode-stdio-1.0+  build-depends:      base             >= 4.11 && < 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
+ tests/GHC/SyntaxHighlighterSpec.hs view
@@ -0,0 +1,162 @@+{-# LANGUAGE OverloadedStrings #-}++module GHC.SyntaxHighlighterSpec+  ( spec )+where++import Data.Text (Text)+import GHC.SyntaxHighlighter+import Test.Hspec+import qualified Data.Text.IO as T++spec :: Spec+spec = describe "tokenizeHaskell" $ do+  it "parses a basic module" (withFile "data/Main.hs" basicModule)+  it "parses a type family" (withFile "data/TypeFamily.hs" typeFamily)+  it "parses an explicit forall" (withFile "data/Forall.hs" explicitForall)++withFile :: FilePath -> [(Token, Text)] -> Expectation+withFile path toks = do+    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")+  ]++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")+  ]++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")+  ]
+ tests/Spec.hs view
@@ -0,0 +1,1 @@+{-# OPTIONS_GHC -F -pgmF hspec-discover #-}