parsley 1.0.2.0 → 2.0.0.0

raw patch · 30 files changed

+730/−371 lines, 30 filesdep ~basedep ~parsley-coredep ~textPVP ok

version bump matches the API change (PVP)

Dependency ranges changed: base, parsley-core, text

API changes (from Hackage documentation)

Files

• ChangeLog.md +19/−0
• README.md +4/−0
• benchmarks/BrainfuckBench/Main.hs +5/−5
• benchmarks/BrainfuckBench/Parsley/Parser.hs +2/−1
• benchmarks/JavascriptBench/Main.hs +2/−2
• benchmarks/JavascriptBench/Parsley/Parser.hs +27/−27
• benchmarks/NandlangBench/Main.hs +1/−1
• benchmarks/NandlangBench/Parsley/Parser.hs +2/−1
• parsley.cabal +11/−9
• src/ghc/Parsley.hs +15/−13
• src/ghc/Parsley/Char.hs +126/−0
• src/ghc/Parsley/Combinator.hs +6/−93
• src/ghc/Parsley/Debug.hs +11/−0
• src/ghc/Parsley/Fold.hs +51/−62
• src/ghc/Parsley/ParserOps.hs +12/−0
• src/ghc/Parsley/Precedence.hs +211/−65
• test/Parsley/Alternative/Test.hs +0/−1
• test/Parsley/Applicative/Test.hs +0/−1
• test/Parsley/Char/Parsers.hs +10/−0
• test/Parsley/Char/Test.hs +58/−0
• test/Parsley/Combinator/Parsers.hs +0/−9
• test/Parsley/Combinator/Test.hs +4/−48
• test/Parsley/Fold/Parsers.hs +5/−5
• test/Parsley/Fold/Test.hs +30/−15
• test/Parsley/Precedence/Parsers.hs +41/−0
• test/Parsley/Precedence/Test.hs +70/−5
• test/Parsley/Register/Test.hs +0/−1
• test/Regression/Parsers.hs +1/−1
• test/Regression/Tests.hs +3/−3
• test/TestUtils.hs +3/−3

@@ -42,3 +42,22 @@  * Added `local_` combinator to `Register`. * Added `localModify` and `localModify_` combinators to `Register`.++## 2.0.0.0 -- 2021-11-24++* Incorporated API naming conventions from _Design Patterns for Parser Combinators_.+    * `chainPre` -> `prefix`+    * `chainPost` -> `postfix`+    * `chainl1'` -> `infixl1`+    * `chainr1'` -> `infixr1`+    * `pfoldr` -> `manyr`+    * `pfoldl` -> `manyl`+    * `pfoldr1` -> `somer`+    * `pfoldl1` -> `somel`+* Reworked the `precedence` combinator system in line with the paper: the horrible overloading+  has gone now!+* Added in the `ParserOps` and `Debug` modules.+* Added `RANGES` to the `Defunc` API.+* Renamed `runParser` to `parse`.+* Moved some functionality to `Parsley.Char`.+* Added `digit`, `letter`, and `letterOrDigit`.

@@ -63,6 +63,7 @@  ## References * This work spawned a paper at ICFP 2020: [**Staged Selective Parser Combinators**](https://dl.acm.org/doi/10.1145/3409002)+* Supports patterns and combinators from Haskell Symposium 2021: [**Design Patterns of Parser Combinators**](https://dl.acm.org/doi/10.1145/3471874.3472984)  ### Talks For talks on how writing parsers changes when using Parsley see either of these:@@ -71,3 +72,6 @@  For the technical overview of how Parsley works: * [*Staged Selective Parser Combinators*](https://www.youtube.com/watch?v=lH65PvRgm8M) - ICFP 2020++For information about how to write parsers cleanly:+* [*Design Patterns for Parser Combinators*](https://www.youtube.com/watch?v=RwzX1XltOGY) - Haskell 2021

@@ -32,19 +32,19 @@ deriving instance NFData BrainFuckOp  brainfuckParsleyS :: String -> Maybe [BrainFuckOp]-brainfuckParsleyS = $$(Parsley.runParser BrainfuckBench.Parsley.Parser.brainfuck)+brainfuckParsleyS = $$(Parsley.parse BrainfuckBench.Parsley.Parser.brainfuck)  brainfuckParsleyT :: Text -> Maybe [BrainFuckOp]-brainfuckParsleyT = $$(Parsley.runParser BrainfuckBench.Parsley.Parser.brainfuck)+brainfuckParsleyT = $$(Parsley.parse BrainfuckBench.Parsley.Parser.brainfuck)  brainfuckParsleyB :: ByteString -> Maybe [BrainFuckOp]-brainfuckParsleyB = $$(Parsley.runParser BrainfuckBench.Parsley.Parser.brainfuck)+brainfuckParsleyB = $$(Parsley.parse BrainfuckBench.Parsley.Parser.brainfuck)  brainfuckParsleySS :: CharList -> Maybe [BrainFuckOp]-brainfuckParsleySS = $$(Parsley.runParser BrainfuckBench.Parsley.Parser.brainfuck)+brainfuckParsleySS = $$(Parsley.parse BrainfuckBench.Parsley.Parser.brainfuck)  brainfuckParsleyLB :: Data.ByteString.Lazy.ByteString -> Maybe [BrainFuckOp]-brainfuckParsleyLB = $$(Parsley.runParser BrainfuckBench.Parsley.Parser.brainfuck)+brainfuckParsleyLB = $$(Parsley.parse BrainfuckBench.Parsley.Parser.brainfuck)  brainfuck :: Benchmark brainfuck =

@@ -7,7 +7,8 @@ import Prelude hiding (fmap, pure, (<*), (*>), (<*>), (<$>), (<$), pred) import BrainfuckBench.Shared import Parsley-import Parsley.Combinator (noneOf, eof)+import Parsley.Combinator (eof)+import Parsley.Char(noneOf) import Parsley.Fold (skipMany) --import Parsley.Garnish import Language.Haskell.TH.Syntax (Lift(..))

@@ -42,10 +42,10 @@ deriving instance NFData JSAtom  javascriptParsleyS :: String -> Maybe JSProgram-javascriptParsleyS = $$(Parsley.runParser JavascriptBench.Parsley.Parser.javascript)+javascriptParsleyS = $$(Parsley.parse JavascriptBench.Parsley.Parser.javascript)  javascriptParsleyT :: Text -> Maybe JSProgram-javascriptParsleyT = $$(Parsley.runParser JavascriptBench.Parsley.Parser.javascript)+javascriptParsleyT = $$(Parsley.parse JavascriptBench.Parsley.Parser.javascript)  javascript :: Benchmark javascript =

@@ -7,9 +7,10 @@  import Prelude hiding (fmap, pure, (<*), (*>), (<*>), (<$>), (<$), pred) import Parsley-import Parsley.Combinator (token, oneOf, noneOf, eof)-import Parsley.Fold (skipMany, skipSome, sepBy, sepBy1, pfoldl1, chainl1)-import Parsley.Precedence (precedence, monolith, prefix, postfix, infixR, infixL)+import Parsley.Char (token, oneOf, noneOf, digit)+import Parsley.Combinator (eof)+import Parsley.Fold (skipMany, skipSome, sepBy, sepBy1, somel, chainl1)+import Parsley.Precedence (precHomo, ops, Fixity(InfixL, Prefix, Postfix)) import Parsley.Defunctionalized (Defunc(CONS, ID, LIFTED, LAM_S), pattern FLIP_H, pattern COMPOSE_H) import JavascriptBench.Shared import Data.Char (isSpace, isUpper, digitToInt, isDigit)@@ -64,25 +65,24 @@     condExpr :: Parser JSExpr'     condExpr = liftA2 [|jsCondExprBuild|] expr' (maybeP ((symbol '?' *> asgn) <~> (symbol ':' *> asgn)))     expr' :: Parser JSExpr'-    expr' = precedence (monolith-      [ prefix  [ operator "--" $> [|jsDec|], operator "++" $> [|jsInc|]-                , operator "-" $> [|jsNeg|], operator "+" $> [|jsPlus|]-                , operator "~" $> [|jsBitNeg|], operator "!" $> [|jsNot|] ]-      , postfix [ operator "--" $> [|jsDec|], operator "++" $> [|jsInc|] ]-      , infixL  [ operator "*" $> [|JSMul|], operator "/" $> [|JSDiv|]-                , operator "%" $> [|JSMod|] ]-      , infixL  [ operator "+" $> [|JSAdd|], operator "-" $> [|JSSub|] ]-      , infixL  [ operator "<<" $> [|JSShl|], operator ">>" $> [|JSShr|] ]-      , infixL  [ operator "<=" $> [|JSLe|], operator "<" $> [|JSLt|]-                , operator ">=" $> [|JSGe|], operator ">" $> [|JSGt|] ]-      , infixL  [ operator "==" $> [|JSEq|], operator "!=" $> [|JSNe|] ]-      , infixL  [ try (operator "&") $> [|JSBitAnd|] ]-      , infixL  [ operator "^" $> [|JSBitXor|] ]-      , infixL  [ try (operator "|") $> [|JSBitOr|] ]-      , infixL  [ operator "&&" $> [|JSAnd|] ]-      , infixL  [ operator "||" $> [|JSOr|] ]-      ])-      ([|JSUnary|] <$> memOrCon)+    expr' = precHomo ([|JSUnary|] <$> memOrCon)+      [ ops Prefix  [ operator "--" $> [|jsDec|], operator "++" $> [|jsInc|]+                    , operator "-" $> [|jsNeg|], operator "+" $> [|jsPlus|]+                    , operator "~" $> [|jsBitNeg|], operator "!" $> [|jsNot|] ]+      , ops Postfix [ operator "--" $> [|jsDec|], operator "++" $> [|jsInc|] ]+      , ops InfixL  [ operator "*" $> [|JSMul|], operator "/" $> [|JSDiv|]+                    , operator "%" $> [|JSMod|] ]+      , ops InfixL  [ operator "+" $> [|JSAdd|], operator "-" $> [|JSSub|] ]+      , ops InfixL  [ operator "<<" $> [|JSShl|], operator ">>" $> [|JSShr|] ]+      , ops InfixL  [ operator "<=" $> [|JSLe|], operator "<" $> [|JSLt|]+                    , operator ">=" $> [|JSGe|], operator ">" $> [|JSGt|] ]+      , ops InfixL  [ operator "==" $> [|JSEq|], operator "!=" $> [|JSNe|] ]+      , ops InfixL  [ try (operator "&") $> [|JSBitAnd|] ]+      , ops InfixL  [ operator "^" $> [|JSBitXor|] ]+      , ops InfixL  [ try (operator "|") $> [|JSBitOr|] ]+      , ops InfixL  [ operator "&&" $> [|JSAnd|] ]+      , ops InfixL  [ operator "||" $> [|JSOr|] ]+      ]     memOrCon :: Parser JSUnary     memOrCon = keyword "delete" *> ([|JSDel|] <$> member)            <|> keyword "new" *> ([|JSCons|] <$> con)@@ -132,11 +132,11 @@     zeroNumFloat :: Parser (Either Int Double)     zeroNumFloat = [|Left|] <$> (hexadecimal <|> octal)                <|> decimalFloat-               <|> (fromMaybeP (fractFloat <*> pure (LIFTED 0)) empty)+               <|> fromMaybeP (fractFloat <*> pure (LIFTED 0)) empty                <|> pure [|Left 0|]      decimalFloat :: Parser (Either Int Double)-    decimalFloat = fromMaybeP (decimal <**> (option (COMPOSE_H [|Just|] [|Left|]) fractFloat)) empty+    decimalFloat = fromMaybeP (decimal <**> option (COMPOSE_H [|Just|] [|Left|]) fractFloat) empty      fractFloat :: Parser (Int -> Maybe (Either Int Double))     fractFloat = [|\g x -> liftM Right (g x)|] <$> fractExponent@@ -149,7 +149,7 @@         g = [|\exp n -> readMaybe (show n ++ exp)|]      fraction :: Parser [Char]-    fraction = char '.' <:> some (oneOf ['0'..'9'])+    fraction = char '.' <:> some digit      exponent' :: Parser [Char]     exponent' = [|$(CONS) 'e'|] <$> (oneOf "eE"@@ -157,12 +157,12 @@              <*> ([|show|] <$> decimal)))      decimal :: Parser Int-    decimal = number (LIFTED 10) (oneOf ['0'..'9'])+    decimal = number (LIFTED 10) digit     hexadecimal = oneOf "xX" *> number (LIFTED 16) (oneOf (['a'..'f'] ++ ['A'..'F'] ++ ['0'..'9']))     octal = oneOf "oO" *> number (LIFTED 8) (oneOf ['0'..'7'])      number :: Defunc Int -> Parser Char -> Parser Int-    number qbase digit = pfoldl1 addDigit (LIFTED 0) digit+    number qbase digit = somel addDigit (LIFTED 0) digit       where         addDigit = [|\x d -> $qbase * x + digitToInt d|] 

@@ -17,7 +17,7 @@ main = defaultMain [nandlang]  nandParsleyB :: ByteString -> Maybe ()-nandParsleyB = $$(Parsley.runParser NandlangBench.Parsley.Parser.nandlang)+nandParsleyB = $$(Parsley.parse NandlangBench.Parsley.Parser.nandlang)  nandlang :: Benchmark nandlang =

@@ -6,7 +6,8 @@  import Prelude hiding (fmap, pure, (<*), (*>), (<*>), (<$>), (<$), pred) import Parsley-import Parsley.Combinator (token, oneOf, eof)+import Parsley.Combinator (eof)+import Parsley.Char (token, oneOf) import Parsley.Fold (skipMany, skipSome) --import Parsley.Garnish import NandlangBench.Parsley.Functions

@@ -5,7 +5,7 @@ --                   | +------- breaking API changes --                   | | +----- non-breaking API additions --                   | | | +--- code changes with no API change-version:             1.0.2.0+version:             2.0.0.0 synopsis:            A fast parser combinator library backed by Typed Template Haskell description:         Parsley is a staged selective parser combinator library, which means                      it does not support monadic operations, and relies on Typed Template@@ -35,15 +35,16 @@   exposed-modules:     Parsley,                        Parsley.Applicative,                        Parsley.Alternative,+                       Parsley.Char,+                       Parsley.Combinator,                        Parsley.Defunctionalized,+                       Parsley.Debug,                        Parsley.Selective,                        Parsley.Register,-                       Parsley.Combinator,                        Parsley.Fold,+                       --Parsley.Patterns,                        Parsley.InputExtras,-                       Parsley.Precedence--  other-modules:       Parsley.Debug+                       Parsley.Precedence,                        Parsley.ParserOps    default-extensions:  BangPatterns,@@ -62,9 +63,10 @@  --                     ghc                  >= 8.6     && < 9.2,   build-depends:       base                 >= 4.10    && < 4.16,-                       parsley-core         >= 1.8     && < 3,+                       parsley-core         >= 2       && < 3,                        template-haskell     >= 2.14    && < 3,-                       text                 >= 1.2.3   && < 1.3,+                       text                 >= 1.2.3   && < 1.3+   hs-source-dirs:      src/ghc   default-language:    Haskell2010   ghc-options:         -Wall -Weverything -Wcompat@@ -108,9 +110,9 @@   build-depends:       tasty-hunit, tasty-quickcheck, th-test-utils, deepseq   main-is:             Parsley/Tests.hs   other-modules:       Parsley.Alternative.Test, Parsley.Applicative.Test, Parsley.Combinator.Test, Parsley.Fold.Test,-                       Parsley.Precedence.Test, Parsley.Register.Test, Parsley.Selective.Test,+                       Parsley.Precedence.Test, Parsley.Register.Test, Parsley.Selective.Test, Parsley.Char.Test,                        Parsley.Alternative.Parsers, Parsley.Applicative.Parsers, Parsley.Combinator.Parsers, Parsley.Fold.Parsers,-                       Parsley.Precedence.Parsers, Parsley.Register.Parsers, Parsley.Selective.Parsers+                       Parsley.Precedence.Parsers, Parsley.Register.Parsers, Parsley.Selective.Parsers, Parsley.Char.Parsers  test-suite regression-test   import:              test-common

@@ -7,7 +7,7 @@ Maintainer  : Jamie Willis Stability   : stable -This module contains the core execution functions `runParser` and `parseFromFile`.+This module contains the core execution functions `parse` and `parseFromFile`. It exports the `Parser` type, as well as the `ParserOps` typeclass, which may be needed as a constraint to create more general combinators. It also exports several of the more important modules and functionality in particular the core set of combinators.@@ -15,14 +15,15 @@ @since 0.1.0.0 -} module Parsley (-    runParser, parseFromFile,+    parse, parseFromFile,     module Core,-    module Primitives,     module Applicative,     module Alternative,     module Selective,     module Combinator,+    module Char,     module Fold,+    module Debug,     module THUtils,   ) where @@ -33,12 +34,13 @@  import Parsley.Alternative              as Alternative import Parsley.Applicative              as Applicative-import Parsley.Combinator               as Combinator  (item, char, string, satisfy, notFollowedBy, lookAhead, try)+import Parsley.Char                     as Char        (item, char, string, satisfy)+import Parsley.Combinator               as Combinator  (notFollowedBy, lookAhead, try) import Parsley.Fold                     as Fold        (many, some) import Parsley.Internal                 as Core        (Parser) import Parsley.ParserOps                as Core        (ParserOps) import Parsley.Internal                 as THUtils     (Quapplicative(..), WQ, Code)-import Parsley.Debug                    as Primitives  (debug)+import Parsley.Debug                    as Debug       (debug) import Parsley.Selective                as Selective  import qualified Parsley.Internal as Internal (parse)@@ -56,7 +58,7 @@ /In @Main.hs@/:  > parseHelloParsley :: String -> Maybe String-> parseHelloParsley = $$(runParser helloParsley)+> parseHelloParsley = $$(parse helloParsley)  Note that the definition of the parser __must__ be in a separate module to the splice (@$$@).@@ -66,25 +68,25 @@ The `Trace` instance is used to enable verbose debugging output for the compilation pipeline when "Parsley.Internal.Verbose" is imported. -@since 0.1.0.0+@since 2.0.0.0 -}-runParser :: (Trace, Input input)-          => Parser a                -- ^ The parser to be compiled-          -> Code (input -> Maybe a) -- ^ The generated parsing function-runParser = Internal.parse+parse :: (Trace, Input input)+      => Parser a                -- ^ The parser to be compiled+      -> Code (input -> Maybe a) -- ^ The generated parsing function+parse = Internal.parse  {-| This function generates a function that reads input from a file and parses it. The input files contents are treated as `Text16`. -See `runParser` for more information.+See `parse` for more information.  @since 0.1.0.0 -} parseFromFile :: Trace               => Parser a                        -- ^ The parser to be compiled               -> Code (FilePath -> IO (Maybe a)) -- ^ The generated parsing function-parseFromFile p = [||\filename -> do input <- readFile filename; return ($$(runParser p) (Text16 input))||]+parseFromFile p = [||\filename -> do input <- readFile filename; return ($$(parse p) (Text16 input))||]  {-| The default instance for `Trace`, which disables all debugging output about the parser compilation

@@ -0,0 +1,126 @@+{-# OPTIONS_GHC -Wno-incomplete-patterns #-}+{-# LANGUAGE PatternSynonyms, ViewPatterns #-}+{-|+Module      : Parsley.Char+Description : The input consuming combinators+License     : BSD-3-Clause+Maintainer  : Jamie Willis+Stability   : stable++This module contains combinators that deal with input consumption..++@since 2.0.0.0+-}+module Parsley.Char (+    satisfy, char, item,+    string, token,+    oneOf, noneOf,+    digit, letter, letterOrDigit+  ) where++import Prelude hiding           (traverse)+import Data.Char                (isAlpha, isAlphaNum)+import Data.List                (sort)+import Parsley.Applicative      (($>), traverse)+import Parsley.Defunctionalized (Defunc(LIFTED, RANGES))+import Parsley.Internal         (Parser, makeQ)+import Parsley.ParserOps        (satisfy)++import qualified Parsley.Internal as Internal (try)++{-|+This combinator will attempt match a given string. If the parser fails midway through, this+combinator will fail having consumed input. On success, the string itself is returned and input+will be consumed.++@since 2.0.0.0+-}+string :: String -> Parser String+string = traverse char++{-|+This combinator will attempt to match any one of the provided list of characters. If one of those+characters is found, it will be returned and the input consumed. If not, the combinator will fail+having consumed no input.++@since 2.0.0.0+-}+oneOf :: [Char] -> Parser Char+oneOf = satisfy . RANGES True . ranges++{-|+This combinator will attempt to not match any one of the provided list of characters. If one of those+characters is found, the combinator will fail having consumed no input. If not, it will return+the character that was not an element of the provided list.++@since 2.0.0.0+-}+noneOf :: [Char] -> Parser Char+noneOf = satisfy . RANGES False . ranges++ranges :: [Char] -> [(Char, Char)]+ranges [] = []+ranges (sort -> c:cs) = go c (fromEnum c) cs+  where+    go :: Char -> Int -> [Char] -> [(Char, Char)]+    go lower prev [] = [(lower, toEnum prev)]+    go lower prev (c:cs)+      | i <- fromEnum c, i == prev + 1 = go lower i cs+      | otherwise = (lower, toEnum prev) : go c (fromEnum c) cs++{-|+Like `string`, excepts parses the given string atomically using `try`. Never consumes input on+failure.++@since 2.0.0.0+-}+token :: String -> Parser String+token = Internal.try . string++{-|+This combinator will attempt to match a given character. If that character is the next input token,+the parser succeeds and the character is returned. Otherwise, the combinator will fail having not+consumed any input.++@since 2.0.0.0+-}+char :: Char -> Parser Char+char c = satisfy (RANGES True [(c, c)]) $> LIFTED c++{-|+Reads any single character. This combinator will only fail if there is no more input remaining.+The parsed character is returned.++@since 2.0.0.0+-}+item :: Parser Char+item = satisfy (RANGES False [])++isDigit :: Defunc (Char -> Bool)+isDigit = RANGES True [('0', '9')]++{-|+Reads a digit (0 through 9).++@since 2.0.0.0+-}+digit :: Parser Char+digit = satisfy isDigit++{-|+Uses `isAlpha` to parse a letter, this includes+unicode letters.++@since 2.0.0.0+-}+letter :: Parser Char+letter = satisfy (makeQ isAlpha [||isAlpha||])++{-|+Uses `isAlphaNum` to parse a letter, this includes+unicode letters, or a digit.++@since 2.0.0.0+-}+letterOrDigit :: Parser Char+letterOrDigit = satisfy (makeQ isAlphaNum [||isAlphaNum||])

@@ -1,5 +1,3 @@-{-# OPTIONS_GHC -Wno-incomplete-patterns #-}-{-# LANGUAGE PatternSynonyms, ViewPatterns #-} {-| Module      : Parsley.Combinator Description : The parsing combinators@@ -7,15 +5,12 @@ Maintainer  : Jamie Willis Stability   : stable -This module contains the classic parser combinator operations specific to parsers themselves.-This means any combinators that deal with input consumption at a primitive level.+This module contains the classic parser combinator operations specific to parsers themselves, excluding+those that consume input.  @since 0.1.0.0 -} module Parsley.Combinator (-    satisfy, char, item,-    string, token,-    oneOf, noneOf,     eof, more,     someTill,     try,@@ -23,13 +18,11 @@     line, col, pos   ) where -import Prelude hiding           (traverse, (*>))-import Data.List                (sort)+import Prelude hiding           ((*>)) import Parsley.Alternative      (manyTill)-import Parsley.Applicative      (($>), void, traverse, (<:>), (*>), (<~>))-import Parsley.Defunctionalized (Defunc(LIFTED, EQ_H, CONST, LAM_S), pattern APP_H, pattern COMPOSE_H)-import Parsley.Internal         (Code, Quapplicative(..), Parser)-import Parsley.ParserOps        (satisfy)+import Parsley.Applicative      (void, (<:>), (*>), (<~>))+import Parsley.Internal         (Parser)+import Parsley.Char             (item)  import qualified Parsley.Internal as Internal (try, lookAhead, notFollowedBy, line, col) @@ -70,66 +63,6 @@ try = Internal.try  {-|-This combinator will attempt match a given string. If the parser fails midway through, this-combinator will fail having consumed input. On success, the string itself is returned and input-will be consumed.--@since 0.1.0.0--}-string :: String -> Parser String-string = traverse char--{-|-This combinator will attempt to match any one of the provided list of characters. If one of those-characters is found, it will be returned and the input consumed. If not, the combinator will fail-having consumed no input.--@since 0.1.0.0--}-oneOf :: [Char] -> Parser Char-oneOf = satisfy . elem'--{-|-This combinator will attempt to not match any one of the provided list of characters. If one of those-characters is found, the combinator will fail having consumed no input. If not, it will return-the character that was not an element of the provided list.--@since 0.1.0.0--}-noneOf :: [Char] -> Parser Char-noneOf = satisfy . COMPOSE_H (makeQ not [||not||]) . elem'--elem' :: [Char] -> Defunc (Char -> Bool)-elem' cs = LAM_S (\c -> makeQ (elem (_val c) cs) (ofChars cs (_code c)))--ofChars :: [Char] -> Code Char -> Code Bool-ofChars [] _ = [||False||]-ofChars cs qc = foldr1 (\p q -> [|| $$p || $$q ||]) (map (makePred qc) (ranges cs))--makePred :: Code Char -> (Char, Char) -> Code Bool-makePred qc (c, c')-  | c == c' = [|| c == $$qc ||]-  | otherwise = [|| c <= $$qc && $$qc <= c' ||]--ranges :: [Char] -> [(Char, Char)]-ranges (sort -> c:cs) = go c (fromEnum c) cs-  where-    go :: Char -> Int -> [Char] -> [(Char, Char)]-    go lower prev [] = [(lower, toEnum prev)]-    go lower prev (c:cs)-      | i <- fromEnum c, i == prev + 1 = go lower i cs-      | otherwise = (lower, toEnum prev) : go c (fromEnum c) cs--{-|-Like `string`, excepts parses the given string atomically using `try`. Never consumes input on-failure.--@since 0.1.0.0--}-token :: String -> Parser String-token = try . string--{-| This parser succeeds only if there is no input left to consume, and fails without consuming input otherwise. @@ -145,26 +78,6 @@ -} more :: Parser () more = lookAhead (void item)---- Parsing Primitives-{-|-This combinator will attempt to match a given character. If that character is the next input token,-the parser succeeds and the character is returned. Otherwise, the combinator will fail having not-consumed any input.--@since 0.1.0.0--}-char :: Char -> Parser Char-char c = satisfy (EQ_H (LIFTED c)) $> LIFTED c--{-|-Reads any single character. This combinator will only fail if there is no more input remaining.-The parsed character is returned.--@since 0.1.0.0--}-item :: Parser Char-item = satisfy (APP_H CONST (LIFTED True))  -- Composite Combinators {-|

@@ -1,3 +1,14 @@+{-|+Module      : Parsley.Debug+Description : Debug combinators+License     : BSD-3-Clause+Maintainer  : Jamie Willis+Stability   : stable++This module contains debugging combinators.++@since 2.0.0.0+-} module Parsley.Debug (debug) where  import Parsley.Internal (Parser)

@@ -16,18 +16,18 @@     skipMany, skipSome, skipManyN, --loop,     sepBy, sepBy1, endBy, endBy1, sepEndBy, sepEndBy1,     chainl1, chainr1, chainl, chainr,-    chainl1', chainr1', chainPre, chainPost,-    pfoldr, pfoldl,-    pfoldr1, pfoldl1+    infixl1, infixr1, prefix, postfix,+    manyr, manyl,+    somer, somel   ) where  import Prelude hiding           (pure, (<*>), (<$>), (*>), (<*)) import Parsley.Alternative      ((<|>), option) import Parsley.Applicative      (pure, (<*>), (<$>), (*>), (<*), (<:>), (<**>), void)-import Parsley.Defunctionalized (Defunc(FLIP, ID, COMPOSE, EMPTY, CONS, CONST), pattern FLIP_H, pattern COMPOSE_H, pattern UNIT)+import Parsley.Defunctionalized (Defunc(FLIP, ID, COMPOSE, EMPTY, CONS, CONST, APP_H), pattern FLIP_H, pattern UNIT) import Parsley.Internal         (Parser) import Parsley.ParserOps        (ParserOps)-import Parsley.Register         (bind, get, put, modify, newRegister, newRegister_)+import Parsley.Register         (get, modify, newRegister, newRegister_)  import qualified Parsley.Internal as Internal (loop) @@ -37,7 +37,7 @@  > loop body exit = let go = body *> go <|> exit in go -@since 1.1.0.0+@since 2.0.0.0 -} loop :: Parser () -> Parser a -> Parser a loop = Internal.loop@@ -46,12 +46,12 @@ This combinator parses repeated applications of an operator to a single final operand. This is primarily used to parse prefix operators in expressions. -@since 0.1.0.0+@since 2.0.0.0 -}-chainPre :: Parser (a -> a) -> Parser a -> Parser a-chainPre op p =-  newRegister (pure ID) (\r ->-    loop (put r (pure (FLIP_H COMPOSE) <*> op <*> get r))+prefix :: Parser (a -> a) -> Parser a -> Parser a+prefix op p =+  newRegister_ ID (\r ->+    loop (modify r (FLIP_H COMPOSE <$> op))          (get r))   <*> p @@ -59,99 +59,95 @@ This combinator parses repeated applications of an operator to a single initial operand. This is primarily used to parse postfix operators in expressions. -@since 0.1.0.0+@since 2.0.0.0 -}-chainPost :: Parser a -> Parser (a -> a) -> Parser a-chainPost p op =+postfix :: Parser a -> Parser (a -> a) -> Parser a+postfix p op =   newRegister p $ \r ->-    loop (put r (op <*> get r))+    loop (modify r op)          (get r)  -- Parser Folds {-|-@pfoldr f k p@ parses __zero__ or more @p@s and combines the results using the function @f@. When @p@+@manyr f k p@ parses __zero__ or more @p@s and combines the results using the function @f@. When @p@ fails without consuming input, the terminal result @k@ is returned. -> many = pfoldr CONS EMPTY+> many = manyr CONS EMPTY -@since 0.1.0.0+@since 2.0.0.0 -}-pfoldr :: (ParserOps repf, ParserOps repk) => repf (a -> b -> b) -> repk b -> Parser a -> Parser b-pfoldr f k p = chainPre (f <$> p) (pure k)+manyr :: (ParserOps repf, ParserOps repk) => repf (a -> b -> b) -> repk b -> Parser a -> Parser b+manyr f k p = prefix (f <$> p) (pure k)  {-|-@pfoldr1 f k p@ parses __one__ or more @p@s and combines the results using the function @f@. When @p@+@somer f k p@ parses __one__ or more @p@s and combines the results using the function @f@. When @p@ fails without consuming input, the terminal result @k@ is returned. -> some = pfoldr1 CONS EMPTY+> some = somer CONS EMPTY -@since 0.1.0.0+@since 2.0.0.0 -}-pfoldr1 :: (ParserOps repf, ParserOps repk) => repf (a -> b -> b) -> repk b -> Parser a -> Parser b-pfoldr1 f k p = f <$> p <*> pfoldr f k p+somer :: (ParserOps repf, ParserOps repk) => repf (a -> b -> b) -> repk b -> Parser a -> Parser b+somer f k p = f <$> p <*> manyr f k p  {-|-@pfoldl f k p@ parses __zero__ or more @p@s and combines the results using the function @f@. The+@manyl f k p@ parses __zero__ or more @p@s and combines the results using the function @f@. The accumulator is initialised with the value @k@. -@since 0.1.0.0+@since 2.0.0.0 -}-pfoldl :: (ParserOps repf, ParserOps repk) => repf (b -> a -> b) -> repk b -> Parser a -> Parser b-pfoldl f k p = chainPost (pure k) ((FLIP <$> pure f) <*> p)+manyl :: (ParserOps repf, ParserOps repk) => repf (b -> a -> b) -> repk b -> Parser a -> Parser b+manyl f k p = postfix (pure k) ((FLIP <$> pure f) <*> p)  {-|-@pfoldl1 f k p@ parses __one__ or more @p@s and combines the results using the function @f@. The+@somel f k p@ parses __one__ or more @p@s and combines the results using the function @f@. The accumulator is initialised with the value @k@. -@since 0.1.0.0+@since 2.0.0.0 -}-pfoldl1 :: (ParserOps repf, ParserOps repk) => repf (b -> a -> b) -> repk b -> Parser a -> Parser b-pfoldl1 f k p = chainPost (f <$> pure k <*> p) ((FLIP <$> pure f) <*> p)+somel :: (ParserOps repf, ParserOps repk) => repf (b -> a -> b) -> repk b -> Parser a -> Parser b+somel f k p = postfix (f <$> pure k <*> p) ((FLIP <$> pure f) <*> p)  -- Chain Combinators {-|-@chainl1' wrap p op @ parses one or more occurrences of @p@, separated by @op@. Returns a value obtained+@infixl1 wrap p op @ parses one or more occurrences of @p@, separated by @op@. Returns a value obtained by a /left/ associative application of all functions returned by @op@ to the values returned by @p@. The function @wrap@ is used to transform the initial value from @p@ into the correct form. -@since 0.1.0.0+@since 2.0.0.0 -}-chainl1' :: ParserOps rep => rep (a -> b) -> Parser a -> Parser (b -> a -> b) -> Parser b-chainl1' f p op = chainPost (f <$> p) (FLIP <$> op <*> p)+infixl1 :: ParserOps rep => rep (a -> b) -> Parser a -> Parser (b -> a -> b) -> Parser b+infixl1 wrap p op = postfix (wrap <$> p) (FLIP <$> op <*> p)  {-|-The classic version of the left-associative chain combinator. See 'chainl1''.+The classic version of the left-associative chain combinator. See 'infixl1'. -> chainl1 p op = chainl1' ID p op+> chainl1 p op = infixl1 ID p op  @since 0.1.0.0 -} chainl1 :: Parser a -> Parser (a -> a -> a) -> Parser a-chainl1 = chainl1' ID+chainl1 = infixl1 ID  {-|-@chainr1' wrap p op @ parses one or more occurrences of @p@, separated by @op@. Returns a value obtained+@infixr1 wrap p op @ parses one or more occurrences of @p@, separated by @op@. Returns a value obtained by a /right/ associative application of all functions returned by @op@ to the values returned by @p@. The function @wrap@ is used to transform the final value from @p@ into the correct form. -@since 0.1.0.0+@since 2.0.0.0 -}-chainr1' :: ParserOps rep => rep (a -> b) -> Parser a -> Parser (a -> b -> b) -> Parser b-chainr1' f p op = newRegister_ ID $ \acc ->-  let go = bind p $ \x ->-           modify acc (FLIP_H COMPOSE <$> (op <*> x)) *> go-       <|> f <$> x-  in go <**> get acc+infixr1 :: ParserOps rep => rep (a -> b) -> Parser a -> Parser (a -> b -> b) -> Parser b+infixr1 wrap p op = let go = p <**> (FLIP <$> op <*> go <|> pure wrap) in go  {-|-The classic version of the right-associative chain combinator. See 'chainr1''.+The classic version of the right-associative chain combinator. See 'infixr1'. -> chainr1 p op = chainr1' ID p op+> chainr1 p op = infixr1 ID p op  @since 0.1.0.0 -} chainr1 :: Parser a -> Parser (a -> a -> a) -> Parser a-chainr1 = chainr1' ID+chainr1 = infixr1 ID  {-| Like `chainr1`, but may parse zero occurences of @p@ in which case the value is returned.@@ -177,7 +173,7 @@ @since 0.1.0.0 -} many :: Parser a -> Parser [a]-many = pfoldr CONS EMPTY+many = manyr CONS EMPTY  {-| Attempts to parse the given parser __n__ or more times, collecting all of the successful results@@ -203,9 +199,8 @@ @since 0.1.0.0 -} skipMany :: Parser a -> Parser ()---skipMany p = let skipManyp = p *> skipManyp <|> unit in skipManyp-skipMany = void . pfoldl CONST UNIT -- the void here will encourage the optimiser to recognise that the register is unused---skipMany = flip loop (pure UNIT) . void -- This should be the optimal one, with register removed, but apparently not?! something is amiss, perhaps space leak?+--skipMany p = loop (void p) unit+skipMany = void . manyl CONST UNIT -- This is still faster, the above generates better code, but GHC starts doing weird things!  {-| Like `manyN`, excepts discards its results.@@ -275,13 +270,7 @@ @since 0.1.0.0 -} sepEndBy1 :: Parser a -> Parser b -> Parser [a]-sepEndBy1 p sep = newRegister_ ID $ \acc ->-  let go = modify acc (COMPOSE_H (FLIP_H COMPOSE) CONS <$> p)-         *> (sep *> (go <|> get acc) <|> get acc)-  in go <*> pure EMPTY--{-sepEndBy1 :: Parser a -> Parser b -> Parser [a] sepEndBy1 p sep =   let seb1 = p <**> (sep *> (FLIP_H CONS <$> option EMPTY seb1)                  <|> pure (APP_H (FLIP_H CONS) EMPTY))-  in seb1-}+  in seb1

@@ -1,3 +1,15 @@+{-|+Module      : Parsley.ParserOps+Description : Combinators that interact with user-defined functions.+License     : BSD-3-Clause+Maintainer  : Jamie Willis+Stability   : stable++This module contains the definition of `ParserOps`, which is used to generalise+the representation of user-defined functions to either `Defunc` or `WQ`.++@since 2.0.0.0+-} module Parsley.ParserOps (module Parsley.ParserOps) where  import Prelude hiding (pure)

@@ -1,5 +1,4 @@-{-# LANGUAGE AllowAmbiguousTypes,-             MultiParamTypeClasses #-}+{-# LANGUAGE MultiParamTypeClasses, UndecidableInstances #-} {-| Module      : Parsley.Precedence Description : The precedence parser functionality@@ -10,100 +9,247 @@ This module exposes the required machinery for parsing expressions given by a precedence table. Unlike those found in [parser-combinators](https://hackage.haskell.org/package/parser-combinators-1.3.0/docs/Control-Monad-Combinators-Expr.html) or [parsec](https://hackage.haskell.org/package/parsec-3.1.14.0/docs/Text-Parsec-Expr.html), this-implementation allows the precedence layers to change type in the table.+implementation allows the precedence layers to change type in the table. This implementation is+based off of /Design Patterns for Parser Combinators (Willis and Wu 21)/.  @since 0.1.0.0 -}-module Parsley.Precedence (module Parsley.Precedence) where+module Parsley.Precedence (+    -- * Main Precedence Combinators+    -- $prec-doc+    precedence, precHomo,+    -- * Operator Fixity+    Fixity(..),+    -- * Level Construction+    -- $ops-doc+    Op,+    GOps(..), sops, ops,+    -- * Level Combining+    -- $levels-doc+    Prec(..), (>+), (+<),+    -- * Subtype Relation+    Subtype(..),+  ) where -import Prelude hiding           ((<$>))-import Parsley.Alternative      (choice)-import Parsley.Applicative      ((<$>))-import Parsley.Defunctionalized (Defunc(BLACK, ID))-import Parsley.Fold             (chainPre, chainPost, chainl1', chainr1')-import Parsley.Internal         (WQ, Parser)+import Prelude hiding                ((<$>), (<*>), pure)+import Data.List                     (foldl') +import Parsley.Alternative           (choice, (<|>))+import Parsley.Applicative           ((<$>), (<*>), pure, (<**>))+import Parsley.Fold                  (prefix, postfix, infixl1, infixr1)+import Parsley.Internal.Common.Utils (WQ(WQ))+import Parsley.Internal.Core         (Parser, Defunc(BLACK, ID, FLIP))++--import qualified Data.Generics.Internal.Profunctor.Prism as GLens+--import qualified Data.Generics.Sum.Internal.Subtype as GLens++{- $prec-doc+Compared to using chain combinators to construct parsers for expression grammars, precedence+combinators provide a light-weight and convenient representation of a precedence table. In @parsley@+these take two forms: a more traditional version called `precHomo` which takes a list of precedence+levels which are all of the same, monolithic, type; and a heterogeneous version called `precedence`.++In /Design Patterns for Parser Combinators/ it is mentioned that the homogeneous approach to+encoding precedence tables can inadvertently misrepresent the grammar: say by changing+left-associative operators into right-associative ones. When the grammar doesn't specify+associativities, then `precHomo` is perfectly appropriate, as it becomes an implementation decision.+Otherwise, `precedence` uses a heterogeneous list to form a precedence table, allowing each layer of+operators to form part of a different datatype. By encoding the resulting AST as a hierarchy of+independent datatypes for each grammar rule, the precedence table can be made to be very strict:+reordering levels or switching their associativities will fail to compile!+-}+ {-|-This combinator will construct and expression parser will provided with a table of precedence along-with a terminal atom.+This combinator will construct and expression parser will provided with a table of precedence. -@since 0.1.0.0+@since 2.0.0.0 -}-precedence :: Prec a b -> Parser a -> Parser b-precedence NoLevel atom = atom-precedence (Level lvl lvls) atom = precedence lvls (level lvl atom)+precedence :: Prec a -> Parser a+precedence (Atom atom) = atom+precedence (Level lvls op) = level (precedence lvls) op   where-    level (InfixL ops wrap) atom  = chainl1' wrap atom (choice ops)-    level (InfixR ops wrap) atom  = chainr1' wrap atom (choice ops)-    level (Prefix ops wrap) atom  = chainPre (choice ops) (wrap <$> atom)-    level (Postfix ops wrap) atom = chainPost (wrap <$> atom) (choice ops)+    level :: Parser a -> Op a b -> Parser b+    level atom (Op InfixL op wrap) = infixl1 wrap atom op+    level atom (Op InfixR op wrap) = infixr1 wrap atom op+    level atom (Op InfixN op wrap) = atom <**> (FLIP <$> op <*> atom <|> pure wrap)+    level atom (Op Prefix op wrap) = prefix op (wrap <$> atom)+    level atom (Op Postfix op wrap) = postfix (wrap <$> atom) op  {-| A simplified version of `precedence` that does not use the heterogeneous list `Prec`, but-instead requires all layers of the table to have the same type.+instead requires all layers of the table to have the same type. The list encodes the precedence+in strongest-to-weakest layout. -@since 0.1.0.0+@since 2.0.0.0 -}-monolith :: [Level a a] -> Prec a a-monolith = foldr Level NoLevel+precHomo :: Parser a -- ^ The root atom of the precedence hierarchy+         -> [Op a a] -- ^ Each layer laid out strongest-to-weakest binding.+         -> Parser a+precHomo atom = precedence . foldl' (>+) (Atom atom)  {-|-A heterogeneous list that represents a precedence table so that @Prec a b@ transforms the type @a@-into @b@ via various layers of operators.+Denotes the fixity of a given level in a precedence table. The type parameter @sig@ encodes the+types of the operators on this level, in a heterogeneous fashion. -@since 0.1.0.0+@since 2.0.0.0 -}-data Prec a b where-  NoLevel :: Prec a a-  Level :: Level a b -> Prec b c -> Prec a c+data Fixity a b sig where+  -- | Denotes a left-associative binary operator.+  InfixL  :: Fixity a b (b -> a -> b)+  -- | Denotes a right-associative binary operator.+  InfixR  :: Fixity a b (a -> b -> b)+  -- | Denotes a non-associative binary operator.+  InfixN  :: Fixity a b (a -> a -> b)+  -- | Denotes a prefix unary operator.+  Prefix  :: Fixity a b (b -> b)+  -- | Denotes a postfix unary operator.+  Postfix :: Fixity a b (b -> b) +{- $ops-doc+By combining a `Fixity` with a `Parser` which can read the operators at a given level, a new+level can be created, ready to add to the table. To provide uniformity and safety, the `Fixity`+type exposes a @sig@ type that expresses the shape of operators that match it. The `Op` datatype,+which is not constructed directly, ties the operators to this signature using existentials.++There are three ways to create a value of type `Op`: `ops`, `sops`, and `gops`. These functions+represent different degrees of relations between this layer of the table, and the one that comes+below:++  - `ops` says that the level below is the same type as this one, in other words the classic+    @a -> a -> a@ type for binary operators.+  - `sops` is stronger, and says that the level below must be a sub-type of this one (see `Subtype`).+    This means that there is a known canonical embedding from one layer into the other, called an+    `upcast`.+  - `gops` is the most general, and says that the level below is related to this one by some more+    complex transformation than the canonical sub-type embedding. Any arbitrary function from+    @underlying -> this@ can be provided to this level to handle the translation.+-}+ {-|-This datatype represents levels of the precedence table `Prec`, where each constructor-takes many parsers of the same level and fixity.+Packages together a level of a precedence table, by associating a `Fixity` with the operators that+match that specific signature converting from one layer of type @a@ to a new layer of type @b@.+See `ops`, `sops`, and `gops` for how to construct them. -@since 0.1.0.0+@since 2.0.0.0 -}-data Level a b = InfixL  [Parser (b -> a -> b)] (Defunc (a -> b)) -- ^ left-associative infix operators-               | InfixR  [Parser (a -> b -> b)] (Defunc (a -> b)) -- ^ right-associative infix operators-               | Prefix  [Parser (b -> b)]      (Defunc (a -> b)) -- ^ prefix unary operators-               | Postfix [Parser (b -> b)]      (Defunc (a -> b)) -- ^ postfix unary operators+data Op a b where+  Op :: Fixity a b sig -> Parser sig -> Defunc (a -> b) -> Op a b  {-|-This class provides a way of working with the t`Level` datatype without needing to-provide wrappers, or not providing `Defunc` arguments.+This typeclass is used to allow abstraction of the representation of user-level functions.+See the instances for information on what these representations are. -@since 0.1.0.0+@since 2.0.0.0 -}-class Monolith a b c where-  -- | Used to construct a precedence level of infix left-associative operators-  infixL  :: [Parser (b -> a -> b)] -> c-  -- | Used to construct a precedence level of infix right-associative operators-  infixR  :: [Parser (a -> b -> b)] -> c-  -- | Used to construct a precedence level of prefix operators-  prefix  :: [Parser (b -> b)]      -> c-  -- | Used to construct a precedence level of postfix operators-  postfix :: [Parser (b -> b)]      -> c+class GOps rep where+  {-|+  Sometimes, the relationship between two levels of a heterogeneous precedence hierarchy is non-trivial.+  By using `gops`, the conversion function can be used to adapt one layer into the type of the next. +  @since 2.0.0.0+  -}+  gops :: Fixity a b sig -> [Parser sig] -> rep (a -> b) -> Op a b+ {-|-This instance is used to handle monolithic types where the input and output are the same,-it does not require the wrapping function to be provided.+This is the default representation used for user-level functions and values: plain old code. -@since 0.1.0.0+@since 2.0.0.0 -}-instance x ~ a => Monolith x a (Level a a) where-  infixL  = flip InfixL ID-  infixR  = flip InfixR ID-  prefix  = flip Prefix ID-  postfix = flip Postfix ID+instance GOps WQ where+  gops fixity ps = gops fixity ps . BLACK  {-|-This instance is used to handle non-monolithic types: i.e. where the input and output types of-a level differ.+This is used to allow defunctionalised versions of many standard Haskell functions to be used+directly as an argument to relevant combinators. -@since 0.1.0.0+@since 2.0.0.0 -}-instance {-# INCOHERENT #-} x ~ (WQ (a -> b) -> Level a b) => Monolith a b x where-  infixL  ops = InfixL ops . BLACK-  infixR  ops = InfixR ops . BLACK-  prefix  ops = Prefix ops . BLACK-  postfix ops = Postfix ops . BLACK+instance {-# INCOHERENT #-} x ~ Defunc => GOps x where+  gops fixity ps = Op fixity (choice ps)++{-|+When two levels in a precedence hierarchy are the same type, they are trivially embedded using the+identity function.++@since 2.0.0.0+-}+ops :: Fixity a a sig -> [Parser sig] -> Op a a+ops fixity ps = Op fixity (choice ps) ID++{-|+Encodes a subtyping relationship between two types @sub@ and @sup@. This allows for the conversion+or embedding of one type into the other, as well as their extraction.++It should be the case that:++prop> fmap upcast . downcast = Just+prop> downcast . upcast = Just++@since 2.0.0.0+-}+class Subtype sub sup where+  -- | Casts a value of the subtype into one of the supertype, likely by wrapping it in some constructor+  upcast   :: sub -> sup+  -- | Attempts to extract a value of a subtype from a supertype+  downcast :: sup -> Maybe sub++{-instance GLens.Context sub sup => Subtype sub sup where+  upcast = GLens.build GLens.derived+  downcast = either (const Nothing) Just . GLens.match GLens.derived-}++{-|+When two levels of a precedence hierarchy are in a subtyping relation, the conversion between+the two can be trivially provided as the `upcast` function.++@since 2.0.0.0+-}+sops :: Subtype a b => Fixity a b sig -> [Parser sig] -> Op a b+sops fixity ps = gops fixity ps (WQ upcast [||upcast||])++{- $levels-doc+Independently, `Op`s are meaningless: they must be combined together to form a table to be useful.+The `Prec` datatype encodes the structure linking together each `Op` level in turn.++The base case+for the table is called `Atom`, which takes a parser for the root of the table: think numbers,+variables, bracketed expressions, and the like.++The `Level` constructor is used to add layers on top of the growing table. It's not designed to be+used directly, which would be clunky, instead use the `(>+)` and `(+<)` operators. These operators+are sugar for `Level`, but allow freedom over which way round the table should be expressed: use+`(>+)` to build the table from strongest- to weakest-binding (with the atom at the front); use+`(+<)` to build the table from weakest- to strongest-binding (with the atom at the end). The direction+the table should be built in is purely stylistic.+-}++{-|+A heterogeneous list that represents a precedence table so that @Prec a@ produces values of type+@a@.++@since 2.0.0.0+-}+data Prec a where+  -- | A Level of the table, containing the sub-level and the operators. See `(>+)` and `(+<)`.+  Level :: Prec a -> Op a b -> Prec b+  -- | The terminal atom in the table.+  Atom :: Parser a -> Prec a++infixl 5 >++{-|+Sugar for the `Level` constructor, this operator - along with its sibling - is hungry and greedy: it+eats the levels with the higher precedence: in @lvls >+ lvl@, @lvl@ is lower precedence than @lvls@.++@since 2.0.0.0+-}+(>+) :: Prec a -> Op a b -> Prec b+(>+) = Level++infixr 5 +<+{-|+Sugar for the `Level` constructor, this operator - along with its sibling - is hungry and greedy: it+eats the levels with the higher precedence: in @lvl +< lvls@, @lvl@ is lower precedence than @lvls@.++@since 2.0.0.0+-}+(+<) :: Op a b -> Prec a -> Prec b+(+<) = flip (>+)

@@ -6,7 +6,6 @@ import qualified Parsley.Alternative.Parsers as Parsers  import Prelude hiding ()-import Parsley (runParser)  tests :: TestTree tests = testGroup "Alternative" [ coproductTests

@@ -6,7 +6,6 @@ import qualified Parsley.Applicative.Parsers as Parsers  import Prelude hiding ()-import Parsley (runParser) import Parsley.Applicative (unit)  tests :: TestTree

@@ -0,0 +1,10 @@+module Parsley.Char.Parsers where++import Parsley (Parser)+import Parsley.Char (oneOf)++abc :: Parser Char+abc = oneOf ['a', 'b', 'c']++nothing :: Parser Char+nothing = oneOf []

@@ -0,0 +1,58 @@+{-# LANGUAGE TemplateHaskell, UnboxedTuples, ScopedTypeVariables #-}+module Parsley.Char.Test where+import Test.Tasty+import Test.Tasty.HUnit+import TestUtils+import qualified Parsley.Char.Parsers as Parsers++import Prelude hiding ((*>))+import Parsley ((*>))+import Parsley.Char (char, item)++tests :: TestTree+tests = testGroup "Char" [ stringTests+                         , oneOfTests+                         , noneOfTests+                         , tokenTests+                         , charTests+                         , itemTests+                         ]++stringTests :: TestTree+stringTests = testGroup "string should" []++nothing :: String -> Maybe Char+nothing = $$(runParserMocked Parsers.nothing [||Parsers.nothing||])++abc :: String -> Maybe Char+abc = $$(runParserMocked Parsers.abc [||Parsers.abc||])++oneOfTests :: TestTree+oneOfTests = testGroup "oneOf should"+  [ testCase "handle no options no input" $ nothing "" @?= Nothing+  , testCase "handle no options with input" $ nothing "a" @?= Nothing+  , testCase "parse any of characters" $ do+      abc "a" @?= Just 'a'+      abc "b" @?= Just 'b'+      abc "c" @?= Just 'c'+  , testCase "fail otherwise" $ abc "d" @?= Nothing+  ]++noneOfTests :: TestTree+noneOfTests = testGroup "noneOf should" []++tokenTests :: TestTree+tokenTests = testGroup "token should" []++charA :: String -> Maybe Char+charA = $$(runParserMocked (char 'a') [||char 'a'||])++charTests :: TestTree+charTests = testGroup "char should"+  [ testCase "fail on empty input" $ charA "" @?= Nothing+  , testCase "succeed on correct char" $ charA "a" @?= Just 'a'+  , testCase "fail on wrong char" $ charA "b" @?= Nothing+  ]++itemTests :: TestTree+itemTests = testGroup "item should" []

@@ -1,10 +1,1 @@ module Parsley.Combinator.Parsers where--import Parsley (Parser)-import Parsley.Combinator (oneOf)--abc :: Parser Char-abc = oneOf ['a', 'b', 'c']--nothing :: Parser Char-nothing = oneOf []

@@ -6,47 +6,16 @@ import qualified Parsley.Combinator.Parsers as Parsers  import Prelude hiding ((*>))-import Parsley (runParser, (*>))-import Parsley.Combinator (eof, more, char, item)+import Parsley ((*>))+import Parsley.Combinator (eof, more)+import Parsley.Char       (char)  tests :: TestTree-tests = testGroup "Combinator" [ stringTests-                               , oneOfTests-                               , noneOfTests-                               , tokenTests-                               , eofTests+tests = testGroup "Combinator" [ eofTests                                , moreTests-                               , charTests-                               , itemTests                                , someTillTests                                ] -stringTests :: TestTree-stringTests = testGroup "string should" []--nothing :: String -> Maybe Char-nothing = $$(runParserMocked Parsers.nothing [||Parsers.nothing||])--abc :: String -> Maybe Char-abc = $$(runParserMocked Parsers.abc [||Parsers.abc||])--oneOfTests :: TestTree-oneOfTests = testGroup "oneOf should"-  [ testCase "handle no options no input" $ nothing "" @?= Nothing-  , testCase "handle no options with input" $ nothing "a" @?= Nothing-  , testCase "parse any of characters" $ do-      abc "a" @?= Just 'a'-      abc "b" @?= Just 'b'-      abc "c" @?= Just 'c'-  , testCase "fail otherwise" $ abc "d" @?= Nothing-  ]--noneOfTests :: TestTree-noneOfTests = testGroup "noneOf should" []--tokenTests :: TestTree-tokenTests = testGroup "token should" []- isNull :: String -> Maybe () isNull = $$(runParserMocked eof [||eof||]) @@ -68,19 +37,6 @@   , testCase "succeed on non-empty input" $ notNull "a" @?= Just ()   , testCase "not consume input" $ notNullThenA "a" @?= Just 'a'   ]--charA :: String -> Maybe Char-charA = $$(runParserMocked (char 'a') [||char 'a'||])--charTests :: TestTree-charTests = testGroup "char should"-  [ testCase "fail on empty input" $ charA "" @?= Nothing-  , testCase "succeed on correct char" $ charA "a" @?= Just 'a'-  , testCase "fail on wrong char" $ charA "b" @?= Nothing-  ]--itemTests :: TestTree-itemTests = testGroup "item should" []  someTillTests :: TestTree someTillTests = testGroup "someTill should" []

@@ -7,19 +7,19 @@ --import Parsley.Garnish  plusOne :: Parser Int-plusOne = chainPre (string "++" $> [|succ|]) (char '1' $> [|1|])+plusOne = prefix (string "++" $> [|succ|]) (char '1' $> [|1|])  plusOne' :: Parser Int-plusOne' = chainPre (try (string "++") $> [|succ|]) (char '1' $> [|1|])+plusOne' = prefix (try (string "++") $> [|succ|]) (char '1' $> [|1|])  plusOnePure :: Parser Int-plusOnePure = try (chainPre (string "++" $> [|succ|]) (pure [|1|])) <|> pure [|0|]+plusOnePure = try (prefix (string "++" $> [|succ|]) (pure [|1|])) <|> pure [|0|]  onePlus :: Parser Int-onePlus = chainPost (char '1' $> [|1|]) (string "++" $> [|succ|])+onePlus = postfix (char '1' $> [|1|]) (string "++" $> [|succ|])  onePlus' :: Parser Int-onePlus' = chainPost (char '1' $> [|1|]) (try (string "++") $> [|succ|])+onePlus' = postfix (char '1' $> [|1|]) (try (string "++") $> [|succ|])  manyAA :: Parser [String] manyAA = many (string "aa")

@@ -6,15 +6,18 @@ import qualified Parsley.Fold.Parsers as Parsers  import Prelude hiding ()-import Parsley (runParser)  tests :: TestTree-tests = testGroup "Fold" [ chainPreTests-                         , chainPostTests-                         , pfoldrTests-                         , pfoldlTests+tests = testGroup "Fold" [ prefixTests+                         , postfixTests+                         , manyrTests+                         , somerTests+                         , manylTests+                         , somelTests                          , chainlTests                          , chainrTests+                         , infixl1Tests+                         , infixr1Tests                          , manyTests                          , skipManyTests                          , sepByTests@@ -30,8 +33,8 @@ plusOnePure :: String -> Maybe Int plusOnePure = $$(runParserMocked Parsers.plusOnePure [||Parsers.plusOnePure||]) -chainPreTests :: TestTree-chainPreTests = testGroup "chainPre should"+prefixTests :: TestTree+prefixTests = testGroup "prefix should"   [ testCase "parse an operatorless value" $ do       plusOne "1" @?= Just 1       plusOne "" @?= Nothing@@ -49,8 +52,8 @@ onePlus' :: String -> Maybe Int onePlus' = $$(runParserMocked Parsers.onePlus' [||Parsers.onePlus'||]) -chainPostTests :: TestTree-chainPostTests = testGroup "chainPost should"+postfixTests :: TestTree+postfixTests = testGroup "postfix should"   [ testCase "require an initial value" $ do       onePlus "1" @?= Just 1       onePlus "" @?= Nothing@@ -59,17 +62,29 @@   , testCase "not fail if the operator fails with try" $ onePlus' "1+++" @?= Just 2   ] -pfoldrTests :: TestTree-pfoldrTests = testGroup "pfoldr should" [] -- pfoldr pfoldr1+manyrTests :: TestTree+manyrTests = testGroup "manyr should" [] -pfoldlTests :: TestTree-pfoldlTests = testGroup "pfoldl should" [] -- pfoldl pfoldl1+somerTests :: TestTree+somerTests = testGroup "somer should" [] +manylTests :: TestTree+manylTests = testGroup "manyl should" []++somelTests :: TestTree+somelTests = testGroup "somel should" []+ chainlTests :: TestTree-chainlTests = testGroup "chainl should" [] -- chainl1' chainl1 chainl+chainlTests = testGroup "chainl should" [] -- chainl1 chainl  chainrTests :: TestTree-chainrTests = testGroup "chainr should" [] -- chainr1' chainr1 chainr+chainrTests = testGroup "chainr should" [] -- chainr1 chainr++infixl1Tests :: TestTree+infixl1Tests = testGroup "infixl1 should" []++infixr1Tests :: TestTree+infixr1Tests = testGroup "infixr1 should" []  manyAA :: String -> Maybe [String] manyAA = $$(runParserMocked Parsers.manyAA [||Parsers.manyAA||])

@@ -1,1 +1,42 @@+{-# LANGUAGE TemplateHaskellQuotes, MultiParamTypeClasses #-} module Parsley.Precedence.Parsers where++import Prelude hiding (pure, (<*>), (*>), (<*), (<$>), ($>), pred)+import Parsley+import Parsley.Precedence+import Parsley.Fold (somel)+import Parsley.Char (oneOf)+import Data.Char (digitToInt)++data Expr = Add Expr Expr | Mul Expr Expr | Negate Expr | Num Int deriving (Eq, Show)++number :: Parser Int+number = somel [| \x d -> x * 10 + digitToInt d |] [|0|] (oneOf ['0'..'9'])++expr :: Parser Expr+expr = precHomo ([|Num|] <$> number)+                [ ops Prefix [string "negate" $> [|Negate|]]+                , ops InfixL [char '*' $> [|Mul|]]+                , ops InfixR [char '+' $> [|Add|]]+                ]++data Pred = Or Term Pred | OfTerm Term deriving (Eq, Show)+data Term = And Not Term | OfNot Not deriving (Eq, Show)+data Not = Not Not | OfAtom Atom deriving (Eq, Show)+data Atom = T | F | Parens Pred deriving (Eq, Show)++instance Subtype Atom Not where+  upcast = OfAtom+  downcast (OfAtom x) = Just x+  downcast _          = Nothing++instance Subtype Not Term where+  upcast = OfNot+  downcast (OfNot x) = Just x+  downcast _         = Nothing++pred = precedence $+  gops InfixR [char '|' $> [|Or|]] [|OfTerm|] +<+  sops InfixR [char '&' $> [|And|]]           +<+  sops Prefix [char '!' $> [|Not|]]           +<+  Atom (char 'T' $> [|T|] <|> char 'F' $> [|F|] <|> char '(' *> ([|Parens|] <$> pred) <* char ')')

@@ -1,14 +1,79 @@-{-# LANGUAGE TemplateHaskell, UnboxedTuples, ScopedTypeVariables #-}+{-# LANGUAGE TemplateHaskell, UnboxedTuples, ScopedTypeVariables, MultiParamTypeClasses, GADTs, DeriveGeneric, TypeApplications, FlexibleInstances, FlexibleContexts #-}+--{-# OPTIONS_GHC -ddump-splices #-} module Parsley.Precedence.Test where import Test.Tasty import Test.Tasty.HUnit import TestUtils import qualified Parsley.Precedence.Parsers as Parsers -import Prelude hiding ()-import Parsley (runParser)+import Prelude hiding (pred)+import Parsley (empty, Parser)+--import Parsley.Patterns (deriveSubtype, deriveLiftedConstructors, deriveDeferredConstructors, Pos)+import Parsley.Precedence (Subtype(..))+--import GHC.Generics (Generic) -tests :: TestTree-tests = testGroup "Precedence should" [+{-data Foo where+  Foo :: Bar -> Foo+  Goo :: String -> Pos -> Int -> Foo+  deriving (Eq, Show, Generic)+newtype Bar = Bar Int deriving (Eq, Show, Generic) +data X a = X a a Pos++deriveSubtype ''Bar ''Foo+deriveLiftedConstructors "mk" ['X]+deriveLiftedConstructors "mk" ['Bar, 'Goo]+deriveDeferredConstructors "mkD" ['X]++testParser :: Parser (X a)+testParser = mkX empty empty+testParser' :: Parser Foo+testParser' = mkGoo empty empty+testParser'' :: Parser (a -> a -> X a)+testParser'' = mkDX-}++tests :: TestTree+tests = testGroup "Precedence" [+    precHomoTests,+    precedenceTests+    --subtypeTests   ]++expr :: String -> Maybe Parsers.Expr+expr = $$(runParserMocked Parsers.expr [||Parsers.expr||])++pred :: String -> Maybe Parsers.Pred+pred = $$(runParserMocked Parsers.pred [||Parsers.pred||])++precHomoTests :: TestTree+precHomoTests = testGroup "precHomo should"+  [ testCase "parse precedence with correct associativity" $ expr "1+3*negate5+4" @?=+        Just (Parsers.Add (Parsers.Num 1)+                          (Parsers.Add (Parsers.Mul (Parsers.Num 3)+                                                    (Parsers.Negate (Parsers.Num 5)))+                                       (Parsers.Num 4)))]++instance Subtype a a where+  upcast = id+  downcast = Just++upcast' :: Parsers.Atom -> Parsers.Term+upcast' = upcast @Parsers.Not . upcast++upcast'' :: Subtype x Parsers.Term => x -> Parsers.Pred+upcast'' = Parsers.OfTerm . upcast++precedenceTests :: TestTree+precedenceTests = testGroup "precedence should"+  [ testCase "parse precedence with correct associativity" $ pred "T|F|(T|!F)&F" @?=+        Just (Parsers.Or (upcast' Parsers.T)+                         (Parsers.Or (upcast' Parsers.F)+                                     (upcast'' (Parsers.And (upcast (Parsers.Parens+                                                               (Parsers.Or (upcast' Parsers.T)+                                                                           (upcast'' (Parsers.Not (upcast Parsers.F))))))+                                                            (upcast' Parsers.F)))))]++{-subtypeTests :: TestTree+subtypeTests = testGroup "Subtype should"+  [ testCase "upcast properly" $ upcast (Bar 5) @?= Foo (Bar 5)+  , testCase "downcast properly" $ downcast (Foo (Bar 5)) @?= Just (Bar 5) ]-}

@@ -6,7 +6,6 @@ import qualified Parsley.Register.Parsers as Parsers  import Prelude hiding ()-import Parsley (runParser)  -- NewRegister is required for any test and can only be tested with another component -- so it is omitted

@@ -4,7 +4,7 @@ import Prelude hiding (pure, (<*>), (*>), (<*)) import Data.Char (isDigit) import Parsley-import Parsley.Combinator (token)+import Parsley.Char (token) --import Parsley.Garnish  issue26_ex1 :: Parser ()

@@ -5,7 +5,7 @@ import TestUtils import qualified Regression.Parsers as Parsers -import Parsley (runParser)+import Parsley (parse) import Parsley.InputExtras (CharList(..))  main :: IO ()@@ -21,7 +21,7 @@   ]  issue26_ex1 :: CharList -> Maybe ()-issue26_ex1 = $$(Parsley.runParser Parsers.issue26_ex1)+issue26_ex1 = $$(Parsley.parse Parsers.issue26_ex1)  issue26_ex2 :: CharList -> Maybe ()-issue26_ex2 = $$(Parsley.runParser Parsers.issue26_ex2)+issue26_ex2 = $$(Parsley.parse Parsers.issue26_ex2)

@@ -1,7 +1,7 @@ {-# LANGUAGE TemplateHaskell, TypeApplications, DeriveAnyClass, StandaloneDeriving, CPP, FlexibleInstances, MonoLocalBinds #-} module TestUtils where -import Parsley (runParser, Parser, Code)+import Parsley (parse, Parser, Code) import Parsley.Internal.Trace (Trace) import Language.Haskell.TH.Syntax #if MIN_VERSION_template_haskell(2,17,0)@@ -23,11 +23,11 @@ -- TODO Use WQ: requires lift plugin to not require any Lift instance for variables (if missing) runParserMocked :: Trace => Parser a -> Code (Parser a) -> Code (String -> Maybe a) runParserMocked p qp = [|| \s ->-    runParserMocked' $$qp `deepseq` $$(runParser p) s+    runParserMocked' $$qp `deepseq` $$(parse p) s   ||]  runParserMocked' :: Parser a -> Exp-runParserMocked' = runTestQ (QState MockQ [] []) . unTypeCode . runParser @String+runParserMocked' = runTestQ (QState MockQ [] []) . unTypeCode . parse @String  deriving instance NFData Exp deriving instance NFData Name