gigaparsec 0.3.0.0 → 0.3.1.0

raw patch · 36 files changed

+5482/−566 lines, 36 filesPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

API changes (from Hackage documentation)

Files

• CHANGELOG.md +5/−1
• benchmarks/Main.hs +2/−1
• gigaparsec.cabal +24/−2
• src/Text/Gigaparsec.hs +517/−67
• src/Text/Gigaparsec/Char.hs +3/−1
• src/Text/Gigaparsec/Combinator.hs +51/−18
• src/Text/Gigaparsec/Combinator/NonEmpty.hs +86/−6
• src/Text/Gigaparsec/Errors/Combinator.hs +141/−16
• src/Text/Gigaparsec/Errors/DefaultErrorBuilder.hs +66/−0
• src/Text/Gigaparsec/Errors/ErrorBuilder.hs +183/−88
• src/Text/Gigaparsec/Errors/ErrorGen.hs +84/−12
• src/Text/Gigaparsec/Errors/Patterns.hs +135/−16
• src/Text/Gigaparsec/Expr.hs +209/−9
• src/Text/Gigaparsec/Expr/Chain.hs +206/−10
• src/Text/Gigaparsec/Expr/Infix.hs +135/−6
• src/Text/Gigaparsec/Expr/Subtype.hs +63/−1
• src/Text/Gigaparsec/Internal.hs +31/−11
• src/Text/Gigaparsec/Internal/TH/DecUtils.hs +13/−0
• src/Text/Gigaparsec/Internal/TH/TypeUtils.hs +126/−0
• src/Text/Gigaparsec/Internal/TH/VersionAgnostic.hs +512/−0
• src/Text/Gigaparsec/Internal/Token/BitBounds.hs +25/−2
• src/Text/Gigaparsec/Internal/Token/Errors.hs +188/−27
• src/Text/Gigaparsec/Internal/Token/Lexer.hs +181/−45
• src/Text/Gigaparsec/Internal/Token/Names.hs +60/−6
• src/Text/Gigaparsec/Internal/Token/Numeric.hs +175/−12
• src/Text/Gigaparsec/Internal/Token/Patterns/IntegerParsers.hs +411/−0
• src/Text/Gigaparsec/Internal/Token/Patterns/LexerCombinators.hs +362/−0
• src/Text/Gigaparsec/Internal/Token/Symbol.hs +64/−6
• src/Text/Gigaparsec/Internal/Token/Text.hs +32/−6
• src/Text/Gigaparsec/Patterns.hs +6/−4
• src/Text/Gigaparsec/Position.hs +76/−7
• src/Text/Gigaparsec/State.hs +183/−10
• src/Text/Gigaparsec/Token/Descriptions.hs +525/−80
• src/Text/Gigaparsec/Token/Errors.hs +382/−80
• src/Text/Gigaparsec/Token/Lexer.hs +131/−10
• src/Text/Gigaparsec/Token/Patterns.hs +89/−6

@@ -1,6 +1,10 @@ # Revision history for gigaparsec -## 0.3.0.0 -- TBD+## 0.3.1.0 -- 2025-01-19+* Added more documentation+* Added lexical combinator TH generators++## 0.3.0.0 -- 2024-04-08 * Generalised `deriveLiftedConstructors`/`deriveDeferredConstructors` functionality to also work   with pattern synonyms and `forall`s in more places. * Added line numbering for the line information in the `ErrorBuilder`.

@@ -4,9 +4,10 @@ module Main (main) where  import Gauge (defaultMain, bench, nf)-import Text.Gigaparsec (Parsec, Result, parse, atomic, (<|>))+import Text.Gigaparsec (Parsec, Result, parse, atomic) import Text.Gigaparsec.Char (string) import Control.DeepSeq (NFData)+import Control.Applicative ((<|>))  p :: Parsec String p = atomic (string "hello wold") <|> atomic (string "hi") <|> string "hello world"

@@ -20,7 +20,7 @@ -- PVP summary:     +-+------- breaking API changes --                  | | +----- non-breaking API additions --                  | | | +--- code changes with no API change-version:            0.3.0.0+version:            0.3.1.0  -- A short (one-line) description of the package. synopsis:@@ -117,12 +117,17 @@                       Text.Gigaparsec.Internal.Errors.ErrorItem,                       Text.Gigaparsec.Internal.Errors.ParseError,                       Text.Gigaparsec.Internal.Require,+                      Text.Gigaparsec.Internal.TH.DecUtils,+                      Text.Gigaparsec.Internal.TH.TypeUtils,+                      Text.Gigaparsec.Internal.TH.VersionAgnostic,                       Text.Gigaparsec.Internal.Token.BitBounds,                       Text.Gigaparsec.Internal.Token.Errors,                       Text.Gigaparsec.Internal.Token.Generic,                       Text.Gigaparsec.Internal.Token.Lexer,                       Text.Gigaparsec.Internal.Token.Names,                       Text.Gigaparsec.Internal.Token.Numeric,+                      Text.Gigaparsec.Internal.Token.Patterns.IntegerParsers,+                      Text.Gigaparsec.Internal.Token.Patterns.LexerCombinators,                       Text.Gigaparsec.Internal.Token.Symbol,                       Text.Gigaparsec.Internal.Token.Text, @@ -216,8 +221,25 @@     hs-source-dirs:  benchmarks     build-depends:         gigaparsec,-        --containers >= 0.6 && < 0.7,         gauge >= 0.1 && < 0.3,         deepseq >= 1.4 && < 1.6      main-is:          Main.hs++--library examples+--    import:             warnings, extensions, base+--    default-language:   Haskell2010+--    hs-source-dirs:     examples+--+--    ghc-options: -ddump-to-file -ddump-simpl -ddump-splices -ddump-file-prefix=Foo+--+--    build-depends:+--        gigaparsec,+--        containers >= 0.6 && < 0.7+--+--    exposed-modules:+--        ExprLang,+--        ExprLang.Parser,+--        ExprLang.Lexer,+--        ExprLang.Lexer.IntConfig,+--        ExprLang.AST

@@ -1,5 +1,5 @@ {-# LANGUAGE Trustworthy #-}-{-# LANGUAGE TypeFamilies, DeriveGeneric #-}+{-# LANGUAGE TypeFamilies, DeriveGeneric, CPP #-} {-| Module      : Text.Gigaparsec Description : Contains the bulk of the core combinators.@@ -7,12 +7,13 @@ Maintainer  : Jamie Willis, Gigaparsec Maintainers Stability   : stable -This object contains the core combinators and parser type: all parsers will require something from+This module contains the core combinators and parser type: all parsers will require something from within!  @since 0.1.0.0 -} module Text.Gigaparsec (+  -- * The 'Parsec' type     Parsec, Result(..), result, parse, parseFromFile, parseRepl,   -- * Primitive Combinators   -- | These combinators are specific to parser combinators. In one way or another, they influence@@ -26,13 +27,11 @@   -- however, reasonably useful; in particular, `pure` and `unit` can be put to good use in   -- injecting results into a parser without needing to consume anything, or mapping another parser.     unit,-  -- *** Re-exported from "Control.Applicative"     pure, empty,   -- * Result Changing Combinators   -- | These combinators change the result of the parser they are called on into a value of a   -- different type. This new result value may or may not be derived from the previous result.     ($>),-  -- *** Re-exported from "Data.Functor"     (<$>), (<$), void,   -- * Sequencing Combinators   -- | These combinators all combine two parsers in sequence. The first argument of the combinator@@ -40,7 +39,6 @@   -- combined in some way (depending on the individual combinator). If one of the parsers fails, the   -- combinator as a whole fails.     (<~>), (<:>),-  -- *** Re-exported from "Control.Applicative"     (<*>), liftA2, (*>), (<*), (<**>),   -- * Branching Combinators   -- | These combinators allow for parsing one alternative or another. All of these combinators are@@ -48,14 +46,11 @@   -- right-hand side of the combinator will only be tried when the left-hand one failed (and did not   -- consume input in the process).     (<+>),-  -- *** Re-exported from "Control.Applicative"-    (<|>),+    (<|>),    -- * Selective Combinators   -- | These combinators will decide which branch to take next based on the result of another parser.   -- This differs from combinators like `(<|>)` which make decisions based on the success/failure of   -- a parser: here the result of a /successful/ parse will direct which option is done.--  -- *** Re-exported from "Control.Selective"     select, branch,    -- * Filtering Combinators@@ -65,18 +60,31 @@     filterS, mapMaybeS,    -- * Folding Combinators-  -- | These combinators repeatedly execute a parser (at least zero or one times depending on the+  {-| These combinators repeatedly execute a parser (at least zero or one times depending on the   -- specific combinator) until it fails. The results of the successes are then combined together   -- using a folding function. An initial value for the accumulation may be given (for the folds),   -- or the first successful result is the initial accumulator (for the reduces). These are   -- implemented efficiently and do not need to construct any intermediate list with which to store   -- the results.-    many, some, manyl, manyr, somel, somer, manyMap, someMap,-- TODO: these need to be properly categorised+  -}+  -- ** The 'many' Combinators+  {-|+    The 'many' combinators will repeatedly parse a given parser zero or more times, and collect each result in a list.+  -}+  many, manyl, manyr, manyMap,+  -- ** The 'some' Combinators+  {-|+    The 'some' combinators will repeatedly parse a given parser one or more times, and collect each result in a list.+    If successful, the list returned by these combinators is always non-empty.+    +    /See also:/ "Text.Gigaparsec.Combinator.NonEmpty" for variants of these combinators that return a 'Data.List.NonEmpty.NonEmpty' list.+  -}+    some, somel, somer, someMap,-- TODO: these need to be properly categorised   ) where  -- NOTE: -- This module is mostly just for re-exports, though there may be primitive--- combinators in here too. If user can see it, it can go in here.+-- combinators in here too. If users can see it, it can go in here. -- -- Care MUST be taken to not expose /any/ implementation details from -- `Internal`: when they are in the public API, we are locked into them!@@ -89,14 +97,29 @@ import Text.Gigaparsec.Errors.Combinator (filterSWith, mapMaybeSWith) import Text.Gigaparsec.Errors.ErrorGen (vanillaGen) ++-- We want to improve the docs for Applicative, so we do some trickery with redefinitions +--  *only* for the haddock generation.+#ifdef __HADDOCK_VERSION__+{-# LANGUAGE NoImplicitPrelude #-}+import Prelude hiding ((<$>), (<$), (<*>), (*>), (<*), pure, liftA2)+import Prelude qualified+import Control.Applicative qualified as Applicative (liftA2, (<|>), empty, many, some, (<**>), (<*>), (*>), (<*), pure) +import Control.Applicative (Alternative)+import Control.Selective qualified as Applicative (select, branch)+import Data.Functor qualified (void)+#else import Data.Functor (void) import Control.Applicative (liftA2, (<|>), empty, many, some, (<**>)) -- liftA2 required until 9.6 import Control.Selective (select, branch)+#endif+ import Control.Monad.RT (RT, runRT, rtToIO)  import Data.Set qualified as Set (singleton, empty) import GHC.Generics (Generic) + -- Hiding the Internal module seems like the better bet: nobody needs to see it anyway :) -- re-expose like this to prevent hlint suggesting import refinement into internal --type Parsec :: * -> *@@ -106,9 +129,25 @@ Similar to @Either@, this type represents whether a parser has failed or not.  This is chosen instead of @Either@ to be more specific about the naming.++@since 0.1.0.0 -}+{- +TODO: could we instead just use+> type Result = Either+and pattern synonyms,+> pattern Success :: a -> Result e a+> pattern Success x = Right x+> pattern Failure :: e -> Result e a+> pattern Failure err = Left err+-} type Result :: * -> * -> *-data Result e a = Success a | Failure e deriving stock (Show, Eq, Generic) -- TODO: monad?+data Result e a = +  -- | The parser succeeded with a result of type @a@.+    Success a +  -- | The parser failed with an error of type @e@.+  | Failure e deriving stock (Show, Eq, Generic) +  -- TODO: monad?  {-| A fold for the 'Result' type.@@ -117,12 +156,14 @@  @since 0.2.0.0 -}-result :: (e -> b) -> (a -> b) -> Result e a -> b+result :: (e -> b)   -- ^ @failure@, the function that handles the failure case.+       -> (a -> b)   -- ^ @success@, the function that handles the successful case.+       -> Result e a -- ^ @result@, the parse result to process.+       -> b          -- ^ applies either @failure@ or @success@ to the @result@, depending on+                     -- whether or not it is successful. result _ success (Success x) = success x result failure _ (Failure err) = failure err -{-# SPECIALISE parse :: Parsec a -> String -> Result String a #-}-{-# INLINABLE parse #-} {-| Runs a parser against some input. @@ -132,7 +173,11 @@ which allows for @parse \@String@ to make use of the defaultly formated @String@ error messages. This may not be required if it is clear from context. To make this process nicer within GHCi, consider using 'parseRepl'.++@since 0.2.0.0 -}+{-# SPECIALISE parse :: Parsec a -> String -> Result String a #-}+{-# INLINABLE parse #-} parse :: forall err a. ErrorBuilder err       => Parsec a     -- ^ the parser to execute       -> String       -- ^ the input to parse@@ -150,9 +195,10 @@ @since 0.2.0.0 -} parseRepl :: Show a-          => Parsec a -- ^ the parser to execute-          -> String   -- ^ the input to parse-          -> IO ()+          => Parsec a -- ^ @p@, the parser to execute.+          -> String   -- ^ @input@, the input to parse.+          -> IO ()    -- ^ An 'IO' action which parses @input@ with @p@, +                      -- and prints the result to the terminal. parseRepl p inp =   do res <- rtToIO $ _parse Nothing p inp      result putStrLn print res@@ -290,11 +336,12 @@ unit = pure ()  {-|-This combinator, pronounced "zip", first parses this parser then parses @q@: if both succeed the result of this-parser is paired with the result of @q@.+This combinator, pronounced "zip", first parses @p@ then parses @q@: +if both succeed the result of @p@ is paired with that of @q@. -First, this parser is ran, yielding @x@ on success, then @q@ is ran, yielding @y@ on success. If both-are successful then @(x, y)@ is returned. If either fail then the entire combinator fails.+First, runs @p@, yielding @x@ on success, then runs @q@, yielding @y@ on success. +If both are successful then @(x, y)@ is returned. +If either fail then the entire combinator fails.  ==== __Examples__ >>> p = char 'a' <~> char 'b'@@ -304,54 +351,69 @@ Failure .. >>> parse p "a" Failure ..++@since 0.1.0.0 -} infixl 4 <~>-(<~>) :: Parsec a -> Parsec b -> Parsec (a, b)+(<~>) :: Parsec a      -- ^ @p@, the first parser to run.+      -> Parsec b      -- ^ @q@, the second parser to run.+      -> Parsec (a, b) -- ^ a parser that runs @p@ and then @q@, and pairs their results. (<~>) = liftA2 (,)  {-|-This combinator, pronounced "as", replaces the result of this parser, ignoring the old result.+This combinator, pronounced "as", replaces the result of the given parser, ignoring the old result. -Similar to @(<$>)@, except the old result of this parser is not required to+Similar to @(<$>)@, except the old result of the given parser is not required to compute the new result. This is useful when the result is a constant value (or function!). Functionally the same as @p *> pure x@ or @const x <$> p@. -/In @parsley@, this combinator is known as @#>@ or @as@/.+/In [scala parsley](https:\/\/j-mie6.github.io\/parsley\/), this combinator is known as /@#>@/ or /'@as@'.  ==== __Examples__ >>> parse (string "true" $> true) "true" Success true++@since 0.1.0.0 -} infixl 4 $>-($>) :: Parsec a -> b -> Parsec b+($>) :: Parsec a -- ^ @p@, the parser to run, whose result is ignored.+     -> b        -- ^ @x@, the value to return+     -> Parsec b -- ^ a parser that runs @p@, but returns the value @x@. ($>) = flip (<$)  {-|-This combinator, pronounced "cons", first parses this parser then parses @ps@: if both succeed the result of this+This combinator, pronounced "cons", first parses @p@ and then @ps@: if both succeed the result of this parser is prepended onto the result of @ps@. -First, this parser is ran, yielding @x@ on success, then @ps@ is ran, yielding @xs@ on success. If both-are successful then @x : xs@ is returned. If either fail then the entire combinator fails.+First, runs @p@, yielding @x@ on success, then runs @ps@, yielding @xs@ on success. +If both are successful then @x : xs@ is returned. +If either fail then the entire combinator fails.  ==== __Examples__ > some p = p <:> many(p)++@since 0.1.0.0 -} infixl 4 <:>-(<:>) :: Parsec a -> Parsec [a] -> Parsec [a]+(<:>) :: Parsec a   -- ^ @p@, the first parser to run+      -> Parsec [a] -- ^ @q@, the second parser to run+      -> Parsec [a] -- ^ a parser that runs @p@ and then @q@, +                    -- and prepends the result of the former onto that of the latter. (<:>) = liftA2 (:)  infixl 3 <+> {-|-This combinator, pronounced "sum", wraps this parser's result in @Left@ if it succeeds, and parses @q@ if it failed __without__ consuming input,+This combinator, pronounced "sum", wraps the given parser's result in @Left@ if it succeeds, and parses @q@ if it failed __without__ consuming input, wrapping the result in @Right@. -If this parser is successful, then its result is wrapped up using @Left@ and no further action is taken.-Otherwise, if this parser fails __without__ consuming input, then @q@ is parsed instead and its result is-wrapped up using @Right@. If this parser fails having consumed input, this combinator fails.+If the given parser @p@ is successful, then its result is wrapped up using @Left@ and no further action is taken.+Otherwise, if @p@ fails __without__ consuming input, then @q@ is parsed instead and its result is+wrapped up using @Right@.+If @p@ fails having consumed input, this combinator fails. This is functionally equivalent to @Left <$> p <|> Right <$> q@. -The reason for this behaviour is that it prevents space leaks and improves error messages. If this behaviour-is not desired, use @atomic p@ to rollback any input consumed on failure.+The reason for this behaviour is that it prevents space leaks and improves error messages. +If this behaviour is not desired, use @atomic p@ to rollback any input consumed on failure.  ==== __Examples__ >>> p = string "abc" <+> char "xyz"@@ -361,39 +423,49 @@ Success (Right "xyz") >>> parse p "ab" Failure .. -- first parser consumed an 'a'!++@since 0.1.0.0 -}-(<+>) :: Parsec a -> Parsec b -> Parsec (Either a b)+(<+>) :: Parsec a            -- ^ @p@, the first parser to run+      -> Parsec b            -- ^ @q@, the parser to run if @p@ fails without consuming input+      -> Parsec (Either a b) -- ^ a parser which either parses @p@, or @q@, projecting their +                             -- results into an 'Either'. p <+> q = Left <$> p <|> Right <$> q  {-|-This combinator will parse this parser __zero__ or more times combining the results with the function @f@ and base value @k@ from the left.+This combinator will parse the given parser __zero__ or more times combining the results with the function @f@ and base value @k@ from the left. -This parser will continue to be parsed until it fails having __not consumed__ input.+The given parser @p@ will continue to be parsed until it fails having __not consumed__ input. All of the results generated by the successful parses are then combined in a left-to-right fashion using the function @f@: the left-most value provided to @f@ is the value @k@.-If this parser does fail at any point having consumed input, this combinator will fail.++If @p@ does fail at any point having consumed input, this combinator will fail.++@since 0.3.0.0 -}-manyl :: (b -> a -> b) -- ^ function to apply to each value produced by this parser, starting at the left.-      -> b             -- ^  the initial value to feed into the reduction-      -> Parsec a-      -> Parsec b      -- ^ a parser which parses this parser many times and folds the results together with @f@ and @k@ left-associatively.+manyl :: (b -> a -> b) -- ^ @f@, function to apply to each value produced by @p@ starting at the left.+      -> b             -- ^ @k@, the initial value to feed into the reduction+      -> Parsec a      -- ^ @p@, the parser to repeatedly run zero or more times.+      -> Parsec b      -- ^ a parser which parses @p@ many times and folds the results together with @f@ and @k@ left-associatively. manyl f k = _repl f (pure k)  {-|-This combinator will parse this parser __one__ or more times combining the results with the function @f@ and base value @k@ from the left.+This combinator will parse the given parser __one__ or more times combining the results with the function @f@ and base value @k@ from the left. -This parser will continue to be parsed until it fails having __not consumed__ input.+The given parser @p@ will continue to be parsed until it fails having __not consumed__ input. All of the results generated by the successful parses are then combined in a left-to-right fashion using the function @f@: the left-most value provided to @f@ is the value @k@.-If this parser does fail at any point having consumed input, this combinator will fail.+If @p@ fails at any point having consumed input, this combinator fails.  ==== __Examples__ > natural = somel (\x d -> x * 10 + digitToInt d) 0 digit++@since 0.3.0.0 -}-somel :: (b -> a -> b) -- ^ function to apply to each value produced by this parser, starting at the left.-      -> b             -- ^  the initial value to feed into the reduction-      -> Parsec a-      -> Parsec b      -- ^ a parser which parses this parser some times and folds the results together with @f@ and @k@ left-associatively.+somel :: (b -> a -> b) -- ^ @f@, the function to apply to each value produced by @p@, starting from the left.+      -> b             -- ^ @k@, the initial value to feed into the reduction.+      -> Parsec a      -- ^ @p@ the parser to run at least once.+      -> Parsec b      -- ^ a parser which parses @p@ at least once, and folds the results together with @f@ and @k@ left-associatively. somel f k p = _repl f (f k <$> p) p  {-|@@ -412,9 +484,10 @@ @since 0.2.2.0 -} manyMap :: Monoid m-        => (a -> m) -- injection function for parser results into a monoid-        -> Parsec a -- parser to execute multiple times-        -> Parsec m+        => (a -> m) -- ^ @f@, injection function for parser results into a monoid+        -> Parsec a -- ^ @p@, parser to execute multiple times+        -> Parsec m -- ^ a parser that repeatedly parses @p@, converting each result to an @s@ with @f@,+                    -- ^ collecting the results together using '<>'. manyMap f = manyr (<>) mempty . fmap f  {-|@@ -434,9 +507,10 @@ @since 0.2.2.0 -} someMap :: Semigroup s-        => (a -> s) -- injection function for parser results into a monoid-        -> Parsec a -- parser to execute multiple times-        -> Parsec s+        => (a -> s) -- ^ @f@, the injection function for parser results into a monoid+        -> Parsec a -- ^ @p@, the parser to execute multiple times+        -> Parsec s -- ^ a parser that parses @p@ at least once, converting each result to an @s@ with @f@,+                    -- ^ collecting the results together using '<>'. someMap f p = _repl (<>) (f <$> p) (f <$> p) -- is there a better implementation, it's tricky!  _repl :: (b -> a -> b) -> Parsec b -> Parsec a -> Parsec b@@ -444,10 +518,13 @@  -- should these be implemented with branch? probably not. {-|-This combinator filters the result of this parser using a given predicate, succeeding only if the predicate returns @True@.+This combinator filters the result of the given parser @p@ using the given predicate, +succeeding only if the predicate returns @True@. -First, parse this parser. If it succeeds then take its result @x@ and apply it to the predicate @pred@. If @pred x@ is-true, then return @x@. Otherwise, the combinator fails.+First, parse @p@. +If it succeeds then take its result @x@ and apply it to the predicate @pred@. +If @pred x@ is true, then return @x@. +Otherwise, the combinator fails.  ==== __Examples__ >>> keywords = Set.fromList ["if", "then", "else"]@@ -466,11 +543,11 @@  -- this is called mapFilter in Scala... there is no collect counterpart {-|-This combinator applies a function @f@ to the result of this parser: if it returns a-@Just y@, @y@ is returned, otherwise the parser fails.+This combinator applies a function @f@ to the result of the given parser @p@: +if it returns a @Just y@, @y@ is returned, otherwise this combinator fails. -First, parse this parser. If it succeeds, apply the function @f@ to the result @x@. If-@f x@ returns @Just y@, return @y@. If @f x@ returns @Nothing@, or this parser failed+First, parse @p@. If it succeeds, apply the function @f@ to the result @x@. If+@f x@ returns @Just y@, return @y@. If @f x@ returns @Nothing@, or @p@ failed then this combinator fails. Is a more efficient way of performing a @filterS@ and @fmap@ at the same time. @@ -484,7 +561,380 @@  @since 0.2.2.0 -}-mapMaybeS :: (a -> Maybe b) -- ^ the function used to both filter the result of this parser and transform it.+mapMaybeS :: (a -> Maybe b) -- ^ the function used to both filter the result of @p@ and transform it.           -> Parsec a       -- ^ the parser to filter, @p@.           -> Parsec b       -- ^ a parser that returns the result of @p@ applied to @f@, if it yields a value. mapMaybeS = mapMaybeSWith vanillaGen++---------------------------------------------------------------------------------------------------+-- Haddock specific re-exports+{-+The haddock documentation for re-exports from other libraries is sometimes quite vague/confusing.+We use some C++ macro stuff to only redefine these re-exports for the gigaparsec haddock documentation,+which lets us provide more descriptive (and specialised) documentation for combinators.+-}++#ifdef __HADDOCK_VERSION__+{-|+Repeatedly parse the given parser __zero__ or more times, collecting the results into a list.++Parses the given parser @p@ repeatedly until it fails. +If @p@ failed having consumed input, this combinator fails. +Otherwise, when @p@ fails __without consuming input__, this combinator will return all of the results, +@x₁@ through @xₙ@ (with @n@ >= 0), in a 'List': @[x₁, .., xₙ]@. +If @p@ was never successful, the empty 'List' is returned.++/Note:/ This is a re-export of [Control.Applicative.many]("Control.Applicative").+If you use 'many' from this module, it actually has the more general type as found in [Control.Applicative.many]("Control.Applicative")+(it works for any 'Control.Applicative.Applicative' @p@, rather than just 'Parsec').++/For Gigaparsec Developers:/ Do not import this, use [Control.Applicative.some]("Control.Applicative"), +as this has the more general type.++@since 0.1.0.0+-}+many :: Parsec a   -- ^ @p@, the parser to execute multiple times.+     -> Parsec [a] -- ^ a parser that parses @p@ until it fails, +                   -- returning the list of all the successful results.+many = Applicative.many++{-|+Repeatedly parse the given parser __one__ or more times, collecting the results into a list.++Parses the given parser @p@ repeatedly until it fails. +If @p@ failed having consumed input, this combinator fails. +Otherwise, when @p@ fails __without consuming input__, this combinator will return all of the results, +@x₁@ through @xₙ@ (with @n@ >= 1), in a 'List': @[x₁, .., xₙ]@. +If @p@ was not successful at least one time, this combinator fails.++/See Also:/ 'Text.Gigaparsec.Combinator.NonEmpty.some' for a version of this combinator which +returns a 'Data.List.NonEmpty' list of results. ++/Note:/ This is a re-export of [Control.Applicative.some]("Control.Applicative").+If you use 'some' from this module, it actually has the more general type as found in [Control.Applicative.some]("Control.Applicative")+(it works for any 'Control.Applicative.Applicative' @p@, rather than just 'Parsec').++/For Gigaparsec Developers:/ Do not import this, use [Control.Applicative.some]("Control.Applicative"), +as this has the more general type.++@since 0.1.0.0+-}+some :: Parsec a   -- ^ @p@, the parser to execute multiple times.+     -> Parsec [a] -- ^ a parser that parses @p@ until it fails, +                   -- returning the list of all the successful results.+some = Applicative.some++{-|+Given the parsers @p@ and @q@, this combinator parses @p@; +if @p@ fails __without consuming input__, it then parses @q@.++If @p@ is successful, then this combinator is successful and no further action is taken. +Otherwise, if @p@ fails without consuming input, then @q@ is parsed instead. +If @p@ (or @q@) fails having consumed input, this combinator fails.++This behaviour prevents space leaks and improves error messages. +If this is not desired, use @atomic p@ to rollback any input consumed on failure in the first branch.++This combinator is /associative/, meaning that:++prop> (p <|> q) <|> r = p <|> (q <|> r)++/Note:/ This is a re-export of [Control.Applicative.<|>]("Control.Applicative").+If you use '<|>' from this module, it actually has the more general type as found in [Control.Applicative.<|>]("Control.Applicative")+(it works for any 'Control.Applicative.Applicative' @p@, rather than just 'Parsec').++/For Gigaparsec Developers:/ Do not import this, use [Control.Applicative.<|>]("Control.Applicative"), +as this has the more general type.++@since 0.1.0.0+-}+-- TODO: re-structure gigaparsec (perhaps a Gigaparsec.Gigaparsec module) that is used throughout the library (as it has the more general type),+-- and only expose '<|>' in this top level module so that it has nice user-facing docs.+infixl 3 <|>+(<|>) :: Parsec a -- ^ @p@ the first parser to run+      -> Parsec a -- ^ @q@ the second parser to run if @p@ fails without consuming input.+      -> Parsec a -- ^ a parser which parses either @p@ or @q@.+(<|>) = (Applicative.<|>)+++{-|+Given parsers @p@ and @f@, this combinator, pronounced "reverse ap", first parses @p@ then parses @f@: +if both succeed then returns the result of @f@ to that of @p@.++First, runs @p@, yielding a value x on success, then @f@ is ran, yielding a function @g@ on success. +If both are successful, then @g(x)@ is returned. +If either fail then the entire combinator fails.++Compared with '<*>', this combinator is useful for left-factoring: +when two branches of a parser share a common prefix, this can often be factored out; +but the result of that factored prefix may be required to help generate the results of each branch. +In this case, the branches can return functions that, when given the factored result, +can produce the original results from before the factoring.++/Note:/ This is a re-export of [Control.Applicative.\<**\>]("Control.Applicative").+If you use '<**>' from this module, it actually has the more general type as found in [Control.Applicative.\<**\>]("Control.Applicative")+(it works for any 'Control.Applicative.Applicative' @p@, rather than just 'Parsec').++/For Gigaparsec Developers:/ Do not import this, use [Control.Applicative.\<**\>]("Control.Applicative"), +as this has the more general type.++@since 0.1.0.0+-}+infixl 4 <**>+(<**>) :: Parsec a        -- ^ @p@, the first parser to run+       -> Parsec (a -> b) -- ^ @q@, the second parser to run+       -> Parsec b        -- ^ a parser that runs @p@ and then @q@, and applies the result of @q@ to that of @p@+(<**>) = (Applicative.<**>)++{-|+This parser fails immediately, with an unknown parse error.++Although this parser has type @'Parsec' a@, no @a@ will actually be returned, as this parser fails.++This is the \'zero\' or \'identity\' of '<|>':++prop> p <|> empty = empty <|> p = p++/Note:/ This is a re-export of [Control.Applicative.empty]("Control.Applicative").+If you use 'empty' from this module, it actually has the more general type as found in [Control.Applicative.empty]("Control.Applicative")+(it works for any 'Control.Applicative.Applicative' @p@, rather than just 'Parsec').++/For Gigaparsec Developers:/ Do not import this, use [Control.Applicative.empty]("Control.Applicative"), +as this has the more general type.++@since 0.1.0.0+-}+empty :: Parsec a -- ^ a parser that immediately fails.+empty = Applicative.empty++{-|+This combinator applies the given parsers in sequence and then applies the given function f of to all of the results.++First, parse @p@, then parse @q@.+If both parsers succeed, this combinator succeeds, returning the application of @f@ to the results of @p@ and @q@.+If either @p@ or @q@ fails, this combinator fails.++/Note:/ This is a re-export of [Control.Applicative.liftA2]("Control.Applicative").+If you use 'liftA2' from this module, it actually has the more general type as found in [Control.Applicative.liftA2]("Control.Applicative")+(it works for any 'Control.Applicative.Applicative' @p@, rather than just 'Parsec').++/For Gigaparsec Developers:/ Do not import this, use [Control.Applicative.liftA2]("Control.Applicative"), +as this has the more general type.++@since 0.1.0.0+-}+liftA2 :: (a -> b -> c) -- ^ @f@, a function to apply to the results of the parsers @p@ and @q@ +       -> Parsec a -- ^ @p@, the first parser to run+       -> Parsec b -- ^ @q@, the second parser to run+       -> Parsec c -- ^ a parser that parsers @p@, then @q@, and then combines their results with @f@.+liftA2 = Applicative.liftA2++{-|+This combinator parses its first argument @p@, then parses @q@ only if @p@ returns a Left.++First, parse @p@, which, if successful, will produce either a @Left x@ or a @Right y@:+  +* If a @Left x@ is produced, then the parser @q@ is executed to produce a function @f@, and @f x@ is returned. +* Otherwise, if a Right(y) is produced, y is returned unmodified and q is not parsed. +  +If either @p@ or @q@ fails, the entire combinator fails. +This is a special case of 'branch' where the right branch is @pure id@.++/Note:/ This is a re-export of [Control.Selective.select]("Control.Selective").+If you use 'select' from this module, it actually has the more general type as found in [Control.Selective.select]("Control.Selective")+(it works for any 'Control.Selective.Selective' @p@, rather than just 'Parsec').++/For Gigaparsec Developers:/ Do not import this, use [Control.Selective.select]("Control.Selective"), +as this has the more general type.++@since 0.1.0.0+-}+select :: Parsec (Either a b) -- ^ @p@, the first parser to execute+       -> Parsec (a -> b)     -- ^ @q@, the parser to to execute when @p@ returns a @Left@+       -> Parsec b            -- ^ a parser that will parse @p@ then possibly parse @q@ to +                              -- transform @p@'s result into a @b@.+select = Applicative.select++{-|+This combinator parses its first argument @either@, and then parses either @left@ or @right@+depending on its result.++First, parses @either@, which, if successful, produces either a @Left x@ or a @Right y@:++* If a @Left x@ is produced, run @left@ is to produce a function @f@, and return @f x@. +* If a @Right y@ is produced, run @right@ to produce a function @g@, and return @g y@. ++If either of the two executed parsers fail, the entire combinator fails.++/Note:/ This is a re-export of [Control.Selective.branch]("Control.Selective").+If you use 'branch' from this module, it actually has the more general type as found in [Control.Selective.branch]("Control.Selective")+(it works for any 'Control.Selective.Selective' @p@, rather than just 'Parsec').++/For Gigaparsec Developers:/ Do not import this, use [Control.Selective.branch]("Control.Selective"), +as this has the more general type.++@since 0.1.0.0+-}+branch :: Parsec (Either a b) -- ^ @either@, the first parser to run; its result decides which parser to execute next.+       -> Parsec (a -> c)     -- ^ @left@, the parser to run if @either@ returns a @Left@.+       -> Parsec (b -> c)     -- ^ @right@, the parser to run if @either@ returns a @Right@.+       -> Parsec c            -- ^ a parser that will parse one of @left@ or @right@ depending on @either@'s result.+branch = Applicative.branch++{-|+This combinator applies a function @f@ to the result of a parser @p@.++When @p@ succeeds with value @x@, return @f x@.++This can be used to build more complex results from parsers, +instead of just characters or strings.++/Note:/ This is a re-export of [Data.Functor.\<$\>]("Data.Functor").+If you use '<$>' from this module, it actually has the more general type as found in [Data.Functor.\<$\>]("Data.Functor")+(it works for any 'Functor' @f@, rather than just 'Parsec').++/For Gigaparsec Developers:/ Do not import this, use [Data.Functor.\<$\>]("Data.Functor") (or the 'Prelude'), +as this has the more general type.++@since 0.1.0.0+-}+infixl 4 <$>+(<$>) :: (a -> b) -- ^ @f@, the function to apply to the result of the parser @p@+      -> Parsec a -- ^ @p@, the parser whose result on which to apply @f@.+      -> Parsec b -- ^ a new parser that behaves the same as @p@, but with the given function @f@ applied to its result.+(<$>) = (Prelude.<$>)++{-|+This combinator runs the given parser @p@, and ignores its results, instead returning the given value @x@.++Similar to '<$>', except the result of @p@ is not required to compute the result.+This may be defined in terms of '<$>':++prop> x <$ p = const x <$> p++/Note:/ This is a re-export of [Data.Functor.<$]("Data.Functor").+If you use '<$' from this module, it actually has the more general type as found in [Data.Functor.<$]("Data.Functor")+(it works for any 'Functor' @f@, rather than just 'Parsec').++/For Gigaparsec Developers:/ Do not import this, use [Data.Functor.<$]("Data.Functor") (or the 'Prelude'), +as this has the more general type.++@since 0.1.0.0+-}+infixl 4 <$+(<$) :: a -- ^ @x@, the value to return after parsing @p@.+     -> Parsec b -- ^ @p@, the parser to run and then discard its results.+     -> Parsec a -- ^ a parser that parses @p@, discards its results, and returns @x@.+(<$) = (Prelude.<$)++{-|+This combinator produces a value without having any other effect.++When this combinator is run, no input is required, nor consumed, +and the given value will always be successfully returned. +It has no other effect on the state of the parser.++/Note:/ This is a re-export of [Control.Applicative.pure]("Control.Applicative").+If you use 'pure' from this module, it actually has the more general type as found in [Control.Applicative.pure]("Control.Applicative")+(it works for any 'Control.Applicative.Applicative' @p@, rather than just 'Parsec').++/For Gigaparsec Developers:/ Do not import this, use [Control.Applicative.pure]("Control.Applicative"), +as this has the more general type.++@since 0.1.0.0+-}+-- TODO: re-structure gigaparsec (perhaps a Gigaparsec.Gigaparsec module) that is used throughout the library (as it has the more general type),+-- and only expose 'pure' in this top level module so that it has nice user-facing docs.+pure :: a        -- ^ @x@ the value to be returned.+     -> Parsec a -- ^ a parser which consumes no input and produces the value @x@.+pure = (Applicative.pure)++{-|+This combinator, pronounced "ap", first parses @p@ then parses @q@: +if both succeed then the function @p@ returns is applied to the value returned by @q@.++First, runs @p@, yielding a function @f@ on success, then runs @q@, yielding a value @x@ on success. +If both @p@ and @q@ are successful, then returns @f x@. +If either fail then the entire combinator fails.++/Note:/ This is a re-export of [Control.Applicative.\<*\>]("Control.Applicative").+If you use '<*>' from this module, it actually has the more general type as found in [Control.Applicative.\<*\>]("Control.Applicative")+(it works for any 'Control.Applicative.Applicative' @p@, rather than just 'Parsec').++/For Gigaparsec Developers:/ Do not import this, use [Control.Applicative.\<*\>]("Control.Applicative"), +as this has the more general type.++@since 0.1.0.0+-}+infixl 4 <*>+(<*>) :: Parsec (a -> b) -- ^ @p@, a parser that produces a function @f@.+      -> Parsec a -- ^ @q@, the parser to run second, which returns a value applicable to @p@'s result. +      -> Parsec b -- ^ a parser that runs @p@ and then @q@ and combines their results with function application.+(<*>) = (Applicative.<*>)++{-|+This combinator, pronounced "then", first parses @p@ then parses @q@: +if both @p@ and @q@ succeed then the result of @q@ is returned.++First, runs @p@, yielding @x@ on success, then runs @q@, yielding @y@ on success. +If both @p@ and @q@ are successful then returns @y@ and ignores @x@ +If either fail then the entire combinator fails.++/Note:/ This is a re-export of [Control.Applicative.*>]("Control.Applicative").+If you use '*>' from this module, it actually has the more general type as found in [Control.Applicative.*>]("Control.Applicative")+(it works for any 'Control.Applicative.Applicative' @p@, rather than just 'Parsec').++/For Gigaparsec Developers:/ Do not import this, use [Control.Applicative.*>]("Control.Applicative"), +as this has the more general type.++@since 0.1.0.0+-}+infixl 4 *>+(*>) :: Parsec a -- ^ @p@, the first parser to run, whose result is discarded.+     -> Parsec b -- ^ @q@, the second parser to run, which returns the result of this combinator.+     -> Parsec b -- ^ a parser that runs @p@ then @q@ and returns @q@'s result.+(*>) = (Applicative.*>)++{-|+This combinator, pronounced "then discard", first parses @p@ then parses @q@: +if both succeed then the result of @p@ is returned.++First, runs @p@, yielding @x@ on success, then runs @q@, yielding @y@ on success. +If both @p@ and @q@ are successful then returns @x@ and ignores @y@. +If either fail then the entire combinator fails.++/Note:/ This is a re-export of [Control.Applicative.<*]("Control.Applicative").+If you use '<*' from this module, it actually has the more general type as found in [Control.Applicative.<*]("Control.Applicative")+(it works for any 'Control.Applicative.Applicative' @p@, rather than just 'Parsec').++/For Gigaparsec Developers:/ Do not import this, use [Control.Applicative.<*]("Control.Applicative"), +as this has the more general type.++@since 0.1.0.0+-}+infixl 4 <*+(<*) :: Parsec a -- ^ @p@, the first parser to run, which returns the result of this combinator.+     -> Parsec b -- ^ @q@, the second parser to run, whose result is discarded.+     -> Parsec a -- ^ a parser that runs @p@ then @q@ and returns @p@'s result.+(<*) = (Applicative.<*)++{-|+Run the given parser @p@, then discard its result.++This combinator is useful when @p@ should be run, but its result is not required.++/Note:/ This is a re-export of [Data.Functor.void]("Data.Functor").+If you use 'void' from this module, it actually has the more general type as found in [Data.Functor.void]("Data.Functor")+(it works for any 'Control.Applicative.Applicative' @p@, rather than just 'Parsec').++/For Gigaparsec Developers:/ Do not import this, use [Data.Functor.void]("Data.Functor"), +as this has the more general type.++@since 0.1.0.0+-}+void :: Parsec a  -- ^ @p@, the parser we wish to run, but whose results are unwanted.+     -> Parsec () -- ^ a parser that behaves the same as @p@, but returns '()' on success.+void = Data.Functor.void+#endif++

@@ -45,13 +45,15 @@     spaces, whitespaces,   ) where -import Text.Gigaparsec (Parsec, atomic, empty, some, many, (<|>))+import Text.Gigaparsec (Parsec, atomic) import Text.Gigaparsec.Combinator (skipMany) import Text.Gigaparsec.Errors.Combinator ((<?>)) -- We want to use this to make the docs point to the right definition for users. import Text.Gigaparsec.Internal qualified as Internal (Parsec(Parsec, unParsec), State(..), expectedErr, useHints) import Text.Gigaparsec.Internal.Errors qualified as Internal (ExpectItem(ExpectRaw), Error) import Text.Gigaparsec.Internal.Require (require)++import Control.Applicative ((<|>), empty, some, many)  import Data.Bits (Bits((.&.), (.|.))) import Data.Char (ord)

@@ -1,4 +1,4 @@-{-# LANGUAGE Safe #-}+{-# LANGUAGE Trustworthy #-} {-| Module      : Text.Gigaparsec.Combinator Description : This module contains a huge number of pre-made combinators that are@@ -52,8 +52,10 @@     ifS, whenS, guardS, whileS,   ) where -import Text.Gigaparsec (Parsec, many, some, (<|>), ($>), (<:>), select,-                        branch, empty, unit, manyl, somel, notFollowedBy, liftA2, void)+import Text.Gigaparsec (Parsec, ($>), (<:>), unit, manyl, somel, notFollowedBy)+import Control.Applicative ((<|>), empty, liftA2, many, some)+import Control.Selective (select, branch)+import Data.Functor (void) import Data.Foldable (asum, sequenceA_)  {-|@@ -166,7 +168,7 @@  -- TODO: collect {-|-This combinator can eliminate an @Maybe@ from the result of the parser @p@.+This combinator can eliminate a @Maybe@ from the result of the parser @p@.  First parse @p@, if it succeeds returning @Just x@, then return @x@. However, if @p@ fails, or returned @Nothing@, then this combinator fails.@@ -331,8 +333,10 @@  Parses a given parser, @p@, repeatedly until it fails. If @p@ failed having consumed input, this combinator fails. Otherwise when @p@ fails __without consuming input__, this combinator-will succeed. The parser @p@ must succeed at least once. The number of times @p@ succeeded is returned as the result.+will succeed. The number of times @p@ succeeded is returned as the result. +The parser @p@ must succeed at least once.+ ==== __Examples__ >>> let p = count1 (string "ab") >>> parse @String p ""@@ -353,7 +357,7 @@ {-| This combinator parses __zero__ or more occurrences of @p@, separated by @sep@. -Behaves just like @sepBy1@, except does not require an initial @p@, returning the empty list instead.+Behaves just like 'sepBy1', except does not require an initial @p@, returning the empty list instead.  ==== __Examples__ >>> ...@@ -379,9 +383,10 @@  First parses a @p@. Then parses @sep@ followed by @p@ until there are no more @sep@s. The results of the @p@'s, @x1@ through @xn@, are returned as @[x1, .., xn]@.-If @p@ or @sep@ fails having consumed input, the whole parser fails. Requires at least-one @p@ to have been parsed.+If @p@ or @sep@ fails having consumed input, the whole parser fails.  +Requires at least one @p@ to have been parsed.+ ==== __Examples__ >>> ... >>> let args = sepBy1 int (string ", ")@@ -404,7 +409,7 @@ {-| This combinator parses __zero__ or more occurrences of @p@, separated and optionally ended by @sep@. -Behaves just like @sepEndBy1@, except does not require an initial @p@, returning the empty list instead.+Behaves just like 'sepEndBy1', except does not require an initial @p@, returning the empty list instead.  ==== __Examples__ >>> ...@@ -430,9 +435,10 @@  First parses a @p@. Then parses @sep@ followed by @p@ until there are no more: if a final @sep@ exists, this is parsed. The results of the @p@'s, @x1@ through @xn@, are returned as @[x1, .., xn]@.-If @p@ or @sep@ fails having consumed input, the whole parser fails. Requires at least-one @p@ to have been parsed.+If @p@ or @sep@ fails having consumed input, the whole parser fails.  +Requires at least one @p@ to have been parsed.+ ==== __Examples__ >>> ... >>> let args = sepEndBy1 int (string ";\n")@@ -455,7 +461,7 @@ {-| This combinator parses __zero__ or more occurrences of @p@, separated and ended by @sep@. -Behaves just like @endBy1@, except does not require an initial @p@ and @sep@, returning the empty list instead.+Behaves just like 'endBy1', except does not require an initial @p@ and @sep@, returning the empty list instead.  ==== __Examples__ >>> ...@@ -483,6 +489,8 @@ The results of the @p@'s, @x1@ through @xn@, are returned as @[x1, .., xn]@. If @p@ or @sep@ fails having consumed input, the whole parser fails. +Requires at least one @p@ to have been parsed.+ ==== __Examples__ >>> ... >>> let args = endBy1 int (string ";\n")@@ -530,11 +538,12 @@ {-| This combinator repeatedly parses a given parser __one__ or more times, until the @end@ parser succeeds, collecting the results into a list. -First ensures that trying to parse @end@ fails, then tries to parse @p@. If it succeed then it will repeatedly: try to parse @end@, if it fails+First ensures that trying to parse @end@ fails, then tries to parse @p@. If it succeeds then it will repeatedly: try to parse @end@, if it fails __without consuming input__, then parses @p@, which must succeed. When @end@ does succeed, this combinator will return all of the results-generated by @p@, @x1@ through @xn@ (with @n >= 1@), in a list: @[x1, .., xn]@. The parser @p@ must succeed at least once-before @end@ succeeds.+generated by @p@, @x1@ through @xn@ (with @n >= 1@), in a list: @[x1, .., xn]@.  +The parser @p@ must succeed at least once before @end@ succeeds.+ ==== __Examples__ This can be useful for scanning comments: @@ -550,15 +559,39 @@  @since 0.1.0.0 -}-someTill :: Parsec a   -- ^ @p@, the parser to execute multiple times.+someTill :: Parsec a   -- ^ @p@, the parser to execute multiple times, at least once.          -> Parsec end -- ^ @end@, the parser that stops the parsing of @p@.          -> Parsec [a] -- ^ a parser that parses @p@ until @end@ succeeds, returning the list of all the successful results. someTill p end = notFollowedBy end *> (p <:> manyTill p end) -skipManyTill :: Parsec a -> Parsec end -> Parsec ()+{-|+This combinator repeatedly parses a given parser __zero__ or more times, until the @end@ parser succeeds, discarding any results from @p@.++Behaves like 'manyTill', except the results of parsing @p@ are ignored.++First tries to parse @end@, if it fails __without consuming input__, then parses @p@, which must succeed. This repeats until @end@ succeeds.+When @end@ does succeed (even of the first try), this combinator will discard any results generated by @p@. ++-}+skipManyTill  :: Parsec a   -- ^ @p@, the parser to execute multiple times+              -> Parsec end -- ^ @end@, the parser that stops the parsing of @p@+              -> Parsec ()  -- ^ a parser that parses @p@ until @end@ succeeds, returning unit. skipManyTill p end = void (manyTill p end) -skipSomeTill :: Parsec a -> Parsec end -> Parsec ()+{-|+This combinator repeatedly parses a given parser __one__ or more times, until the @end@ parser succeeds, discarding any results from @p@, and returns unit.++Behaves like 'someTill', except the results of parsing @p@ are ignored.++First ensures that trying to parse @end@ fails, then tries to parse @p@. If it succeeds then it will repeatedly: try to parse @end@, if it fails+__without consuming input__, then parses @p@, which must succeed. +When @end@ does succeed, this combinator will discard any results generated by @p@, returning unit. ++The parser @p@ must succeed at least once before @end@ succeeds.+-}+skipSomeTill  :: Parsec a   -- ^ @p@, the parser to execute multiple times, at least once.+              -> Parsec end -- ^ @end@, the parser that stops the parsing of @p@.+              -> Parsec ()  -- ^ a parser that parses @p@ until @end@ succeeds, returning unit. skipSomeTill p end = void (someTill p end)  -- this is ifP

@@ -1,9 +1,22 @@ {-# LANGUAGE Safe #-}+{-|+Module      : Text.Gigaparsec.Combinator.NonEmpty+Description : This module contains variants of combinators that return non-empty lists of results, modifying the result type to 'NonEmpty'.+License     : BSD-3-Clause+Maintainer  : Jamie Willis, Gigaparsec Maintainers+Stability   : stable++This module contains variants of combinators that return non-empty lists of results, modifying the result type to 'NonEmpty'.+These allow for stronger guarantees of parsed results to be baked into their types.++@since 0.3.0.0+-} module Text.Gigaparsec.Combinator.NonEmpty (some, someTill, sepBy1, sepEndBy1, endBy1) where -import Text.Gigaparsec (Parsec, liftA2, many, notFollowedBy)+import Text.Gigaparsec (Parsec, notFollowedBy) import Text.Gigaparsec.Combinator qualified as Combinator (manyTill, sepEndBy1) +import Control.Applicative (liftA2, many) import Data.List.NonEmpty as NonEmpty (NonEmpty((:|)), fromList)  infixl 4 <:|>@@ -16,17 +29,84 @@ (<<|>) = liftA2 (<|) -} -some :: Parsec a -> Parsec (NonEmpty a)+{-| +This combinator repeatedly parses a given parser __one__ or more times, collecting the results into a non-empty list.++Parses a given parser, @p@, repeatedly until it fails. If @p@ failed having consumed input,+this combinator fails. +Otherwise, when @p@ fails __without consuming input__, this combinator+will return all of the results, @x₁@ through @xₙ@ (with @n ≥ 1@), in a non-empty list: @x₁ :| [x₂, .., xₙ]@.++Requires at least one @p@ to have been parsed.++@since 0.3.0.0+-}+some  :: Parsec a            -- ^ the parser @p@ to execute multiple times+      -> Parsec (NonEmpty a) -- ^ a parser that parses @p@ until it fails, returning a non-empty list of the successful results. some p = p <:|> many p -someTill :: Parsec a -> Parsec end -> Parsec (NonEmpty a)+{-|+This combinator repeatedly parses a given parser __one__ or more times, until the @end@ parser succeeds, collecting the results into a non-empty list.++First ensures that trying to parse @end@ fails, then tries to parse @p@. If it succeeds then it will repeatedly: try to parse @end@, if it fails+__without consuming input__, then parses @p@, which must succeed. +When @end@ does succeed, this combinator will return all of the results+generated by @p@, @x₁@ through @xₙ@ (with @n ≥ 1@), in a non-empty list: @x₁ :| [x₂, .., xₙ]@.++The parser @p@ must succeed at least once before @end@ succeeds.++@since 0.3.0.0+-}+someTill  :: Parsec a            -- ^ @p@, the parser to execute multiple times, at least once.+          -> Parsec end          -- ^ @end@, the parser that stops the parsing of @p@.+          -> Parsec (NonEmpty a) -- ^ a parser that parses @p@ until @end@ succeeds, returning the non-empty list of all the successful results. someTill p end = notFollowedBy end *> (p <:|> Combinator.manyTill p end) -sepBy1 :: Parsec a -> Parsec sep -> Parsec (NonEmpty a)+{-|+This combinator parses __one__ or more occurrences of @p@, separated by @sep@.++First parses a @p@. Then parses @sep@ followed by @p@ until there are no more @sep@s.+The results of the @p@'s, @x₁@ through @xₙ@, are returned as @x₁ :| [x₂, .., xₙ]@.+If @p@ or @sep@ fails having consumed input, the whole parser fails.++Requires at least one @p@ to have been parsed.++@since 0.3.0.0+-}+sepBy1  :: Parsec a            -- ^ @p@, the parser whose results are collected into a non-empty list.+        -> Parsec sep          -- ^ @sep@, the delimiter that must be parsed between every @p@.+        -> Parsec (NonEmpty a) -- ^ a parser that parses @p@ delimited by @sep@, returning the non-empty list of @p@'s results. sepBy1 p sep = p <:|> many (sep *> p) -endBy1 :: Parsec a -> Parsec sep -> Parsec (NonEmpty a)+{-|+This combinator parses __one__ or more occurrences of @p@, separated and ended by @sep@.++Parses @p@ followed by @sep@ one or more times.+The results of the @p@'s, @x₁@ through @xₙ@, are returned as @x₁ :| [x₂, .., xₙ]@.+If @p@ or @sep@ fails having consumed input, the whole parser fails.++Requires at least one @p@ to have been parsed.++@since 0.3.0.0+-}+endBy1  :: Parsec a            -- ^ @p@, the parser whose results are collected into a non-empty list.+        -> Parsec sep          -- ^ @sep@, the delimiter that must be parsed between every @p@.+        -> Parsec (NonEmpty a) -- ^ a parser that parses @p@ delimited by @sep@, returning the non-empty list of @p@'s results. endBy1 p sep = some (p <* sep) -sepEndBy1 :: Parsec a -> Parsec sep -> Parsec (NonEmpty a)+{-|+This combinator parses __one__ or more occurrences of @p@, separated and optionally ended by @sep@,+collecting the results in a non-empty list.++First parses a @p@. Then parses @sep@ followed by @p@ until there are no more: if a final @sep@ exists, this is parsed.+The results of the @p@'s, @x₁@ through @xₙ@, are returned as @x₁ :| [x₂, .., xₙ]@.+If @p@ or @sep@ fails having consumed input, the whole parser fails. ++Requires at least one @p@ to have been parsed.++@since 0.3.0.0+-}+sepEndBy1 :: Parsec a            -- ^ @p@, the parser whose results are collected into a list.+          -> Parsec sep          -- ^ @sep@, the delimiter that must be parsed between every @p@.+          -> Parsec (NonEmpty a) -- ^ a parser that parses @p@ delimited by @sep@, returning the non-empty list of @p@'s results. sepEndBy1 p sep = NonEmpty.fromList <$> Combinator.sepEndBy1 p sep

@@ -313,7 +313,9 @@ parser. This combinator can be used to cancel all entrenchment after the critical section has passed. -}-dislodgeBy :: Word -> Parsec a -> Parsec a+dislodgeBy  :: Word     -- ^ The number of 'entrench' combinators to undo+            -> Parsec a -- ^ The parser containing the 'entrench' combinators+            -> Parsec a dislodgeBy by = Internal.adjustErr (Internal.dislodgeErr by)  {-|@@ -327,7 +329,9 @@ This combinator first tries to amend the position of any error generated by the given parser, and if the error was entrenched will dislodge it the given number of times instead. -}-amendThenDislodgeBy :: Word -> Parsec a -> Parsec a+amendThenDislodgeBy :: Word     -- ^ The number of 'entrench' combinators to dislodge.+                    -> Parsec a -- ^ The parser to amend and dislodge.+                    -> Parsec a amendThenDislodgeBy n = dislodgeBy n . amend  {-|@@ -367,55 +371,176 @@ (<?>) = flip label  -- should these be implemented with branch? probably not.-{-+{-|+This combinator filters the result of this parser with the given predicate, +generating an error with the given error generator if the function returned 'False'.++Behaves like 'Text.Gigaparsec.filterS', except the error message generated is fine-tuned with+respect to the parser's result and width of input consumed, using the 'ErrorGen'.++First, parse @p@. +If it succeeds then take its result @x@ and apply it to the predicate @pred@. ++* If @pred x@ is true, then return @x@. +* If @pred x@ is false, the combinator fails and produces an error message descrbied by the given 'ErrorGen'.++If @p@ failed, this combinator fails without using the given 'ErrorGen'.+ @since 0.2.2.0 -}-filterSWith :: ErrorGen a -> (a -> Bool) -> Parsec a -> Parsec a+filterSWith :: ErrorGen a  -- ^ the generator for the error message when @p@ succeeds but @pred@ fails.+            -> (a -> Bool) -- ^ @pred@, the predicate that is tested against the result of @p@+            -> Parsec a    -- ^ @p@, the parser to test+            -> Parsec a    -- ^ a parser that returns the result of @p@ if it passes the predicate. filterSWith errGen f p = amendThenDislodgeBy 1 $ withWidth (entrench p) >>= \(x, w) ->   if f x then pure x else ErrorGen.asErr errGen x w -{-+{-|+Filters the result of the given parser @p@ using a given function @f@, succeeding only if @pred@ returns @Nothing@.++First, parse @p@. +If it succeeds then take its result @x@ and apply it to the predicate @pred@. ++* If @pred x@ is 'Nothing', then return @x@. +* If @pred x@ is @'Just' reason@, the combinator fails, and produces a /vanilla/ error with the given @reason@.++If @p@ failed, this combinator fails in the same way.++This is useful for performing data validation, +but where a definitive reason can be given for the failure. +In this instance, the rest of the error message is generated as normal, +with the expected and unexpected components still given, along with any other generated reasons.+ @since 0.2.2.0 -}-filterOut :: (a -> Maybe String) -> Parsec a -> Parsec a+filterOut :: (a -> Maybe String) -- ^ @f@, the function that produces a reason for values we wish to filter out+          -> Parsec a            -- ^ @p@, the parser to filter+          -> Parsec a            -- ^ a parser that returns @x@, the result of @p@, only when @f x@ is 'Nothing'. filterOut p =   filterSWith (vanillaGen { ErrorGen.reason = p }) (isNothing . p) -{-+{-|+This combinator filters the result of the given parser using the given partial-predicate, succeeding only when the predicate returns 'Nothing'.++First, run the given parser @p@. +If it succeeds with result @x@, then apply the given partial-predicate @pred@:++* If @pred x@ is 'Nothing', the parser succeeds, returning @x@. +* If @pred x@ is @'Just' msgs@, the parser fails, producing a /specialised/ error only consisting of the messages @msgs@.++This is useful for performing data validation, but where failure is not tied to the grammar +but some other property of the results.++Where 'guardAgainst' shines, however, is in scenarios where the expected alternatives, +or the unexpected component itself distracts from the cause of the error, or is irrelevant in some way. +This might be because 'guardAgainst' is checking some property of the data that is possible to encode in the grammar, +but otherwise impractical, either because it is hard to maintain or generates poor error messages for the user.+ @since 0.2.2.0 -} -- FIXME: 0.3.0.0 change to NonEmptyList-guardAgainst :: (a -> Maybe [String]) -> Parsec a -> Parsec a+guardAgainst :: (a -> Maybe [String]) -- ^ @pred@, the predicate that is tested against the parser result, which also generates errors. +             -> Parsec a              -- ^ @p@, the parser to test against. +             -> Parsec a              -- ^ a parser that returns the result of @p@ if it fails the @pred@. guardAgainst p =   filterSWith (specializedGen { ErrorGen.messages = fromJust . p }) (isNothing . p) -{-+{-|+This combinator filters the result of the given parser using the given partial-predicate, +succeeding only when the predicate is undefined.++First, run the given parser @p@. +If it succeeds with result @x@, apply the given partial-predicate, @pred@:++* If @pred x@ is 'Nothing', the parser succeeds, returning x. +* If @pred x@ is @'Just' lbl@, the parser fails using 'unexpected' with the label @lbl@.++If @p@ fails, then this combinator also fails.++This is useful for performing data validation where failure results in the entire token being unexpected. +In this instance, the rest of the error message is generated as normal, with the expected components still given, +along with any generated reasons.++ @since 0.2.2.0 -}-unexpectedWhen :: (a -> Maybe String) -> Parsec a -> Parsec a+unexpectedWhen :: (a -> Maybe String) -- ^ @pred@, the predicate that is tested against the parser result, which also generates errors. +               -> Parsec a            -- ^ @p@, the parser to test against. +               -> Parsec a            -- ^ a parser that returns the result of @p@ if it fails the @pred@. unexpectedWhen p =   filterSWith (vanillaGen { ErrorGen.unexpected = ErrorGen.NamedItem . fromJust . p }) (isNothing . p) -{-+{-|+This combinator filters the result of the given parser using the given partial-predicate, +succeeding only when the predicate is undefined.++First, run the given parser @p@. +If it succeeds with result @x@, apply the given partial-predicate, @pred@:++* If @pred x@ is 'Nothing', the parser succeeds, returning x. +* If @pred x@ is @'Just' (lbl, rsn)@, the parser fails using the unexpected label @lbl@ and reason @rsn@.++If @p@ fails, then this combinator also fails.++This is useful for performing data validation where failure results in the entire token being unexpected. +In this instance, the rest of the error message is generated as normal, with the expected components still given, +along with any generated reasons.+ @since 0.2.2.0 -}-unexpectedWithReasonWhen :: (a -> Maybe (String, String)) -> Parsec a -> Parsec a+unexpectedWithReasonWhen +  :: (a -> Maybe (String, String)) -- ^ @pred@, the predicate that is tested against the parser result, which also generates errors.+  -> Parsec a                      -- ^ @p@, the parser to test against.+  -> Parsec a                      -- ^ a parser that returns the result of @p@ if it fails the @pred@. unexpectedWithReasonWhen p =   filterSWith (vanillaGen { ErrorGen.unexpected = ErrorGen.NamedItem . fst . fromJust . p                           , ErrorGen.reason = fmap snd . p                           }) (isNothing . p)  -- this is called mapFilter in Scala... there is no collect counterpart-{-+{-|+This combinator applies a function @f@ to the result of a parser @p@: if it returns+@'Just' y@, @y@ is returned.+If @p@ succeeds but @f@ returns 'Nothing', then this combinator produces an error message according to the given 'ErrorGen'.++Behaves like 'Text.Gigaparsec.mapMaybeS' with a customised error message.++First, run the given parser @p@. +If it succeeds, apply the function @f@ to the result @x@. ++* If @f x@ returns @'Just' y@, return @y@. +* If @f x@ returns @'Nothing'@, the combinator fails and produces an error message descrbied by the given 'ErrorGen'.++If @p@ failed, this combinator fails without using the given 'ErrorGen'.++This is a more efficient way of performing a @filterS@ and @fmap@ at the same time.+ @since 0.2.2.0 -}-mapMaybeSWith :: ErrorGen a -> (a -> Maybe b) -> Parsec a -> Parsec b+mapMaybeSWith :: ErrorGen a     -- ^ how to generate error messages based on the result of this parser.+              -> (a -> Maybe b) -- ^ @f@, the function used to both filter and transform the result of @p@.+              -> Parsec a       -- ^ @p@, the parser to filter+              -> Parsec b       -- ^ a parser which returns the result of @p@ applied to @f@, if possible. mapMaybeSWith errGen f p = amendThenDislodgeBy 1 $ withWidth (entrench p) >>= \(x, w) ->   maybe (ErrorGen.asErr errGen x w) pure (f x) -{-+{-|+This combinator conditionally transforms the result of this parser with a given function: +if a @'Left' xs@ is returned, it generates an error with the messages @xs@; otherwise returns @y@ for the result @'Right' y@.++First, run the given parser @p@. +If it succeeds, apply the function @f@ to the result @x@. ++* If @f x@ returns @'Right' y@, return @y@. +* If @f x@ returns @'Left' xs@, the combinator fails with the error messages @xs@.++If @p@ failed, this combinator also fails.+ @since 0.2.4.0 -}-mapEitherS :: (a -> Either (NonEmpty String) b) -> Parsec a -> Parsec b+mapEitherS  :: (a -> Either (NonEmpty String) b) +                        -- ^ @f@, the predicate that is tested against the parser result.+            -> Parsec a -- ^ @p@, the parser to test against the predicate+            -> Parsec b -- ^ a parser which returns the result of @p@ applied to @f@, if possible. mapEitherS f p = amendThenDislodgeBy 1 $ withWidth (entrench p) >>= \(x, w) ->   either (failWide w) pure (f x)

@@ -1,6 +1,18 @@ {-# LANGUAGE Trustworthy #-} {-# LANGUAGE DerivingVia, OverloadedStrings #-} {-# OPTIONS_GHC -Wno-missing-import-lists #-}+{-|+Module      : Text.Gigaparsec.Errors.DefaultErrorBuilder+Description : This module defines Gigaparsec's default error messages.+License     : BSD-3-Clause+Maintainer  : Jamie Willis, Gigaparsec Maintainers+Stability   : stable++This module defines Gigaparsec's default error messages.+The actual 'Text.Gigaparsec.Errors.ErrorBuilder.ErrorBuilder' class instance is found in +"Text.Gigaparsec.Errors.ErrorBuilder".++-} module Text.Gigaparsec.Errors.DefaultErrorBuilder (module Text.Gigaparsec.Errors.DefaultErrorBuilder) where  import Prelude hiding (lines)@@ -14,6 +26,7 @@  -- For now, this is the home of the default formatting functions +-- | A string-builder is an efficient way of constructing a string through a series of concatenations. type StringBuilder :: * newtype StringBuilder = StringBuilder (String -> String)   deriving (Semigroup, Monoid) via Endo String@@ -24,61 +37,98 @@   fromString str = StringBuilder (str ++)  {-# INLINE toString #-}+-- | Runs the given string-builder, producing a string. toString :: StringBuilder -> String toString (StringBuilder build) = build mempty  {-# INLINE from #-}+-- | Create a string-builder which starts with the string representation of the given argument. from :: Show a => a -> StringBuilder from = StringBuilder . shows +{-|+Forms an error message with 'blockError', with two spaces of indentation and incorporating +the source file and position into the header.+-} {-# INLINABLE buildDefault #-} buildDefault :: StringBuilder -> Maybe StringBuilder -> [StringBuilder] -> String buildDefault pos source lines = toString (blockError header lines 2)   where header = maybe mempty (\src -> "In " <> src <> " ") source <> pos +{-|+Forms a vanilla error by combining all the components in sequence, if there is no information other than the lines,+"unknown parse error" is used instead.+-} {-# INLINABLE vanillaErrorDefault #-} vanillaErrorDefault :: Foldable t => Maybe StringBuilder -> Maybe StringBuilder -> t StringBuilder -> [StringBuilder] -> [StringBuilder] vanillaErrorDefault unexpected expected reasons =   combineInfoWithLines (maybe id (:) unexpected (maybe id (:) expected (toList reasons))) +{-|+Forms a specialized error by combining all components in sequence, if there are no msgs, then "unknown parse error" is used instead.+-} {-# INLINABLE specialisedErrorDefault #-} specialisedErrorDefault :: [StringBuilder] -> [StringBuilder] -> [StringBuilder] specialisedErrorDefault = combineInfoWithLines +{-|+Joins together the given sequences: if the first is empty, then "unknown parse error" is prepended onto lines instead.+-} {-# INLINABLE combineInfoWithLines #-} combineInfoWithLines :: [StringBuilder] -> [StringBuilder] -> [StringBuilder] combineInfoWithLines [] lines = "unknown parse error" : lines combineInfoWithLines info lines = info ++ lines +{-|+Encloses the item in double-quotes.+-} --TODO: this needs to deal with whitespace and unprintables+{-+If the given item is either a whitespace character or is otherwise "unprintable", +a special name is given to it, otherwise the item is enclosed in double-quotes.+-} {-# INLINABLE rawDefault #-} rawDefault :: String -> String rawDefault n = "\"" <> n <> "\"" +-- | Returns the given name unchanged. {-# INLINABLE namedDefault #-} namedDefault :: String -> String namedDefault = id +-- | Simply displays "end of input" {-# INLINABLE endOfInputDefault #-} endOfInputDefault :: String endOfInputDefault = "end of input" +-- | Returns the given message unchanged. {-# INLINABLE messageDefault #-} messageDefault :: String -> String messageDefault = id +-- | Adds "expected " before the given alternatives, should they exist. {-# INLINABLE expectedDefault #-} expectedDefault :: Maybe StringBuilder -> Maybe StringBuilder expectedDefault = fmap ("expected " <>) +-- | Adds "unexpected " before the unexpected item. {-# INLINABLE unexpectedDefault #-} unexpectedDefault :: Maybe String -> Maybe StringBuilder unexpectedDefault = fmap (("unexpected " <>) . fromString) +{-|+Combines the alternatives, separated by commas/semicolons, with the final two separated by "or". +If the elements contain a comma, then semicolon is used as the list separator.+-} {-# INLINABLE disjunct #-} disjunct :: Bool -> [String] -> Maybe StringBuilder disjunct oxford elems = junct oxford elems "or" +{-|+Combines the alternatives, separated by commas/semicolons, with the final two separated by "or". +An Oxford comma is added if there are more than two elements, as this helps prevent ambiguity in the list. +If the elements contain a comma, then semicolon is used as the list separator.+-} {-# INLINABLE junct #-} junct :: Bool -> [String] -> String -> Maybe StringBuilder junct oxford elems junction = junct' (sortBy (comparing Down) elems)@@ -100,19 +150,32 @@               | oxford    = fromString delim <> j <> " " <> fromString l               | otherwise = " " <> j <> " " <> fromString l +{-|+Filters out any empty messages and returns the rest.+-} {-# INLINABLE combineMessagesDefault #-} combineMessagesDefault :: Foldable t => t String -> [StringBuilder] combineMessagesDefault = mapMaybe (\msg -> if null msg then Nothing else Just (fromString msg)) . toList +{-|+Forms an error with the given header followed by a colon, a newline, then the remainder of the lines indented.+-} {-# INLINABLE blockError #-} blockError :: StringBuilder -> [StringBuilder] -> Int -> StringBuilder blockError header lines indent = header <> ":\n" <> indentAndUnlines lines indent +{-|+Indents and concatenates the given lines by the given depth.+-} {-# INLINABLE indentAndUnlines #-} indentAndUnlines :: [StringBuilder] -> Int -> StringBuilder indentAndUnlines lines indent = fromString pre <> intercalate (fromString ('\n' : pre)) lines   where pre = replicate indent ' ' +{-|+Constructs error context by concatenating them together with a "caret line" +underneath the focus line, line, where the error occurs.+-} {-# INLINABLE lineInfoDefault #-} lineInfoDefault :: String -> [String] -> [String] -> Word -> Word -> Word -> [StringBuilder] lineInfoDefault curLine beforeLines afterLines _line pointsAt width =@@ -122,6 +185,9 @@         caretLine :: StringBuilder         caretLine = fromString (replicate (fromIntegral (pointsAt + 1)) ' ') <> fromString (replicate (fromIntegral width) '^') +{-|+Pairs the line and column up in the form @(line m, column n)@.+-} {-# INLINABLE posDefault #-} posDefault :: Word -> Word -> StringBuilder posDefault line col = "(line "

@@ -2,13 +2,14 @@ {-# LANGUAGE TypeFamilies, AllowAmbiguousTypes, FlexibleInstances, FlexibleContexts #-} {-| Module      : Text.Gigaparsec.Errors.ErrorBuilder-Description : This typeclass specifies how to generate an error from a parser as a specified type.+Description : This module defines the ErrorBuilder typeclass, which specifies how to generate +              an error from a parser as a specified type. License     : BSD-3-Clause Maintainer  : Jamie Willis, Gigaparsec Maintainers Stability   : stable -This typeclass specifies how to generate an error from a parser-as a specified type.+This module defines the ErrorBuilder typeclass, which specifies how to generate +an error from a parser as a specified type.  An instance of this typeclass is required when calling 'Text.Gigaparsec.parse' (or similar). By default, @gigaparsec@ defines its own instance for@@ -21,101 +22,190 @@ the basics of formatting without having to define the entire instance, use the methods found in "Text.Gigaparsec.Errors.DefaultErrorBuilder". -= How an Error is Structured-There are two kinds of error messages that are generated by @gigaparsec@:-/Specialised/ and /Vanilla/. These are produced by different combinators-and can be merged with other errors of the same type if both errors appear-at the same offset. However, /Specialised/ errors will take precedence-over /Vanilla/ errors if they appear at the same offset. The most-common form of error is the /Vanilla/ variant, which is generated by-most combinators, except for some in "Text.Gigaparsec.Errors.Combinator".--Both types of error share some common structure, namely:+@since 0.2.0.0+-}+-- TODO: at 0.3.0.0, remove the Token re-export, because hs-boot doesn't carry docs+module Text.Gigaparsec.Errors.ErrorBuilder (+  -- * How an Error is Structured+  {-|+  There are two kinds of error messages that are generated by @gigaparsec@:+  /Specialised/ and /Vanilla/. These are produced by different combinators+  and can be merged with other errors of the same type if both errors appear+  at the same offset. However, /Specialised/ errors will take precedence+  over /Vanilla/ errors if they appear at the same offset. The most+  common form of error is the /Vanilla/ variant, which is generated by+  most combinators, except for some in "Text.Gigaparsec.Errors.Combinator". -  - The error preamble, which has the file and the position.-  - The content lines, the specifics of which differ between the two types of error.-  - The context lines, which has the surrounding lines of input for contextualisation.+  Both types of error share some common structure, namely: -== /Vanilla/ Errors-There are three kinds of content line found in a /Vanilla/ error:+    - The error preamble, which has the file and the position.+    - The content lines, the specifics of which differ between the two types of error.+    - The context lines, which has the surrounding lines of input for contextualisation.+  -}+  -- ** /Vanilla/ Errors+  {-|+  There are three kinds of content line found in a /Vanilla/ error: -  1. Unexpected info: this contains information about the kind of token that caused the error.-  2. Expected info: this contains the information about what kinds of token could have avoided the error.-  3. Reasons: these are the bespoke reasons that an error has occurred (as generated by 'Text.Gigaparsec.Errors.Combinator.explain').+    1. Unexpected info: this contains information about the kind of token that caused the error.+    2. Expected info: this contains the information about what kinds of token could have avoided the error.+    3. Reasons: these are the bespoke reasons that an error has occurred (as generated by 'Text.Gigaparsec.Errors.Combinator.explain'). -There can be at most one unexpected line, at most one expected line, and zero or more reasons.-Both of the unexpected and expected info are built up of /error items/, which are either:-the end of input, a named token, raw input taken from the parser definition. These can all be-formatted separately.+  There can be at most one unexpected line, at most one expected line, and zero or more reasons.+  Both of the unexpected and expected info are built up of /error items/, which are either:+  the end of input, a named token, raw input taken from the parser definition. These can all be+  formatted separately. -The overall structure of a /Vanilla/ error is given in the following diagram:+  The overall structure of a /Vanilla/ error is given in the following diagram: -> ┌───────────────────────────────────────────────────────────────────────┐-> │   Vanilla Error                                                       │-> │                          ┌────────────────┐◄──────── position         │-> │                  source  │                │                           │-> │                     │    │   line      col│                           │-> │                     ▼    │     │         ││                           │-> │                  ┌─────┐ │     ▼         ▼│   end of input            │-> │               In foo.txt (line 1, column 5):       │                  │-> │                 ┌─────────────────────┐            │                  │-> │unexpected ─────►│                     │            │  ┌───── expected │-> │                 │          ┌──────────┐ ◄──────────┘  │               │-> │                 unexpected end of input               ▼               │-> │                 ┌──────────────────────────────────────┐              │-> │                 expected "(", "negate", digit, or letter              │-> │                          │    └──────┘  └───┘     └────┘ ◄────── named│-> │                          │       ▲        └──────────┘ │              │-> │                          │       │                     │              │-> │                          │      raw                    │              │-> │                          └─────────────────┬───────────┘              │-> │                 '-' is a binary operator   │                          │-> │                 └──────────────────────┘   │                          │-> │                ┌──────┐        ▲           │                          │-> │                │>3+4- │        │           expected items             │-> │                │     ^│        │                                      │-> │                └──────┘        └───────────────── reason              │-> │                   ▲                                                   │-> │                   │                                                   │-> │                   line info                                           │-> └───────────────────────────────────────────────────────────────────────┘+  > ┌───────────────────────────────────────────────────────────────────────┐+  > │   Vanilla Error                                                       │+  > │                          ┌────────────────┐◄──────── position         │+  > │                  source  │                │                           │+  > │                     │    │   line      col│                           │+  > │                     ▼    │     │         ││                           │+  > │                  ┌─────┐ │     ▼         ▼│   end of input            │+  > │               In foo.txt (line 1, column 5):       │                  │+  > │                 ┌─────────────────────┐            │                  │+  > │unexpected ─────►│                     │            │  ┌───── expected │+  > │                 │          ┌──────────┐ ◄──────────┘  │               │+  > │                 unexpected end of input               ▼               │+  > │                 ┌──────────────────────────────────────┐              │+  > │                 expected "(", "negate", digit, or letter              │+  > │                          │    └──────┘  └───┘     └────┘ ◄────── named│+  > │                          │       ▲        └──────────┘ │              │+  > │                          │       │                     │              │+  > │                          │      raw                    │              │+  > │                          └─────────────────┬───────────┘              │+  > │                 '-' is a binary operator   │                          │+  > │                 └──────────────────────┘   │                          │+  > │                ┌──────┐        ▲           │                          │+  > │                │>3+4- │        │           expected items             │+  > │                │     ^│        │                                      │+  > │                └──────┘        └───────────────── reason              │+  > │                   ▲                                                   │+  > │                   │                                                   │+  > │                   line info                                           │+  > └───────────────────────────────────────────────────────────────────────┘ +  -}+  -- ** /Specialised/ Errors+  {-|+  There is only one kind of content found in a /Specialised/ error:+  a message. These are completely free-form, and are generated by the+  'Text.Gigaparsec.Errors.Combinator.failWide' combinator, as well as its derived combinators.+  There can be one or more messages in a /Specialised/ error. -== /Specialised/ Errors-There is only one kind of content found in a /Specialised/ error:-a message. These are completely free-form, and are generated by the-'Text.Gigaparsec.Errors.Combinator.failWide' combinator, as well as its derived combinators.-There can be one or more messages in a /Specialised/ error.+  The overall structure of a /Specialised/ error is given in the following diagram: -The overall structure of a /Specialised/ error is given in the following diagram:+  > ┌───────────────────────────────────────────────────────────────────────┐+  > │   Specialised Error                                                   │+  > │                          ┌────────────────┐◄──────── position         │+  > │                  source  │                │                           │+  > │                     │    │   line       col                           │+  > │                     ▼    │     │         │                            │+  > │                  ┌─────┐ │     ▼         ▼                            │+  > │               In foo.txt (line 1, column 5):                          │+  > │                                                                       │+  > │           ┌───► something went wrong                                  │+  > │           │                                                           │+  > │ message ──┼───► it looks like a binary operator has no argument       │+  > │           │                                                           │+  > │           └───► '-' is a binary operator                              │+  > │                ┌──────┐                                               │+  > │                │>3+4- │                                               │+  > │                │     ^│                                               │+  > │                └──────┘                                               │+  > │                   ▲                                                   │+  > │                   │                                                   │+  > │                   line info                                           │+  > └───────────────────────────────────────────────────────────────────────┘ -> ┌───────────────────────────────────────────────────────────────────────┐-> │   Specialised Error                                                   │-> │                          ┌────────────────┐◄──────── position         │-> │                  source  │                │                           │-> │                     │    │   line       col                           │-> │                     ▼    │     │         │                            │-> │                  ┌─────┐ │     ▼         ▼                            │-> │               In foo.txt (line 1, column 5):                          │-> │                                                                       │-> │           ┌───► something went wrong                                  │-> │           │                                                           │-> │ message ──┼───► it looks like a binary operator has no argument       │-> │           │                                                           │-> │           └───► '-' is a binary operator                              │-> │                ┌──────┐                                               │-> │                │>3+4- │                                               │-> │                │     ^│                                               │-> │                └──────┘                                               │-> │                   ▲                                                   │-> │                   │                                                   │-> │                   line info                                           │-> └───────────────────────────────────────────────────────────────────────┘+  -}+  -- * The Error Builder API+  -- ** Top-Level Construction+  {-|+  These methods help assemble the final products of the error messages. +  The 'build' method will return the desired @err@ types, +  whereas 'specialisedError' and 'vanillaError' both assemble an 'ErrorInfoLines' that +  the 'build' method can consume.+  +  * 'ErrorInfoLines'+  * 'build'+  * 'specialisedError'+  * 'vanillaError'+  -} -@since 0.2.0.0--}--- TODO: at 0.3.0.0, remove the Token re-export, because hs-boot doesn't carry docs-module Text.Gigaparsec.Errors.ErrorBuilder (ErrorBuilder(..), Token(..)) where+  -- ** Error Preamble+  {-|+  These methods control the construction of the preamble of an error message, +  consisting of the position and source info. +  These are then consumed by 'build' itself.+  +  * 'Position'+  * 'Source'+  * 'pos'+  * 'source'+  -}+  -- ** Contextual Input Lines+  {-|+  These methods control how many lines of input surrounding the error are requested, +  and direct how these should be put together to form a 'LineInfo'.+  +  * 'LineInfo'+  * 'lineInfo'+  * 'numLinesAfter'+  * 'numLinesBefore'+  -}+  -- ** Shared Components+  {-|+  These methods control any components or structure shared by both types of messages. +  In particular, the representation of reasons and messages is shared, +  as well as how they are combined together to form a unified block of content lines.+  +  * 'Message'+  * 'Messages'+  * 'combineMessages'+  -}+  -- ** Specialized-Specific Components+  {-|+  These methods control the /Specialized/-specific components, +  namely the construction of a bespoke error message.+  +  * 'message'+  -}+  -- ** Vanilla-Specific Components+  {-|+  These methods control the /Vanilla/-specific error components, +  namely how expected error items should be combined, +  how to represent the unexpected line, +  and how to represent reasons generated from 'Text.Gigaparsec.Errors.Combinator.explain'.+  +  * 'ExpectedItems'+  * 'ExpectedLine'+  * 'UnexpectedLine'+  * 'combineExpectedItems'+  * 'expected'+  * 'reason'+  * 'unexpected'+  -}+  -- ** Error Items+  {-|+  These methods control how error items within /Vanilla/ errors are constructed. +  These are either the end of input, a named label generated by the +  'Text.Gigaparsec.Errors.Combinator.label' combinator, +  or a raw piece of input intrinsically associated with a combinator.+  * 'Item'+  * 'endOfInput'+  * 'named'+  * 'raw'+  * 'unexpectedToken' +  -}+  -- * Documentation+  -- ** Error Builder+  ErrorBuilder(..),+  -- ** Tokens+  Token(..)+  ) where  import Text.Gigaparsec.Errors.DefaultErrorBuilder ( StringBuilder, buildDefault                                                   , vanillaErrorDefault, specialisedErrorDefault@@ -136,7 +226,7 @@  {-| This class describes how to construct an error message generated by a parser in-a represention the parser writer desires.+a represention, @err@, the parser writer desires. -} type ErrorBuilder :: * -> Constraint class Ord (Item err) => ErrorBuilder err where@@ -293,6 +383,11 @@ {-| Builds error messages as @String@, using the functions found in "Text.Gigaparsec.Errors.DefaultErrorBuilder".++While this comes with 'ErrorBuilder' typeclass, it should not be considered a stable contract: +the formatting can be changed at any time and without notice. +The API, however, will remain stable.+ -} instance ErrorBuilder String where   {-# INLINE build #-}

@@ -1,45 +1,117 @@ {-# LANGUAGE Safe #-} {-# LANGUAGE OverloadedLists, RecordWildCards #-} {-# OPTIONS_GHC -Wno-partial-fields #-}+{-|+Module      : Text.Gigaparsec.Expr+Description : This module can be used to generate hand-tuned error messages without using monadic bind.+License     : BSD-3-Clause+Maintainer  : Jamie Willis, Gigaparsec Maintainers+Stability   : experimental++This module can be used to generate hand-tuned error messages without using monadic bind.++-} module Text.Gigaparsec.Errors.ErrorGen (-    ErrorGen(..), UnexpectedItem(..), asFail, asSelect, asErr, vanillaGen, specializedGen+    -- * Documentation+    -- ** Error Generators+    ErrorGen(..),+    UnexpectedItem(..), +    -- *** Blank Generators+    vanillaGen, specializedGen,+    -- ** Error Generating Combinators+    {-|+    These combinators create parsers that fail or raise errors with messages desribed by a given 'ErrorGen'.+    -}+    asFail, asSelect, asErr,    ) where import Text.Gigaparsec.Internal (Parsec) import Text.Gigaparsec.Internal qualified as Internal (Parsec(Parsec), State, specialisedErr, emptyErr, expectedErr, unexpectedErr, raise) import Text.Gigaparsec.Internal.Errors qualified as Internal (Error, CaretWidth(RigidCaret), addReason) +{-|+This type describes special primitives that can use the results of a previous parser +to form and raise an error message. +This is not something that is normally possible with raw combinators, without using '(>>=)', +which is expensive.++Primarily, these are designed to be used with +'Text.Gigaparsec.Errors.Combinator.filterSWith'\/'Text.Gigaparsec.Errors.Patterns.verifiedWith'\/'Text.Gigaparsec.Errors.Patterns.preventWith'+but can be used in other parsers as well. +-} type ErrorGen :: * -> *-data ErrorGen a = SpecializedGen { messages :: a -> [String] -- FIXME: 0.3.0.0 change to NonEmptyList-                                 , adjustWidth :: a -> Word -> Word-                                 }-                | VanillaGen { unexpected :: a -> UnexpectedItem-                             , reason :: a -> Maybe String-                             , adjustWidth :: a -> Word -> Word-                             }+data ErrorGen a +  -- | An error generator for /Specialized/ errors, which can tune the freeform messages of the error.+  = SpecializedGen { +      -- | Produces the messages of the error message when given the result of the offending parser. +      messages :: a -> [String] -- FIXME: 0.3.0.0 change to NonEmptyList.+      -- | Controls how wide an error is based on the value @a@ and width @Word@ provided.+    , adjustWidth :: a -> Word -> Word+    }+  -- | An error generator for /Vanilla/ errors, which can tune the unexpected message and a generated reason.+  | VanillaGen { +      -- | Produces the unexpected component (if any) of the error message when given the result of the offending parser.+      unexpected :: a -> UnexpectedItem+      -- | Produces the reason component (if any) of the error message when given the result of the offending parser.+    , reason :: a -> Maybe String+    , adjustWidth :: a -> Word -> Word+    } +-- | A blank /Vanilla/ error generator, which does not affect the unexpected message or reason. vanillaGen :: ErrorGen a vanillaGen = VanillaGen { unexpected = const EmptyItem                         , reason = const Nothing                         , adjustWidth = const id                         } +-- | The default /Specialized/ error generator, which does not affect the error message. specializedGen :: ErrorGen a specializedGen = SpecializedGen { messages = const []                                 , adjustWidth = const id                                 } +{-|+This type describes how to form the unexpected component of a vanilla error message from a 'VanillaGen'.++This includes the different sorts of 'unexpected item' messages that may occur;+whether to display the expected characters, a name for the expected expression, or not to display at all.+-} type UnexpectedItem :: *-data UnexpectedItem = RawItem | EmptyItem | NamedItem String+data UnexpectedItem +  -- | The error should use whatever input was consumed by the offending parser, verbatim.+  = RawItem +  -- | The error should not have an unexpected component at all (as in 'Text.Gigaparsec.filterS').+  | EmptyItem +  -- | The error should use the given name as the unexpected component.+  | NamedItem String -asErr :: ErrorGen a -> a -> Word -> Parsec b+{-|+Given a parser result and its width, raise an error according to the given error generator.+-}+asErr :: ErrorGen a -- ^ @errGen@, the generator for the error message to raise.+      -> a          -- ^ @x@, the result of the offending parser+      -> Word       -- ^ The width of the parsed result, @x@.+      -> Parsec b   -- ^ A parser that unconditionally raises an error described by @errGen@. asErr errGen x w = Internal.raise $ \st -> genErr errGen st x w -asFail :: ErrorGen a -> Parsec (a, Word) -> Parsec b+{-|+This combinator takes a given parser @p@ and unconditionally fails with a message based on @p@'s results.+-}+asFail  :: ErrorGen a       -- ^ @errGen@, the generator for the error message.+        -> Parsec (a, Word) -- ^ @p@, a parser that returns a result @x@ and its width @w@.+        -> Parsec b         -- ^ A parser that unconditionally fails with a message described by @errGen@, +                            --   using the result of @p@. asFail errGen (Internal.Parsec p) = Internal.Parsec $ \st _ bad ->   let good (x, w) st' = bad (genErr errGen st' x w) st'   in  p st good bad -asSelect :: ErrorGen a -> Parsec (Either (a, Word) b) -> Parsec b+{-|+This combinator takes a given parser @p@ and, if @p@ returns an @a@, +fails with a message based on this result.+-}+asSelect  :: ErrorGen a                  -- ^ @errGen@, the generator for the error message.+          -> Parsec (Either (a, Word) b) -- ^ @p@, a parser which may produce a bad result of type @a@+          -> Parsec b                    -- ^ A parser that fails if @p@ produces a bad result, +                                         --   otherwise returns the result of @p@ if it is a @b@ asSelect errGen (Internal.Parsec p) = Internal.Parsec $ \st good bad ->   let good' (Right x) st' = good x st'       good' (Left (x, w)) st' = bad (genErr errGen st' x w) st'

@@ -1,10 +1,54 @@ {-# LANGUAGE Safe #-} {-# OPTIONS_GHC -Wno-incomplete-record-updates #-}+{-|+Module      : Text.Gigaparsec.Errors.Patterns+Description : This module contains combinators that help facilitate the error message generational patterns /Verified Errors/ and /Preventative Errors/.+License     : BSD-3-Clause+Maintainer  : Jamie Willis, Gigaparsec Maintainers+Stability   : experimental++This module contains combinators that help facilitate the error message generational patterns /Verified Errors/™ and /Preventative Errors/™.+-} module Text.Gigaparsec.Errors.Patterns (+    -- ** Verified Errors+    {-|+    These are combinators related to the /Verified Errors/ parser design pattern.++    They allow for the parsing of known illegal values, providing richer error messages in case they succeed.+    -}+    {-| ==== __Note__+    The following applies to each of the @verified\<...\>@ combinators:++    When this combinator fails (and not this parser itself), it will generate errors rooted +    at the start of the parse (as if 'amend' had been used) and the caret will span the +    entire successful parse of this parser.++    When this parser is not to be considered as a terminal error, use atomic around the entire+    combinator to allow for backtracking if this parser succeeds (and therefore fails).+    -}     verifiedWith,-    verifiedFail, verifiedUnexpected, verifiedExplain,+    verifiedFail, +    verifiedUnexpected, +    verifiedExplain,+    -- ** Preventative Errors+    {-|+    These are combinators related to the /Preventative Errors/ parser design pattern.++    They allow for the parsing of known illegal values, providing richer error messages in case they succeed.+    -}+    {-| ==== __Note__+    The following applies to each of the @verified\<...\>@ combinators:++    When this combinator fails (and not this parser itself), it will generate errors rooted +    at the start of the parse (as if 'amend' had been used) and the caret will span the +    entire successful parse of this parser.++    When this parser is not to be considered as a terminal error, use atomic around the entire+    combinator to allow for backtracking if this parser succeeds (and therefore fails).+    -}     preventWith,-    preventativeFail, preventativeExplain+    preventativeFail, +    preventativeExplain   ) where  import Text.Gigaparsec (Parsec, atomic, (<+>), unit)@@ -16,10 +60,20 @@     vanillaGen, specializedGen, unexpected, reason, messages   ) -{-+{-|+Ensures this parser does not succeed, failing with an error as described by the given 'ErrorGen' object.++If this parser succeeds, input is consumed and this combinator will fail, +producing an error message using the given 'ErrorGen' with width the same as the parsed data. +However, if this parser fails, no input is consumed and an empty error is generated. ++This parser will produce no labels if it fails.+ @since 0.2.3.0 -}-verifiedWith :: ErrorGen a -> Parsec a -> Parsec b+verifiedWith :: ErrorGen a -- ^ @err@, the generator that produces the error message.+             -> Parsec a   -- ^ @p@, the parser for the bad input.+             -> Parsec b   -- ^ a parser that ensures @p@ fails, otherwise it raises an error described by @err@. verifiedWith err p = amend (ErrorGen.asFail err (hide (withWidth (atomic p))))  verifiedWithVanilla :: (a -> ErrorGen.UnexpectedItem) -> (a -> Maybe String) -> Parsec a -> Parsec b@@ -32,31 +86,74 @@ verifiedWithVanillaRaw :: (a -> Maybe String) -> Parsec a -> Parsec b verifiedWithVanillaRaw = verifiedWithVanilla (const ErrorGen.RawItem) -{-+{-|+Ensures this parser does not succeed, failing with a specialised error based on this parsers result if it does.++If this parser succeeds, input is consumed and this combinator will fail, +producing an error message based on the parsed result. +However, if this parser fails, no input is consumed and an empty error is generated. ++This parser will produce no labels if it fails.+ @since 0.2.3.0 -}-verifiedFail :: (a -> [String]) -> Parsec a -> Parsec b+verifiedFail :: (a -> [String]) -- ^ the function that generates the error messages from the parsed value.+             -> Parsec a        -- ^ @p@, the parser for the bad input.+             -> Parsec b        -- ^ a parser that ensures @p@ fails, otherwise it raises an error with +                                -- the given message based on the result. verifiedFail msggen = verifiedWith $   ErrorGen.specializedGen {     ErrorGen.messages = msggen   } -{-+{-|+Ensures this parser does not succeed, failing with a vanilla error with an unexpected message +and caret spanning the parse.++If this parser succeeds, input is consumed and this combinator will fail, +producing an unexpected message the same width as the parse. +However, if this parser fails, no input is consumed and an empty error is generated. ++This parser will produce no labels if it fails.+ @since 0.2.3.0 -}-verifiedUnexpected :: Parsec a -> Parsec b+verifiedUnexpected :: Parsec a -- ^ @p@, the parser for the bad input.+                   -> Parsec b -- ^ a parser that ensures @p@ fails, otherwise it raises an unexpected error. verifiedUnexpected = verifiedWithVanillaRaw (const Nothing) -{-+{-|+Ensures this parser does not succeed, failing with a vanilla error with an unexpected message +and caret spanning the parse and a reason generated from this parser's result.++If this parser succeeds, input is consumed and this combinator will fail, +producing an unexpected message the same width as the parse along with a reason generated from the successful parse. +However, if this parser fails, no input is consumed and an empty error is generated. +This parser will produce no labels if it fails.+ @since 0.2.3.0 -}-verifiedExplain :: (a -> String) -> Parsec a -> Parsec b+verifiedExplain :: (a -> String) -- ^ a function that produces a reason for the error given the parsed result.+                -> Parsec a      -- ^ @p@, the parser for the bad input.+                -> Parsec b      -- ^ a parser that ensures @p@ fails, otherwise it raises an error with +                                 -- the given reason based on the result. verifiedExplain reasongen = verifiedWithVanillaRaw (Just . reasongen) -{-+{-|+Ensures this parser does not succeed, failing with an error as described by the given ErrorGen object.++If this parser succeeds, input is consumed and this combinator will fail, +producing an error message using the given errGen with width the same as the +parsed data along with the given labels. +However, if this parser fails, no input is consumed and this combinator succeeds. +  +This parser will produce no evidence of running if it succeeds.+ @since 0.2.3.0 -}-preventWith :: ErrorGen a -> Parsec a -> Parsec ()+preventWith :: ErrorGen a -- ^ @err@, the generator that produces the error message.+            -> Parsec a   -- ^ @p@, the parser for the bad input.+            -> Parsec ()  -- ^ a parser that ensures @p@ fails, otherwise it raises an error described by @err@. preventWith err p = amend (ErrorGen.asSelect err (withWidth (hide (atomic p)) <+> unit))  preventWithVanilla :: (a -> ErrorGen.UnexpectedItem) -> (a -> Maybe String) -> Parsec a -> Parsec ()@@ -69,17 +166,39 @@ preventWithVanillaRaw :: (a -> Maybe String) -> Parsec a -> Parsec () preventWithVanillaRaw = preventWithVanilla (const ErrorGen.RawItem) -{-+{-|+Ensures this parser does not succeed, failing with a specialised error based on this parsers result if it does.++If this parser succeeds, input is consumed and this combinator will fail, +producing an error message based on the parsed result. +However, if this parser fails, no input is consumed and this combinator succeeds. +This parser will produce no evidence of running if it succeeds.+ @since 0.2.3.0 -}-preventativeFail :: (a -> [String]) -> Parsec a -> Parsec ()+preventativeFail :: (a -> [String]) -- ^ the function that generates the error messages from the parsed value.+                 -> Parsec a        -- ^ @p@, the parser for the bad input.+                 -> Parsec ()       -- ^ a parser that ensures @p@ fails, otherwise it raises an error with +                                    -- the given message based on the result. preventativeFail msggen = preventWith $   ErrorGen.specializedGen {     ErrorGen.messages = msggen   } -{-+{-|+Ensures this parser does not succeed, failing with a vanilla error with an unexpected message +and caret spanning the parse and a reason generated from this parser's result.++If this parser succeeds, input is consumed and this combinator will fail, +producing an unexpected message the same width as the parse along with a reason generated +from the successful parse along with the given labels. +However, if this parser fails, no input is consumed and this combinator succeeds. +This parser will produce no evidence of running if it succeeds.+ @since 0.2.3.0 -}-preventativeExplain :: (a -> String) -> Parsec a -> Parsec ()+preventativeExplain :: (a -> String) -- ^ a function that produces a reason for the error given the parsed result.+                    -> Parsec a      -- ^ @p@, the parser for the bad input.+                    -> Parsec ()     -- ^ a parser that ensures @p@ fails, otherwise it raises an unexpected error with +                                     -- the given reason based on the result. preventativeExplain reasongen = preventWithVanillaRaw (Just . reasongen)

@@ -1,7 +1,90 @@ {-# LANGUAGE Safe #-} {-# LANGUAGE GADTs #-}-module Text.Gigaparsec.Expr (module Text.Gigaparsec.Expr) where+{-|+Module      : Text.Gigaparsec.Expr+Description : This module contains various functionality relating to the parsing of expressions.+License     : BSD-3-Clause+Maintainer  : Jamie Willis, Gigaparsec Maintainers+Stability   : experimental +This module contains various functionality relating to the parsing of expressions.++It also includes functionality for constructing larger precedence tables, +which may even vary the type of each layer in the table, +allowing for strongly-typed expression parsing.+-}+module Text.Gigaparsec.Expr (+  -- ** Infix combinators+  {-|+  These are standalone Infix combinators. +  They are useful for parsing the application of operators to values in many different configurations, including: +  prefix, postfix, infix (left and right associated), and mixed fixity. ++  Although these combinators do have their uses, +  they are overshadowed by the 'precedence' combinator, +  which allows for the combining of multiple levels of infix-chaining in a clean and concise way.++  See "Text.Gigaparsec.Expr.Infix" and "Text.Gigaparsec.Expr.Chain" for more information on chaining combinators.+  -}+  -- *** Binary Operator Chains+  {-|+  These combinators allow for the chaining together of values and binary operators in either left-, +  right- or non-associative application.+  -}+  infixl1, infixr1, infixn1, +  -- *** Unary Operator Chains+  {-|+  These combinators allow for the chaining together, and application, of multiple +  prefix or postfix unary operators to a single value.+  -}+  prefix, postfix,+  -- ** Precedence Combinators+  {-|+  These combinators represent each of the different "shapes" of precedence combinator, +  which takes a description of the precedence relations between various operators and constructs a parser for them.+  -}+  precedence,+  precedence',+  -- ** Precedence Layer Builders+  {-|+  These are used to construct an individual layer of a precedence table. +  They all allow for the tying of a 'Fixity' to the parsers that inhabit the level, +  which will have type @'Op' a b@ for some @a@ (the type of the layer below) and @b@ (the type of this layer). +  'Op' uses existential types, so that the types of the parsers are only known when fixity itself is known. +  +  The different objects represent different inter-layer relationships: ++    * are they the same type? Use 'ops'; +    * is the layer below a subtype of this layer? use 'sops'; +    * or none of the above? Use 'gops'!+  -}+  ops, sops, gops,+  -- ** Fixity Description+  {-|+  These all describe the fixities and associativities of operators at a given level of the precedence table. +  They are special because they each encode an 'Op' type, +  which directs the type of the operators that are legal at the level (using existential types).+  -}+  Fixity(InfixL, InfixR, InfixN, Prefix, Postfix),+  -- ** Precedence Table Datatypes+  {-|+  These are the parts that make up a precedence table+   (in particular, they are used for heterogeneous expression parsing, +   with the types of each layer of the table vary from one another). +   +  These are (mostly) not constructed directly,+  but are instead constructed via the use of the Ops builders or the :+ and +: methods.+  -}+  Op(Op),+  Prec(Atom, Level),+  (>+),+  (+<),+  -- ** Module Re-export+  {-|+  This should be removed at some point.+  -}+  module Text.Gigaparsec.Expr) where+ import Text.Gigaparsec (Parsec) import Text.Gigaparsec.Combinator (choice) import Text.Gigaparsec.Expr.Infix (infixl1, infixr1, infixn1, prefix, postfix)@@ -9,31 +92,109 @@  import Data.List (foldl') +{-|+Denotes the fixity and associativity of an operator. ++Importantly, it also specifies the types of the operations themselves.+-} type Fixity :: * -> * -> * -> * data Fixity a b sig where+  -- | A left-associative binary Operator.   InfixL  :: Fixity a b (b -> a -> b)+  -- | A right-associative binary Operator.   InfixR  :: Fixity a b (a -> b -> b)+  -- | A non-associative binary Operators.   InfixN  :: Fixity a b (a -> a -> b)+  -- | A Unary prefix operator.   Prefix  :: Fixity a b (b -> b)+  -- | A Unary postfix operator.   Postfix :: Fixity a b (b -> b) +{-|+Describes a single layer of operators in the precedence tree.++The parameters are:++* @a@: the base tyep consumed by the operators.+* @b@: the type produced/consumed by the operators.+-} type Op :: * -> * -> *-data Op a b = forall sig. Op (Fixity a b sig) (a -> b) (Parsec sig)+data Op a b +  {-| +  Describes the operators at a specific level in the precedence tree, +  such that these ops consume @b@s, possibly @a@s and produce @b@s: +  this depends on the 'Fixity' of the operators.+  -}+  = forall sig. Op (Fixity a b sig) (a -> b) (Parsec sig) +{-|+The base type for precedence tables.++The parameter @a@ is the type of structure produced by the list of levels.++For more complex expression parser types, 'Prec' describes the precedence table whilst preserving the intermediate structure between each level.++The base of the table will always be an 'Atom', and each layer built on top of the last using the 'Level' constructor.+-} type Prec :: * -> * data Prec a where+  {-|+  Adds a new layer to this precedence table on the left, in a weakest-to-tightest ordering.++  This method associates to the left, so left-most applications are tighter binding +  (closer to the atoms) than those to the right.++  It should not be mixed with '(+<)', as this can be create a confusing and less predictable precedence table.+  -}   Level :: Prec a -> Op a b -> Prec b+  {-|+  The base of a precedence table.++  Forms the base of a precedence table, requiring at least one atom to be provided. This first atom will be parsed first.+  -}   Atom  :: Parsec a -> Prec a +{-|+Adds a new layer to this precedence table on the left, in a weakest-to-tightest ordering.+This is an alias for 'Level'.++This method associates to the left, so left-most applications are tighter binding +(closer to the atoms) than those to the right.++It should not be mixed with '(+<)', as this can be create a confusing and less predictable precedence table.+-} infixl 5 >+-(>+) :: Prec a -> Op a b -> Prec b+(>+) :: Prec a -- ^ the lower precedence table.+     -> Op a b -- ^ the operators that make up the new level on the table.+     -> Prec b -- ^ a new table that incorporates the operators and atoms in the given table, along with extra ops. (>+) = Level ++{-|+Adds a new layer to this precedence table on the right, in a tightest-to-weakest ordering.++This method associates to the right (with this table on the right!), +so right-most applications are tighter binding (closer to the atoms) than those to the left. ++It should not be mixed with '(>+)', as this can be create a confusing and less predictable precedence table.+-} infixr 5 +<-(+<) :: Op a b -> Prec a -> Prec b+(+<) :: Op a b -- ^ the lower precedence table. +     -> Prec a -- ^ the operators that make up the new level on the table. +     -> Prec b -- ^ a new table that incorporates the operators and atoms in the given table, along with extra ops. (+<) = flip (>+) -precedence :: Prec a -> Parsec a+{-|+Constructs a precedence parser.++This combinator builds an expression parser given a heterogeneous precedence table.++An expression parser will be formed by collapsing the given precedence table layer-by-layer. +Since this table is heterogeneous, each level of the table produces a difference type, +which is then consumed by the next level above.+-}+precedence  :: Prec a   -- ^ the description of the heterogeneous table, where each level can vary in output and input types.+            -> Parsec a -- ^ an expression parser for the described precedence table. precedence (Atom atom) = atom precedence (Level lvls lvl) = con (precedence lvls) lvl   where con :: Parsec a -> Op a b -> Parsec b@@ -43,14 +204,53 @@         con p (Op Prefix wrap op) = prefix wrap op p         con p (Op Postfix wrap op) = postfix wrap p op -precedence' :: Parsec a -> [Op a a] -> Parsec a+{-|+This combinator builds an expression parser given a collection of homogeneous atoms and operators.++An expression parser will be formed by treating the given parser as the base 'Atom', +then each successive layer in the given list as another 'Level' in a tightest-to-weakest binding.+This means the last element of the given list will be at the top of the precedence table.++Each level must consume and produce the same type.+-}+precedence' :: Parsec a -- ^ The atom at the base of the table.+            -> [Op a a] -- ^ The levels of operators, oredered tightest-to-weakest.+            -> Parsec a -- ^ An expression parser for the constructed precedence table. precedence' atom = precedence . foldl' (>+) (Atom atom) -gops :: Fixity a b sig -> (a -> b) -> [Parsec sig] -> Op a b+{-|+Constructs a single layer of operators @Op a b@, supporting fully heterogeneous precedence parsing.++This function builds an Ops object representing many operators found at the same precedence level, with a given fixity.++The operators found on the level constructed by this function are heterogeneous: +the type of the level below may vary from the types of the values produced at this level. +To make this work, a function must be provided that can transform the values from the +layer below into the types generated by this layer.++The fixity describes the shape of the operators expected.+-}+gops  :: Fixity a b sig -- ^ the fixity of the operators described.+      -> (a -> b)       -- ^ the function that will convert @a@s to @b@s.+                        -- this will be at right of a left-assoc chain, left of a right-assoc chain, or the root of a prefix/postfix chain.+      -> [Parsec sig]   -- ^ The operators themselves, provided variadically.+      -> Op a b         -- ^ A layer in the precedence table, containing the given parsers. gops fixity wrap = Op fixity wrap . choice -ops :: Fixity a a sig -> [Parsec sig] -> Op a a+{-|+Constructs a single layer of operators in the precedence tree.+-}+ops :: Fixity a a sig -- ^ The fixity of the layer to add.+    -> [Parsec sig]   -- ^ The parsers that can be run in this layer.+    -> Op a a         -- ^ A layer in the precedence table, containing the given parsers. ops fixity = gops fixity id -sops :: Subtype a b => Fixity a b sig -> [Parsec sig] -> Op a b+{-|+Constructs a single layer of operators in the precedence tree for values of @Op a b@, where @a@ is a 'Subtype' of @b@.+This provides support for subtyped heterogeneous precedence parsing.+-}+sops :: Subtype a b+     => Fixity a b sig -- ^ The fixity of the layer to add.+     -> [Parsec sig]   -- ^ The parsers that can be run in this layer.+     -> Op a b         -- ^ A layer in the precedence table, containing the given parsers. sops fixity = gops fixity upcast

@@ -1,32 +1,228 @@ {-# LANGUAGE Safe #-}-module Text.Gigaparsec.Expr.Chain (module Text.Gigaparsec.Expr.Chain) where+{-|+Module      : Text.Gigaparsec.Expr.Infix+Description : This module contains the very useful chaining family of combinators, +              which are mostly used to parse operators and expressions of varying fixities.+License     : BSD-3-Clause+Maintainer  : Jamie Willis, Gigaparsec Maintainers+Stability   : experimental +This module contains the very useful chaining family of combinators, +which are mostly used to parse operators and expressions of varying fixities. ++It is a lower-level API than 'Text.Gigaparsec.Expr.precedence'.++See "Text.Gigaparsec.Expr.Infix" for combinators that allow for more +freedom in the type of the values and the operators.+-}+module Text.Gigaparsec.Expr.Chain (+  -- ** Binary Operator Chains+  {-|+  These combinators allow for the chaining together of values and binary operators in either left-, +  right- or non-associative application.+  -}+  -- *** Left-Associative Binary Operators+  chainl,+  chainl1,+  -- *** Right-Associative Binary Operators+  chainr1,+  chainr,+  -- *** Non-Associative Binary Operators+  chainn1,+  -- ** Unary Operator Chains+  {-|+  These combinators allow for the chaining together, and application, of multiple +  prefix or postfix unary operators to a single value.+  -}+  -- *** Prefix Operators+  prefix,+  prefix1,+  -- *** Postfix Operators+  postfix,+  postfix1,+  -- ** Module Re-export+  -- | This should be removed.+  module Text.Gigaparsec.Expr.Chain) where+ import Text.Gigaparsec (Parsec, (<|>), (<**>)) import Text.Gigaparsec.Expr.Infix qualified as Infix (infixl1, infixr1, infixn1, prefix, postfix) -chainl1 :: Parsec a -> Parsec (a -> a -> a) -> Parsec a+{-|+This combinator handles left-associative parsing, and the application of, +__zero__ or more binary operators between __one__ or more values.++First parse @p@, then parse @op@ followed by a @p@ repeatedly. +The results of the @p@s, @x₁@ through @xₙ@, are combined with the results of the @op@s, +@f₁@ through @fₙ₋₁@, with left-associative application: +fₙ₋₁(fₙ₋₂(..f₁(x₁, x₂).., xₙ₋₁), xₙ).+This application is then returned as the result of the combinator. +If @p@ or @op@ fails having consumed input at any point, the whole combinator fails.++See also 'Text.Gigaparsec.Expr.Infix.infixl1' for a version where the types can vary, +ensuring that the associativity is enforced type-safely.+-}+chainl1 :: Parsec a             -- ^ @p@, the value to be parsed+        -> Parsec (a -> a -> a) -- ^ @op@, the operator between each value.+        -> Parsec a             -- ^ a parser that parses alternating @p@ and @op@, ending in a @p@, +                                -- and applies their results left-associatively. chainl1 = Infix.infixl1 id -chainr1 :: Parsec a -> Parsec (a -> a -> a) -> Parsec a+{-|+This combinator handles right-associative parsing, and the application of, +__zero__ or more binary operators between __one__ or more values.++First parse @p@, then parse @op@ followed by a @p@ repeatedly. +The results of the @p@s, @x₁@ through @xₙ@, are combined with the results of the @op@s, +@f₁@ through @fₙ@, with right-associative application: +f₁(x₁,f₂(x₂,...fₙ₋₁(xₙ₋₁, xₙ)..)).+This application is then returned as the result of the combinator. +If @p@ or @op@ fails having consumed input at any point, the whole combinator fails.++See also 'Text.Gigaparsec.Expr.Infix.infixr1' for a version where the types can vary, +ensuring that the associativity is enforced type-safely.+-}+chainr1 :: Parsec a             -- ^ @p@, the value to be parsed+        -> Parsec (a -> a -> a) -- ^ @op@, the operator between each value.+        -> Parsec a             -- ^ a parser that parses alternating @p@ and @op@, ending in a @p@,+                                --  and applies their results right-associatively. chainr1 = Infix.infixr1 id -chainn1 :: Parsec a -> Parsec (a -> a -> a) -> Parsec a+{-|+This combinator handles non-associative parsing, and the application of, +__zero__ or __one__ binary operators between __one__ or __two__ values.++First parse @p@.+Then:++* If this not is followed by an @op@, simply return @p@.+* Otherwise, parse this @op@ followed by a single @p@. +  Then ensure that this is not followed by a further @op@, to enforce non-associativity.+  The results of the @p@s, @x@ and @y@, are combined with the result of @op@, +  @f@ with the application @f x y@.+  This application is then returned as the result of the combinator. ++If @p@ or @op@ fails having consumed input at any point, the whole combinator fails.+This combinator also fails if the second @p@ is followed by another @op@.+-}+chainn1 :: Parsec a             -- ^ @p@, the value to be parsed+        -> Parsec (a -> a -> a) -- ^ @op@, the operator between each value.+        -> Parsec a             -- ^ a parser that parses @p@, and possibly an @op@ and then @p@, and applies the +                                -- result of @op@ to those of @p@ in the same order. chainn1 = Infix.infixn1 id -prefix :: Parsec (a -> a) -> Parsec a -> Parsec a+{-|+This combinator handles right-assocative parsing, and application of, +__zero__ or more prefix unary operators to a single value.++First parse many repeated @op@s. +When there are no more @op@s left to parse, parse a single @p@. +The result of @p@, @x@, is applied to each of the results of the @op@s, @f₁@ through @fₙ@, +such that @fₙ@ is applied first and @f₁@ last: @f₁ (f₂ (..(fₙ x)..))@. +This application is then returned as the result of the combinator. ++If @p@ or @op@ fails having consumed input at any point, the whole combinator fails.+-}+prefix :: Parsec (a -> a) -- ^ @op@, the prefix operator to repeatedly parse before @p@.+       -> Parsec a        -- ^ @p@, the single value to be parsed+       -> Parsec a        -- ^ a parser that parses many @op@s, and a final @p@, and applies all +                          -- of the results right-associatively. prefix = Infix.prefix id -postfix :: Parsec a -> Parsec (a -> a) -> Parsec a+{-|+This combinator handles left-assocative parsing, and application of, +__zero__ or more postfix unary operators to a single value.++First parse a single @p@.+Then, parse many repeated @op@s.+The result of @p@, @x@, is applied to each of the results of the @op@s, @f₁@ through @fₙ@, +such that @f₁@ is applied first and @fₙ@ last: @fₙ(fₙ₋₁ (..(f₁ x)..))@. +This application is then returned as the result of the combinator. ++If @p@ or @op@ fails having consumed input at any point, the whole combinator fails.+-}+postfix :: Parsec a        -- ^ @p@, the single value to be parsed+        -> Parsec (a -> a) -- ^ @op@, the postfix operator to repeatedly parse after @p@.+        -> Parsec a        -- ^ a parser that parses many @op@s, and a final @p@, and applies all +                           -- of the results left-associatively. postfix = Infix.postfix id -prefix1 :: (b -> a) -> Parsec (a -> b) -> Parsec a -> Parsec b+{-|+This combinator handles left-assocative parsing, and application of, +__one__ or more postfix unary operators to a single value.++First parse a single @p@.+Then, parse at least one repeated @op@s.+The result of @p@, @x@, is applied first to @wrap@, and then to each of the results of the @op@s, @f₁@ through @fₙ@, +such that @f₁@ is applied first and @fₙ@ last: @fₙ(fₙ₋₁ (..(f₁ (wrap x))..))@. +This application is then returned as the result of the combinator. ++If @p@ or @op@ fails having consumed input at any point, the whole combinator fails.+-}+prefix1 :: (b -> a)             -- ^ @wrap@, a function converting @b@s into @a@s+        -> Parsec (a -> b)      -- ^ @op@, the prefix operator to repeatedly parse before @p@+        -> Parsec a             -- ^ @p@, the single value to be parsed+        -> Parsec b             -- ^ a parser that parses at least one @op@, and a final @p@,+                                -- and applies their results right-associatively. prefix1 wrap op p = op <*> prefix ((wrap .) <$> op) p -postfix1 :: (b -> a) -> Parsec a -> Parsec (a -> b) -> Parsec b+{-|+This combinator handles left-assocative parsing, and application of, +__one__ or more postfix unary operators to a single value.++First parse a single @p@.+Then, parse at least one repeated @op@s.+The result of @p@, @x@, is applied first to @wrap@, and then to each of the results of the @op@s, @f₁@ through @fₙ@, +such that @f₁@ is applied first and @fₙ@ last: @fₙ( fₙ₋₁(..f₁ (wrap x)..))@. +This application is then returned as the result of the combinator. ++If @p@ or @op@ fails having consumed input at any point, the whole combinator fails.+-}+postfix1 :: (b -> a)        -- ^ a function converting the value type @a@ into the result type @b@ +         -> Parsec a        -- ^ @p@, the single value to be parsed+         -> Parsec (a -> b) -- ^ @op@, the postfix operator to repeatedly parse after @p@.+         -> Parsec b        -- ^ a parser that parses at least one @op@, and a final @p@, and applies all +                            -- of the results left-associatively. postfix1 wrap p op = postfix (p <**> op) ((. wrap) <$> op) -chainl :: Parsec a -> Parsec (a -> a -> a) -> a -> Parsec a+{-|+This combinator handles left-associative parsing, and the application of, +__zero__ or more binary operators between __zero__ or more values.++First parse @p@, then parse @op@ followed by a @p@ repeatedly. +The results of the @p@s, @x₁@ through @xₙ@, are combined with the results of the @op@s, +@f₁@ through @fₙ₋₁@, with left-associative application: +fₙ₋₁(fₙ₋₂(..f₁(x₁, x₂).., xₙ₋₁), xₙ).+This application is then returned as the result of the combinator. ++If @p@ or @op@ fails having consumed input at any point, the whole combinator fails.+If no @p@ could be parsed, return a default value @x@.+-}+chainl :: Parsec a             -- ^ @p@, the value to be parsed+       -> Parsec (a -> a -> a) -- ^ @op@, the operator between each value.+       -> a                    -- ^ @x@, the default value to return if no @p@s can be parsed.+       -> Parsec a             -- ^ a parser that parses alternating @p@ and @op@, ending in a @p@, +                               -- and applies their results left-associatively.+                               -- If no @p@ was parsed, returns @x@. chainl p op x = chainl1 p op <|> pure x -chainr :: Parsec a -> Parsec (a -> a -> a) -> a -> Parsec a+{-|+This combinator handles right-associative parsing, and the application of, +__zero__ or more binary operators between __zero__ or more values.++First parse @p@, then parse @op@ followed by a @p@ repeatedly. +The results of the @p@s, @x₁@ through @xₙ@, are combined with the results of the @op@s, +@f₁@ through @fₙ@, with right-associative application: +@f₁ x₁ (f₂ x₂ (...(fₙ₋₁ xₙ₋₁ xₙ)...))@.+This application is then returned as the result of the combinator. ++If @p@ or @op@ fails having consumed input at any point, the whole combinator fails.+If no @p@ could be parsed, return a default value @x@.++-}+chainr :: Parsec a             -- ^ @p@, the value to be parsed +       -> Parsec (a -> a -> a) -- ^ @op@, the operator between each value. +       -> a                    -- ^ @x@, the default value to return if no @p@s can be parsed.+       -> Parsec a             -- ^ a parser that parses alternating @p@ and @op@, ending in a @p@, +                               -- and applies their results right-associatively.+                               -- If no @p@ was parsed, returns @x@. chainr p op x = chainr1 p op <|> pure x

@@ -1,20 +1,149 @@ {-# LANGUAGE Safe #-}-module Text.Gigaparsec.Expr.Infix (module Text.Gigaparsec.Expr.Infix) where+{-|+Module      : Text.Gigaparsec.Expr.Infix+Description : This module contains the very useful chaining family of combinators, +              which are mostly used to parse operators and expressions of varying fixities.+License     : BSD-3-Clause+Maintainer  : Jamie Willis, Gigaparsec Maintainers+Stability   : experimental +This module contains the very useful chaining family of combinators, +              which are mostly used to parse operators and expressions of varying fixities.++It is a lower-level API than 'Text.Gigaparsec.Expr.precedence'.++Compared with the combinators in "Text.Gigaparsec.Expr.Chain", +these allow for more freedom in the type of the values and the operators.+-}+module Text.Gigaparsec.Expr.Infix (+  -- ** Binary Operator Chains+  {-|+  These combinators allow for the chaining together of values and binary operators in either left-, +  right- or non-associative application.+  -}+  infixl1,+  infixr1,+  infixn1,+  -- ** Unary Operator Chains+  {-|+  These combinators allow for the chaining together, and application, of multiple +  prefix or postfix unary operators to a single value.+  -}+  prefix,+  postfix,+  -- ** Module Re-export+  {-|+  This should be removed.+  -}+  module Text.Gigaparsec.Expr.Infix) where+ import Text.Gigaparsec (Parsec, (<|>), (<**>)) -infixl1 :: (a -> b) -> Parsec a -> Parsec (b -> a -> b) -> Parsec b+{-|+This combinator handles left-associative parsing, and the application of, +__zero__ or more binary operators between __one__ or more values.++First parse @p@, then parse @op@ followed by a @p@ repeatedly. +The results of the @p@s, @x₁@ through @xₙ@, are combined with the results of the @op@s, +@f₁@ through @fₙ₋₁@, with left-associative application: +fₙ₋₁ (fₙ₋₂ (..(f₁ x₁ x₂)..) xₙ₋₁) xₙ.+This application is then returned as the result of the combinator. +If @p@ or @op@ fails having consumed input at any point, the whole combinator fails.++Compared with 'Text.Gigaparsec.Expr.Chain.chainl1', +this combinator allows the types of the operators to more accurately encode their associativity in their types. +However, 'Text.Gigaparsec.Expr.Chain.chainl1', in which @a@ and @b@ must match, +allows for more flexibility to change the associativity.+-}+infixl1 :: (a -> b)             -- ^ a function converting the value type @a@ into the result type @b@.+        -> Parsec a             -- ^ @p@, the value to be parsed+        -> Parsec (b -> a -> b) -- ^ @op@, the operator between each value.+        -> Parsec b             -- ^ a parser that parses alternating @p@ and @op@, ending in a @p@, +                                -- and applies their results left-associatively. infixl1 wrap p op = postfix wrap p (flip <$> op <*> p) -infixr1 :: (a -> b) -> Parsec a -> Parsec (a -> b -> b) -> Parsec b+{-|+This combinator handles right-associative parsing, and the application of, +__zero__ or more binary operators between __one__ or more values.++First parse @p@, then parse @op@ followed by a @p@ repeatedly. +The results of the @p@s, @x₁@ through @xₙ@, are combined with the results of the @op@s, +@f₁@ through @fₙ@, with right-associative application: +@f₁ x₁ (f₂ x₂ (...(fₙ₋₁ xₙ₋₁ xₙ)...))@.+This application is then returned as the result of the combinator. +If @p@ or @op@ fails having consumed input at any point, the whole combinator fails.++Compared with 'Text.Gigaparsec.Expr.Chain.chainr1', +this combinator allows the types of the operators to more accurately encode their associativity in their types. +However, 'Text.Gigaparsec.Expr.Chain.chainr1', in which @a@ and @b@ must match, +allows for more flexibility to change the associativity.+-}+infixr1 :: (a -> b)             -- ^ a function converting the value type @a@ into the result type @b@.+        -> Parsec a             -- ^ @p@, the value to be parsed+        -> Parsec (a -> b -> b) -- ^ @op@, the operator between each value.+        -> Parsec b             -- ^ a parser that parses alternating @p@ and @op@, ending in a @p@,+                                --  and applies their results right-associatively. infixr1 wrap p op = p <**> (flip <$> op <*> infixr1 wrap p op <|> pure wrap) -infixn1 :: (a -> b) -> Parsec a -> Parsec (a -> a -> b) -> Parsec b+{-|+This combinator handles non-associative parsing, and the application of, +__zero__ or __one__ binary operators between __one__ or __two__ values.++First parse @p@.+Then:++* If this not is followed by an @op@, simply return @p@.+* Otherwise, parse this @op@ followed by a single @p@. +  Then ensure that this is not followed by a further @op@, to enforce non-associativity.+  The results of the @p@s, @x@ and @y@, are combined with the result of @op@, +  @f@ with the application @f x y@.+  This application is then returned as the result of the combinator. ++If @p@ or @op@ fails having consumed input at any point, the whole combinator fails.+This combinator also fails if the second @p@ is followed by another @op@.+-}+infixn1 :: (a -> b)             -- ^ a function converting the value type @a@ into the result type @b@.+        -> Parsec a             -- ^ @p@, the value to be parsed+        -> Parsec (a -> a -> b) -- ^ @op@, the operator between each value.+        -> Parsec b             -- ^ a parser that parses @p@, @op@ and then @p@, and applies the +                                -- result of @op@ to those of @p@ in the same order. infixn1 wrap p op = p <**> (flip <$> op <*> p <|> pure wrap) -prefix :: (a -> b) -> Parsec (b -> b) -> Parsec a -> Parsec b+{-|+This combinator handles right-assocative parsing, and application of, +__zero__ or more prefix unary operators to a single value.++First parse many repeated @op@s. +When there are no more @op@s left to parse, parse a single @p@. +The result of @p@, @x@, is applied first to @wrap@, and then to each of the results of the @op@s, @f₁@ through @fₙ@, +such that @fₙ@ is applied first and @f₁@ last: @f₁ (f₂ (..(fₙ (wrap x))..))@. +This application is then returned as the result of the combinator. ++If @p@ or @op@ fails having consumed input at any point, the whole combinator fails.+-}+prefix  :: (a -> b)        -- ^ @wrap@ a function converting the value type @a@ into the result type @b@ +        -> Parsec (b -> b) -- ^ @op@, the prefix operator to repeatedly parse before @p@.+        -> Parsec a        -- ^ @p@, the single value to be parsed+        -> Parsec b        -- ^ a parser that parses many @op@s, and a final @p@, and applies all +                           -- of the results right-associatively. prefix wrap op p = op <*> prefix wrap op p <|> wrap <$> p -postfix :: (a -> b) -> Parsec a -> Parsec (b -> b) -> Parsec b+{-|+This combinator handles left-assocative parsing, and application of, +__zero__ or more postfix unary operators to a single value.++First parse a single @p@.+Then, parse many repeated @op@s.+The result of @p@, @x@, is applied first to @wrap@, and then to each of the results of the @op@s, @f₁@ through @fₙ@, +such that @f₁@ is applied first and @fₙ@ last: @fₙ( fₙ₋₁(..f₁ (wrap x)..))@. +This application is then returned as the result of the combinator. ++If @p@ or @op@ fails having consumed input at any point, the whole combinator fails.+-}+postfix :: (a -> b)        -- ^ a function converting the value type @a@ into the result type @b@ +        -> Parsec a        -- ^ @p@, the single value to be parsed+        -> Parsec (b -> b) -- ^ @op@, the postfix operator to repeatedly parse after @p@.+        -> Parsec b        -- ^ a parser that parses many @op@s, and a final @p@, and applies all +                           -- of the results left-associatively. postfix wrap p op = wrap <$> p <**> rest   where rest = flip (.) <$> op <*> rest <|> pure id

@@ -1,16 +1,78 @@ {-# LANGUAGE Safe #-} {-# LANGUAGE MultiParamTypeClasses, ConstraintKinds, TypeOperators, FlexibleInstances #-} --{-# LANGUAGE UndecidableInstances, AllowAmbiguousTypes #-}-module Text.Gigaparsec.Expr.Subtype (module Text.Gigaparsec.Expr.Subtype) where+{-|+Module      : Text.Gigaparsec.Expr.Subtype+Description : This module defines explicit subtyping, with up- and -downcasting.+License     : BSD-3-Clause+Maintainer  : Jamie Willis, Gigaparsec Maintainers+Stability   : experimental +This module defines explicit subtyping, with up- and -downcasting.++Subtyping is used in "Text.Gigaparsec.Expr" to allow for more specific types within a single layer of a precedence table,+as long as they all have a common supertype.+-}+module Text.Gigaparsec.Expr.Subtype (+  -- ** Subtyping+  {-|+  -}+  Subtype(upcast, downcast),+  type (<),+  -- ** Module Re-export+  -- | This should be removed.+  module Text.Gigaparsec.Expr.Subtype) where+ import Data.Kind (Constraint) --import Control.Monad ((>=>)) +{-|+Explicit subtyping with up- and down-casting.++@sub@ is a 'Subtype' of @sup@ when there is an /upcasting/ function @sub -> sup@.+The intuition is that for each value of type @sub@, there is a (unique) corresponding value in @sup@+`upcast` will convert values in @sub@ to their corresponding values in @sup@.++The `downcast` function describes all those values in @sup@ which correspond to values in @sub@;+if @v :: sup@ does not correspond to any value in @sub@, then @'downcast' v = 'Nothing'@.++This is encapsulated by the following property: ++prop> downcast . upcast = Just++meaning that `upcast` should be a right inverse for `downcast`.+In other words, if you `upcast` and then `downcast` some value, you will end up with the same value +(albeit wrapped under a 'Just').++-} type Subtype :: * -> * -> Constraint class Subtype sub sup where+  {-| +  Inject the subtype into the supertype.++  Cast values in @sub@ into a value of type @sup@.+  This should be a right inverse of 'downcast'.+  -}   upcast :: sub -> sup+  {-|+  Describes which elements of @sup@ correspond with those in @sub@.+  +  That is, @'downcast' v = 'Just' w@  precisely when  @'upcast' w = v@.++  If @v :: sup@ corresponds with some element @w :: sub@, then,++  > downcast v = Just w+  +  Otherwise, if @v :: sup@ is not the upcast of any element of @sub@, then,++  > downcast v = Nothing+  +  -}   downcast :: sup -> Maybe sub +{-| +An infix alias of 'Subtype'.+-} type (<) :: * -> * -> Constraint type sub < sup = Subtype sub sup 

@@ -52,6 +52,8 @@ up a final 'Parsec' value that can be passed to 'Text.Gigaparsec.parse' or one of the similar functions. This is implemented internally similar to other libraries like @parsec@ and @gigaparsec@.++@since 0.1.0.0 -} type Parsec :: * -> * newtype Parsec a = Parsec {@@ -61,8 +63,10 @@              -> RT r   } +-- | @since 0.1.0.0 deriving stock instance Functor Parsec -- not clear if there is a point to implementing this +-- | @since 0.1.0.0 instance Applicative Parsec where   pure :: a -> Parsec a   pure x = Parsec $ \st ok _ -> ok x st@@ -86,6 +90,7 @@   {-# INLINE (<*) #-}   {-# INLINE (*>) #-} +-- | @since 0.1.0.0 instance Selective Parsec where   select :: Parsec (Either a b) -> Parsec (a -> b) -> Parsec b   select p q = _branch p q (pure id)@@ -108,6 +113,7 @@         -- feed a/b to the function of the good continuation   in  p st ok' err +-- | @since 0.1.0.0 instance Monad Parsec where   return :: a -> Parsec a   return = pure@@ -128,6 +134,7 @@ raise :: (State -> Error) -> Parsec a raise mkErr = Parsec $ \st _ bad -> useHints bad (mkErr st) st +-- | @since 0.1.0.0 instance Alternative Parsec where   empty :: Parsec a   empty = raise (`emptyErr` 0)@@ -155,53 +162,66 @@   {-# INLINE some #-}  {-|-This combinator will parse this parser __zero__ or more times combining the results with the function @f@ and base value @k@ from the right.+This combinator will parse the given parser @p@ __zero__ or more times,+combining the results with the function @f@ and base value @k@ from the right. -This parser will continue to be parsed until it fails having __not consumed__ input.+@p@ will continue to be parsed until it fails having __not consumed__ input. All of the results generated by the successful parses are then combined in a right-to-left fashion using the function @f@: the right-most value provided to @f@ is the value @k@. If this parser does fail at any point having consumed input, this combinator will fail.  ==== __Examples__ > many = manyr (:) []++@since 0.3.0.0 -} {-# INLINE manyr #-}-manyr :: (a -> b -> b) -- ^ function to apply to each value produced by this parser, starting at the right.-      -> b             -- ^ value to use when this parser no longer succeeds.-      -> Parsec a-      -> Parsec b      -- ^ a parser which parses this parser many times and folds the results together with @f@ and @k@ right-associatively.+manyr :: (a -> b -> b) -- ^ @f@, function to apply to each value produced by @p@ starting at the right.+      -> b             -- ^ @k@, the value to use when this parser no longer succeeds.+      -> Parsec a      -- ^ @p@, the parser to repeatedly run zero or more times.+      -> Parsec b      -- ^ a parser which parses @p@ many times and folds the results together with @f@ and @k@ right-associatively. manyr f k p = let go = liftA2 f p go <|> pure k in go  {-|-This combinator will parse this parser __one__ or more times combining the results with the function @f@ and base value @k@ from the right.+This combinator will parse the given parser @p@ __one__ or more times,+combining the results with the function @f@ and base value @k@ from the right. -This parser will continue to be parsed until it fails having __not consumed__ input.+@p@ will continue to be parsed until it fails having __not consumed__ input. All of the results generated by the successful parses are then combined in a right-to-left fashion using the function @f@: the right-most value provided to @f@ is the value @k@. If this parser does fail at any point having consumed input, this combinator will fail.  ==== __Examples__ > some = somer (:) []++@since 0.3.0.0 -} {-# INLINE somer #-} somer :: (a -> b -> b) -- ^ function to apply to each value produced by this parser, starting at the right.-      -> b             -- ^ value to use when this parser no longer succeeds.-      -> Parsec a-      -> Parsec b      -- ^ a parser which parses this parser some times and folds the results together with @f@ and @k@ right-associatively.+      -> b             -- ^ @k@, the value to use when this parser no longer succeeds.+      -> Parsec a      -- ^ @p@, the parser to repeatedly run one or more times.+      -> Parsec b      -- ^ a parser which parses @p@ some times and folds the results together with @f@ and @k@ right-associatively. somer f k p = liftA2 f p (manyr f k p) +-- | @since 0.1.0.0 instance Semigroup m => Semigroup (Parsec m) where   (<>) :: Parsec m -> Parsec m -> Parsec m   (<>) = liftA2 (<>)    {-# INLINE (<>) #-} +-- | @since 0.1.0.0 instance Monoid m => Monoid (Parsec m) where   mempty :: Parsec m   mempty = pure mempty    {-# INLINE mempty #-} +{-|+The 'State' of the parser, containing position information, the input being parsed, and more.++@since 0.1.0.0+-} type State :: UnliftedDatatype data State = State {     -- | the input string, in future this may be generalised

@@ -0,0 +1,13 @@+{-# LANGUAGE Safe #-}++{-# OPTIONS_HADDOCK hide #-}+++module Text.Gigaparsec.Internal.TH.DecUtils (+  module Text.Gigaparsec.Internal.TH.DecUtils+  ) where+import Text.Gigaparsec.Internal.TH.VersionAgnostic (Q, Name, Exp, Dec)+import Language.Haskell.TH (normalB, clause, funD)+    +funDsingleClause :: Name -> Q Exp -> Q Dec+funDsingleClause x body = funD x [clause [] (normalB body) []]

@@ -0,0 +1,126 @@+{-# LANGUAGE Safe #-}++{-# OPTIONS_HADDOCK hide #-}++{-# LANGUAGE CPP #-}+{-# LANGUAGE GADTs #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE TupleSections #-}+{-# LANGUAGE TypeFamilies #-}++{- |+Module      : Text.Gigaparsec.Internal.TH.TypeUtils+Description : Common Template Haskell Utils+License     : BSD-3-Clause+Maintainer  : Jamie Willis, Gigaparsec Maintainers+Stability   : experimental++Common utils for manipulating Template Haskell Type AST.++@since 0.2.2.0+-}+module Text.Gigaparsec.Internal.TH.TypeUtils (module Text.Gigaparsec.Internal.TH.TypeUtils) where++import Text.Gigaparsec.Internal.TH.VersionAgnostic++import Data.Bifunctor (Bifunctor (bimap))+import Data.Set (Set)+import Data.Set qualified as Set+import Language.Haskell.TH (pprint)++-- When KindSignatures is off, the default (a :: *) that TH generates is broken!+sanitiseStarT :: TyVarBndr flag -> TyVarBndr flag+sanitiseStarT = recTyVarBndr mkPlainTV (\x y -> const (mkPlainTV x y))++-- | Remove stars from binder annotations when we don't have `KindSignatures` enabled.+sanitiseBndrStars :: [TyVarBndr flag] -> Q [TyVarBndr flag]+sanitiseBndrStars bndrs = do+  kindSigs <- isExtEnabled KindSignatures+  return (if kindSigs then bndrs else map sanitiseStarT bndrs)++sanitiseTypeStars :: Type -> Q Type+sanitiseTypeStars = cataType go+ where+  go :: TypeF (Q Type) -> Q Type+  go (ForallTF bnds ctx tp) =+    ForallT <$> mapM helpBnd bnds <*> sequence ctx <*> tp+  go (ForallVisTF bnds tp) = mkForallVisT <$> mapM helpBnd bnds <*> tp+  go e = embedType <$> sequence e++  helpBnd :: TyVarBndrF flag (Q Type) -> Q (TyVarBndr flag)+  helpBnd (PlainTVF n f) = return $ mkPlainTV n f+  helpBnd (KindedTVF n f ~_) = return $ mkPlainTV n f++unTyVarBndrF :: TyVarBndrF flag k -> (Name, flag, Maybe k)+unTyVarBndrF = recTyVarBndrF (,,Nothing) (\x y z -> (x, y, Just z))++reTyVarBndr :: Name -> flag -> Maybe Type -> TyVarBndr flag+reTyVarBndr n f mt = case mt of+  Nothing -> mkPlainTV n f+  Just t -> mkKindedTV n f t++getBndrFName :: TyVarBndrF flag k -> Name+getBndrFName = (\(a, _, _) -> a) . unTyVarBndrF++removeUnusedTVars :: Type -> Type+removeUnusedTVars = zygoType typeFreeVarsAlg go+ where+  go :: TypeF (Set Name, Type) -> Type+  go (ForallTF bnds ctx (tpNames, tp)) =+    let (ctxNames, ctx') = unzip ctx+        -- All names that *do* occur in the rest of the type/constraints+        allFreeNames = Set.unions (tpNames : ctxNames)+        (bnds', _) = foldr discardUnusedTVars ([], allFreeNames) bnds+     in ForallT bnds' ctx' tp+  go (ForallVisTF bnds (tpNames, tp)) =+    let (bnds', _) = foldr discardUnusedTVars ([], tpNames) bnds+     in ForallVisT bnds' tp+  go e = embedType (snd <$> e)++  discardUnusedTVars ::+    TyVarBndrF s (Set Name, Type) ->+    ([TyVarBndr s], Set Name) ->+    ([TyVarBndr s], Set Name)+  discardUnusedTVars bnd (bnds, names) =+    let (n, f, mk) = unTyVarBndrF bnd+     in if n `Set.member` names+          -- We keep n, and add any free vars in its kind (if it has one)+          then+            ( reTyVarBndr n f (snd <$> mk) : bnds+            , Set.union (maybe Set.empty fst mk) names+            )+          -- We discard n as it does not appear in subterms+          else (bnds, names)++typeFreeVarsAlg :: TypeF (Set Name) -> Set Name+typeFreeVarsAlg = go+ where+  go :: TypeF (Set Name) -> Set Name+  go (VarTF x) = Set.singleton x+  go (ForallTF bnds ctx tp) = handleBnds bnds (Set.unions $ (tp : ctx))+  go (ForallVisTF bnds tp) = handleBnds bnds tp+  go e = foldr Set.union Set.empty e++  handleBnds :: [TyVarBndrF flag (Set Name)] -> Set Name -> Set Name+  handleBnds bnds ns =+    let (as, ks) =+          bimap Set.fromList Set.unions $ unzip (map bndrFreeAndBoundNames bnds)+     in Set.difference (Set.union ks ns) as++  bndrFreeAndBoundNames :: TyVarBndrF flag (Set Name) -> (Name, Set Name)+  bndrFreeAndBoundNames (PlainTVF x _) = (x, Set.empty)+  bndrFreeAndBoundNames (KindedTVF x _ k) = (x, k)++typeFreeVars :: Type -> Set Name+typeFreeVars = cataType typeFreeVarsAlg++getRecordFields :: Info -> Q [(Name, Type)]+getRecordFields i = case i of+  TyConI (DataD _ _ _ _ cstrs _) -> concat <$> mapM getFieldNames cstrs+  TyConI (NewtypeD _ _ _ _ cstr _) -> getFieldNames cstr+  DataConI _ _ tname -> getRecordFields =<< reify tname+  info -> fail $ concat ["getRecordFields: given info is not for a record: `", pprint info, "`"]+  where+    getFieldNames :: Con -> Q [(Name, Type)]+    getFieldNames (RecC _ tps) = return $ map (\(nm, _, tp) -> (nm, tp)) tps+    getFieldNames c = fail ("getRecordFields: Constructor is not a record: " ++ pprint c)

@@ -0,0 +1,512 @@+{-# LANGUAGE Trustworthy #-}++{-# OPTIONS_HADDOCK hide #-}++{-# LANGUAGE TemplateHaskell, CPP, PatternSynonyms, LambdaCase #-}+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE DeriveFunctor #-}+{-# LANGUAGE DeriveFoldable #-}+{-# LANGUAGE DeriveTraversable, PatternSynonyms #-}+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE TypeOperators #-}+{-# LANGUAGE ExistentialQuantification #-}+{-# LANGUAGE FlexibleContexts #-}+{-# OPTIONS_GHC -Wno-missing-kind-signatures #-}+{-|+Mostly some utils for dealing with TH in a version-agnostic way.+-}+module Text.Gigaparsec.Internal.TH.VersionAgnostic (+  -- * `TH.Type` Smart Constructors+  mkVarT,+  mkConT,+  mkPromotedT,+  mkSigT,+  mkAppT,+  mkForallT,+  -- *** Version ≥ 2.11+  mkInfixT,+  mkUInfixT,+  mkParensT,+  -- *** Version ≥ 2.15+  mkAppKindT,+  mkImplicitParamT,+  -- *** Version ≥ 2.16+  mkForallVisT,+  -- *** Version ≥ 2.19+  mkPromotedInfixT,+  mkPromotedUInfixT,+  -- * TyVarBndr+  -- ** Constructors and Recursors+  TyVarBndr,+  mkPlainTV,+  mkKindedTV,+  recTyVarBndr,+  -- ** Base Functor+  TyVarBndrF,+  pattern PlainTVF,+  pattern KindedTVF,+  recTyVarBndrF,+  projectBnd,+  embedBnd,+  -- * `TH.Type` Base Functor+  TypeF,+  -- ** View Patterns+  pattern ForallTF,+  pattern ForallVisTF, +  pattern AppTF, +  pattern AppKindTF, +  pattern SigTF, +  pattern InfixTF, +  pattern UInfixTF, +  pattern PromotedInfixTF, +  pattern PromotedUInfixTF, +  pattern ImplicitParamTF,+  pattern AtomicF, +  pattern ParensTF,+  pattern VarTF,+  -- ** Recursion and Corecursion+  projectType,+  embedType,+  cataType,+  zygoType,+  -- * Template Haskell select re-exports+  module TH,+  module TH.Lib,+  TH.pprint,+#if !(MIN_VERSION_template_haskell(2,17,0))+  Quote(..),+  DocLoc(..),+  pattern MulArrowT,+  getDoc,+  putDoc,+#endif+  ) where++#if (MIN_VERSION_template_haskell(2,17,0))+import Language.Haskell.TH.Syntax hiding (TyVarBndr(..), Specificity)+import Language.Haskell.TH qualified as TH hiding (TyVarBndr(..), Specificity)+import Language.Haskell.TH.Syntax qualified as TH hiding (TyVarBndr(..), Specificity)+import Language.Haskell.TH.Syntax qualified as THAll+import Language.Haskell.TH.Lib as TH.Lib+#else+import Data.IORef (atomicModifyIORef')+import Language.Haskell.TH.Syntax hiding (TyVarBndr(..), Specificity, newName)+import Language.Haskell.TH qualified as TH hiding (TyVarBndr(..), Specificity)+import Language.Haskell.TH.Syntax qualified as TH hiding (TyVarBndr(..), Specificity)+import Language.Haskell.TH.Syntax qualified as THAll+import Language.Haskell.TH.Lib as TH.Lib+#endif+++import Control.Applicative (liftA2)++import GHC.Generics (Generic)+import Data.Kind (Constraint)+import Data.Bitraversable (bisequence)+++---------------------------------------------------------------------------------------------------+-- TyVarBndr Base Functor++-- use this defn so that TypeF doesn't need to have two recursion params+type TyVarBndrF :: * -> * -> *+type TyVarBndrF flag k = Either (Name, flag) (Name, flag, k)+++{-# COMPLETE PlainTVF, KindedTVF #-}+++pattern PlainTVF :: Name -> flag -> TyVarBndrF flag k+pattern KindedTVF :: Name -> flag -> k -> TyVarBndrF flag k+pattern PlainTVF n f = Left (n, f)+pattern KindedTVF n f knd = Right (n, f, knd)+++recTyVarBndrF +  :: (Name -> flag -> a) -- The `PlainTV` case+  -> (Name -> flag -> k -> a) -- The `KindedTV` case+  -> TyVarBndrF flag k+  -> a+recTyVarBndrF f _ (PlainTVF nm ~flag) = f nm flag+recTyVarBndrF _ g (KindedTVF nm ~flag k) = g nm flag k++{-| Unrolls one step of recursion on `TyVarBndr`.++Projects a `TyVarBndr` onto its base functor.+-}+projectBnd :: TyVarBndr flag -> TyVarBndrF flag Type+projectBnd = recTyVarBndr PlainTVF KindedTVF++{-| Rolls up one step of recursion into a `TyVarBndr`.++Embeds a `TyVarBndrF` onto the standard representation `TyVarBndr`.+-}+embedBnd :: TyVarBndrF flag Type -> TyVarBndr flag+embedBnd = recTyVarBndrF mkPlainTV mkKindedTV++---------------------------------------------------------------------------------------------------+-- Type Base Functor++{-|+Base functor for `Type`.++Use a hand-rolled base functor, as we then only need to handle the TH version inconsistencies+in the `embed` and `project` functions.+-}+type TypeF :: * -> *+data TypeF k = +    ForallTF_ [TyVarBndrF Specificity k] [k] k+  | ForallVisTF_ [TyVarBndrF () k] k+  | AppTF_ k k+  | AppKindTF_ k k+  | SigTF_ k k+  | InfixTF_ k Name k+  | UInfixTF_ k Name k+  | PromotedInfixTF_ k Name k+  | PromotedUInfixTF_ k Name k+  | ImplicitParamTF_ String k+  | AtomicF_ Type+  | ParensTF_ k+  deriving stock (Functor, Foldable, Traversable, Generic)++{-# COMPLETE ForallTF,ForallVisTF, AppTF, AppKindTF, SigTF, InfixTF, UInfixTF, +  PromotedInfixTF, PromotedUInfixTF, ImplicitParamTF, AtomicF, ParensTF #-}++pattern ForallTF :: [TyVarBndrF Specificity k] -> [k] -> k -> TypeF k+pattern ForallTF bnds ctx t <- ForallTF_ bnds ctx t+pattern ForallVisTF :: [TyVarBndrF () k] -> k -> TypeF k+pattern ForallVisTF bnds t <- ForallVisTF_ bnds t +pattern AppTF :: k -> k -> TypeF k+pattern AppTF a b <- AppTF_ a b+pattern AppKindTF :: k -> k -> TypeF k+pattern AppKindTF a k <- AppKindTF_ a k+pattern SigTF :: k -> k -> TypeF k+pattern SigTF a k <- SigTF_ a k+pattern InfixTF :: k -> Name -> k -> TypeF k+pattern InfixTF  a n b      <- InfixTF_ a n b+pattern UInfixTF :: k -> Name -> k -> TypeF k+pattern UInfixTF a n b      <- UInfixTF_ a n b+pattern PromotedInfixTF :: k -> Name -> k -> TypeF k+pattern PromotedInfixTF a n b <- PromotedInfixTF_ a n b +pattern PromotedUInfixTF :: k -> Name -> k -> TypeF k+pattern PromotedUInfixTF a n b <- PromotedUInfixTF_ a n b +pattern ImplicitParamTF :: String -> k -> TypeF k+pattern ImplicitParamTF x a <- ImplicitParamTF_ x a+pattern AtomicF :: Type -> TypeF k+pattern AtomicF  a <- AtomicF_ a+pattern ParensTF :: k -> TypeF k+pattern ParensTF a <- ParensTF_ a++pattern VarTF :: Name -> TypeF k+pattern VarTF nm = AtomicF_ (VarT nm)++-------------------------------------------------------------------------------+-- Recursion Schemes Stuff+{-+To avoid adding a dependency on `recursion-schemes`, we re-implement some of+the core features from this library.+The originals can be found at:+https://hackage.haskell.org/package/recursion-schemes+-}++type Base :: * -> * -> *+type family Base t :: * -> *++type Recursive :: * -> Constraint+class Functor (Base t) => Recursive t where+  project :: t -> Base t t+  cata :: (Base t a -> a) -> t -> a+  cata f = c +    where +    c = f . fmap c . project++type Corecursive :: * -> Constraint+class Functor (Base t) => Corecursive t where+  embed :: Base t t -> t++zygo :: Recursive t => (Base t b -> b) -> (Base t (b, a) -> a) -> t -> a+zygo f g = snd . cata (bisequence (f . fmap fst, g))++-------------------------------------------------------------------------------+-- Base Functor Recursive/Corecursive instances++-- | Newtype for `TH.Type`, so we can make an instance of Recursive and Corecursive.+type THType :: *+newtype THType = THType {getTHType :: TH.Type}++type instance Base THType = TypeF++projectType :: Type -> TypeF Type+projectType = fmap getTHType . project . THType++embedType :: TypeF Type -> Type+embedType = getTHType . embed . fmap THType++cataType :: (TypeF a -> a) -> Type -> a+cataType alg = cata alg . THType++zygoType :: (TypeF b -> b) -> (TypeF (b, a) -> a) -> Type -> a+zygoType α β = zygo α β . THType+++instance Recursive THType where+  project :: THType -> Base THType THType+  project = fmap THType . go . getTHType+    where+    go :: Type -> Base THType Type+    go t = case t of+      ForallT bnds ctx a -> +        ForallTF_ (map projectBnd bnds) ctx a+      AppT a b -> AppTF_ a b+      SigT a k -> SigTF_ a k+#if MIN_VERSION_template_haskell(2,11,0)+      InfixT a n b -> InfixTF_ a n b+      UInfixT a n b -> UInfixTF_ a n b+      ParensT k -> ParensTF_ k+#endif+#if MIN_VERSION_template_haskell(2,15,0)+      AppKindT a k -> AppKindTF_ a k+      ImplicitParamT x a -> ImplicitParamTF_ x a+#endif+#if MIN_VERSION_template_haskell(2,16,0)+      ForallVisT bnds a ->+        ForallVisTF_ (map projectBnd bnds) a+#endif+#if MIN_VERSION_template_haskell(2,19,0)+      PromotedInfixT a n b -> PromotedInfixTF_ a n b+      PromotedUInfixT a n b -> PromotedUInfixTF_ a n b+#endif+      a -> AtomicF_ a+    +instance Corecursive THType where+  embed :: Base THType THType -> THType+  embed = THType . go . fmap getTHType +    where+    go :: TypeF Type -> Type+    go t = case t of+      ForallTF bnds ctx a -> +        mkForallT (map embedBnd bnds) ctx a+      ForallVisTF bnds a ->+        mkForallVisT (map embedBnd bnds) a+      AppTF a b -> mkAppT a b+      AppKindTF a k -> mkAppKindT a k+      SigTF a k -> mkSigT a k+      InfixTF a n b -> mkInfixT a n b+      UInfixTF a n b -> mkUInfixT a n b+      PromotedInfixTF a n b -> mkPromotedInfixT a n b+      PromotedUInfixTF a n b -> mkPromotedUInfixT a n b+      ImplicitParamTF x a -> mkImplicitParamT x a+      ParensTF k -> mkParensT k+      AtomicF a -> a+++---------------------------------------------------------------------------------------------------+-- Smart Types and Constructors for version agnosticism++{-| A type variable binder.++__Do not__ pattern match on this, instead use `recTyVarBndr`, which safely handles pattern matching in different+versions of template haskell.++/Note:/ In TemplateHaskell < 2.17, the flag parameter is ignored.+-}+#if MIN_VERSION_template_haskell(2,17,0)+type TyVarBndr :: * -> *+type TyVarBndr flag = THAll.TyVarBndr flag+#else+type TyVarBndr flag = THAll.TyVarBndr +#endif++{-| The specificity of a binding; whether it is inferred or given by a user.++__Note:__ In TemplateHaskell < 2.17, this is unit.+-}+type Specificity :: *+#if MIN_VERSION_template_haskell(2,17,0)+type Specificity = THAll.Specificity+#else+type Specificity = ()+#endif++{-| Version-safe way to pattern match on `TyVarBndr`.++First case is for `TH.PlainTV`, the second for `TH.KindedTV`.+-}+recTyVarBndr +  :: (Name -> flag -> a) -- The `PlainTV` case+  -> (Name -> flag -> Kind -> a) -- The `KindedTV` case+  -> TyVarBndr flag +  -> a+#if MIN_VERSION_template_haskell(2,17,0)+recTyVarBndr f _ (THAll.PlainTV nm flag) = f nm flag+recTyVarBndr _ g (THAll.KindedTV nm flag k) = g nm flag k+#else+  -- TODO: this is quite naughty+recTyVarBndr f _ (THAll.PlainTV nm) = f nm undefined+recTyVarBndr _ g (THAll.KindedTV nm k) = g nm undefined k+#endif++{-| Version-safe `TH.PlainTV` constructor for `TyVarBndr`.++In Template Haskell < 2.17, @flag@ can be assumed to be @()@.+-}+mkPlainTV :: Name -> flag -> TyVarBndr flag++{-| Version-safe `TH.KindedTV` constructor for `TyVarBndr`.++In Template Haskell < 2.17, @flag@ can be assumed to be @()@.+-}+mkKindedTV :: Name -> flag -> Type -> TyVarBndr flag+#if MIN_VERSION_template_haskell(2,17,0)+mkPlainTV  = THAll.PlainTV+mkKindedTV = THAll.KindedTV+#else+mkPlainTV  n ~_ = THAll.PlainTV n+mkKindedTV n ~_ = THAll.KindedTV n+#endif++mkVarT :: Name -> Type+mkVarT = VarT++mkConT :: Name -> Type+mkConT = ConT++mkPromotedT :: Name -> Type+mkPromotedT = PromotedT++-- | Smart constructor for `ForallT`. Version-safe.+mkForallT :: [TyVarBndr Specificity] -> Cxt -> Type -> Type+mkForallT = ForallT+-- | Smart constructor for `SigT`. Version-safe.+mkAppT :: Type -> Type -> Type+mkAppT = AppT+-- | Smart constructor for `SigT`. Version-safe.+mkSigT :: Type -> Kind -> Type+mkSigT = SigT++{-| Smart constructor for `InfixT`.++Equal to `undefined` for template haskell versions < 2.11, so ensure any code that+uses this will need only be run in versions ≥ 2.11 .+-}+mkInfixT :: Type -> Name -> Type -> Type+{-| Smart constructor for `UInfixT`.++Equal to `undefined` for template haskell versions < 2.11, so ensure any code that+uses this will need only be run in versions ≥ 2.11 .+-}+mkUInfixT :: Type -> Name -> Type -> Type++{-| Smart constructor for `ParensT`.++Equal to `undefined` for template haskell versions < 2.11, so ensure any code that+uses this will need only be run in versions ≥ 2.11 .+-}+mkParensT :: Type -> Type+#if MIN_VERSION_template_haskell(2,11,0)+mkParensT = ParensT+mkUInfixT = UInfixT+mkInfixT = InfixT+#else+mkUInfixT = undefined+mkParensT = undefined+mkInfixT = undefined+#endif++{-| Smart constructor for `AppKindT`.++Equal to `undefined` for template haskell versions < 2.15, so ensure any code that+uses this will need only be run in versions ≥ 2.15 .+-}+mkAppKindT :: Type -> Type -> Type++{-| Smart constructor for `ImplicitParamT`.++Equal to `undefined` for template haskell versions < 2.15, so ensure any code that+uses this will need only be run in versions ≥ 2.15 .+-}+mkImplicitParamT :: String -> Type -> Type+#if MIN_VERSION_template_haskell(2,15,0)+mkAppKindT = AppKindT+mkImplicitParamT = ImplicitParamT+#else+mkAppKindT = undefined+mkImplicitParamT = undefined+#endif++{-| Smart constructor for `ForallVisT`.++Equal to `undefined` for template haskell versions < 2.16, so ensure any code that+uses this will need only be run in versions ≥ 2.16 .+-}+mkForallVisT :: [TyVarBndr ()] -> Type -> Type+#if MIN_VERSION_template_haskell(2,16,0)+mkForallVisT bnds tp = ForallVisT bnds tp+#else+mkForallVisT bnds tp = undefined+#endif++{-| Smart constructor for `PromotedInfixT`.++Equal to `undefined` for template haskell versions < 2.19, so ensure any code that+uses this will need only be run in versions ≥ 2.19 .+-}+mkPromotedInfixT :: Type -> Name -> Type -> Type++{-| Smart constructor for `PromotedUInfixT`.++Equal to `undefined` for template haskell versions < 2.19, so ensure any code that+uses this will need only be run in versions ≥ 2.19 .+-}+mkPromotedUInfixT :: Type -> Name -> Type -> Type+#if MIN_VERSION_template_haskell(2,19,0)+mkPromotedInfixT = PromotedInfixT+mkPromotedUInfixT = PromotedUInfixT+#else+mkPromotedInfixT = undefined+mkPromotedUInfixT = undefined+#endif+++#if !(MIN_VERSION_template_haskell(2,17,0))++{-+All of this is ported from:+https://hackage.haskell.org/package/template-haskell-2.22.0.0/docs/src/Language.Haskell.TH.Syntax.html++-}++class Monad m => Quote m where+  newName :: String -> m Name++instance Quote IO where+  newName s = do { n <- atomicModifyIORef' counter (\x -> (x + 1, x))+                 ; pure (mkNameU s n) }+instance Quote Q where+  newName = qNewName++instance (Semigroup a) => Semigroup (Q a) where+  (<>) = liftA2 (<>)+instance (Monoid a) => Monoid (Q a) where+  mempty = pure mempty+++#endif+++#if !(MIN_VERSION_template_haskell(2,17,0))++data DocLoc = DeclDoc Name++getDoc :: DocLoc -> Q (Maybe String)+getDoc _ = pure Nothing++putDoc :: DocLoc -> String -> Q ()+putDoc _ _ = pure ()++-- Is this awful?+pattern MulArrowT = ArrowT+++#endif

@@ -27,15 +27,37 @@  #endif +{-| The bit-width of certain data.++This is used to help enforce parsers of bounded precision to only return types+that can losslessly accommodate that precision.++@since 0.1.0.0++-} type Bits :: *-data Bits = B8 | B16 | B32 | B64+data Bits+  -- | 8 bits of data+  = B8+  -- | 16 bits of data+  | B16+  -- | 32 bits of data+  | B32+  -- | 64 bits of data+  | B64+  deriving stock (+      Show -- ^ @since 0.4.0.0+    , Eq   -- ^ @since 0.4.0.0+    , Ord   -- ^ @since 0.4.0.0+    )  type BitWidth :: * -> Bits type family BitWidth t where   BitWidth Integer = 'B64-  BitWidth Int     = 'B64+  BitWidth Int     = 'B64    BitWidth Word    = 'B64   BitWidth Word64  = 'B64+  BitWidth Int64   = 'B64   BitWidth Natural = 'B64   BitWidth Int32   = 'B32   BitWidth Word32  = 'B32@@ -55,6 +77,7 @@   Signedness Int     'Signed   = ()   Signedness Word    'Unsigned = ()   Signedness Word64  'Unsigned = ()+  Signedness Int64   'Signed   = ()   Signedness Natural 'Unsigned = ()   Signedness Int32   'Signed   = ()   Signedness Word32  'Unsigned = ()

@@ -21,25 +21,58 @@ import Data.List.NonEmpty (NonEmpty) import Data.List.NonEmpty qualified as NonEmpty (toList) +{-|+This type configures both errors that make labels and those that make reasons.+-} type LabelWithExplainConfig :: *-data LabelWithExplainConfig = LENotConfigured-                            | LELabel !(Set String)-                            | LEReason !String-                            | LEHidden-                            | LELabelAndReason !(Set String) !String+data LabelWithExplainConfig+  -- | No special labels or reasons should be generated, and default errors should be used instead.+  = LENotConfigured+  -- | The configuration produces the labels in the given set, which should be non-empty.+  | LELabel !(Set String)+  -- | The error should be displayed using the given reason.+  | LEReason !String+  -- | This label should be hidden.+  | LEHidden+  -- | The configuration produces the labels in the given set, and provides the given reason.+  | LELabelAndReason !(Set String) !String +{-|+This type configures errors that make labels.+-} type LabelConfig :: *-data LabelConfig = LNotConfigured-                 | LLabel !(Set String)-                 | LHidden+data LabelConfig+  -- | No special labels should be generated, and default errors should be used instead.+  = LNotConfigured+  -- | The configuration produces the labels in the given set, which should not be empty.+  | LLabel !(Set String)+  -- | This label should be hidden.+  | LHidden +{-|+This type configures errors that give reasons.+-} type ExplainConfig :: *-data ExplainConfig = ENotConfigured-                   | EReason !String+data ExplainConfig+  -- | No special reasons should be generated, and default errors should be used instead.+  = ENotConfigured+  -- | The error should be displayed using the given reason.+  | EReason !String +{-|+A type @config@ is an 'Annotate' if it can be used to attach extra information to a 'Parsec' parser.++These annotations may consist of, for example:++- Labels ('LabelConfig'), which give a parser a name (or names) they can be referred to by.+- Reasons for errors ('ExplainConfig'), which will supply a reason for when a parser produces an error.+-} type Annotate :: * -> Constraint class Annotate config where-  annotate :: config -> Parsec a -> Parsec a+  -- | Annotate the given parser according to the @config@.+  annotate :: config   -- ^ The configuration controlling the annotation.+           -> Parsec a -- ^ The parser to annotate+           -> Parsec a -- ^ An annotated parser.  instance Annotate LabelConfig where   annotate LNotConfigured = id@@ -57,28 +90,140 @@   annotate (LEReason r) = Errors.explain r   annotate (LELabelAndReason ls r) = Errors.label ls . Errors.explain r +{-|+Configures how filters should be used within the 'Text.Gigaparsec.Token.Lexer.Lexer'.+-} type FilterConfig :: * -> *-data FilterConfig a = VSBasicFilter-                    | VSSpecializedFilter (a -> NonEmpty String)-                    | VSUnexpected (a -> String)-                    | VSBecause (a -> String)-                    | VSUnexpectedBecause (a -> String) (a -> String)+data FilterConfig a+  -- | No error configuration for the filter is specified; a regular filter is used instead.+  = VSBasicFilter+  {-|+  Ensure the filter will generate specialised messages for the given failing parse. +  Usage: @'VSSpecializedFilter' message@, where++  - @message@: a function producing the message for the given value.+  -}+  | VSSpecializedFilter+    (a -> NonEmpty String) -- ^ a function producing the message for the given value.+  {-|+  Ensure the filter generates a /vanilla/ unexpected item for the given failing parse.++  Usage: @'VSUnexpected' unexpected@, where++  - @unexpected@: a function producing the unexpected label for the given value.+  -}+  | VSUnexpected (a -> String)+  {-|+  Ensure that the filter will generate a /vanilla/ reason for the given failing parse.++  Usage: @'VSBecause' reason@, where++  - @reason@: a function producing the reason for the given value.+  -}+  | VSBecause+    (a -> String) -- ^ a function producing the reason for the given value.+  {-|+  The filter generates a /vanilla/ unexpected item and a reason for the given failing parse.++  Usage: @'VSUnexpectedBecause' reason unexpected@, where++  - @reason@: a function producing the reason for the given value.+  - @unexpected@: a function producing the unexpected label for the given value.+  -}+  | VSUnexpectedBecause+    (a -> String) -- ^ a function producing the reason for the given value.+    (a -> String) -- ^ a function producing the unexpected label for the given value.++{-|+Specifies that only filters generating /vanilla/ errors can be used.+-} type VanillaFilterConfig :: * -> *-data VanillaFilterConfig a = VBasicFilter-                           | VUnexpected (a -> String)-                           | VBecause (a -> String)-                           | VUnexpectedBecause (a -> String) (a -> String)+data VanillaFilterConfig a+  -- | No error configuration for the filter is specified; a regular filter is used instead.+  = VBasicFilter+  {-|+  Ensure the filter generates a /vanilla/ unexpected item for the given failing parse. +  Usage: @'VUnexpected' unexpected@, where++  - @unexpected@: a function producing the unexpected label for the given value.+  -}+  | VUnexpected+    (a -> String) -- ^ a function producing the unexpected label for the given value.+  {-|+  Ensure that the filter will generate a /vanilla/ reason for the given failing parse.++  Usage: @'VBecause' reason@, where++  - @reason@: a function producing the reason for the given value.+  -}+  | VBecause+    (a -> String)+  {-|+  The filter generates a /vanilla/ unexpected item, and a reason for the given failing parse.++  Usage: @'VUnexpectedBecause' reason unexpected@, where++  - @reason@: a function producing the reason for the given value.+  - @unexpected@: a function producing the unexpected label for the given value.+  -}+  | VUnexpectedBecause+    (a -> String) -- ^ a function producing the reason for the given value.+    (a -> String) -- ^ a function producing the unexpected label for the given value.++{-|+Specifies that only filters generating /specialised/ errors can be used.+-} type SpecializedFilterConfig :: * -> *-data SpecializedFilterConfig a = SBasicFilter-                               | SSpecializedFilter (a -> NonEmpty String)+data SpecializedFilterConfig a+  -- | No error configuration for the filter is specified; a regular filter is used instead.+  = SBasicFilter+  {-|+  Ensure the filter will generate specialised messages for the given failing parse. +  Usage: @'SSpecializedFilter' message@, where++  - @message@: a function producing the message for the given value.+  -}+  | SSpecializedFilter+    (a -> NonEmpty String) -- ^ a function producing the message for the given value.+++{-|+A type @config@ is a 'Filter' when it describes how to process the results of a 'Errors.filterS' or 'Errors.mapMaybeS' on a parser.++The @config@ may allow for these results to have more specialised error messages.+-} type Filter :: (* -> *) -> Constraint class Filter config where-  filterS :: config a -> (a -> Bool) -> Parsec a -> Parsec a+  {-|+  Filter a parser according to a predicate, use the @config@ to improve the error message if the predicate fails.++  This combinator filters the result of this parser using a given predicate, succeeding only if the predicate returns true;+  if the predicate fails, the @config@ is used to elaborate the error message.++  This will likely have the same success/failure behaviour as 'Errors.filterS', except the messages output by failure will+  be changed according to the @config@.+  -}+  filterS :: config a     -- ^ The configuration which alters the failure message.+          -> (a -> Bool)  -- ^ @pred@, the predicate to filter by.+          -> Parsec a     -- ^ @p@, the parser whose results are to be filtered.+          -> Parsec a     -- ^ a parser that returns the result of @p@ if it passes @pred@;+                          --   if @pred@ fails, then the error message is altered according to the config.   filterS = filterS' id-  mapMaybeS :: config a -> (a -> Maybe b) -> Parsec a -> Parsec b+  {-|+  This combinator filters the result of this parser using a given predicate, succeeding only if the predicate returns @Just x@ for some @x@;+  if the predicate fails, the @config@ is used to elaborate the error message.++  This will likely have the same success/failure behaviour as 'Errors.mapMaybeS', except the messages output by failure will+  be changed according to the @config@.+  -}+  mapMaybeS :: config a       -- ^ The configuration which alters the failure message.+            -> (a -> Maybe b) -- ^ @pred@, the predicate to filter by.+            -> Parsec a       -- ^ @p@, the parser whose results are to be filtered.+            -> Parsec b       -- ^ a parser that returns the result of @pred@ applied to that of @p@;+                              --   if @pred@ returns @Nothing@, then the error message is altered according to the config.   mapMaybeS = mapMaybeS' id    filterS' :: (a -> x) -> config x -> (a -> Bool) -> Parsec a -> Parsec a@@ -126,10 +271,26 @@ mapMaybeSDefault filt f config g = fmap (fromJust . g) . filt f config (isJust . g)  +{-|+Configures what error should be generated when illegal characters in a string or character literal are parsable.+-} type VerifiedBadChars :: *-data VerifiedBadChars = BadCharsFail !(Map Char (NonEmpty String))-                      | BadCharsReason !(Map Char String)-                      | BadCharsUnverified+data VerifiedBadChars+  {-|+  "bad literal chars" generate a bunch of given messages in a specialised error.+  The map sends bad characters to their messages.+  -}+  = BadCharsFail !(Map Char (NonEmpty String))+  {-|+  "bad literal chars" generate a reason as a /vanilla/ error.+  The map sends bad characters to their reasons.+  -}+  | BadCharsReason !(Map Char String)+  {-|+  Disable the verified error for bad characters:+  this may improve parsing performance slightly on the failure case.+  -}+  | BadCharsUnverified  checkBadChar :: VerifiedBadChars -> Parsec a checkBadChar (BadCharsFail cs) = verifiedFail (NonEmpty.toList . (cs Map.!)) (satisfy (`Map.member` cs))

@@ -53,17 +53,36 @@ import Control.Monad (join, guard) import System.IO.Unsafe (unsafePerformIO) +{-|+A lexer describes how to transform the input string into a series of tokens.+-} type Lexer :: *-data Lexer = Lexer { lexeme :: !Lexeme-                   , nonlexeme :: !Lexeme-                   , fully :: !(forall a. Parsec a -> Parsec a)-                   , space :: !Space-                   }+data Lexer = Lexer { +  -- | This contains parsers for tokens treated as "words", +  -- such that whitespace will be consumed after each token has been parsed.+    lexeme :: !Lexeme+  -- | This contains parsers for tokens that do not give any special treatment to whitespace.+  , nonlexeme :: !Lexeme+  -- | This combinator ensures a parser fully parses all available input, and consumes whitespace at the start.+  , fully :: !(forall a. Parsec a -> Parsec a)+  -- | This contains parsers that directly treat whitespace.+  , space :: !Space+  } -mkLexer :: Desc.LexicalDesc -> Lexer+{-|+Create a 'Lexer' with a given description for the lexical structure of the language.+-}+mkLexer :: Desc.LexicalDesc -- ^ The description of the lexical structure of the language.+        -> Lexer -- ^ A lexer which can convert the input stream into a series of lexemes. mkLexer !desc = mkLexerWithErrorConfig desc defaultErrorConfig -mkLexerWithErrorConfig :: Desc.LexicalDesc -> ErrorConfig -> Lexer+{-|+Create a 'Lexer' with a given description for the lexical structure of the language, +which reports errors according to the given error config.+-}+mkLexerWithErrorConfig  :: Desc.LexicalDesc -- ^ The description of the lexical structure of the language.+                        -> ErrorConfig -- ^ The description of how to process errors during lexing.+                        -> Lexer -- ^ A lexer which can convert the input stream into a series of lexemes. mkLexerWithErrorConfig Desc.LexicalDesc{..} !errConfig = Lexer {..}   where apply p = p <* whiteSpace space         gen = mkGeneric errConfig@@ -115,47 +134,164 @@         space = mkSpace spaceDesc errConfig  --TODO: better name for this, I guess?+{-|+A 'Lexeme' is a collection of parsers for handling various tokens (such as symbols and names), where either all or none of the parsers consume whitespace.+-} type Lexeme :: *-data Lexeme = Lexeme-                { apply :: !(forall a. Parsec a -> Parsec a) -- this is tricky...-                , sym :: !(String -> Parsec ())-                , symbol :: !Symbol-                , names :: !Names-                , natural :: !(IntegerParsers CanHoldUnsigned)-                , integer :: !(IntegerParsers CanHoldSigned)-                -- desperate times, desperate measures-                --, floating :: !FloatingParsers-                --, unsignedCombined :: !CombinedParsers-                --, signedCombined :: !CombinedParsers-                , stringLiteral :: !(TextParsers String)-                , rawStringLiteral :: !(TextParsers String)-                , multiStringLiteral :: !(TextParsers String)-                , rawMultiStringLiteral :: !(TextParsers String)-                , charLiteral :: !(TextParsers Char)-                }-            | NonLexeme-                { sym :: !(String -> Parsec ())-                , symbol :: !Symbol-                , names :: !Names-                , natural :: !(IntegerParsers CanHoldUnsigned)-                , integer :: !(IntegerParsers CanHoldSigned)-                -- desperate times, desperate measures-                --, floating :: !FloatingParsers-                --, unsignedCombined :: !CombinedParsers-                --, signedCombined :: !CombinedParsers-                , stringLiteral :: !(TextParsers String)-                , rawStringLiteral :: !(TextParsers String)-                , multiStringLiteral :: !(TextParsers String)-                , rawMultiStringLiteral :: !(TextParsers String)-                , charLiteral :: !(TextParsers Char)-                }+data Lexeme = +  -- | The parsers do consume whitespace+  Lexeme {+      -- | This turns a non-lexeme parser into a lexeme one by ensuring whitespace is consumed after the parser.+        apply :: !(forall a. Parsec a -> Parsec a) -- this is tricky...+      -- | Parse the given string.+      , sym :: !(String -> Parsec ())+      -- | This contains lexing functionality relevant to the parsing of atomic symbols.+      , symbol :: !Symbol+      -- | This contains lexing functionality relevant to the parsing of names, which include operators or identifiers.+      -- The parsing of names is mostly concerned with finding the longest valid name that is not a reserved name, +      -- such as a hard keyword or a special operator.+      , names :: !Names+      -- | A collection of parsers concerned with handling unsigned (positive) integer literals.+      , natural :: !(IntegerParsers CanHoldUnsigned)+      {-|+      This is a collection of parsers concerned with handling signed integer literals. +      Signed integer literals are an extension of unsigned integer literals which may be prefixed by a sign.+      -}+      , integer :: !(IntegerParsers CanHoldSigned)+      -- desperate times, desperate measures+      --, floating :: !FloatingParsers+      --, unsignedCombined :: !CombinedParsers+      --, signedCombined :: !CombinedParsers+      {-|+      A collection of parsers concerned with handling single-line string literals.++      String literals are generally described by the 'Text.Gigaparsec.Token.Descriptions.TextDesc' fields:++      * 'Text.Gigaparsec.Token.Descriptions.stringEnds'+      * 'Text.Gigaparsec.Token.Descriptions.graphicCharacter'+      * 'Text.Gigaparsec.Token.Descriptions.escapeSequences'++      -}+      , stringLiteral :: !(TextParsers String)+      {-|+      A collection of parsers concerned with handling single-line string literals, /without/ handling any escape sequences:+      this includes literal-end characters and the escape prefix (often @"@ and @\\@ respectively).++      String literals are generally described by the 'Text.Gigaparsec.Token.Descriptions.TextDesc' fields:++      * 'Text.Gigaparsec.Token.Descriptions.stringEnds'+      * 'Text.Gigaparsec.Token.Descriptions.graphicCharacter'+      * 'Text.Gigaparsec.Token.Descriptions.escapeSequences'++      -}+      , rawStringLiteral :: !(TextParsers String)+      {-|+      A collection of parsers concerned with handling multi-line string literals.++      Multi-string literals are generally described by the 'Text.Gigaparsec.Token.Descriptions.TextDesc' fields:++      * 'Text.Gigaparsec.Token.Descriptions.multiStringEnds'+      * 'Text.Gigaparsec.Token.Descriptions.graphicCharacter'+      * 'Text.Gigaparsec.Token.Descriptions.escapeSequences'++      -}+      , multiStringLiteral :: !(TextParsers String)+      {-|+      A collection of parsers concerned with handling multi-line string literals, /without/ handling any escape sequences:+      this includes literal-end characters and the escape prefix (often @"@ and @\\@ respectively).++      Multi-string literals are generally described by the 'Text.Gigaparsec.Token.Descriptions.TextDesc' fields:++      * 'Text.Gigaparsec.Token.Descriptions.multiStringEnds'+      * 'Text.Gigaparsec.Token.Descriptions.graphicCharacter'+      * 'Text.Gigaparsec.Token.Descriptions.escapeSequences'+  +      -}+      , rawMultiStringLiteral :: !(TextParsers String)+      {-|+      A collection of parsers concerned with handling character literals.++      Charcter literals are generally described by the 'Text.Gigaparsec.Token.Descriptions.TextDesc' fields:++      * 'Text.Gigaparsec.Token.Descriptions.characterLiteralEnd'+      * 'Text.Gigaparsec.Token.Descriptions.graphicCharacter'+      * 'Text.Gigaparsec.Token.Descriptions.escapeSequences'++      -}+      , charLiteral :: !(TextParsers Char)+      }+  -- | The parsers do not consume whitespace+  | NonLexeme {+        sym :: !(String -> Parsec ())+      , symbol :: !Symbol+      , names :: !Names+      , natural :: !(IntegerParsers CanHoldUnsigned)+      , integer :: !(IntegerParsers CanHoldSigned)+      -- desperate times, desperate measures+      --, floating :: !FloatingParsers+      --, unsignedCombined :: !CombinedParsers+      --, signedCombined :: !CombinedParsers+      , stringLiteral :: !(TextParsers String)+      , rawStringLiteral :: !(TextParsers String)+      , multiStringLiteral :: !(TextParsers String)+      , rawMultiStringLiteral :: !(TextParsers String)+      , charLiteral :: !(TextParsers Char)+      }++{-|+This type is concerned with special treatment of whitespace.++For the vast majority of cases, the functionality within this object shouldn't be needed, +as whitespace is consistently handled by lexeme and fully. +However, for grammars where whitespace is significant (like indentation-sensitive languages), +this object provides some more fine-grained control over how whitespace is consumed by the parsers within lexeme.+-} type Space :: *-data Space = Space { whiteSpace :: !(Parsec ())-                   , skipComments :: !(Parsec ())-                   , alter :: forall a. Desc.CharPredicate -> Parsec a -> Parsec a-                   , initSpace :: Parsec ()-                   }+data Space = Space { +  {-|+  Skips zero or more (insignificant) whitespace characters as well as comments.++  The implementation of this parser depends on whether 'Text.Gigaparsec.Token.Descriptions.whiteSpaceIsContextDependent' is true: +  when it is, this parser may change based on the use of the alter combinator. ++  This parser will always use the hide combinator as to not appear as a valid alternative in an error message: +  it's likely always the case whitespace can be added at any given time, but that doesn't make it a useful suggestion unless it is significant.+  -}+    whiteSpace :: !(Parsec ())+  {-|+  Skips zero or more comments.++  The implementation of this combinator does not vary with 'Text.Gigaparsec.Token.Descriptions.whiteSpaceIsContextDependent'. +  It will use the hide combinator as to not appear as a valid alternative in an error message: +  adding a comment is often legal, +  but not a useful solution for how to make the input syntactically valid.+  -}+  , skipComments :: !(Parsec ())+  {-|+  This combinator changes how lexemes parse whitespace for the duration of a given parser.++  So long as 'Text.Gigaparsec.Token.Descriptions.whiteSpaceIsContextDependent' is true, +  this combinator will be able to locally change the definition of whitespace during the given parser.++  === __Examples__+  * In indentation sensitive languages, the indentation sensitivity is often ignored within parentheses or braces. +  In these cases, +  @parens (alter withNewLine p)@ +  would allow unrestricted newlines within parentheses.+  -}+  , alter :: forall a. Desc.CharPredicate -> Parsec a -> Parsec a+  {-|+  This parser initialises the whitespace used by the lexer when 'Text.Gigaparsec.Token.Descriptions.whiteSpaceIsContextDependent' is true.++  The whitespace is set to the implementation given by the lexical description.+  This parser must be used, by fully or otherwise, +  as the first thing the global parser does or an UnfilledRegisterException will occur.++  See 'alter' for how to change whitespace during a parse.+  -}+  , initSpace :: Parsec ()+  }  mkSpace :: Desc.SpaceDesc -> ErrorConfig -> Space mkSpace desc@Desc.SpaceDesc{..} !errConfig = Space {..}

@@ -27,14 +27,68 @@ import Text.Gigaparsec.Internal.Token.Errors (filterS)  -- TODO: primes are gross, better way?+{-|+This class defines a uniform interface for defining parsers for user-defined names +(identifiers and operators), independent of how whitespace should be handled after the name.++The parsing of names is mostly concerned with finding the longest valid name that is not a reserved name, +such as a hard keyword or a special operator.+-} type Names :: *-data Names = Names { identifier :: !(Parsec String)-                   , identifier' :: !(CharPredicate -> Parsec String)-                   , userDefinedOperator :: !(Parsec String)-                   , userDefinedOperator' :: !(CharPredicate -> Parsec String)-                   }+data Names = Names { +  {-| +  Parse an identifier based on the given 'NameDesc' predicates 'identifierStart' and 'identifierLetter'.+  The 'NameDesc' is provided by 'mkNames'. -mkNames :: NameDesc -> SymbolDesc -> ErrorConfig -> Names+  Capable of handling unicode characters if the configuration permits.+  If hard keywords are specified by the configuration, this parser is not permitted to parse them.+  -}+    identifier :: !(Parsec String)+  {-| +  Parse an identifier whose start satisfies the given predicate, and subseqeunt letters satisfy 'identifierLetter' in the given 'NameDesc'.+  The 'NameDesc' is provided by 'mkNames'.++  Behaves as 'identifier', then ensures the first character matches the given predicate.+  Thus, 'identifier'' can only /refine/ the output of 'identifier';+  if 'identifier' fails due to the first character, then so will 'identifier'', +  even if this character passes the supplied predicate.+  +  Capable of handling unicode characters if the configuration permits.+  If hard keywords are specified by the configuration, this parser is not permitted to parse them.+  -}+  , identifier' :: !(CharPredicate -> Parsec String)+  {-| +  Parse a user-defined operator based on the given 'SymbolDesc' predicates 'operatorStart' and 'operatorLetter'.+  The 'SymbolDesc' is provided by 'mkNames'.++  Capable of handling unicode characters if the configuration permits. +  If hard operators are specified by the configuration, this parser is not permitted to parse them.+  -}+  , userDefinedOperator :: !(Parsec String)+  {-| +  Parse a user-defined operator whose first character satisfies the given predicate,+  and subsequent characters satisfying 'operatorLetter' in the given 'SymbolDesc'.+  The 'SymbolDesc' is provided by 'mkNames'.++  Behaves as 'userDefinedOperator', then ensures the first character matches the given predicate.+  Thus, 'userDefinedOperator'' can only /refine/ the output of 'userDefinedOperator';+  if 'userDefinedOperator' fails due to the first character, then so will 'userDefinedOperator'', +  even if this character passes the supplied predicate.++  Capable of handling unicode characters if the configuration permits. +  If hard operators are specified by the configuration, this parser is not permitted to parse them.+  -}+  , userDefinedOperator' :: !(CharPredicate -> Parsec String)+  }++{-|+Create a 'Names' -- an interface for parsing identifiers and operators +-- according to the given name and symbol descriptions.+-}+mkNames :: NameDesc    -- ^ the description of identifiers.+        -> SymbolDesc  -- ^ the description of symbols.+        -> ErrorConfig -- ^ how errors should be produced on failed parses.+        -> Names       -- ^ a collection of parsers for identifiers and operators as described by the given descriptions. mkNames NameDesc{..} symbolDesc@SymbolDesc{..} !err = Names {..}   where     !isReserved = isReservedName symbolDesc

@@ -37,19 +37,31 @@ import Text.Gigaparsec.Internal.Token.Errors (mapMaybeS, LabelWithExplainConfig, annotate)  -- TODO: switch to private versions in future+{-|+A uniform interface for defining parsers for integer literals, +independent of how whitespace should be handled after the literal +or whether the literal should allow for negative numbers.+-} type IntegerParsers :: (Bits -> * -> Constraint) -> *-data IntegerParsers canHold = IntegerParsers { decimal :: Parsec Integer-                                             , hexadecimal :: Parsec Integer-                                             , octal :: Parsec Integer-                                             , binary :: Parsec Integer-                                             , number :: Parsec Integer-                                             , _bounded :: forall (bits :: Bits) t. canHold bits t-                                                        => Proxy bits-                                                        -> Parsec Integer-                                                        -> Int-                                                        -> (ErrorConfig -> Bool -> Maybe Bits -> LabelWithExplainConfig)-                                                        -> Parsec t-                                             }+data IntegerParsers canHold = IntegerParsers { +  -- | Parse a single integer literal in decimal form (base 10).+    decimal :: Parsec Integer+  -- | Parse a single integer literal in hexadecimal form (base 16).+  , hexadecimal :: Parsec Integer+  -- | Parse a single integer literal in octal form (base 8).+  , octal :: Parsec Integer+  -- | Parse a single integer literal in binary form (base 2).+  , binary :: Parsec Integer+  -- | Parse a single integer literal, +  -- which can be in many forms and bases depending on the configuration.+  , number :: Parsec Integer+  , _bounded :: forall (bits :: Bits) t. canHold bits t+            => Proxy bits+            -> Parsec Integer+            -> Int+            -> (ErrorConfig -> Bool -> Maybe Bits -> LabelWithExplainConfig)+            -> Parsec t+  }  decimalBounded :: forall (bits :: Bits) canHold t. canHold bits t => IntegerParsers canHold -> Parsec t decimalBounded IntegerParsers{..} = _bounded (Proxy @bits) decimal 10 label@@ -76,47 +88,198 @@   where label !err True = labelIntegerSignedNumber err         label err False = labelIntegerUnsignedNumber err +{-|+This parser behaves the same as 'decimal' except it ensures that the resulting value is a valid 8-bit number.++The resulting number will be converted to the given type @a@, which must be able to losslessly store the parsed value; +this is enforced by the @canHold@ constraint on the type. +This accounts for unsignedness when necessary.+-} decimal8 :: forall a canHold. canHold 'B8 a => IntegerParsers canHold -> Parsec a decimal8 = decimalBounded @'B8+{-|+This parser behaves the same as 'hexadecimal' except it ensures that the resulting value is a valid 8-bit number.++The resulting number will be converted to the given type @a@, which must be able to losslessly store the parsed value; +this is enforced by the @canHold@ constraint on the type. +This accounts for unsignedness when necessary.+-} hexadecimal8 :: forall a canHold. canHold 'B8 a => IntegerParsers canHold -> Parsec a hexadecimal8 = hexadecimalBounded @'B8+{-|+This parser behaves the same as 'octal' except it ensures that the resulting value is a valid 8-bit number.++The resulting number will be converted to the given type @a@, which must be able to losslessly store the parsed value; +this is enforced by the @canHold@ constraint on the type. +This accounts for unsignedness when necessary.+-} octal8 :: forall a canHold. canHold 'B8 a => IntegerParsers canHold -> Parsec a octal8 = octalBounded @'B8+{-|+This parser behaves the same as 'binary' except it ensures that the resulting value is a valid 8-bit number.++The resulting number will be converted to the given type @a@, which must be able to losslessly store the parsed value; +this is enforced by the @canHold@ constraint on the type. +This accounts for unsignedness when necessary.+-} binary8 :: forall a canHold. canHold 'B8 a => IntegerParsers canHold -> Parsec a binary8 = binaryBounded @'B8+{-|+This parser behaves the same as 'number' except it ensures that the resulting value is a valid 8-bit number.++The resulting number will be converted to the given type @a@, which must be able to losslessly store the parsed value; +this is enforced by the @canHold@ constraint on the type. +This accounts for unsignedness when necessary.+-} number8 :: forall a canHold. canHold 'B8 a => IntegerParsers canHold -> Parsec a number8 = numberBounded @'B8 ++---------------------------------------------------------------------------------------------------+-- *** 16-bit Parsers++{-|+This parser behaves the same as 'decimal' except it ensures that the resulting value is a valid 16-bit number.++The resulting number will be converted to the given type @a@, which must be able to losslessly store the parsed value; +this is enforced by the @canHold@ constraint on the type. +This accounts for unsignedness when necessary.+-} decimal16 :: forall a canHold. canHold 'B16 a => IntegerParsers canHold -> Parsec a decimal16 = decimalBounded @'B16+{-|+This parser behaves the same as 'hexadecimal' except it ensures that the resulting value is a valid 16-bit number.++The resulting number will be converted to the given type @a@, which must be able to losslessly store the parsed value; +this is enforced by the @canHold@ constraint on the type. +This accounts for unsignedness when necessary.+-} hexadecimal16 :: forall a canHold. canHold 'B16 a => IntegerParsers canHold -> Parsec a hexadecimal16 = hexadecimalBounded @'B16+{-|+This parser behaves the same as 'octal' except it ensures that the resulting value is a valid 16-bit number.++The resulting number will be converted to the given type @a@, which must be able to losslessly store the parsed value; +this is enforced by the @canHold@ constraint on the type. +This accounts for unsignedness when necessary.+-} octal16 :: forall a canHold. canHold 'B16 a => IntegerParsers canHold -> Parsec a octal16 = octalBounded @'B16+{-|+This parser behaves the same as 'binary' except it ensures that the resulting value is a valid 16-bit number.++The resulting number will be converted to the given type @a@, which must be able to losslessly store the parsed value; +this is enforced by the @canHold@ constraint on the type. +This accounts for unsignedness when necessary.+-} binary16 :: forall a canHold. canHold 'B16 a => IntegerParsers canHold -> Parsec a binary16 = binaryBounded @'B16+{-|+This parser behaves the same as 'number' except it ensures that the resulting value is a valid 16-bit number.++The resulting number will be converted to the given type @a@, which must be able to losslessly store the parsed value; +this is enforced by the @canHold@ constraint on the type. +This accounts for unsignedness when necessary.+-} number16 :: forall a canHold. canHold 'B16 a => IntegerParsers canHold -> Parsec a number16 = numberBounded @'B16 ++---------------------------------------------------------------------------------------------------+-- *** 32-bit Parsers+{-|+This parser behaves the same as 'decimal' except it ensures that the resulting value is a valid 32-bit number.++The resulting number will be converted to the given type @a@, which must be able to losslessly store the parsed value; +this is enforced by the @canHold@ constraint on the type. +This accounts for unsignedness when necessary.+-} decimal32 :: forall a canHold. canHold 'B32 a => IntegerParsers canHold -> Parsec a decimal32 = decimalBounded @'B32+{-|+This parser behaves the same as 'hexadecimal' except it ensures that the resulting value is a valid 32-bit number.++The resulting number will be converted to the given type @a@, which must be able to losslessly store the parsed value; +this is enforced by the @canHold@ constraint on the type. +This accounts for unsignedness when necessary.+-} hexadecimal32 :: forall a canHold. canHold 'B32 a => IntegerParsers canHold -> Parsec a hexadecimal32 = hexadecimalBounded @'B32+{-|+This parser behaves the same as 'octal' except it ensures that the resulting value is a valid 32-bit number.++The resulting number will be converted to the given type @a@, which must be able to losslessly store the parsed value; +this is enforced by the @canHold@ constraint on the type. +This accounts for unsignedness when necessary.+-} octal32 :: forall a canHold. canHold 'B32 a => IntegerParsers canHold -> Parsec a octal32 = octalBounded @'B32+{-|+This parser behaves the same as 'binary' except it ensures that the resulting value is a valid 32-bit number.++The resulting number will be converted to the given type @a@, which must be able to losslessly store the parsed value; +this is enforced by the @canHold@ constraint on the type. +This accounts for unsignedness when necessary.+-} binary32 :: forall a canHold. canHold 'B32 a => IntegerParsers canHold -> Parsec a binary32 = binaryBounded @'B32+{-|+This parser behaves the same as 'number' except it ensures that the resulting value is a valid 32-bit number.++The resulting number will be converted to the given type @a@, which must be able to losslessly store the parsed value; +this is enforced by the @canHold@ constraint on the type. +This accounts for unsignedness when necessary.+-} number32 :: forall a canHold. canHold 'B32 a => IntegerParsers canHold -> Parsec a number32 = numberBounded @'B32 ++---------------------------------------------------------------------------------------------------+-- *** 64-bit Parsers++{-|+This parser behaves the same as 'decimal' except it ensures that the resulting value is a valid 64-bit number.++The resulting number will be converted to the given type @a@, which must be able to losslessly store the parsed value; +this is enforced by the @canHold@ constraint on the type. +This accounts for unsignedness when necessary.+-} decimal64 :: forall a canHold. canHold 'B64 a => IntegerParsers canHold -> Parsec a decimal64 = decimalBounded @'B64+{-|+This parser behaves the same as 'hexadecimal' except it ensures that the resulting value is a valid 64-bit number.++The resulting number will be converted to the given type @a@, which must be able to losslessly store the parsed value; +this is enforced by the @canHold@ constraint on the type. +This accounts for unsignedness when necessary.+-} hexadecimal64 :: forall a canHold. canHold 'B64 a => IntegerParsers canHold -> Parsec a hexadecimal64 = hexadecimalBounded @'B64+{-|+This parser behaves the same as 'octal' except it ensures that the resulting value is a valid 64-bit number.++The resulting number will be converted to the given type @a@, which must be able to losslessly store the parsed value; +this is enforced by the @canHold@ constraint on the type. +This accounts for unsignedness when necessary.+-} octal64 :: forall a canHold. canHold 'B64 a => IntegerParsers canHold -> Parsec a octal64 = octalBounded @'B64+{-|+This parser behaves the same as 'binary' except it ensures that the resulting value is a valid 64-bit number.++The resulting number will be converted to the given type @a@, which must be able to losslessly store the parsed value; +this is enforced by the @canHold@ constraint on the type. +This accounts for unsignedness when necessary.+-} binary64 :: forall a canHold. canHold 'B64 a => IntegerParsers canHold -> Parsec a binary64 = binaryBounded @'B64+{-|+This parser behaves the same as 'number' except it ensures that the resulting value is a valid 64-bit number.++The resulting number will be converted to the given type @a@, which must be able to losslessly store the parsed value; +this is enforced by the @canHold@ constraint on the type. +This accounts for unsignedness when necessary.+-} number64 :: forall a canHold. canHold 'B64 a => IntegerParsers canHold -> Parsec a number64 = numberBounded @'B64 

@@ -0,0 +1,411 @@+{-# LANGUAGE Trustworthy #-}++{-# OPTIONS_HADDOCK hide #-}++{-# LANGUAGE CPP #-}+{-# LANGUAGE DeriveTraversable #-}+{-# LANGUAGE ExistentialQuantification #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE NamedFieldPuns #-}+{-# LANGUAGE PatternSynonyms #-}+{-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE TupleSections #-}+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE TypeOperators #-}+{-# LANGUAGE UnicodeSyntax #-}+{-# LANGUAGE ViewPatterns #-}+{-# OPTIONS_GHC -Wno-missing-import-lists #-}++module Text.Gigaparsec.Internal.Token.Patterns.IntegerParsers (+  module Text.Gigaparsec.Internal.Token.Patterns.IntegerParsers+) where++import Text.Gigaparsec (Parsec)+import Text.Gigaparsec.Internal.Token.Lexer (natural, integer)+++++import Control.Monad (forM)+import Data.Bitraversable (bisequence)+import Data.Function (on)+import Data.List (groupBy)+import Data.Map (Map)+import Data.Map qualified as Map+import Data.Maybe (fromJust)+import Data.Set (Set)+import Data.Set qualified as Set+import Language.Haskell.TH (+  RuleMatch (FunLike),+  pragInlD,+  sigD,+  varE,+ )+import Text.Gigaparsec.Internal.TH.VersionAgnostic (Name, Dec (..), Exp, Inline (Inline), Phases (AllPhases), Q, Quote (newName), Type, nameBase)+import Text.Gigaparsec.Internal.Token.BitBounds (Bits (..))+import Text.Gigaparsec.Token.Lexer qualified as Lexer++import GHC.Exts (IsList (..))+import Text.Gigaparsec.Internal.TH.DecUtils (funDsingleClause)+import Text.Gigaparsec.Internal.Token.Patterns.LexerCombinators++intLitBaseList :: [IntLitBase]+intLitBaseList = [Binary, Octal, Decimal, Hexadecimal]++-- | Names of the+integerParsers :: [(Name, IntLitBase)]+integerParsers =+  [ 'Lexer.binary+  , 'Lexer.octal+  , 'Lexer.decimal+  , 'Lexer.hexadecimal+  ]+    `zip` intLitBaseList++intParsers8Bit :: [(Name, IntLitBase)]+intParsers8Bit =+  [ 'Lexer.binary8+  , 'Lexer.octal8+  , 'Lexer.decimal8+  , 'Lexer.hexadecimal8+  ]+    `zip` intLitBaseList++intParsers16Bit :: [(Name, IntLitBase)]+intParsers16Bit =+  [ 'Lexer.binary16+  , 'Lexer.octal16+  , 'Lexer.decimal16+  , 'Lexer.hexadecimal16+  ]+    `zip` intLitBaseList++intParsers32Bit :: [(Name, IntLitBase)]+intParsers32Bit =+  [ 'Lexer.binary32+  , 'Lexer.octal32+  , 'Lexer.decimal32+  , 'Lexer.hexadecimal32+  ]+    `zip` intLitBaseList++intParsers64Bit :: [(Name, IntLitBase)]+intParsers64Bit =+  [ 'Lexer.binary64+  , 'Lexer.octal64+  , 'Lexer.decimal64+  , 'Lexer.hexadecimal64+  ]+    `zip` intLitBaseList++{-|+The base of a numeric literal.++Used in `IntegerParserConfig` to specify which parsers for which bases should be generated.++@since 0.4.0.0++-}+type IntLitBase :: *+data IntLitBase+  = Binary+  | Octal+  | Decimal+  | Hexadecimal+  deriving stock (Show, Eq, Ord)++{-|+Set of all possible `IntLitBase`s.++@since 0.4.0.0++-}+allBases :: Set IntLitBase+allBases = Set.fromList [Binary, Octal, Decimal, Hexadecimal]++{-| Determines if the combinators are for 'Signed' or 'Unsigned' int literals.++@since 0.4.0.0++-}+type SignedOrUnsigned :: *+data SignedOrUnsigned = +    {-| The int literal is signed, so can be negative.+    +    @since 0.4.0.0+    +    -}+    Signed +  | {-|  The literal is unsigned, so is always non-negative.+    +    @since 0.4.0.0+    +    -}+    Unsigned++{-|+True when `Signed`.++@since 0.4.0.0++-}+isSigned :: SignedOrUnsigned -> Bool+isSigned Signed = True+isSigned Unsigned = False+++{-|+This type describes how to generate numeric parsers with `generateIntegerParsers`.+This includes configuration for which bases and bitwidths to support, and whether to generate+parsers that can handle multiple bases. ++See the 'emptyIntegerParserConfig' smart constructor to define a 'IntegerParserConfig'.++@since 0.4.0.0++-}+type IntegerParserConfig :: *+data IntegerParserConfig = IntegerParserConfig+  { {-|+    The string to prepend to each generated parser's name (except for the `collatedParser`, if specified).+    +    @since 0.4.0.0++    -}+    prefix :: String+    {-| The fixed bit-widths (8-bit, 16-bit, etc/) for which to generate parsers.++    @since 0.4.0.0++    -}+  , widths :: Map Bits (Q Type)+    {-|+    The numeric bases (binary, octal, etc) for which to generate parsers.++    @since 0.4.0.0++    -}+  , bases :: Set IntLitBase+    {-|+    When 'True', generate the unbounded integer parsers (e.g. `Text.Gigaparsec.Token.Lexer.decimal`) for each base specified in `bases`.+    +    @since 0.4.0.0++    -}+  , includeUnbounded :: Bool+    {-|+    Generate a generic integer parser with the given name,+    at each width (including unbounded) specified by `widths`, that+    is able to parse each base specified in `bases`.+  +    * If 'Nothing', do not generate such a parser.+    * If @'Just' ""@, then the default name will be @"natural"@  or @"integer"@ when `signedOrUnsigned`+      is `Unsigned` or `Signed`, respectively.++    @since 0.4.0.0++    -}+  , collatedParser :: Maybe String+    {-|+    Whether or not the parsers to generate are for 'Signed' or 'Unsigned' integers.++    @since 0.4.0.0+    +    -}+  , signedOrUnsigned :: SignedOrUnsigned+  }++filterByBase :: Set IntLitBase -> [(a, IntLitBase)] -> [a]+filterByBase bs = map fst . filter ((`Set.member` bs) . snd)++filterByWidth :: Bits -> [(Bits, a)] -> [a]+filterByWidth b = map snd . filter ((== b) . fst)++-- | Monoidal when; if false, then return `mempty`+mwhen :: (Monoid m) => Bool -> m -> m+mwhen True x = x+mwhen False _ = mempty++groupByBits :: [(Bits, Name)] -> [(Bits, [Name])]+groupByBits [] = [] -- So that we may assume xs is nonempty in the second line (so we can use head)+groupByBits xs = map (bisequence (fst . head, map snd)) $ groupBy ((==) `on` fst) xs++{-|+This function automatically generates lexer combinators for handling signed or unsigned integers.++See 'IntegerParserConfig' for how to configure which combinators are generated.++/Note:/ Due to staging restrictions in Template Haskell, the `IntegerParserConfig` must be+defined in a separate module to where this function is used.+Multiple configs can be defined in the same module.++==== __Usage:__+First, the config must be defined in another module.+You can define multiple configs in the same module, as long as they are used in a different module.++> {-# LANGUAGE TemplateHaskell, OverloadedLists #-}+> module IntegerConfigs where+> …+> uIntCfg :: IntegerParserConfig+> uIntCfg = emptyUnsignedIntegerParserConfig {+>     prefix = "u",+>     widths = [(B8, [t| Word8 |]), (B32, [t| Word32 |])],+>     bases = [Hexadecimal, Decimal, Binary],+>     includeUnbounded = False,+>     signedOrUnsigned = Unsigned,+>     collatedParser = Just "natural"+>   }++Then, we can feed this config, along with a quoted lexer, to `generateIntegerParsers`:++> {-# LANGUAGE TemplateHaskell #-}+> module Lexer where+> import IntegerConfigs (uIntCfg)+> …+> lexer :: Lexer+> lexer = …+>+> $(generateIntegerParsers [| lexer |] uIntCfg)++This will generate the following combinators,++>    ubinary8 :: Parsec Word8+>    udecimal8 :: Parsec Word8+>    uhexadecimal8 :: Parsec Word8+>    ubinary32 :: Parsec Word32+>    udecimal3 :: Parsec Word32+>    uhexadecimal32 :: Parsec Word32+>    natural8 :: Parsec Word8+>    natural32 :: Parsec Word32++@since 0.4.0.0++-}+generateIntegerParsers +  :: Q Exp               -- ^ The quoted 'Text.Gigaparsec.Token.Lexer.Lexer'+  -> IntegerParserConfig -- ^ The configuration describing what numeric combinators to produce.+  -> Q [Dec]             -- ^ The declarations of the specified combinators.+generateIntegerParsers lexer cfg@IntegerParserConfig{..} = do+  (ubNames, concat -> ubDecs) <- unzip <$> mwhen includeUnbounded (lexerUnboundedParsers lexer cfg)+  (fwNames, fwBits, concat -> fwDecs) <- unzip3 <$> lexerFixedWidthIntParsers lexer cfg+  let fwBitsNames = groupByBits (zip fwBits fwNames)+  cDecs <- maybe mempty (mkCollatedParsers ubNames fwBitsNames) collatedParser+  return $ ubDecs <> fwDecs <> cDecs+ where+  mkCollatedParser :: [Name] -> String -> Q Type -> Q [Dec]+  mkCollatedParser [] _ _ = pure []+  mkCollatedParser (x : xs) nm tp = do+    f <- newName nm+    let body = foldl (\e y -> [|$e <|> $(varE y)|]) [|$(varE x)|] xs+    sequence+      [ pragInlD f Inline FunLike AllPhases+      , sigD f [t|Parsec $tp|]+      , funDsingleClause f body+      ]+  mkCollatedParsers :: [Name] -> [(Bits, [Name])] -> String -> Q [Dec]+  mkCollatedParsers xs bys nm =+    mkCollatedParser xs nm [t|Integer|]+      <> ( concat+            <$> forM+              bys+              ( \(b, nms) ->+                  let tp = fromJust (Map.lookup b widths)+                   in mkCollatedParser nms (bitsSuffix b nm) tp+              )+         )++bitsSuffix :: Bits -> String -> String+bitsSuffix B8 = (++ "8")+bitsSuffix B16 = (++ "16")+bitsSuffix B32 = (++ "32")+bitsSuffix B64 = (++ "64")++{-| An empty `IntegerParserConfig`, which will generate nothing when given to `generateIntegerParsers`.+Extend this using record updates, to tailor a config to your liking.++By default, the `prefix` field is the empty string, which will likely cause issues if you do not override this.++@since 0.4.0.0++-}+emptyIntegerParserConfig :: IntegerParserConfig+emptyIntegerParserConfig =+  IntegerParserConfig+    { prefix = ""+    , widths = Map.empty+    , bases  = Set.empty+    , includeUnbounded = False+    , signedOrUnsigned = Signed+    , collatedParser = Nothing+    }++{-| An empty `IntegerParserConfig` for `Signed` integers, which will generate nothing when given to `generateIntegerParsers`.+Extend this using record updates, to tailor a config to your liking.++By default, the `prefix` field is the empty string, which will likely cause issues if you do not override this.++@since 0.4.0.0++-}+emptySignedIntegerParserConfig :: IntegerParserConfig+emptySignedIntegerParserConfig = emptyIntegerParserConfig{signedOrUnsigned = Signed}++{-| An empty `IntegerParserConfig` for `Unsigned` integers, which will generate nothing when given to `generateIntegerParsers`.+Extend this using record updates, to tailor a config to your liking.++By default, the `prefix` field is the empty string, which will likely cause issues if you do not override this.++@since 0.4.0.0++-}+emptyUnsignedIntegerParserConfig :: IntegerParserConfig+emptyUnsignedIntegerParserConfig = emptyIntegerParserConfig{signedOrUnsigned = Unsigned}++lexerUnboundedParsers ::+  -- | Quoted Lexer+  Q Exp ->+  IntegerParserConfig ->+  -- | The name and definition of each unbounded parsers+  Q [(Name, [Dec])]+lexerUnboundedParsers lexer (IntegerParserConfig{signedOrUnsigned = s, prefix, bases}) = do+  let proj = if isSigned s then [|integer|] else [|natural|]+  let parsers = filterByBase bases integerParsers+  forM+    parsers+    ( \p -> do+        newTp <- getLexerCombinatorType p False+        mkLexerCombinatorDecWithProj lexer (prefix ++ nameBase p) p (pure newTp) proj+    )++lexerFixedWidthIntParsers+  :: Q Exp -- ^ The quoted lexer+  -> IntegerParserConfig -- ^ config+  -> Q [(Name, Bits, [Dec])] -- ^ Name, bitwidth and def of each generated combinator.+lexerFixedWidthIntParsers+  lexer+  (IntegerParserConfig{signedOrUnsigned = sign, prefix, bases, widths}) =+    let proj = if isSigned sign then [|integer|] else [|natural|]+     in forM+          parsersToMake+          ( \(old, bw, newTp) -> do+              (nm, decs) <-+                mkLexerCombinatorDecWithProj+                  lexer+                  (prefix ++ nameBase old)+                  old+                  [t|Parsec $newTp|]+                  proj+              return (nm, bw, decs)+          )+   where+    parsersToMake :: [(Name, Bits, Q Type)]+    parsersToMake =+      concatMap+        (\(b, tp) -> map (,b,tp) (parsersAtWidth b))+        (Map.toList widths)+    parsersAtWidth :: Bits -> [Name]+    parsersAtWidth b = filterByBase bases $ case b of+      B8 -> intParsers8Bit+      B16 -> intParsers16Bit+      B32 -> intParsers32Bit+      B64 -> intParsers64Bit

@@ -0,0 +1,362 @@+{-# LANGUAGE Trustworthy #-}++{-# OPTIONS_HADDOCK hide #-}++{-# LANGUAGE CPP #-}+{-# LANGUAGE DeriveTraversable #-}+{-# LANGUAGE ExistentialQuantification #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE NamedFieldPuns #-}+{-# LANGUAGE PatternSynonyms #-}+{-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE TupleSections #-}+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE TypeOperators #-}+{-# LANGUAGE UnicodeSyntax #-}+{-# LANGUAGE ViewPatterns #-}+{-# OPTIONS_GHC -Wno-unused-do-bind #-}++{- |+Module      : Text.Gigaparsec.Token.Patterns+Description : Template Haskell generators to help with patterns+License     : BSD-3-Clause+Maintainer  : Jamie Willis, Gigaparsec Maintainers+Stability   : experimental++This module is currently experimental, and may have bugs depending on the version+of Haskell, or the extensions enabled. Please report any issues to the maintainers.++@since 0.2.2.0+-}+module Text.Gigaparsec.Internal.Token.Patterns.LexerCombinators (+  module Text.Gigaparsec.Internal.Token.Patterns.LexerCombinators,+) where++import safe Text.Gigaparsec.Internal.Token.Lexer (+  Lexeme (+    charLiteral,+    multiStringLiteral,+    names,+    rawMultiStringLiteral,+    rawStringLiteral,+    stringLiteral,+    symbol+  ),+  Lexer (lexeme, space),+  Space,+ )+import safe Text.Gigaparsec.Internal.Token.Names (Names)+import safe Text.Gigaparsec.Internal.Token.Symbol (Symbol)+import safe Text.Gigaparsec.Internal.Token.Text (TextParsers)++import Text.Gigaparsec.Internal.TH.DecUtils (funDsingleClause)+import Text.Gigaparsec.Internal.TH.TypeUtils (removeUnusedTVars, sanitiseBndrStars, sanitiseTypeStars)++import Text.Gigaparsec.Internal.TH.VersionAgnostic (+  Dec, DocLoc(DeclDoc), Exp, Inline (Inline), Phases (AllPhases), Q, Quasi (qRecover), +  Quote (newName), Type (ForallT), addModFinalizer, getDoc, isInstance, +  nameBase, putDoc, reifyType,+  RuleMatch (FunLike),+  Type (AppT, ArrowT, ForallVisT), +  pattern MulArrowT,+  clause,+  funD,+  normalB,+  pprint,+  pragInlD,+  sigD,+  varE,+  )++import Data.Bifunctor (Bifunctor (first))+import Data.Kind (Constraint)+import Data.Maybe (fromMaybe)+import Text.Gigaparsec.Internal.TH.VersionAgnostic (Name)+import Text.Gigaparsec.Token.Lexer qualified as Lexer++{-|+Generates the specified lexer combinators using a quoted `Lexer`, for example, @[|lexer|]@.++The generated combinators will behave like their counterparts in "Text.Gigaparsec.Token.Lexer", +except they won't require a lexer (or subcomponents thereof) to be supplied as an argument.+++==== __Usage:__++> import Text.Gigaparsec.Token.Lexer qualified as Lexer+> import Text.Gigaparsec.Token.Lexer (Lexer)+> lexer :: Lexer+> $(lexerCombinators [| lexer |] ['Lexer.lexeme, 'Lexer.fully, 'Lexer.identifier, 'Lexer.stringLiteral])++This will generate the following combinators/functions:++> lexeme :: Lexeme+> fully :: ∀ a . Parsec a -> Parsec a+> identifier :: Parsec String+> stringLiteral :: TextParsers String++These will behave like their counterparts in "Text.Gigaparsec.Token.Lexer", except they will not need+a 'Lexer' (or its subcomponents) as an argument.++@since 0.4.0.0++-}+lexerCombinators+  :: Q Exp   -- ^ The quoted 'Lexer'.+  -> [Name]  -- ^ The combinators to generate.+  -> Q [Dec] -- ^ Definitions of the generated combinators.+lexerCombinators lexer ns = lexerCombinatorsWithNames lexer (zip ns (map nameBase ns))++{-|+Generates the specified lexer combinators with the given names using a quoted `Lexer`, for example, @[|lexer|]@.++The generated combinators will behave like their counterparts in "Text.Gigaparsec.Token.Lexer", +except they won't require a lexer (or subcomponents thereof) to be supplied as an argument.+++==== __Usage:__++> import Text.Gigaparsec.Token.Lexer qualified as Lexer+> import Text.Gigaparsec.Token.Lexer (Lexer)+> lexer :: Lexer+> $(lexerCombinatorsWithNames [| lexer |] [('Lexer.lexeme, "myLexeme"), ('Lexer.fully, "myFully")])++This will generate the following combinators/functions:++> myLexeme :: Lexeme+> myFully :: ∀ a . Parsec a -> Parsec a++These will behave like their counterparts in "Text.Gigaparsec.Token.Lexer", except they will not need+a 'Lexer' (or its subcomponents) as an argument.++@since 0.4.0.0++-}+lexerCombinatorsWithNames +  :: Q Exp            -- ^ The quoted `Lexer`.+  -> [(Name, String)] -- ^ The combinators to generate with the given name.+  -> Q [Dec]          -- ^ Definitions of the generated combinators.+lexerCombinatorsWithNames lexer = fmap concat . traverse (uncurry (lexerCombinatorWithName lexer))++{-|+Create a single lexer combinator with a given name, defined in terms of the lexer.+-}+lexerCombinatorWithName+  :: Q Exp+  -> Name -- The name of the old combinator+  -> String -- the new name of the combinator+  -> Q [Dec]+lexerCombinatorWithName lexer old nm = do+  newTp <- getLexerCombinatorType old True+  mkLexerCombinatorDec lexer nm old newTp++{-| +Constructs the combinator using the given type.+Calculates the definition of the combinator using a typeclass (if possible).+-}+mkLexerCombinatorDec+  :: Q Exp -- ^ The quoted Lexer  +  -> String -- ^ The name of the combinator to generate+  -> Name -- ^ The quoted name of the original combinator+  -> Type -- ^ The return type of the new combinator+  -> Q [Dec]+mkLexerCombinatorDec lexer nm old tp = do+  newX <- newName nm+  oldDocs <- getDoc (DeclDoc old)+  let newDocs = fromMaybe "" oldDocs+  addModFinalizer $ putDoc (DeclDoc newX) newDocs+  sequence+    [ pragInlD newX Inline FunLike AllPhases+    , sigD newX (pure tp)+    , funD newX [clause [] (normalB [|project $(varE old) $lexer|]) []]+    ]++{-| +Constructs the combinator using the given type.+Calculates the definition of the combinator using the `LexerField` typeclass (if possible).+-}+mkLexerCombinatorDecWithProj +  :: Q Exp -- ^ The quoted Lexer+  -> String -- ^ The name of the combinator to generate+  -> Name -- ^ @old@, The quoted name of the original combinator+  -> Q Type -- ^ The return type of the new combinator+  -> Q Exp -- ^ projection to precompose the @old@ combinator with+  -> Q (Name, [Dec]) -- ^ The name of the new combinator and its declaration+mkLexerCombinatorDecWithProj lexer nm old tp proj = do+  newX <- newName nm+  oldDocs <- getDoc (DeclDoc old)+  let newDocs = fromMaybe "" oldDocs+  addModFinalizer $ putDoc (DeclDoc newX) newDocs+  (newX,)+    <$> sequence+      [ pragInlD newX Inline FunLike AllPhases+      , sigD newX tp+      , funDsingleClause newX [|project ($(varE old) . $proj) $lexer|]+      ]++{-| +Figures out the type of the combinator minus the domain; this will be one of a 'Lexer' component, or any other subcomponents (e.g. 'Symbol' or 'Space').+Calculates the domain type, and the return type of the new combinator.+The boolean flag set to True means one should ensure the domain type gives a specific combinator,+and doesn't lead to an ambiguous return type.+-}+getLexerCombinatorType :: Name -> Bool -> Q Type+getLexerCombinatorType old checkType = do+  tp <- reifyType old+  (prefix, dom, _, cod) <-+    fail (notFunctionTypeMsg old tp) `qRecover` fnTpDomain tp+  let newTp = prefix cod+  b <- isInstance ''LexerField [dom]+  if checkType && not b+    then catchErrors dom newTp+    else return $ prefix cod+ where+  -- If the quoted name is not at least a function type, then there's no real way to define the combinator :p+  notFunctionTypeMsg :: Name -> Type -> String+  notFunctionTypeMsg x tp = concat ["Constant `", nameBase x, "` does not have a function type: ", show tp]++  -- Preventative Errors: catch the cases someone tries to define one of the String or Integer parsers+  -- they should do these manually or with the bespoke generators!+  catchErrors :: Type -> Type -> Q a+  catchErrors dom newTp+    | old == 'Lexer.ascii = failStringParser old+    | old == 'Lexer.unicode = failStringParser old+    | old == 'Lexer.latin1 = failStringParser old+    | otherwise = fail (notLexerFieldMsg old dom)++  -- Message to give to the user when they give a TextParser field, as there is no way to disambiguate+  -- exactly *which* TextParser they want.+  -- And there is no point in implementing a way for the user to ask for this;+  -- at that point, it would be no more work on the user's end than were they to write a manual definition.+  failStringParser :: Name -> Q a+  failStringParser nm =+    fail $+      concat+        [ "Cannot derive a lexer combinator for `"+        , nameBase nm+        , "`, as there are many possible "+        , pprint ''TextParsers+        , " to define it in terms of, including:"+        , pprint 'stringLiteral+        , ", "+        , pprint 'rawStringLiteral+        , ", "+        , pprint 'multiStringLiteral+        , ", and "+        , pprint 'rawMultiStringLiteral+        , "."+        , "\n You will need to manually define this combinator, as you are then able to pick which TextParser it should use."+        ]++  -- If the quoted name is not a recognised lexer field, then we should tell the user as much.+  -- The error may be due to being able to disambiguate the field, rather than the field not existing.+  notLexerFieldMsg :: Name -> Type -> String+  notLexerFieldMsg x tp =+    concat+      [ "Cannot produce a lexer combinator for function: "+      , nameBase x+      , "."+      , "\n This is because the type: `"+      , pprint tp+      , "` cannot be used to give a precise combinator, either because it does not refer to "+      , "any fields of a `Lexer`, or because it ambiguously refers to many fields of a `Lexer`."+      , "\n Some fields of the `Lexer` share the same type, so there are multiple possible candidate combinators for a particular field."+      , " For example: "+      , "\n   - `decimal`, `hexadecimal`,... all have type `IntegerParsers canHold -> Parsec Integer`."+      , "\n   - `ascii`, `unicode`, ... all have type `TextParsers t -> Parsec t`."+      ]++---------------------------------------------------------------------------------------------------+-- Util functions++{-|+Denote the type of an arrow; it is either normal or linear.+-}+type ArrowTp :: *+data ArrowTp = StdArrow | LinearArrow++{-|+Get the domain of a function type.+Keep any prefixed constraints and type variable quantifiers as a prefixing function.+-}+fnTpDomain+  :: Type+  -> Q (Type -> Type, Type, ArrowTp, Type)+-- The head of the type, includes any preceding constraints+-- and foralls. this is a function which prefixes the given type with the constraints/foralls+-- The domain and codomain of the type+fnTpDomain x = do+  (a, (b, c, d)) <- fnTpDomain' =<< sanitiseTypeStars x+  return (removeUnusedTVars . a, b, c, d)+ where+  fnTpDomain' (ForallT bnds ctx tp) = do+    bnds' <- sanitiseBndrStars bnds+    first (ForallT bnds' ctx .) <$> fnTpDomain' tp+  fnTpDomain' (ForallVisT bnds tp) = do+    bnds' <- sanitiseBndrStars bnds+    first (ForallVisT bnds' .) <$> fnTpDomain' tp+  fnTpDomain' (AppT (AppT ArrowT a) b) =+    return (id, (a, StdArrow, b))+  fnTpDomain' (AppT (AppT MulArrowT a) b) =+    return (id, (a, LinearArrow, b))+  fnTpDomain' tp =+    fail+      ("Type of given function is not a function type: " ++ show tp)++---------------------------------------------------------------------------------------------------+-- Lexer Field++{- |+@a@ is a `LexerField` when it is the type of a component or subcomponent of the `Lexer` type.+This includes things like `Lexeme` and `Symbol`.++Avoid writing instances for:+- IntegerParsers+- TextParsers String++As this leads to ambiguous projections if users try to generate combinators for, e.g., 'Lexer.decimal.+There are two possible instances here, one for `integer`, the other for `natural`, and there is no way to disambiguate here.+By avoiding writing these instances, we can give the user a more informative error message should they try this.+-}+type LexerField :: * -> Constraint+class LexerField a where+  project :: (a -> b) -> (Lexer -> b)++type LexerProj :: * -> * -> *+type LexerProj a b = (a -> b) -> (Lexer -> b)++instance LexerField Lexer where+  {-# INLINE project #-}+  project :: (Lexer -> b) -> (Lexer -> b)+  project = id++---------------------------------------------------------------------------------------------------+-- Lexemes++instance LexerField Lexeme where+  {-# INLINE project #-}+  project :: (Lexeme -> b) -> (Lexer -> b)+  project f = f . lexeme++instance LexerField Symbol where+  {-# INLINE project #-}+  project :: (Symbol -> b) -> (Lexer -> b)+  project f = f . symbol . lexeme++instance LexerField Names where+  {-# INLINE project #-}+  project :: (Names -> b) -> (Lexer -> b)+  project f = f . names . lexeme++instance LexerField (TextParsers Char) where+  {-# INLINE project #-}+  project :: (TextParsers Char -> b) -> (Lexer -> b)+  project f = f . charLiteral . lexeme++---------------------------------------------------------------------------------------------------+-- Space++instance LexerField Space where+  {-# INLINE project #-}+  project :: (Space -> b) -> (Lexer -> b)+  project f = f . space

@@ -22,26 +22,84 @@ import Text.Gigaparsec.Token.Errors (ErrorConfig (labelSymbolEndOfKeyword, labelSymbolEndOfOperator, labelSymbol), notConfigured) import Text.Gigaparsec.Internal.Token.Errors (annotate) +{-|+This contains lexing functionality relevant to the parsing of atomic symbols.++Symbols are characterised by their "unitness", that is, every parser inside returns Unit. +This is because they all parse a specific known entity, and, as such, the result of the parse is irrelevant. +These can be things such as reserved names, or small symbols like parentheses. ++This type also contains a means of creating new symbols as well as implicit conversions +to allow for Haskell's string literals (with @OverloadedStringLiterals@ enabled) to serve as symbols within a parser.+-} type Symbol :: *-data Symbol = Symbol { softKeyword :: !(String -> Parsec ())-                     , softOperator :: !(String -> Parsec ())-                     }+data Symbol = Symbol { +  {- | This combinator parses a given soft keyword atomically: +  the keyword is only valid if it is not followed directly by a character +  which would make it a larger valid identifier. -mkSymbol :: SymbolDesc -> NameDesc -> ErrorConfig -> Symbol+  Soft keywords are keywords that are only reserved within certain contexts. +  The 'Text.Gigaparsec.Token.Lexer.apply' combinator handles so-called hard keywords automatically, +  as the given string is checked to see what class of symbol it might belong to.+  However, soft keywords are not included in this set, +  as they are not always reserved in all situations. +  As such, when a soft keyword does need to be parsed, +  this combinator should be used to do it explicitly. +  Care should be taken to ensure that soft keywords take+  parsing priority over identifiers when they do occur.+  -}+    softKeyword :: !(String -> Parsec ())+  {-|+  This combinator parses a given soft operator atomically:+  the operator is only valid if it is not followed directly by a character which +  would make it a larger valid operator (reserved or otherwise).++  Soft operators are operators that are only reserved within certain contexts. +  The apply combinator handles so-called hard operators automatically, +  as the given string is checked to see what class of symbol it might belong to. +  However, soft operators are not included in this set, +  as they are not always reserved in all situations.+  As such, when a soft operator does need to be parsed, +  this combinator should be used to do it explicitly.+  -}+  , softOperator :: !(String -> Parsec ())+  }++{-|+Create a 'Symbol' -- an interface for parsing atomic symbols -- according to the given descriptions.+-}+mkSymbol  :: SymbolDesc  -- ^ the description of symbols (keywords and operators).+          -> NameDesc    -- ^ the description of identifiers.+          -> ErrorConfig -- ^ how errors should be produced on failed parses.+          -> Symbol      -- ^ a collection of parsers for keywords and operators as described by the given descriptions. mkSymbol SymbolDesc{..} NameDesc{..} !err = Symbol {..}   where softKeyword name = require (not (null name)) "softKeyword" "keywords may not be empty"           (_softKeyword caseSensitive identifierLetter name err <?> [name])         softOperator name = require (not (null name)) "softOperator" "operators may not be empty"           (_softOperator hardOperators operatorLetter name err <?> [name]) -mkSym :: SymbolDesc -> Symbol -> ErrorConfig -> (String -> Parsec ())+{-|+Create a parser that parses the given string, but first checks if this is a hard keyword or operator, +in which case these are parsed using the 'softKeyword' and 'softOperator' parsers instead.+-}+mkSym :: SymbolDesc             -- ^ @symbolDesc@, the description of symbols (keywords and operators)+      -> Symbol                 -- ^ @symbol@, a collection of parsers for symbols described by @symbolDesc@+      -> ErrorConfig            -- ^ how errors should be produced on failed parses.+      -> (String -> Parsec ())  -- ^ a function which parses the given string; if this string is a keyword or operator, +                                -- ^ it is parsed using @symbol@. mkSym SymbolDesc{..} Symbol{..} !err str =   annotate (Map.findWithDefault notConfigured str (labelSymbol err)) $     if | Set.member str hardKeywords  -> softKeyword str        | Set.member str hardOperators -> softOperator str        | otherwise                    -> void (atomic (string str)) -lexeme :: (forall a. Parsec a -> Parsec a) -> Symbol -> Symbol+{-|+Given a whitespace consumer (or any function on a parser) and a 'Symbol' parser, create a 'Symbol' parser+where each constituent parser also applies this whitespace consumer after parsing.+-}+lexeme  :: (forall a. Parsec a -> Parsec a) -- ^ @f@, a parser transformer, usually consumes whitespace after running the parser+        -> Symbol -- ^ the symbol parser+        -> Symbol -- ^ a symbol parser with each constituent parser transformed by @f@. lexeme lexe Symbol{..} = Symbol { softKeyword = lexe . softKeyword                                 , softOperator = lexe . softOperator                                 }

@@ -4,7 +4,7 @@ {-# OPTIONS_HADDOCK hide #-} module Text.Gigaparsec.Internal.Token.Text (module Text.Gigaparsec.Internal.Token.Text) where -import Text.Gigaparsec (Parsec, void, (<|>), empty, somel, (<~>), ($>), atomic, some)+import Text.Gigaparsec (Parsec, void, somel, (<~>), ($>), atomic) import Text.Gigaparsec.Char (char, digit, hexDigit, octDigit, bit, satisfy, trie, string) import Text.Gigaparsec.Token.Descriptions (     TextDesc(TextDesc, characterLiteralEnd, graphicCharacter),@@ -35,6 +35,9 @@ import Text.Gigaparsec.Internal.Token.Generic (     GenericNumeric(zeroAllowedDecimal, zeroAllowedHexadecimal, zeroAllowedOctal, zeroAllowedBinary)   )++import Control.Applicative (liftA3, (<|>), empty, some)+ import Data.Char (isSpace, chr, ord, digitToInt, isAscii, isLatin1) import Data.Map qualified as Map (insert, map) import Data.Set (Set)@@ -42,16 +45,39 @@ import Data.List.NonEmpty (NonEmpty((:|)), sort) import Text.Gigaparsec.State (Ref, make, unsafeMake, gets, update, set, get) import Text.Gigaparsec.Combinator (guardS, choice, manyTill)-import Control.Applicative (liftA3) import Data.Maybe (catMaybes)  -- TODO: is it possible to /actually/ support Text/Bytestring in future? -- Perhaps something like the Numeric stuff?+{-|+This type defines a uniform interface for defining parsers for textual literals, independent of how whitespace should be handled after the literal.++The type of these literals is determined by the parameter @t@.+-} type TextParsers :: * -> *-data TextParsers t = TextParsers { unicode :: Parsec t-                                 , ascii :: Parsec t-                                 , latin1 :: Parsec t-                                 }+data TextParsers t = TextParsers { +    {-|+    Parses a single @t@-literal, which may contain any unicode graphic character +    as defined by up to two UTF-16 codepoints.++    It may also contain escape sequences.+    -}+    unicode :: Parsec t+    {-|+    Parses a single @t@-literal, which may contain any graphic ASCII character. +    These are characters with ordinals in range 0 to 127 inclusive. ++    It may also contain escape sequences, but only those which result in ASCII characters.+    -}+  , ascii :: Parsec t+    {-|+    Parses a single @t@-literal, which may contain any graphic extended ASCII character. +    These are characters with ordinals in range 0 to 255 inclusive. ++    It may also contain escape sequences, but only those which result in extended ASCII characters.+    -}+  , latin1 :: Parsec t+  }  -- I want the convenient naming, sue me type StringParsers :: *

@@ -5,7 +5,7 @@ {-# OPTIONS_GHC -Wno-monomorphism-restriction #-} {-| Module      : Text.Gigaparsec.Patterns-Description : Template Haskell generators to help with patterns+Description : Template Haskell generators to help with patterns. License     : BSD-3-Clause Maintainer  : Jamie Willis, Gigaparsec Maintainers Stability   : experimental@@ -20,10 +20,12 @@ import Prelude (     Bool(True, False), String, Int, Maybe(Just, Nothing), Eq((==), (/=)),     fmap, map, concat, (.), traverse, sequence, foldr1, length, (-), return, (++),-    fail, ($), unwords, maybe, otherwise, id, reverse, show, flip, takeWhile, (+)+    fail, ($), unwords, maybe, otherwise, id, reverse, show, flip, takeWhile, (+),+    -- use Prelude's pure instead of that from Gigaparsec so the latter can have type-specialised haddock documentation.+    pure    ) -import Text.Gigaparsec (Parsec, (<**>), (<*>), pure)+import Text.Gigaparsec (Parsec, (<**>), (<*>)) import Text.Gigaparsec.Position (Pos, pos) import Control.Monad (replicateM) import Data.List (foldl')@@ -99,7 +101,7 @@ This function is used to automatically generate /Deferred Constructors/, which are one of the patterns in /"Design Patterns for Parser Combinators/". It is provided with a prefix, which is used to denote an application of the constructor, and-then a list of "ticked" constructors to generate deferred constructors for. This+then a list of "ticked" constructors for which to generate deferred constructors. This means adding a single @'@ in front of the constructor name. For example:  > {-# LANGUAGE TemplateHaskell #-}

@@ -1,24 +1,93 @@ {-# LANGUAGE Safe #-}-module Text.Gigaparsec.Position (Pos, line, col, pos, offset, withWidth) where+{-|+Module      : Text.Gigaparsec.Position+Description : This module contains parsers that provide a way to extract position information during parsing.+License     : BSD-3-Clause+Maintainer  : Jamie Willis, Gigaparsec Maintainers+Stability   : stable +This module contains parsers that provide a way to extract position information during parsing.++Position parsers can be important for when the final result of the parser needs to encode position information for later consumption: +this is particularly useful for abstract syntax trees. +Offset is also exposed by this interface (via 'offset'), which may be useful for establishing a caret size in specialised error messages.+-}+module Text.Gigaparsec.Position (+  {-| === Position+  The position of a parser determines where in the input stream the next character is to be consumed.+  This position is defined in terms of the line (see 'line') and column (see 'col') numbers at which the character occurs in the input text.++  To simply see how many characters total have been parsed, see 'offset'.+  -}+  Pos, +  line, +  col, +  pos, +  {-| === Offset & Width+  'offset' and 'withWidth' allow one to calculate how much input has been consumed by a parser.+  -}+  offset, +  withWidth) where+ import Text.Gigaparsec.Internal (Parsec) import Text.Gigaparsec.Internal qualified as Internal (Parsec(Parsec), line, col, consumed) import Control.Applicative (liftA2, liftA3) ++{-|+A type representing the position of a parser in terms of line and column numbers.+-} type Pos :: * type Pos = (Word, Word) -line :: Parsec Word+{-|+This parser returns the current line number (starting at 1) of the input without having any other effect.++When this combinator is ran, no input is required, nor consumed, and the current line number will always be successfully returned. +It has no other effect on the state of the parser.++@since 0.3.0.0+-}+line :: Parsec Word -- ^ a parser that returns the line number the parser is currently at. line = Internal.Parsec $ \st good _ -> good (Internal.line st) st -col :: Parsec Word+{-|+This parser returns the current column number (starting at 1) of the input without having any other effect.++When this combinator is run, no input is required, nor consumed, and the current column number will always be successfully returned. +It has no other effect on the state of the parser.+@since 0.3.0.0+-}+col :: Parsec Word -- ^ a parser that returns the column number the parser is currently at. col = Internal.Parsec $ \st good _ -> good (Internal.col st) st -offset :: Parsec Word-offset = Internal.Parsec $ \st good _ -> good (Internal.consumed st) st+{-|+This parser returns the current line and column numbers (starting at 1) of the input without having any other effect. -pos :: Parsec Pos+When this combinator is ran, no input is required, nor consumed, and the current line and column number will always be successfully returned. +It has no other effect on the state of the parser.+@since 0.3.0.0+-}+pos :: Parsec Pos -- ^ a parser that returns the line and column number the parser is currently at. pos = liftA2 (,) line col -withWidth :: Parsec a -> Parsec (a, Word)+{-|+This parser returns the current offset - the total number of characters consumed - into the input (starting at 0) without having any other effect.++When this combinator is ran, no input is required, nor consumed, and the current offset into the input will always be successfully returned. +It has no other effect on the state of the parser.+-}+offset :: Parsec Word -- ^ a parser that returns the offset the parser is currently at.+offset = Internal.Parsec $ \st good _ -> good (Internal.consumed st) st++{-|+This combinator returns the result of a given parser @p@ and the number of characters it consumed.++First records the initial offset on entry to given parser @p@, then executes @p@. +If @p@ succeeds, then the offset is taken again, and the two values are subtracted to give width @w@. +The result, @x@, of @p@ is returned along with @w@ as the pair @(x, w)@. +If @p@ fails, this combinator will also fail.+-}+withWidth :: Parsec a         -- ^ the parser whose width we wish to compute+          -> Parsec (a, Word) -- ^ a parser that pairs the result of the parser @p@ with the number of characters it consumed withWidth p = liftA3 (\s x e -> (x, e-s)) offset p offset

@@ -1,6 +1,22 @@ {-# LANGUAGE Safe #-} {-# LANGUAGE BlockArguments #-}+{-|+Module      : Text.Gigaparsec.State+Description : This module contains all the functionality and operations for using and manipulating references.+License     : BSD-3-Clause+Maintainer  : Jamie Willis, Gigaparsec Maintainers+Stability   : stable++This module contains all the functionality and operations for using and manipulating references.++These often have a role in performing context-sensitive parsing tasks, where a Turing-powerful system is required. +Whilst a generic state monad is capable of such parsing, it is much less efficient than the use of references, though slightly more flexible. +-} module Text.Gigaparsec.State (+    {-| === References+    The Ref type describes pieces of state that are threaded through a parser. +    The creation and basic combinators of references are also found here.+    -}     Ref,     make, unsafeMake,     get, gets,@@ -8,6 +24,9 @@     update,     updateDuring, setDuring,     rollback,+    {-| === Reference-Based Combinators+    The following are variants of "Text.Gigaparsec.Combinator" combinators, made much more efficient using references.+    -}     forP, forP', forP_, forP'_   ) where @@ -18,18 +37,42 @@  import Data.Ref (Ref, newRef, readRef, writeRef) +{-|+Run a parser @f@ parameterised by a reference, which is uninitialised.++The function @f@ effectively defines a parser that has access to a new uninitialised reference of type @a@.+This reference __must__ be initialised by @f@ before it is read from, otherwise an 'error' will be thrown.+The parameterization of 'Ref' by @r@ ensures that the reference cannot escape the scope of the inner parser defined by @f@.++This function is __unsafe__, meaning it will throw a GHC `error` if the reference is read before it is set.+-} unsafeMake :: (forall r. Ref r a -> Parsec b) -> Parsec b unsafeMake = make (error "reference used but not set")  _make :: Parsec a -> (forall r. Ref r a -> Parsec b) -> Parsec b _make p f = p >>= \x -> make x f -make :: a -> (forall r. Ref r a -> Parsec b) -> Parsec b+{-|+Run a parser @f@ parameterised by a reference with initial value @x@.++The function @f@ effectively defines a parser that has access to a new reference of type @a@, whose initial value is @x@.+The parameterization of 'Ref' by @r@ ensures that the reference cannot escape the scope of the inner parser defined by @f@.+-}+make  :: a                               -- ^ @x@, the initial value the reference will hold.+      -> (forall r. Ref r a -> Parsec b) -- ^ @f@, a function which runs a parser with access to the given reference +      -> Parsec b                        -- ^ a parser that produces a @b@ with access to the reference make x f = Internal.Parsec $ \st good bad ->   newRef x $ \ref ->     let Internal.Parsec p = f ref     in p st good bad +{-|+Return the current value of a reference.++Given a reference @ref@, this produces a parser that simply returns the current value of @ref@.++This parser consumes no input and always succeeds.+-} get :: Ref r a -> Parsec a get ref = Internal.Parsec $ \st good _ ->   do x <- readRef ref@@ -39,44 +82,154 @@ _gets :: Ref r a -> Parsec (a -> b) -> Parsec b _gets ref pf = pf <*> get ref -gets :: Ref r a -> (a -> b) -> Parsec b+{-|+Get a specific component of the reference, using a projection function supplied.++Given a reference @ref@, and a function @f@, this function produces a parser which returns the+value of applying @f@ to the current value of @ref@.++This parser consumes no input and always succeeds.+-}+gets  :: Ref r a  -- ^ @ref@, The reference to extract a value from+      -> (a -> b) -- ^ @f@, The function which processes the current value of @ref@.+      -> Parsec b -- ^ a parser returning the result of @f@ applied to the current value of @ref@. gets ref f = f <$> get ref  _set :: Ref r a -> Parsec a -> Parsec () _set ref px = px >>= set ref +{-|+Replace the value of the given reference.++Given a reference @ref@, and a value @x@, this function replaces the current value of @ref@ with @x@.+This produces a parser which changes the value of @ref@ during any subsequent parsing.++This parser consumes no input and always succeeds.+-} set :: Ref r a -> a -> Parsec () set ref x = Internal.Parsec $ \st good _ ->   do writeRef ref x      good () st -sets :: Ref r b -> (a -> b) -> Parsec a -> Parsec ()+{-|+Replace the value of the reference by the result of applying a function to the result of the given parser.++Given a parser @p@, a function @f@, and reference @ref@: +run the parser @p@, which produces a result of type @a@;+then replace the value of @ref@ by that of @f@ applied to the result of @p@.+This produces a parser which changes the value of @ref@ during any subsequent parsing.++This parser consumes input and fails if and only if the given parser @p@ does also.+-}+sets  :: Ref r b   -- ^ @ref@, the reference whose value we wish to replace.+      -> (a -> b)  -- ^ @f@, the function to apply to the result of @p@.+      -> Parsec a  -- ^ @p@, the given parser.+      -> Parsec () -- ^ a parser which runs @p@, and replaces the value of @ref@ to be that of applying @f@ to the result of @p@. sets ref f px = _set ref (f <$> px)  _update :: Ref r a -> Parsec (a -> a) -> Parsec () _update ref pf = _set ref (_gets ref pf) +{-|+Set the new value of the reference to be the result of applying a function to the old value.++Given a function @f@ and reference @ref@; the current value of @ref@ is replaced by that of applying @f@ to this value.++This parser consumes no input and always succeeds.+-} update :: Ref r a -> (a -> a) -> Parsec () update ref f = _set ref (gets ref f) -updateDuring :: Ref r a -> (a -> a) -> Parsec b -> Parsec b+{-|+Run the given parser @p@ with a modified value of the reference, and then reset this value if @p@ succeeds.++Behaves like 'update', except the scope of the update of the reference @ref@ is limited just to the given parser @p@, +assuming that @p@ succeeds.+If the parser @p@ fails, then the value of the reference @ref@ is __not reset__ to its original value.+In summary, this parser unconditionally modifies the value of @ref@, and resets the value of @ref@ only when @p@ succeeds.++This parser consumes input and fails if and only if the given parser @p@ does also.+-}+updateDuring  :: Ref r a  -- ^ @ref@, the reference to modify.+              -> (a -> a) -- ^ @xf, the function to modify the value of @ref@. +              -> Parsec b -- ^ @p@, the parser to run with the modified reference.+              -> Parsec b -- ^ a parser which runs @p@ with the modified reference, and resets @ref@ if @p@ succeeds. updateDuring ref f p = do x <- get ref                           set ref (f x)                           p <* set ref x -setDuring :: Ref r a -> a -> Parsec b -> Parsec b+{-|+Run the given parser @p@ with a new value of the reference, and then reset this value if @p@ succeeds.++Behaves like 'updateDuring', except the value of the reference is simply replaced by the given value @x@.+If the parser @p@ fails, then the value of the reference @ref@ is __not reset__ to its original value.++This parser consumes input and fails if and only if the given parser @p@ does also.+-}+setDuring :: Ref r a  -- ^ @ref@, the reference to modify.+          -> a        -- ^ @x@, the value to temporarily replace that of @ref@.+          -> Parsec b -- ^ @p@, the parser to run with the modified reference.+          -> Parsec b -- ^ a parser which runs @p@ with the modified reference, and resets @ref@ if @p@ succeeds. setDuring ref x = updateDuring ref (const x)  _setDuring :: Ref r a -> Parsec a -> Parsec b -> Parsec b _setDuring ref px q = px >>= flip (setDuring ref) q -rollback :: Ref r a -> Parsec b -> Parsec b+{-|+Run a parser, and if it fails __without consuming input__, undo its modifications to the given reference.++This parser consumes input only if @p@ does also; it fails if and only if @p@ fails __having consumed input__.+-}+rollback  :: Ref r a  -- ^ @ref@, the reference whose value will be 'rolled-back' on failure of @p@+          -> Parsec b -- ^ @p@, the parser to run+          -> Parsec b -- ^ a parser that runs @p@, and restores the original value of @ref@ if @p@ fails without consuming input. rollback ref p = get ref >>= \x -> p <|> (set ref x *> empty) -forP :: Parsec a -> Parsec (a -> Bool) -> Parsec (a -> a) -> Parsec b -> Parsec [b]+{-|+Repeatedly execute a parser in a loop until the condition passes.++@'forP' ini cond step body@ behaves much like a traditional for loop using @ini@, @cond@, @step@,+and @body@ as parsers which control the loop itself. +In pseudocode, this would be equivalent to:++@+  results = []+  for (i: a := ini ; not (cond i) ; i := step i ) {+      r <- body+      results.append r+  }+  return results+@++-}+forP  :: Parsec a           -- ^ @ini@,  the initial value of the iterator.+      -> Parsec (a -> Bool) -- ^ @cond@, the condition by which the loop terminates.+      -> Parsec (a -> a)    -- ^ @step@, how the iterator is updated on each iteration.+      -> Parsec b           -- ^ @body@, the parser to run on each iteration.+      -> Parsec [b]         -- ^ a parser that repeatedly parses @body@ until @cond@ is satisfied. forP ini cond step = forP' ini cond step . const -forP' :: Parsec a -> Parsec (a -> Bool) -> Parsec (a -> a) -> (a -> Parsec b) -> Parsec [b]+{-|+Repeatedly execute a parser in a loop until the condition passes.++'forP'' is similar to 'forP', except the @body@ of the loop is able to access the value of the iterator.+In pseudocode, this would be equivalent to:++@+  results = []+  for (i: a := ini ; not (cond i) ; i := step i ) {+      r <- body i+      results.append r+  }+  return results+@++-}+forP' :: Parsec a           -- ^ @ini@,  the initial value of the iterator.+      -> Parsec (a -> Bool) -- ^ @cond@, the condition by which the loop terminates.+      -> Parsec (a -> a)    -- ^ @step@, how the iterator is updated on each iteration.+      -> (a -> Parsec b)    -- ^ @body@, the parser to run on each iteration, parameterised by the current iterator value.+      -> Parsec [b]         -- ^ a parser that repeatedly parses @body@ until @cond@ is satisfied. forP' ini cond step body = ini >>= go   where go i = flip (ifS (cond <*> pure i)) (pure []) do                   x <- body i@@ -84,10 +237,30 @@                   xs <- go (f i)                   return (x : xs) -forP_ :: Parsec a -> Parsec (a -> Bool) -> Parsec (a -> a) -> Parsec b -> Parsec ()+{-|+Repeatedly execute a parser in a loop until the condition passes, ignoring any results.++@'forP_' ini cond step body@ behaves much like a traditional for loop using @ini@, @cond@, @step@,+and @body@ as parsers which control the loop itself. +Unlike 'forP', this function ignores any results from the @body@ parser.+-}+forP_ :: Parsec a           -- ^ @ini@,  the initial value of the iterator.+      -> Parsec (a -> Bool) -- ^ @cond@, the condition by which the loop terminates.+      -> Parsec (a -> a)    -- ^ @step@, how the iterator is updated on each iteration.+      -> Parsec b           -- ^ @body@, the parser to run on each iteration.+      -> Parsec ()          -- ^ a parser that repeatedly parses @body@ until @cond@ is satisfied, ignoring any results from @body@. forP_ ini cond step = forP'_ ini cond step . const -forP'_ :: Parsec a -> Parsec (a -> Bool) -> Parsec (a -> a) -> (a -> Parsec b) -> Parsec ()+{-|+Repeatedly execute a parser in a loop until the condition passes, ignoring any results.++'forP'_' is similar to 'forP_', except the @body@ of the loop is able to access the value of the iterator.+-}+forP'_  :: Parsec a           -- ^ @ini@,  the initial value of the iterator.+        -> Parsec (a -> Bool) -- ^ @cond@, the condition by which the loop terminates.+        -> Parsec (a -> a)    -- ^ @step@, how the iterator is updated on each iteration.+        -> (a -> Parsec b)    -- ^ @body@, the parser to run on each iteration, parameterised by the current iterator value.+        -> Parsec ()          -- ^ a parser that repeatedly parses @body@ until @cond@ is satisfied, ignoring any results from @body@. forP'_ ini cond step body = ini >>= go   where go i = whenS (cond <*> pure i) do                   body i

@@ -4,21 +4,246 @@ -- TODO: In next major, don't expose the constructors of the descriptions, -- we want them built up by record copy for forwards compatible evolution -- We can move this into an internal module to accommodate that if we want-module Text.Gigaparsec.Token.Descriptions (module Text.Gigaparsec.Token.Descriptions) where+{-|+Module      : Text.Gigaparsec.Token.Descriptions+Description : This module contains the descriptions of various lexical structures to configure the lexer.+License     : BSD-3-Clause+Maintainer  : Jamie Willis, Gigaparsec Maintainers+Stability   : experimental +This module contains the descriptions of various lexical structures to configure the lexer.++Many languages share common lexical tokens, such as numeric and string literals.+Writing lexers turning these strings into tokens is effectively boilerplate.+A __Description__ encodes how to lex one of these common tokens.+Feeding a 'LexicalDesc' to a 'Text.Gigaparsec.Token.Lexer.Lexer' provides many combinators+for dealing with these tokens.++==== Usage+Rather than use the internal constructors, such as @NameDesc@, one should extend the \'@plain@\' definitions with record field updates.+For example,++@+myLexicalDesc = plain+  { nameDesc = myNameDesc+  , textDesc = myTextDesc+  }+@++will produce a description that overrides the default name and text descriptions by those given.+See 'plainName', 'plainSymbol', 'plainNumeric', 'plainText' and 'plainSpace' for further examples.++@since 0.2.2.0+-}+module Text.Gigaparsec.Token.Descriptions (+  -- * Lexical Descriptions+  {-|+  A lexer is configured by extending the default 'plain' template, producing a 'LexicalDesc'.++  * 'LexicalDesc'+  * 'plain'++  -}+  -- ** Name Descriptions+  {-|+  A 'NameDesc' configures the lexing of name-like tokens, such as variable and function names.+  To create a 'NameDesc', use 'plainName', and configure it to your liking with record updates.++  * 'NameDesc'++      * 'identifierStart'+      * 'identifierLetter'+      * 'operatorStart'+      * 'operatorLetter'++  * 'plainName'++  -}+  -- ** Symbol Descriptions+  {-|+  A 'SymbolDesc' configures the lexing of \'symbols\' (textual literals), such as keywords and operators.+  To create a 'SymbolDesc', use 'plainSymbol' and configure it to your liking with record updates.++  * 'SymbolDesc'++      * 'hardKeywords'+      * 'hardOperators'+      * 'caseSensitive'++  * 'plainSymbol'++  -}+  -- ** Numeric Descriptions+  {-|+  A 'NumericDesc' configures the lexing of numeric literals, such as integer and floating point literals.+  To create a 'NumericDesc', use 'plainNumeric' and configure it to your liking with record updates.+  Also see 'ExponentDesc', 'BreakCharDesc', and 'PlusSignPresence', for further configuration options.++  * 'NumericDesc'++      * 'literalBreakChar'+      * 'leadingDotAllowed'+      * 'trailingDotAllowed'+      * 'leadingZerosAllowed'+      * 'positiveSign'+      * 'integerNumbersCanBeHexadecimal'+      * 'integerNumbersCanBeOctal'+      * 'integerNumbersCanBeBinary'+      * 'realNumbersCanBeHexadecimal'+      * 'realNumbersCanBeOctal'+      * 'realNumbersCanBeBinary'+      * 'hexadecimalLeads'+      * 'octalLeads'+      * 'binaryLeads'+      * 'decimalExponentDesc'+      * 'hexadecimalExponentDesc'+      * 'octalExponentDesc'+      * 'binaryExponentDesc'++  * 'plainNumeric'+  -}+  -- *** Exponent Descriptions+  {-|+  An 'ExponentDesc' configures scientific exponent notation.++    * 'ExponentDesc'++        * 'NoExponents'+        * 'ExponentsSupported'++            * 'compulsory'+            * 'chars'+            * 'base'+            * 'expSign'+            * 'expLeadingZerosAllowd'+  -}+  -- *** Break-Characters in Numeric Literals+  {-|+  Some languages allow a single numeric literal to be separated by a \'break\' symbol.++    * 'BreakCharDesc'++      * 'NoBreakChar'+      * 'BreakCharSupported'++          * 'breakChar'+          * 'allowedAfterNonDecimalPrefix'+  -}+  -- *** Numeric Literal Prefix Configuration+  {-|++  * 'PlusSignPresence'++      * 'PlusRequired'+      * 'PlusOptional'+      * 'PlusIllegal'+  -}+  -- ** Text Descriptions+  {-|+  A 'TextDesc' configures the lexing of string and character literals, as well as escaped numeric literals.+  To create a 'TextDesc', use 'plainText' and configure it to your liking with record updates.+  See 'EscapeDesc', 'NumericEscape' and 'NumberOfDigits' for further configuration of escape sequences and escaped numeric literals.++  * 'TextDesc'++      * 'escapeSequences'+      * 'characterLiteralEnd'+      * 'stringEnds'+      * 'multiStringEnds'+      * 'graphicCharacter'++  * 'plainText'+  -}+  -- *** Escape Character Descriptions+  {-|+  Configuration of escape sequences, such as tabs @\t@ and newlines @\n@, and+  escaped numbers, such as hexadecimals @0x...@ and binary @0b...@.++  * 'EscapeDesc'++      * 'escBegin'+      * 'literals'+      * 'mapping'+      * 'decimalEscape'+      * 'hexadecimalEscape'+      * 'octalEscape'+      * 'binaryEscape'+      * 'emptyEscape'+      * 'gapsSupported'++  * 'plainEscape'+  -}+  -- *** Numeric Escape Sequences+  {-|+  Configuration of escaped numeric literals.+  For example, hexadecimals, @0x...@.++  * 'NumericEscape'++      * 'NumericIllegal'+      * 'NumericSupported'++          * 'prefix'+          * 'numDigits'+          * 'maxValue'++  * 'NumberOfDigits'++      * 'Unbounded'+      * 'Exactly'+      * 'AtMost'++  -}+  -- ** Whitespace and Comment Descriptions+  {-|+  A 'SpaceDesc' configures the lexing whitespace and comments.+  To create a 'SpaceDesc', use 'plainSpace' and configure it to your liking with record updates.++  * 'SpaceDesc'++      * 'lineCommentStart'+      * 'lineCommentAllowsEOF'+      * 'multiLineCommentStart'+      * 'multiLineCommentEnd'+      * 'multiLineNestedComments'+      * 'space'+      * 'whitespaceIsContextDependent'++  * 'plainSpace'+  * 'CharPredicate'++  -}+  module Text.Gigaparsec.Token.Descriptions+  ) where+ import Data.Char (isSpace) import Data.Set (Set) import Data.Map (Map) import Data.List.NonEmpty (NonEmpty) +{-|+This type describes the aggregation of a bunch of different sub-configurations for lexing a specific language.++See the 'plain' smart constructor to define a @LexicalDesc@.+-} type LexicalDesc :: *-data LexicalDesc = LexicalDesc { nameDesc :: {-# UNPACK #-} !NameDesc-                               , symbolDesc :: {-# UNPACK #-} !SymbolDesc-                               , numericDesc :: {-# UNPACK #-} !NumericDesc-                               , textDesc :: {-# UNPACK #-} !TextDesc-                               , spaceDesc :: {-# UNPACK #-} !SpaceDesc-                               }+data LexicalDesc = LexicalDesc {+  -- | the description of name-like lexemes+     nameDesc :: {-# UNPACK #-} !NameDesc+  -- | the description of specific symbolic lexemes+  , symbolDesc :: {-# UNPACK #-} !SymbolDesc+  -- | the description of numeric literals+  , numericDesc :: {-# UNPACK #-} !NumericDesc+  -- | the description of text literals+  , textDesc :: {-# UNPACK #-} !TextDesc+  -- | the description of whitespace+  , spaceDesc :: {-# UNPACK #-} !SpaceDesc+  } +{-|+This lexical description contains the template @plain\<...\>@ descriptions defined in this module.+See 'plainName', 'plainSymbol', 'plainNumeric', 'plainText' and 'plainSpace' for how this description configures the lexer.+-} plain :: LexicalDesc plain = LexicalDesc { nameDesc = plainName                     , symbolDesc = plainSymbol@@ -27,13 +252,42 @@                     , spaceDesc = plainSpace                     } +{-|+This type describes how name-like things are described lexically.++In particular, this defines which characters will constitute identifiers and operators.++See the 'plainName' smart constructor for how to implement a custom name description.+-} type NameDesc :: *-data NameDesc = NameDesc { identifierStart :: !CharPredicate-                         , identifierLetter :: !CharPredicate-                         , operatorStart :: !CharPredicate-                         , operatorLetter :: !CharPredicate-                         }+data NameDesc = NameDesc {+  -- | the characters that start an identifier+    identifierStart :: !CharPredicate+  -- | the characters that continue an identifier+  , identifierLetter :: !CharPredicate+  -- | the characters that start a user-defined operator+  , operatorStart :: !CharPredicate+  -- | the characters that continue a user-defined operator+  , operatorLetter :: !CharPredicate+  } +{-|+This is a blank name description template, which should be extended to form a custom name description.++In its default state, 'plainName' makes no characters able to be part of an identifier or operator.+To change this, one should use record field copies, for example:++@+myNameDesc :: NameDesc+myNameDesc = plainName+  { identifierStart = myIdentifierStartPredicate+  , identifierLetter = myIdentifierLetterPredicate+  }+@++@myNameDesc@ with then lex identifiers according to the given predicates.++-} plainName :: NameDesc plainName = NameDesc { identifierStart = Nothing                      , identifierLetter = Nothing@@ -41,42 +295,105 @@                      , operatorLetter = Nothing                      } ++{-|+This type describes how symbols (textual literals in a BNF) should be processed lexically, including keywords and operators.++This includes keywords and (hard) operators that are reserved by the language.+For example, in Haskell, "data" is a keyword, and "->" is a hard operator.++See the 'plainSymbol' smart constructor for how to implement a custom name description.+-} type SymbolDesc :: *-data SymbolDesc = SymbolDesc { hardKeywords :: !(Set String)-                             , hardOperators :: !(Set String)-                             , caseSensitive :: !Bool-                             }+data SymbolDesc = SymbolDesc {+  -- | what keywords are always treated as keywords within the language.+    hardKeywords :: !(Set String)+  -- | what operators are always treated as reserved operators within the language.+  , hardOperators :: !(Set String)+  -- | @True@ if the keywords are case sensitive, @False@ if not (so that e.g. @IF = if@).+  , caseSensitive :: !Bool+  } +{-|+This is a blank symbol description template, which should be extended to form a custom symbol description.++In its default state, 'plainSymbol' has no keywords or reserved/hard operators.+To change this, one should use record field copies, for example:++@+{-# LANGUAGE OverloadedLists #-} -- This lets us write @[a,b]@ to get a 'Data.Set' containing @a@ and @b@+                                 -- If you don't want to use this, just use @'Data.Set.fromList' [a,b]@+mySymbolDesc :: SymbolDesc+mySymbolDesc = plainSymbol+  { hardKeywords = ["data", "where"]+  , hardOperators = ["->"]+  , caseSensitive = True+  }+@++@mySymbolDesc@ with then treat @data@ and @where@ as keywords, and @->@ as a reserved operator.++-} plainSymbol :: SymbolDesc plainSymbol = SymbolDesc { hardKeywords = []                          , hardOperators = []                          , caseSensitive = True                          } +{-|+This type describes how numeric literals (integers, decimals, hexadecimals, etc...), should be lexically processed.+-} type NumericDesc :: *-data NumericDesc = NumericDesc { literalBreakChar :: !BreakCharDesc-                               , leadingDotAllowed :: !Bool-                               , trailingDotAllowed :: !Bool-                               , leadingZerosAllowed :: !Bool-                               , positiveSign :: !PlusSignPresence-                               -- generic number-                               , integerNumbersCanBeHexadecimal :: !Bool-                               , integerNumbersCanBeOctal :: !Bool-                               , integerNumbersCanBeBinary :: !Bool-                               , realNumbersCanBeHexadecimal :: !Bool-                               , realNumbersCanBeOctal :: !Bool-                               , realNumbersCanBeBinary :: !Bool-                               -- special literals-                               , hexadecimalLeads :: !(Set Char)-                               , octalLeads :: !(Set Char)-                               , binaryLeads :: !(Set Char)-                               -- exponents-                               , decimalExponentDesc :: !ExponentDesc-                               , hexadecimalExponentDesc :: !ExponentDesc-                               , octalExponentDesc :: !ExponentDesc-                               , binaryExponentDesc :: !ExponentDesc-                               }+data NumericDesc = NumericDesc {+  -- | can breaks be found within numeric literals? (see 'BreakCharDesc')+    literalBreakChar :: !BreakCharDesc+  -- | can a real number omit a leading 0 before the point?+  , leadingDotAllowed :: !Bool+  -- | can a real number omit a trailing 0 after the point?+  , trailingDotAllowed :: !Bool+  -- | are extraneous zeros allowed at the start of decimal numbers?+  , leadingZerosAllowed :: !Bool+  -- | describes if positive (+) signs are allowed, compulsory, or illegal.+  , positiveSign :: !PlusSignPresence+  -- generic number+  -- | can generic "integer numbers" to be hexadecimal?+  , integerNumbersCanBeHexadecimal :: !Bool+  -- | can generic "integer numbers" to be octal?+  , integerNumbersCanBeOctal :: !Bool+  -- | can generic "integer numbers" to be binary?+  , integerNumbersCanBeBinary :: !Bool+  -- | can generic "real numbers" to be hexadecimal?+  , realNumbersCanBeHexadecimal :: !Bool+  -- | can generic "real numbers" to be octal?+  , realNumbersCanBeOctal :: !Bool+  -- | can generic "real numbers" to be binary?+  , realNumbersCanBeBinary :: !Bool+  -- special literals+  -- | the characters that begin a hexadecimal literal following a 0 (may be empty).+  , hexadecimalLeads :: !(Set Char)+  -- | the characters that begin an octal literal following a 0 (may be empty).+  , octalLeads :: !(Set Char)+  -- | the characters that begin a binary literal following a 0 (may be empty).+  , binaryLeads :: !(Set Char) +  -- exponents+  -- | describes how scientific exponent notation should work for decimal literals.+  , decimalExponentDesc :: !ExponentDesc+  -- | describes how scientific exponent notation should work for hexadecimal literals.+  , hexadecimalExponentDesc :: !ExponentDesc+  -- | describes how scientific exponent notation should work for octal literals.+  , octalExponentDesc :: !ExponentDesc+  -- | describes how scientific exponent notation should work for binary literals.+  , binaryExponentDesc :: !ExponentDesc+  }++{-|+This is a blank numeric description template, which should be extended to form a custom numeric description.++In its default state, 'plainNumeric' allows for hex-, oct-, and bin-ary numeric literals,+with the standard prefixes.+To change this, one should use record field copies.+-} plainNumeric :: NumericDesc plainNumeric = NumericDesc { literalBreakChar = NoBreakChar                            , leadingDotAllowed = False@@ -121,32 +438,89 @@                                                                      }                            } +{-|+Describe how scientific exponent notation can be used within real literals.++A common notation would be @1.6e3@ for @1.6 × 10³@, which the following @ExponentDesc@ describes:++@+{-# LANGUAGE OverloadedLists #-} -- Lets us write @[a]@ to generate a singleton 'Data.Set' containing @a@.+usualNotation :: ExponentDesc+usualNotation = ExponentsSupported+  { compulsory = False+  , chars = [\'e\']  -- The letter \'e\' separates the significand from the exponent+  , base  = 10   -- The base of the exponent is 10, so that @2.3e5@ means @2.3 × 10⁵@+  , expSign = PlusOptional -- A positive exponent does not need a plus sign, but can have one.+  , expLeadingZerosAllowd = True -- We allow leading zeros on exponents; so @1.2e005@ is valid.+  }+@++-} type ExponentDesc :: *-data ExponentDesc = NoExponents-                  | ExponentsSupported { compulsory :: !Bool-                                       , chars :: !(Set Char)-                                       , base :: !Int-                                       , expSign :: !PlusSignPresence-                                       , expLeadingZerosAllowd :: !Bool-                                       }+data ExponentDesc+  = NoExponents         -- ^ The language does not allow exponent notation.+  | ExponentsSupported  -- ^ The language does allow exponent notation, according to the following fields:+    { compulsory :: !Bool            -- ^ Is exponent notation required for real literals?+    , chars :: !(Set Char)           -- ^ The characters that separate the significand from the exponent+    , base :: !Int                   -- ^ The base of the exponent; this is usually base ten.+    , expSign :: !PlusSignPresence   -- ^ Is a plus (@+@) sign required for positive exponents?+    , expLeadingZerosAllowd :: !Bool -- ^ Can the exponent contain leading zeros; for example is @3.2e005@ valid?+    } +{-|+Prescribes whether or not numeric literals can be broken up by a specific symbol.++For example, can one write @300.2_3@?+-} type BreakCharDesc :: *-data BreakCharDesc = NoBreakChar-                   | BreakCharSupported { breakChar :: !Char-                                        , allowedAfterNonDecimalPrefix :: !Bool-                                        }+data BreakCharDesc+  = NoBreakChar                             -- ^ Literals cannot be broken.+  | BreakCharSupported                      -- ^ Literals can be broken.+    { breakChar :: !Char                    -- ^ the character allowed to break a literal (often _).+    , allowedAfterNonDecimalPrefix :: !Bool -- ^ can non-decimals be broken; e.g. can one write, 0x_300?+    } +{-|+Whether or not a plus sign (@+@) can prefix a numeric literal.+-} type PlusSignPresence :: *-data PlusSignPresence = PlusRequired | PlusOptional | PlusIllegal+data PlusSignPresence+  = PlusRequired -- ^ (@+@) must always precede a positive numeric literal+  | PlusOptional -- ^ (@+@) may precede a positive numeric literal, but is not necessary+  | PlusIllegal  -- ^ (@+@) cannot precede a numeric literal as a prefix (this is separate to allowing an infix binary @+@ operator). +{-|+  This type describes how to parse string and character literals.+-} type TextDesc :: *-data TextDesc = TextDesc { escapeSequences :: {-# UNPACK #-} !EscapeDesc-                         , characterLiteralEnd :: !Char-                         , stringEnds :: !(Set (String, String))-                         , multiStringEnds :: !(Set (String, String))-                         , graphicCharacter :: !CharPredicate-                         }+data TextDesc = TextDesc+  { escapeSequences :: {-# UNPACK #-} !EscapeDesc -- ^ the description of escape sequences in literals.+  , characterLiteralEnd :: !Char -- ^ the character that starts and ends a character literal.+  , stringEnds :: !(Set (String, String)) -- ^ the sequences that may begin and end a string literal.+  , multiStringEnds :: !(Set (String, String)) -- ^ the sequences that may begin and end a multi-line string literal.+  , graphicCharacter :: !CharPredicate -- ^ the characters that can be written verbatim into a character or string literal.+  } +{-|+This is a blank text description template, which should be extended to form a custom text description.++In its default state, 'plainText' parses characters as symbols between @\'@ and @\'@, and strings between @"@ and @"@.+To change this, one should use record field copies, for example:++@++{-# LANGUAGE OverloadedLists #-} -- This lets us write @[a,b]@ to get a 'Data.Set' containing @a@ and @b@+                                 -- If you don't want to use this, just use @'Data.Set.fromList' [a,b]@+myPlainText:: TextDesc+myPlainText= plainText+  { characterLiteralEnd = a+  , stringEnds = [(b, c)]+  }++@++@myPlainText@ with then parse characters as a single character between @a@ and @a@, and a string as characters between @b@ and @c@.+-} plainText :: TextDesc plainText = TextDesc { escapeSequences = plainEscape                      , characterLiteralEnd = '\''@@ -155,18 +529,49 @@                      , graphicCharacter = Just (>= ' ')                      } +{-|+Defines the escape characters, and their meaning.++This includes character escapes (e.g. tabs, carriage returns), and numeric escapes, such as binary (usually \"0b\") and hexadecimal, \"0x\".+-} type EscapeDesc :: *-data EscapeDesc = EscapeDesc { escBegin :: !Char-                             , literals :: !(Set Char)-                             , mapping :: !(Map String Char)-                             , decimalEscape :: !NumericEscape-                             , hexadecimalEscape :: !NumericEscape-                             , octalEscape :: !NumericEscape-                             , binaryEscape :: !NumericEscape-                             , emptyEscape :: !(Maybe Char)-                             , gapsSupported :: !Bool-                             }+data EscapeDesc = EscapeDesc+  { escBegin :: !Char                   -- ^ the character that begins an escape sequence: this is usually @\\@.+  , literals :: !(Set Char)             -- ^ the characters that can be directly escaped, but still represent themselves, for instance \'"\', or \'\\\'.+  , mapping :: !(Map String Char)       -- ^ the possible escape sequences that map to a character other than themselves and the (full UTF-16) character they map to, for instance "n" -> 0xa+  , decimalEscape :: !NumericEscape     -- ^ if allowed, the description of how numeric escape sequences work for base 10.+  , hexadecimalEscape :: !NumericEscape -- ^ if allowed, the description of how numeric escape sequences work for base 16+  , octalEscape :: !NumericEscape       -- ^ if allowed, the description of how numeric escape sequences work for base 8+  , binaryEscape :: !NumericEscape      -- ^ if allowed, the description of how numeric escape sequences work for base 2+  , emptyEscape :: !(Maybe Char)        -- ^ if one should exist, the character which has no effect on+                                        -- the string but can be used to disambiguate other escape sequences: in Haskell this would be \&+  , gapsSupported :: !Bool              -- ^ specifies whether or not string gaps are supported:+                                        -- this is where whitespace can be injected between two escBegin characters and this will all be ignored in the final string,+                                        -- such that @"hello \ \world"@ is "hello world"+  } +{-|+This is a blank escape description template, which should be extended to form a custom escape description.++In its default state, 'plainEscape' the only escape symbol is a backslash, \"\\\\".+To change this, one should use record field copies, for example:++@++{-# LANGUAGE OverloadedLists #-} -- This lets us write @[a,b]@ to get a 'Data.Set' containing @a@ and @b@,+                                 -- and [(a,b),(c,d)] for a 'Data.Map' which sends @a ↦ b@ and @c ↦ d@+myPlainEscape:: EscapeDesc+myPlainEscape= plainEscape+  { literals = a+  , stringEnds = [(b, c)]+  , mapping = [("t",0x0009), ("r",0x000D)]+  , hexadecimalEscape = NumericSupported TODO+  }++@++@myPlainText@ with then parse characters as a single character between @a@ and @a@, and a string as characters between @b@ and @c@.+-} plainEscape :: EscapeDesc plainEscape = EscapeDesc { escBegin = '\\'                          , literals = ['\\']@@ -181,26 +586,48 @@  -- TODO: haskellEscape +{-|+Describes how numeric escape sequences should work for a given base.+-} type NumericEscape :: *-data NumericEscape = NumericIllegal-                   | NumericSupported { prefix :: !(Maybe Char)-                                      , numDigits :: !NumberOfDigits-                                      , maxValue :: !Char-                                      }+data NumericEscape+  = NumericIllegal    -- ^ Numeric literals are disallowed for this specific base.+  | NumericSupported  -- ^ Numeric literals are supported for this specific base.+    { prefix :: !(Maybe Char)      -- ^ the character, if any, that is required to start the literal (like x for hexadecimal escapes in some languages).+    , numDigits :: !NumberOfDigits -- ^ the number of digits required for this literal: this may be unbounded, an exact number, or up to a specific number.+    , maxValue :: !Char            -- ^ the largest character value that can be expressed by this numeric escape.+    } +{-|+Describes how many digits a numeric escape sequence is allowed.+-} type NumberOfDigits :: *-data NumberOfDigits = Unbounded | Exactly !(NonEmpty Word) | AtMost !Word+data NumberOfDigits+  = Unbounded -- ^ there is no limit on the number of digits that may appear in this sequence.+  | Exactly !(NonEmpty Word) -- ^ the number of digits in the literal must be one of the given values.+  | AtMost -- ^ there must be at most @n@ digits in the numeric escape literal, up to and including the value given.+    !Word  -- ^ the maximum (inclusive) number of digits allowed in the literal.. +{-|+This type describes how whitespace and comments should be handled lexically.+-} type SpaceDesc :: *-data SpaceDesc = SpaceDesc { lineCommentStart :: !String-                           , lineCommentAllowsEOF :: !Bool-                           , multiLineCommentStart :: !String-                           , multiLineCommentEnd :: !String-                           , multiLineNestedComments :: !Bool-                           , space :: !CharPredicate-                           , whitespaceIsContextDependent :: !Bool-                           }+data SpaceDesc = SpaceDesc+  { lineCommentStart :: !String           -- ^ how to start single-line comments (empty for no single-line comments).+  , lineCommentAllowsEOF :: !Bool         -- ^ can a single-line comment be terminated by the end-of-file (@True@), or must it end with a newline (@False@)?+  , multiLineCommentStart :: !String      -- ^ how to start multi-line comments (empty for no multi-line comments).+  , multiLineCommentEnd :: !String        -- ^ how to end multi-line comments (empty for no multi-line comments).+  , multiLineNestedComments :: !Bool      -- ^ @True@ when multi-line comments can be nested, @False@ otherwise.+  , space :: !CharPredicate               -- ^ the characters to be treated as whitespace+  , whitespaceIsContextDependent :: !Bool -- ^ does the context change the definition of whitespace (@True@), or not (@False@)?+                                          --  (e.g. in Python, newlines are valid whitespace within parentheses, but are significant outside of them)+  }+{-|+This is a blank whitespace description template, which should be extended to form the desired whitespace descriptions. +In its default state, 'plainName' makes no comments possible, and the only whitespace characters are those+defined by 'GHC.Unicode.isSpace'+-} plainSpace :: SpaceDesc plainSpace = SpaceDesc { lineCommentStart = ""                        , lineCommentAllowsEOF = True@@ -211,5 +638,23 @@                        , whitespaceIsContextDependent = False                        } +{-|+An optional predicate on characters:+if @pred :: CharPredicate@ and @pred x = Just True@, then the lexer should accept the character @x@.++==== __Examples__+- A predicate that only accepts alphabetical or numbers:++  @+    isAlphaNumPred = Just . isAlphaNum+  @++- A predicate that only accepts capital letters:++  @+    isCapital = Just . isAsciiUpper+  @++-} type CharPredicate :: * type CharPredicate = Maybe (Char -> Bool)

@@ -1,8 +1,61 @@ {-# LANGUAGE Safe #-} {-# LANGUAGE NoMonomorphismRestriction, BlockArguments, OverloadedLists, OverloadedStrings #-} {-# OPTIONS_GHC -Wno-incomplete-uni-patterns #-}+  {-|+Module      : Text.Gigaparsec.Token.Errors+Description : This module contains the relevant functionality for configuring the error messages generated by the parsers provided by the Lexer.+License     : BSD-3-Clause+Maintainer  : Jamie Willis, Gigaparsec Maintainers+Stability   : experimental++This module contains the relevant functionality for configuring the error messages generated by the parsers provided by the 'Text.Gigaparsec.Token.Lexer.Lexer'.++@since 0.2.2.0+-} module Text.Gigaparsec.Token.Errors (+    -- ** Error Configuration+    -- | This is the main type that defines the configuration for errors from the Lexer.     ErrorConfig,+    -- *** Labelling and Explanation Configuration+    {-| +    Labels and Explanations make parser errors more descriptive, by giving a name to the parser that failed, or providing a reason a particular parser failed.+    These help make error messages more descriptive than the usual 'unexpected symbol' messages.++    'LabelConfigurable' types describe errors that can provide labels upon failure, +    'ExplainConfigurable' types those that can providing reaons for failure, +    and 'LabelWithExplainConfigurable' types those that can provide both.    +    These configs are used by the 'ErrorConfig', whose fields include combinators that configure both labels and/or explains for simple description configurations.+    -}+    -- **** Label Configurations +    {-| +    Labels provide names to a parser to be used upon failure.+    A 'LabelConfig' or 'LabelConfigurable' type is able to produce these sorts of errors.+    -}+    LabelConfig, LabelConfigurable(..),+    -- **** Explain Configurations +    {-| +    Explains provide a reason that a parser has failed.+    An 'ExplainConfig' or 'ExplainConfigurable' type is able to produce these sorts of errors.+    -}+    ExplainConfig, ExplainConfigurable(..),+    -- **** Label-with-Explain Configurations +    {-| +    'LabelWithExplainConfig' combines 'LabelConfig' and 'ExplainConfig', +    describing configs that are able to give labels and/or reasons to errors.++    'LabelWithExplainConfigurable' types are those able to produce an error providing both labels and a reason.+    -}+    LabelWithExplainConfig, LabelWithExplainConfigurable(..),+    -- **** No-special-error-generating Configs+    {-|+    Sometimes it is best to defer to the default errors, instead of generating specialised ones.+    Configs that allow this are 'NotConfigurable'.+    -}+    NotConfigurable(..),+    -- *** Numeric Errors+    {-|+    These control the errors generated with the numeric ('Text.Gigaparsec.Token.Descriptions.NumericDesc') component of the 'Text.Gigaparsec.Token.Lexer.Lexer'.+    -}     labelNumericBreakChar, labelIntegerUnsignedDecimal,     labelIntegerUnsignedHexadecimal, labelIntegerUnsignedOctal,     labelIntegerUnsignedBinary, labelIntegerUnsignedNumber,@@ -13,9 +66,24 @@     labelIntegerHexadecimalEnd, labelIntegerOctalEnd,     labelIntegerBinaryEnd, labelIntegerNumberEnd,     filterIntegerOutOfBounds,+    -- **** Bit-Widths+    {-|+    Some of the numeric errors can take into account the supposed bit-width of the parsed data.+    +    Using 'Bits' achieves this.+    -}+    Bits(B8, B16, B32, B64),+    -- *** Name Errors+    {-|+    These control the errors generated with the names ('Text.Gigaparsec.Token.Descriptions.NameDesc') component of the 'Text.Gigaparsec.Token.Lexer.Lexer'.+    -}     labelNameIdentifier, labelNameOperator,     unexpectedNameIllegalIdentifier, unexpectedNameIllegalOperator,     filterNameIllFormedIdentifier, filterNameIllFormedOperator,+     -- *** Text Errors+    {-|+    These control the errors generated with the text ('Text.Gigaparsec.Token.Descriptions.TextDesc') component of the 'Text.Gigaparsec.Token.Lexer.Lexer'.+    -}     labelCharAscii, labelCharLatin1, labelCharUnicode,     labelCharAsciiEnd, labelCharLatin1End, labelCharUnicodeEnd,     labelStringAscii, labelStringLatin1, labelStringUnicode,@@ -23,23 +91,45 @@     labelStringCharacter, labelGraphicCharacter, labelEscapeSequence,     labelEscapeNumeric, labelEscapeNumericEnd, labelEscapeEnd,     labelStringEscapeEmpty, labelStringEscapeGap, labelStringEscapeGapEnd,+    -- *** Filtering Errors+    {-|+    These configs and combinators describe how to generate the filters to rule out specific parses. +    They can generate types of vanilla error or specialised errors.+    -}+    -- **** Filtering Configs+    FilterConfig,+    BasicFilterConfigurable(..),+    VanillaFilterConfig, VanillaFilterConfigurable(..),+    SpecializedFilterConfig, SpecializedFilterConfigurable(..),+    -- **** Filtering Combinators     filterCharNonAscii, filterCharNonLatin1, filterStringNonAscii, filterStringNonLatin1,     filterEscapeCharRequiresExactDigits, filterEscapeCharNumericSequenceIllegal,+    -- *** Verifying Bad Characters +    {-|+    These types and combinators help implement the Verified Error™ pattern for illegal string and literal characters.+    -}+    -- **** Configs+    {-|+    These types help configure the Verified Error pattern for illegal string and character literal characters, +    used by 'verifiedCharBadCharsUsedInLiteral' and 'verifiedStringBadCharsUsedInLiteral'.+    -}+    VerifiedBadChars, +    Unverified(..),+    -- **** Combinators+    badCharsFail, badCharsReason,     verifiedCharBadCharsUsedInLiteral, verifiedStringBadCharsUsedInLiteral,+    -- *** Symbol Errors+    {-| +    These control the errors generated with the symbol ('Text.Gigaparsec.Token.Descriptions.SymbolDesc') component of the 'Text.Gigaparsec.Token.Lexer.Lexer'+    -}     labelSymbol, labelSymbolEndOfKeyword, labelSymbolEndOfOperator,+    -- *** Space Errors+    {-| +    These control the errors generated with the space ('Text.Gigaparsec.Token.Descriptions.SpaceDesc') component of the 'Text.Gigaparsec.Token.Lexer.Lexer'.+    -}     labelSpaceEndOfLineComment, labelSpaceEndOfMultiComment,+    -- ** The Default Configuration     defaultErrorConfig,-    LabelWithExplainConfig, LabelWithExplainConfigurable(..),-    LabelConfig, LabelConfigurable(..),-    ExplainConfig, ExplainConfigurable(..),-    NotConfigurable(..),-    FilterConfig,-    VanillaFilterConfig, VanillaFilterConfigurable(..),-    SpecializedFilterConfig, SpecializedFilterConfigurable(..),-    BasicFilterConfigurable(..),-    VerifiedBadChars, badCharsFail, badCharsReason,-    Unverified(..),-    Bits(B8, B16, B32, B64)   ) where  import Data.Set (Set)@@ -61,71 +151,221 @@     VerifiedBadChars(BadCharsUnverified, BadCharsFail, BadCharsReason)   ) +{-|+An 'ErrorConfig' specifies how errors should be produced by the 'Text.Gigaparsec.Token.Lexer.Lexer'.++The Lexer is set up to produce a variety of different errors via @label@-ing, @explain@-ing, and @filter@-ing, +and some applications of the Verified and Preventative error patterns. +The exact content of those errors can be configured here. +Errors can be suppressed or specified with different levels of detail, +or even switching between vanilla or specialised errors.++A custom 'ErrorConfig' should be created by extending the 'defaultErrorConfig' +with record updates to override the relevant default fields.+Not configuring something does not mean it will not appear in the message, +but will mean it uses the underlying base errors.+-} type ErrorConfig :: * data ErrorConfig =-  ErrorConfig { labelNumericBreakChar :: !LabelWithExplainConfig-              , labelIntegerUnsignedDecimal :: Maybe Bits -> LabelWithExplainConfig-              , labelIntegerUnsignedHexadecimal :: Maybe Bits -> LabelWithExplainConfig-              , labelIntegerUnsignedOctal :: Maybe Bits -> LabelWithExplainConfig-              , labelIntegerUnsignedBinary :: Maybe Bits -> LabelWithExplainConfig-              , labelIntegerUnsignedNumber :: Maybe Bits -> LabelWithExplainConfig-              , labelIntegerSignedDecimal :: Maybe Bits -> LabelWithExplainConfig-              , labelIntegerSignedHexadecimal :: Maybe Bits -> LabelWithExplainConfig-              , labelIntegerSignedOctal :: Maybe Bits -> LabelWithExplainConfig-              , labelIntegerSignedBinary :: Maybe Bits -> LabelWithExplainConfig-              , labelIntegerSignedNumber :: Maybe Bits -> LabelWithExplainConfig-              , labelIntegerDecimalEnd :: LabelConfig-              , labelIntegerHexadecimalEnd :: LabelConfig-              , labelIntegerOctalEnd :: LabelConfig-              , labelIntegerBinaryEnd :: LabelConfig-              , labelIntegerNumberEnd :: LabelConfig-              , filterIntegerOutOfBounds :: Integer -> Integer -> Int -> FilterConfig Integer-              , labelNameIdentifier :: String-              , labelNameOperator :: String-              , unexpectedNameIllegalIdentifier :: String -> String-              , unexpectedNameIllegalOperator :: String -> String-              , filterNameIllFormedIdentifier :: FilterConfig String-              , filterNameIllFormedOperator :: FilterConfig String-              , labelCharAscii :: LabelWithExplainConfig-              , labelCharLatin1 :: LabelWithExplainConfig-              , labelCharUnicode :: LabelWithExplainConfig-              , labelCharAsciiEnd :: LabelConfig-              , labelCharLatin1End :: LabelConfig-              , labelCharUnicodeEnd :: LabelConfig-              , labelStringAscii :: Bool -> Bool -> LabelWithExplainConfig-              , labelStringLatin1 :: Bool -> Bool -> LabelWithExplainConfig-              , labelStringUnicode :: Bool -> Bool -> LabelWithExplainConfig-              , labelStringAsciiEnd :: Bool -> Bool -> LabelConfig-              , labelStringLatin1End :: Bool -> Bool -> LabelConfig-              , labelStringUnicodeEnd :: Bool -> Bool -> LabelConfig-              , labelStringCharacter :: LabelConfig-              , labelGraphicCharacter :: LabelWithExplainConfig-              , labelEscapeSequence :: LabelWithExplainConfig-              , labelEscapeNumeric :: Int -> LabelWithExplainConfig-              , labelEscapeNumericEnd :: Char -> Int -> LabelWithExplainConfig-              , labelEscapeEnd :: LabelWithExplainConfig-              , labelStringEscapeEmpty :: LabelConfig-              , labelStringEscapeGap :: LabelConfig-              , labelStringEscapeGapEnd :: LabelConfig-              , filterCharNonAscii :: VanillaFilterConfig Char-              , filterCharNonLatin1 :: VanillaFilterConfig Char-              , filterStringNonAscii :: SpecializedFilterConfig String-              , filterStringNonLatin1 :: SpecializedFilterConfig String-              , filterEscapeCharRequiresExactDigits :: Int -> NonEmpty Word -> SpecializedFilterConfig Word-              , filterEscapeCharNumericSequenceIllegal :: Char -> Int -> SpecializedFilterConfig Integer-              , verifiedCharBadCharsUsedInLiteral :: VerifiedBadChars-              , verifiedStringBadCharsUsedInLiteral :: VerifiedBadChars-              , labelSymbol :: Map String LabelWithExplainConfig-              -- don't bother with these until parsley standardises-              --, defaultSymbolKeyword :: Labeller-              --, defaultSymbolOperator :: Labeller-              --, defaultSymbolPunctuaton :: Labeller-              , labelSymbolEndOfKeyword :: String -> String-              , labelSymbolEndOfOperator :: String -> String-              , labelSpaceEndOfLineComment :: LabelWithExplainConfig-              , labelSpaceEndOfMultiComment :: LabelWithExplainConfig-              }+  ErrorConfig { +  -- | How a numeric break character should (like @_@) be referred to or explained within an error.+    labelNumericBreakChar :: !LabelWithExplainConfig+  -- | How unsigned decimal integers (of a possibly given bit-width) should be referred to or explained within an error.+  , labelIntegerUnsignedDecimal :: Maybe Bits -> LabelWithExplainConfig+  -- | How unsigned hexadecimal integers (of a possibly given bit-width) should be referred to or explained within an error.+  , labelIntegerUnsignedHexadecimal :: Maybe Bits -> LabelWithExplainConfig+  -- | How unsigned octal integers (of a possibly given bit-width) should be referred to or explained within an error.+  , labelIntegerUnsignedOctal :: Maybe Bits -> LabelWithExplainConfig+  -- | How unsigned binary integers (of a possibly given bit-width) should be referred to or explained within an error.+  , labelIntegerUnsignedBinary :: Maybe Bits -> LabelWithExplainConfig+  -- | How generic unsigned integers (of a possibly given bit-width) should be referred to or explained within an error.+  , labelIntegerUnsignedNumber :: Maybe Bits -> LabelWithExplainConfig+  -- | How signed decimal integers (of a possibly given bit-width) should be referred to or explained within an error.+  , labelIntegerSignedDecimal :: Maybe Bits -> LabelWithExplainConfig+  -- | How signed hexadecimal integers (of a possibly given bit-width) should be referred to or explained within an error.+  , labelIntegerSignedHexadecimal :: Maybe Bits -> LabelWithExplainConfig+  -- | How signed octal integers (of a possibly given bit-width) should be referred to or explained within an error.+  , labelIntegerSignedOctal :: Maybe Bits -> LabelWithExplainConfig+  -- | How signed binary integers (of a possibly given bit-width) should be referred to or explained within an error.+  , labelIntegerSignedBinary :: Maybe Bits -> LabelWithExplainConfig+  -- | How generic signed integers (of a possibly given bit-width) should be referred to or explained within an error.+  , labelIntegerSignedNumber :: Maybe Bits -> LabelWithExplainConfig+  -- | How the fact that the end of a decimal integer literal is expected should be referred to within an error.+  , labelIntegerDecimalEnd :: LabelConfig+  -- | How the fact that the end of a hexadecimal integer literal is expected should be referred to within an error.+  , labelIntegerHexadecimalEnd :: LabelConfig+  -- | How the fact that the end of an octal integer literal is expected should be referred to within an error.+  , labelIntegerOctalEnd :: LabelConfig+  -- | How the fact that the end of a binary integer literal is expected should be referred to within an error.+  , labelIntegerBinaryEnd :: LabelConfig+  -- | How the fact that the end of a generic integer literal is expected should be referred to within an error.+  , labelIntegerNumberEnd :: LabelConfig+  -- | Describes the content of the error when an integer literal is parsed and it is not within the required bit-width.+  --+  -- In @'filterIntegerOutOfBounds' x y r@: +  --+  --  - @x@ is the smallest value the integer could have taken, +  --  - @y@ is the largest value the integer could have taken, and+  --  - @r@ is the radix that the integer was parsed using+  , filterIntegerOutOfBounds  :: Integer+                              -> Integer +                              -> Int +                              -> FilterConfig Integer+  -- | How an identifier should be referred to in an error message.+  , labelNameIdentifier :: String+  -- | How a user-defined operator should be referred to in an error message.+  , labelNameOperator :: String+  -- | How an illegally parsed hard keyword should be referred to as an unexpected component.+  , unexpectedNameIllegalIdentifier :: String -> String+  -- | How an illegally parsed hard operator should be referred to as an unexpected component.+  , unexpectedNameIllegalOperator :: String -> String+  -- | When parsing identifiers that are required to have specific start characters, how bad identifiers should be reported.+  , filterNameIllFormedIdentifier :: FilterConfig String+  -- | When parsing operators that are required to have specific start/end characters, how bad operators should be reported.+  , filterNameIllFormedOperator :: FilterConfig String+  -- | How an ASCII character literal should be referred to or explained in error messages.+  , labelCharAscii :: LabelWithExplainConfig+  -- | How a Latin1 (extended ASCII) character literal should be referred to or explained in error messages.+  , labelCharLatin1 :: LabelWithExplainConfig+  -- | How a UTF-16 character literal should be referred to or explained in error messages.+  , labelCharUnicode :: LabelWithExplainConfig+  -- | How the closing quote of an ASCII character literal should be referred to in error messages.+  , labelCharAsciiEnd :: LabelConfig+  -- | How the closing quote of a Latin1 (extended ASCII) character literal should be referred to in error messages.+  , labelCharLatin1End :: LabelConfig+  -- | How the closing quote of a UTF-16 character literal should be referred to in error messages.+  , labelCharUnicodeEnd :: LabelConfig+  {-| How an ASCII-only string should literal be referred to or explained in error messages. +  With the arguments @'labelStringAscii' multi raw@:++  - @multi@: whether this is for a multi-line string+  - @raw@: whether this is for a raw string+  -}+  , labelStringAscii :: Bool -> Bool -> LabelWithExplainConfig+  {-| How a Latin1-only string should literal be referred to or explained in error messages.++  With the arguments @'labelStringLatin1' multi raw@:++  - @multi@: whether this is for a multi-line string+  - @raw@: whether this is for a raw string+  -}+  , labelStringLatin1 :: Bool -> Bool -> LabelWithExplainConfig+  {-| How a UTF-16-only string should literal be referred to or explained in error messages.++  With the arguments @'labelStringUnicode' multi raw@:++  - @multi@: whether this is for a multi-line string+  - @raw@: whether this is for a raw string+  -}+  , labelStringUnicode :: Bool -> Bool -> LabelWithExplainConfig+  {- | How the closing quote(s) of an ASCII string literal should be referred to in error messages.++  With the arguments @'labelStringAsciiEnd' multi raw@:++  - @multi@: whether this is for a multi-line string+  - @raw@: whether this is for a raw string+  -}+  , labelStringAsciiEnd :: Bool -> Bool -> LabelConfig+  {-| How the closing quote(s) of a Latin1 string literal should be referred to in error messages.++  With the arguments @'labelStringLatin1End' multi raw@:++  - @multi@: whether this is for a multi-line string+  - @raw@: whether this is for a raw string+  -}+  , labelStringLatin1End :: Bool -> Bool -> LabelConfig+  {-| How the closing quote(s) of a UTF-16 string literal should be referred to in error messages.++  With the arguments @'labelStringUnicodeEnd' multi raw@:++  - @multi@: whether this is for a multi-line string+  - @raw@: whether this is for a raw string+  -}+  , labelStringUnicodeEnd :: Bool -> Bool -> LabelConfig+  -- | How general string characters should be referred to in error messages.+  , labelStringCharacter :: LabelConfig+  -- | How a graphic character (a regular character in the literal) should be referred to or explained in error messages.+  , labelGraphicCharacter :: LabelWithExplainConfig+  -- | How an escape sequence should be referred to or explained in error messages.+  , labelEscapeSequence :: LabelWithExplainConfig+  {- | How a numeric escape sequence (after the opening character) should be referred to or explained in error messages.++  In @'labelEscapeNumeric' radix@:++  - @radix@: the radix this specific configuration applies to.+  -}+  , labelEscapeNumeric :: Int -> LabelWithExplainConfig+  {-| How the end of a numeric escape sequence (after a prefix) should be referred to or explained in error messages.++  In @'labelEscapeNumericEnd' prefix radix@:++  - @prefix@: the character that started this sequence+  - @radix@: the radix this specific configuration applies to.+  -}+  , labelEscapeNumericEnd :: Char -> Int -> LabelWithExplainConfig+  -- | How the end of an escape sequence (anything past the opening character) should be referred to or explained within an error message.+  , labelEscapeEnd :: LabelWithExplainConfig+  -- | How zero-width escape characters should be referred to within error messages.+  , labelStringEscapeEmpty :: LabelConfig+  -- | How string gaps should be referred to within error messages.+  , labelStringEscapeGap :: LabelConfig+  -- | How the end of a string gap (the closing slash) should be referred to within error messages.+  , labelStringEscapeGapEnd :: LabelConfig+  -- | When a non-ASCII character is found in a ASCII-only character literal, specifies how this should be reported.+  , filterCharNonAscii :: VanillaFilterConfig Char+  -- | When a non-Latin1 character is found in a Latin1-only character literal, specifies how this should be reported.+  , filterCharNonLatin1 :: VanillaFilterConfig Char+  -- | When a non-ASCII character is found in a ASCII-only string literal, specifies how this should be reported.+  , filterStringNonAscii :: SpecializedFilterConfig String+  -- | When a non-Latin1 character is found in a Latin1-only string literal, specifies how this should be reported.+  , filterStringNonLatin1 :: SpecializedFilterConfig String+  {-| When a numeric escape sequence requires a specific number of digits but this was not successfully parsed, +  this describes how to report that error given the number of successfully parsed digits up this point.++  In @'filterEscapeCharRequiresExactDigits' radix needed@:++  - @radix@: the radix used for this numeric escape sequence.+  - @needed@: the possible numbers of digits required.+  -}+  , filterEscapeCharRequiresExactDigits :: Int -> NonEmpty Word -> SpecializedFilterConfig Word+  {-| When a numeric escape sequence is not legal, this describes how to report that error, given the original illegal character.+  +  In @'filterEscapeCharNumericSequenceIllegal' maxEscape radix@:++  - @maxEscape@: the largest legal escape character.+  - @radix@: the radix used for this numeric escape sequence.+  -}+  , filterEscapeCharNumericSequenceIllegal :: Char -> Int -> SpecializedFilterConfig Integer+  -- | Character literals parse either graphic characters or escape characters.+  , verifiedCharBadCharsUsedInLiteral :: VerifiedBadChars+  -- | String literals parse either graphic characters or escape characters.+  , verifiedStringBadCharsUsedInLiteral :: VerifiedBadChars+  {-|+  Gives names and/or reasons to symbols.++  Symbols that do not appear in the map are assumed to be 'NotConfigurable'.+  -}+  , labelSymbol :: Map String LabelWithExplainConfig+  -- don't bother with these until parsley standardises+  --, defaultSymbolKeyword :: Labeller+  --, defaultSymbolOperator :: Labeller+  --, defaultSymbolPunctuaton :: Labeller++  -- | How the required end of a given keyword should be specified in an error.+  , labelSymbolEndOfKeyword :: String -> String+  -- | How the required end of a given operator should be specified in an error.+  , labelSymbolEndOfOperator :: String -> String+  -- | How the end of a single-line comment should be described or explained.+  , labelSpaceEndOfLineComment :: LabelWithExplainConfig+  -- | How the end of a multi-line comment should be described or explained.+  , labelSpaceEndOfMultiComment :: LabelWithExplainConfig+  }++{-|+The default configuration.+This serves as the base configuration, to be customised using record field updates.+-} defaultErrorConfig :: ErrorConfig defaultErrorConfig = ErrorConfig {..}   where labelNumericBreakChar = notConfigured@@ -210,9 +450,17 @@           | n < 0 = ('-' :) . showIntAtBase (toInteger radix) intToDigit (abs n)           | otherwise = showIntAtBase (toInteger radix) intToDigit n +{-|+A type @config@ is 'ExplainConfigurable' when it is able to configure errors that make labels.++This means @config@ is able to behave like a 'LabelConfig'+-} type LabelConfigurable :: * -> Constraint class LabelConfigurable config where-  label :: Set String -> config+  -- | The configuration produces the labels in the given set, which should not be empty.+  label :: Set String -- ^ The labels to produce.+        -> config+  -- | Configure a label by stating it must be hidden.   hidden :: config  instance LabelConfigurable LabelConfig where@@ -222,32 +470,63 @@   label = LELabel   hidden = LEHidden +{-|+A type @config@ is 'ExplainConfigurable' when it is able to configure an error which provides a reason.++This means @config@ is able to behave like an 'ExplainConfig'+-} type ExplainConfigurable :: * -> Constraint class ExplainConfigurable config where-  reason :: String -> config+  -- | The error should be displayed using the given reason.+  reason  :: String -- ^ The reason a parser failed.+          -> config  instance ExplainConfigurable ExplainConfig where reason = EReason instance ExplainConfigurable LabelWithExplainConfig where reason = LEReason +{-|+A type @config@ is 'LabelWithExplainConfigurable' when it is able to configure an error which provides both a reason and labels.+-} type LabelWithExplainConfigurable :: * -> Constraint class LabelWithExplainConfigurable config where-  labelAndReason :: Set String -> String -> config+  -- | The configuration produces the labels in the given set, and provides the given reason.+  labelAndReason :: Set String -- ^ The labels to produce+                 -> String     -- ^ The reason for the error.+                 -> config  instance LabelWithExplainConfigurable LabelWithExplainConfig where labelAndReason = LELabelAndReason +{-|+A type @config@ is 'NotConfigurable' when it is able to specify that no special error should be generated,+and instead use default errors.+-} type NotConfigurable :: * -> Constraint class NotConfigurable config where+  -- | No special error should be generated, and default errors should be used instead.   notConfigured :: config  instance NotConfigurable LabelWithExplainConfig where notConfigured = LENotConfigured instance NotConfigurable LabelConfig where notConfigured = LNotConfigured instance NotConfigurable ExplainConfig where notConfigured = ENotConfigured +{-|+A type @config@ is 'VanillaFilterConfigurable' when it is able to generate vanilla errors.++This means @config@ is able to behave like a 'VanillaFilterConfig'+-} type VanillaFilterConfigurable :: (* -> *) -> Constraint class VanillaFilterConfigurable config where-  unexpected :: (a -> String) -> config a-  because :: (a -> String) -> config a-  unexpectedBecause :: (a -> String) -> (a -> String) -> config a+  -- | Ensure the filter generates a /vanilla/ unexpected item for the given failing parse.+  unexpected  :: (a -> String) -- ^ a function producing the unexpected label for the given value.+              -> config a+  -- | Ensure the filter generates a /vanilla/ reason for the given failing parse.+  because :: (a -> String)  -- ^ a function producing the reason for the given value.+          -> config a+  -- | Ensure the filter generates a /vanilla/ unexpected item and a reason for the given failing parse.+  unexpectedBecause +    :: (a -> String) -- ^ @reason@, a function producing the reason for the given value.+    -> (a -> String) -- ^ @unexpected@, a function producing the unexpected label for the given value.+    -> config a  instance VanillaFilterConfigurable FilterConfig where   unexpected = VSUnexpected@@ -259,30 +538,53 @@   because = VBecause   unexpectedBecause = VUnexpectedBecause +{-|+A type @config@ is 'SpecializedFilterConfigurable' when it is able to generate specialised errors.++This means @config@ is able to behave like a 'SpecializedFilterConfig'+-} type SpecializedFilterConfigurable :: (* -> *) -> Constraint class SpecializedFilterConfigurable config where-  specializedFilter :: (a -> NonEmpty String) -> config a+  -- | Ensure the filter generates /specialised/ messages for the given failing parse.+  specializedFilter +    :: (a -> NonEmpty String) -- ^ @message@: a function producing the message for the given value.+    -> config a  instance SpecializedFilterConfigurable FilterConfig where   specializedFilter = VSSpecializedFilter instance SpecializedFilterConfigurable SpecializedFilterConfig where   specializedFilter = SSpecializedFilter +{-|+A type @config@ is 'BasicFilterConfigurable' when it is able to provide /no/ error configuration, +and instead defer to a regular filter.+-} type BasicFilterConfigurable :: (* -> *) -> Constraint class BasicFilterConfigurable config where+  -- | No error configuration for the filter is specified; a regular filter is used instead.   basicFilter :: config a  instance BasicFilterConfigurable FilterConfig where basicFilter = VSBasicFilter instance BasicFilterConfigurable VanillaFilterConfig where basicFilter = VBasicFilter instance BasicFilterConfigurable SpecializedFilterConfig where basicFilter = SBasicFilter +-- | Makes "bad literal chars" generate a bunch of given messages in a specialised error. +-- Requires a map from bad characters to their messages. badCharsFail :: Map Char (NonEmpty String) -> VerifiedBadChars badCharsFail = BadCharsFail++-- | Makes "bad literal chars" generate a reason in a vanilla error. +-- Requires a map from bad characters to their reasons. badCharsReason :: Map Char String -> VerifiedBadChars badCharsReason = BadCharsReason +{-|+A type @config@ is 'Unverified' when it can disable the verified error for bad characters:+this may improve parsing performance slightly on the failure case.+-} type Unverified :: * -> Constraint class Unverified config where+  -- | A configuration which disables the verified error for bad characters.   unverified :: config  instance Unverified VerifiedBadChars where unverified = BadCharsUnverified

@@ -2,27 +2,148 @@ {-# LANGUAGE ConstraintKinds, DataKinds #-} -- Ideally, we should probably expose all the functionally via this one file -- for ergonomics+{-|+Module      : Text.Gigaparsec.Token.Lexer+Description : This module provides a large selection of functionality concerned with lexing.+License     : BSD-3-Clause+Maintainer  : Jamie Willis, Gigaparsec Maintainers+Stability   : experimental++This module provides a large selection of functionality concerned with lexing.++In traditional compilers, lexing and parsing are two largely separate processes;+lexing turns raw input into a series of tokens, and parsing then processes these tokens.+Parser combinators, on the other hand, are often implemented to deal directly with the input stream.++Nonetheless, a lexer abstraction may be achieved by defining a core set of /lexing/ combinators that convert input to tokens,+and then defining the /parsing/ combinators in terms of these.+The parsers defined using 'Lexer' construct these /lexing/ combinators, which creates a clear and logical separation from the rest of the parser.++It is possible that some of the implementations of parsers found within this class may have been hand-optimised for performance:+care will have been taken to ensure these implementations precisely match the semantics of the originals.++-} module Text.Gigaparsec.Token.Lexer (-    Lexer, mkLexer, mkLexerWithErrorConfig,-    Lexeme, lexeme, nonlexeme, fully, space,+    -- ** Lexing+    Lexer,+    mkLexer,+    mkLexerWithErrorConfig,+    -- ** Lexemes and Non-Lexemes+    {-|+    A key distinction in lexers is between lexemes and non-lexemes:++    * 'lexeme' consumes whitespace.+    It should be used by a wider parser, to ensure whitespace is handled uniformly.+    The output of 'lexeme' can be considered a /token/ as provided by traditional lexers, and can be used by the parser.+    * 'nonlexeme' does not consume whitespace.+    It should be used to define further composite tokens or in special circumstances where whitespace should not be consumed.+    One may consider the output of 'nonlexeme' to still be in the /lexing/ stage of parsing, and not necessarily a valid token.+    -}++    -- *** Lexemes+    {-|+    Ideally, a wider parser should not be concerned with handling whitespace,+    as it is responsible for dealing with a stream of tokens.+    With parser combinators, however, it is usually not the case that there is a separate distinction between the parsing phase and the lexing phase.+    That said, it is good practice to establish a logical separation between the two worlds.+    As such, 'lexeme' contains parsers that parse tokens, and these are whitespace-aware.+    This means that whitespace will be consumed after any of these parsers are parsed.+    It is not required that whitespace be present.+    -}+    lexeme,+    -- *** Non-Lexemes+    {-|+    Whilst the functionality in lexeme is strongly recommended for wider use in a parser, the functionality here may be useful for more specialised use-cases.+    In particular, these may for the building blocks for more complex tokens (where whitespace is not allowed between them, say),+    in which case these compound tokens can be turned into lexemes manually.++    For example, the lexer does not have configuration for trailing specifiers on numeric literals (like, 1024L in Scala, say):+    the desired numeric literal parser could be extended with this functionality before whitespace is consumed by using the variant found in this object.++    These tokens can also be used for lexical extraction,+    which can be performed by the ErrorBuilder typeclass:+    this can be used to try and extract tokens from the input stream when an error happens,+    to provide a more informative error.+    In this case, it is desirable to not consume whitespace after the token to keep+    the error tight and precise.+    -}+    nonlexeme,+    -- *** Fully and Space+    fully, space,+    -- *** 'Lexeme' Fields+    {-|+    Despite their differences, lexemes and non-lexemes share a lot of common functionality.+    The type 'Lexeme' describes both lexemes and non-lexemes, so that this common functionality may be exploited.+    -}+    Lexeme,+    {-|+    Lexemes and Non-Lexemes are described by these common fields.+    -}     apply, sym, symbol, names,-    -- Symbol+    -- ** Symbolic Tokens+    {-|+    The 'Symbol' interface handles the parsing of symbolic tokens, such as keywords.+    -}     Symbol, softKeyword, softOperator,-    -- Names+    -- ** Name Tokens+    {-|+    The 'Names' interface handles the parsing of identifiers and operators.+    -}     Names, identifier, identifier', userDefinedOperator, userDefinedOperator',-    -- Numeric-    IntegerParsers, CanHoldSigned, CanHoldUnsigned,-    integer, natural, decimal, hexadecimal, octal, binary,+    -- ** Numeric Tokens+    {-|+    These types and combinators parse numeric literals, such as integers and reals.+    -}++    CanHoldSigned, CanHoldUnsigned,+    -- *** Integer Parsers+    {-|+    'IntegerParsers' handles integer parsing (signed and unsigned).+    This is mainly used by the combinators 'integer' and 'natural'.+    -}+    IntegerParsers,+    integer, natural,+    -- **** Fixed-Base Parsers+    decimal, hexadecimal, octal, binary,+    -- **** Fixed-Width Numeric Tokens+    {-|+    These combinators tokenize numbers that must be within specific bit-widths.+    The possible bit-widths are provided by 'Text.Gigaparsec.Internal.Token.BitBounds.Bits'.+    -}+    -- ***** Decimal Tokens     decimal8, decimal16, decimal32, decimal64,+    -- ***** Hexadecimal Tokens     hexadecimal8, hexadecimal16, hexadecimal32, hexadecimal64,+    -- ***** Octal Tokens     octal8, octal16, octal32, octal64,+    -- ***** Binary Tokens     binary8, binary16, binary32, binary64,-    -- Text+    -- ** Textual Tokens+    {-|+    The 'TextParsers' interface handles the parsing of string and character literals.+    -}     TextParsers,+    ascii, unicode, latin1,+    -- *** String Parsers+    {-|+    A 'Lexer' provides the following 'TextParsers' for string literals.+    -}     stringLiteral, rawStringLiteral, multiStringLiteral, rawMultiStringLiteral,+    -- *** Character Parsers+    {-|+    A 'Lexer' provides the following 'TextParsers' for character literals.+    -}     charLiteral,-    ascii, unicode, latin1,-    -- Space+    -- ** Whitespace and Comments+    {-|+    'Space' and its fields are concerned with special treatment of whitespace itself.++    Most of the time, the functionality herein will not be required,+    as 'lexeme' and 'fully' will consistently handle whitespace.++    However, whitespace /is/ significant in some languages, like Python and Haskell,+    in which case 'Space' provides a way to control how whitespace is consumed.+    -}     Space, skipComments, whiteSpace, alter, initSpace,   ) where 

@@ -1,5 +1,8 @@ {-# LANGUAGE Trustworthy #-}-{-# LANGUAGE TemplateHaskell, TypeOperators #-}+{-# LANGUAGE TemplateHaskell #-}++{-# OPTIONS_GHC -Wno-missing-import-lists #-}+ {-| Module      : Text.Gigaparsec.Token.Patterns Description : Template Haskell generators to help with patterns@@ -12,25 +15,105 @@  @since 0.2.2.0 -}-module Text.Gigaparsec.Token.Patterns (overloadedStrings) where+module Text.Gigaparsec.Token.Patterns (+  -- * Overloaded Strings+  overloadedStrings,+  -- * Lexer Combinators+  {-|+  These functions will generate combinators for parsing things like identifiers, keywords, etc,+  as described by a 'Lexer'. +  The combinators will behave like their counterparts in "Text.Gigaparsec.Token.Lexer",+  except they do not need to be given a lexer(/a subcomponent of a lexer) as an argument.+  +  * 'lexerCombinators' will generate these lexer combinators using the same name as the original combinators.+  * 'lexerCombinatorsWithNames' lets you rename the generated combinator; otherwise it behaves exactly as 'lexerCombinators'.+  * 'generateIntegerParsers' will generate lexer combinators for integer literals.+    If you try to generate a `Text.Gigaparsec.Token.Lexer.decimal` parser using `lexerCombinators` or `lexerCombinatorsWithNames`,+    you will get an error.+  +  ==== __Examples:__++  The combinator "Text.Gigaparsec.Token.Lexer.identifier" is used for parsing identifiers, and has the type,++  > Lexer.identifier :: Lexer -> Parsec String++  It is annoying to have to feed the lexer as the initial argument, as this will be fixed throughout the parser.+  Usually, one ends up writing their own combinator:++  > identifier :: Parsec String+  > identifier = Lexer.identifier lexer++  Writing these by hand is tedious; especially if we wish to use multiple such combinators.+  This is where `lexerCombinators` comes in:++  > $(lexerCombinators [| lexer |] ['Lexer.identifier])++  will generate the combinator,++  > identifier :: Parsec String+  > identifier = Lexer.identifier lexer++  If we wish to use multiple combinators, we just add each one to the list.+  For example,++  > $(lexerCombinators [| lexer |] ['Lexer.identifier, 'Lexer.fully, 'Lexer.softKeyword, 'Lexer.softOperator])+++  -}+  lexerCombinators,+  lexerCombinatorsWithNames,+  -- ** Integer Parsers+  generateIntegerParsers,+  -- *** IntegerParserConfig+  IntegerParserConfig,+  prefix, widths, bases, includeUnbounded, signedOrUnsigned, collatedParser,+  -- **** Presets+  emptyIntegerParserConfig,+  emptySignedIntegerParserConfig,+  emptyUnsignedIntegerParserConfig,+  -- **** Associated Types+  SignedOrUnsigned(..),+  allBases,+  IntLitBase(..),+  ) where+ import Text.Gigaparsec (Parsec)-import Text.Gigaparsec.Token.Lexer (lexeme, sym)+import safe Text.Gigaparsec.Internal.Token.Lexer+    ( Lexeme(sym),+      Lexer(lexeme) )+import safe Text.Gigaparsec.Internal.Token.Patterns.IntegerParsers+    ( IntegerParserConfig(collatedParser, prefix, widths, bases,+                          includeUnbounded, signedOrUnsigned),+      SignedOrUnsigned(..),+      allBases,+      IntLitBase(..),+      generateIntegerParsers,+      emptyIntegerParserConfig,+      emptySignedIntegerParserConfig,+      emptyUnsignedIntegerParserConfig ) + import Data.String (IsString(fromString))-import Language.Haskell.TH.Syntax (Q, Dec, Exp)+import Language.Haskell.TH.Syntax (Q, Dec (..), Exp) ++++import Text.Gigaparsec.Internal.Token.Patterns.LexerCombinators (lexerCombinators, lexerCombinatorsWithNames)+ {-|-When given a quoted reference to a 'Text.Gigaparsec.Token.Lexer', for example+When given a quoted reference to a 'Text.Gigaparsec.Token.Lexer.Lexer', for example @[|lexer|]@, this function will synthesise an `IsString` instance that will allow string literals to serve as @Parsec ()@. These literals will parse symbols in the language associated with the lexer, followed by consuming valid whitespace.  @since 0.2.2.0 -}-overloadedStrings :: Q Exp   -- ^ the quoted 'Text.Gigaparsec.Token.Lexer'+overloadedStrings :: Q Exp   -- ^ the quoted 'Text.Gigaparsec.Token.Lexer.Lexer'                   -> Q [Dec] -- ^ a synthesised `IsString` instance. overloadedStrings qlexer = [d|     instance u ~ () => IsString (Parsec u) where       fromString = sym (lexeme $qlexer) -- TODO: one day, $qlexer.lexeme.sym   |]+