aihc-parser 3.0.1.0 → 3.0.1.1
raw patch · 8 files changed
+104/−8 lines, 8 filesPVP ok
version bump matches the API change (PVP)
API changes (from Hackage documentation)
Files
- CHANGELOG.md +13/−0
- aihc-parser.cabal +1/−1
- docs/aihc-parser-supported-extensions.md +6/−6
- src/Aihc/Parser/Internal/Common.hs +48/−1
- test/Test/Fixtures/golden/module/class-context-list-implication-constraint.yaml +7/−0
- test/Test/Fixtures/golden/module/class-context-list-quantified-constraint.yaml +7/−0
- test/Test/Fixtures/golden/module/instance-context-list-quantified-constraint.yaml +7/−0
- test/Test/Fixtures/oracle/QuantifiedConstraints/context-list-items.hs +15/−0
CHANGELOG.md view
@@ -6,6 +6,19 @@ ## [Unreleased] +## [3.0.1.1] - 2026-09-15++### Fixed++- Read a quantified constraint that is one item of a comma-separated context.+ The context-item parser had no rule for `forall a. C a => D (f a)` or for+ `p => q`, so a context such as+ `class (Eq1 t, forall a. Eq a => Eq (t a)) => Eq1Wrapper t` did not divide+ into items. The parentheses then fell back to the general type parser, which+ read the full list as one tuple type, and `classDeclContext` held a single+ `TTuple` instead of two constraints. A quantified constraint that is the only+ item of a context was not affected.+ ## [3.0.1.0] - 2026-09-09 ### Performance
aihc-parser.cabal view
@@ -1,6 +1,6 @@ cabal-version: 3.8 name: aihc-parser-version: 3.0.1.0+version: 3.0.1.1 build-type: Simple license: Unlicense license-file: LICENSE
docs/aihc-parser-supported-extensions.md view
@@ -17,7 +17,7 @@ | CApiFFI | 🟢 | 4/4 | | CPP | 🟢 | 8/8 | | ConstraintKinds | 🟢 | 8/8 |-| DataKinds | 🟢 | 65/65 |+| DataKinds | 🟢 | 68/68 | | DefaultSignatures | 🟢 | 4/4 | | DerivingStrategies | 🟢 | 8/8 | | DerivingVia | 🟢 | 7/7 |@@ -51,7 +51,7 @@ | LinearTypes | 🟢 | 15/15 | | MagicHash | 🟢 | 24/24 | | MultiParamTypeClasses | 🟢 | 24/24 |-| MultiWayIf | 🟢 | 21/21 |+| MultiWayIf | 🟢 | 22/22 | | MultilineStrings | 🟢 | 6/6 | | NamedFieldPuns | 🟢 | 6/6 | | NamedWildCards | 🟢 | 5/5 |@@ -63,7 +63,7 @@ | OverloadedRecordDot | 🟢 | 8/8 | | PackageImports | 🟢 | 6/6 | | ParallelListComp | 🟢 | 3/3 |-| PartialTypeSignatures | 🟢 | 21/21 |+| PartialTypeSignatures | 🟢 | 22/22 | | PatternGuards | 🟢 | 9/9 | | PatternSynonyms | 🟢 | 34/34 | | PolyKinds | 🟢 | 14/14 |@@ -80,18 +80,18 @@ | StandaloneDeriving | 🟢 | 18/18 | | StandaloneKindSignatures | 🟢 | 12/12 | | StarIsType | 🟢 | 4/4 |-| TemplateHaskell | 🟢 | 68/68 |+| TemplateHaskell | 🟢 | 69/69 | | TemplateHaskellQuotes | 🟢 | 14/14 | | TransformListComp | 🟢 | 18/18 | | TupleSections | 🟢 | 4/4 | | TypeAbstractions | 🟢 | 5/5 |-| TypeApplications | 🟢 | 13/13 |+| TypeApplications | 🟢 | 14/14 | | TypeData | 🟢 | 1/1 | | TypeFamilies | 🟢 | 61/61 | | TypeFamilyDependencies | 🟢 | 4/4 | | TypeOperators | 🟢 | 71/71 | | UnboxedSums | 🟢 | 13/13 |-| UnboxedTuples | 🟢 | 22/22 |+| UnboxedTuples | 🟢 | 25/25 | | UnicodeSyntax | 🟢 | 21/21 | | ViewPatterns | 🟢 | 26/26 |
src/Aihc/Parser/Internal/Common.hs view
@@ -720,12 +720,59 @@ MP.try parenthesizedContextItemsParser <|> fmap pure (contextItemParserWith typeParser typeAtomParser) where parenthesizedContextItemsParser = do- items <- parens (contextItemParserWith typeParser typeAtomParser `MP.sepEndBy` expectedTok TkSpecialComma)+ items <- parens (listContextItemParser `MP.sepEndBy` expectedTok TkSpecialComma) guardNotFollowedByConstraintInfixOp case items of [] -> fail "empty constraint list in parens" [item] -> pure [typeAnnSpan NoSourceSpan (TParen item)] _ -> pure items+ listContextItemParser =+ MP.try quantifiedContextItemParser <|> contextItemParserWith typeParser typeAtomParser+ -- \| Extension form (QuantifiedConstraints):+ --+ -- > context item -> ['forall' binders '.'] [context '=>'] constraint+ --+ -- 'contextItemParserWith' cannot read these two forms. Without this+ -- alternative the comma-separated list fails, and the enclosing+ -- parentheses fall back to 'typeAtomParser', which reads the full list as+ -- one tuple type. The generic type parser reads both forms.+ quantifiedContextItemParser = do+ guard =<< startsQuantifiedConstraint+ typeParser+ -- \| Look ahead for a 'forall' or a '=>' that belongs to this list item.+ -- The scan stops at the comma that ends the item and at the closing+ -- parenthesis of the list.+ startsQuantifiedConstraint :: TokParser Bool+ startsQuantifiedConstraint = MP.lookAhead (go (0 :: Int))+ where+ go depth = do+ tok <- anySingle+ case lexTokenKind tok of+ TkEOF -> pure False+ TkKeywordForall | depth == 0 -> pure True+ TkReservedDoubleArrow | depth == 0 -> pure True+ TkSpecialComma | depth == 0 -> pure False+ TkSpecialLParen -> go (depth + 1)+ TkSpecialRParen+ | depth > 0 -> go (depth - 1)+ | otherwise -> pure False+ TkSpecialUnboxedLParen -> go (depth + 1)+ TkSpecialUnboxedRParen+ | depth > 0 -> go (depth - 1)+ | otherwise -> pure False+ TkSpecialLBracket -> go (depth + 1)+ TkSpecialRBracket+ | depth > 0 -> go (depth - 1)+ | otherwise -> pure False+ TkSpecialLBrace+ | lexTokenOrigin tok == InsertedLayout -> pure False+ TkSpecialRBrace+ | lexTokenOrigin tok == InsertedLayout -> pure False+ TkSpecialSemicolon -> pure False+ TkReservedEquals -> pure False+ TkReservedPipe -> pure False+ TkKeywordWhere -> pure False+ _ -> go depth guardNotFollowedByConstraintInfixOp = do isFollowed <- fmap (either (const False) (const True))
+ test/Test/Fixtures/golden/module/class-context-list-implication-constraint.yaml view
@@ -0,0 +1,7 @@+extensions: [QuantifiedConstraints]+input: |+ {-# LANGUAGE QuantifiedConstraints #-}+ class (Marker f, p => q) => Implies f p q+ast: |-+ Module {[QuantifiedConstraints], [DeclClass (ClassDecl {[TApp (TCon "Marker") (TVar "f"), TContext [TVar "p"] (TVar "q")], Prefix "Implies" [TyVarBinder {"f"}, TyVarBinder {"p"}, TyVarBinder {"q"}]})]}+status: pass
+ test/Test/Fixtures/golden/module/class-context-list-quantified-constraint.yaml view
@@ -0,0 +1,7 @@+extensions: [QuantifiedConstraints]+input: |+ {-# LANGUAGE QuantifiedConstraints #-}+ class (Eq1 t, forall a. Eq a => Eq (t a)) => Eq1Wrapper t+ast: |-+ Module {[QuantifiedConstraints], [DeclClass (ClassDecl {[TApp (TCon "Eq1") (TVar "t"), TForall [TyVarBinder {"a"}] (TContext [TApp (TCon "Eq") (TVar "a")] (TApp (TCon "Eq") (TParen (TApp (TVar "t") (TVar "a")))))], Prefix "Eq1Wrapper" [TyVarBinder {"t"}]})]}+status: pass
+ test/Test/Fixtures/golden/module/instance-context-list-quantified-constraint.yaml view
@@ -0,0 +1,7 @@+extensions: [QuantifiedConstraints]+input: |+ {-# LANGUAGE QuantifiedConstraints #-}+ instance (Show a, forall b. Show b => Show (f b)) => Show (Wrap f a)+ast: |-+ Module {[QuantifiedConstraints], [DeclInstance (InstanceDecl {[TApp (TCon "Show") (TVar "a"), TForall [TyVarBinder {"b"}] (TContext [TApp (TCon "Show") (TVar "b")] (TApp (TCon "Show") (TParen (TApp (TVar "f") (TVar "b")))))], TApp (TCon "Show") (TParen (TApp (TApp (TCon "Wrap") (TVar "f")) (TVar "a")))})]}+status: pass
+ test/Test/Fixtures/oracle/QuantifiedConstraints/context-list-items.hs view
@@ -0,0 +1,15 @@+{- ORACLE_TEST pass -}+{-# LANGUAGE QuantifiedConstraints #-}++module QuantifiedConstraintContextListItems where++class Marker f++class (Marker f, forall a. Eq a => Eq (f a)) => Eq1Wrapper f++class (Marker f, p => q) => Implies f p q++data Wrap f a = Wrap (f a)++instance (Show a, forall b. Show b => Show (f b)) => Show (Wrap f a) where+ show (Wrap x) = show x