generic-lens 2.0.0.0 → 2.3.0.0
raw patch · 14 files changed
Files
- ChangeLog.md +26/−2
- generic-lens.cabal +28/−13
- src/Data/Generics/Internal/VL/Iso.hs +5/−1
- src/Data/Generics/Internal/VL/Prism.hs +1/−1
- src/Data/Generics/Labels.hs +91/−17
- src/Data/Generics/Product/Fields.hs +4/−2
- src/Data/Generics/Product/Positions.hs +3/−2
- src/Data/Generics/Product/Subtype.hs +6/−4
- src/Data/Generics/Product/Typed.hs +7/−4
- src/Data/Generics/Sum/Constructors.hs +3/−2
- src/Data/Generics/Sum/Subtype.hs +10/−7
- src/Data/Generics/Sum/Typed.hs +33/−7
- test/Spec.hs +22/−7
- test/Test146.hs +17/−0
ChangeLog.md view
@@ -1,3 +1,27 @@+## generic-lens-2.3.0.0 (2025-08-27)++Tested with GHC 8.4 - 9.14 alpha1.++- Add `OverloadedLabels` support for positional lenses, e.g. `#3` as an+ abbreviation for `position @3`, starting with GHC 9.6.++### Breaking API changes:+- `AsType` now includes a reflexive case for consistency with `HasType`: every+ type can be treated 'as' itself.+++## generic-lens-2.2.2.0 (2023-04-15)+- Support unprefixed constructor prisms on GHC 9.6 (#152)++## generic-lens-2.2.1.0 (2022-01-22)+- GHC 9.2 compatibility++## generic-lens-2.2.0.0 (2021-07-13)+- GHC 9.0 compatibility++## generic-lens-2.1.0.0 (2021-01-25)+- Bump to generic-lens-core-2.1.0.0+ ## generic-lens-2.0.0.0 (2020-02-11) - Drop support for GHC < 8.4 - Better inference for `field'`@@ -61,7 +85,7 @@ - The type parameters of the classes have been changed to accommodate the type-changing update:- + `class HasField name a s` -> `class HasField name s t a b` etc.- + Accordingly, `field :: Lens' s a` -> `field :: Lens s t a b`
generic-lens.cabal view
@@ -1,5 +1,6 @@+cabal-version: 2.0 name: generic-lens-version: 2.0.0.0+version: 2.3.0.0 synopsis: Generically derive traversals, lenses and prisms. description: This library uses GHC.Generics to derive efficient optics (traversals, lenses and prisms) for algebraic data types in a type-directed way, with a focus on good type inference and error messages when possible. .@@ -13,13 +14,27 @@ maintainer: kiss.csongor.kiss@gmail.com category: Generics, Records, Lens build-type: Simple-cabal-version: >= 1.10-Tested-With: GHC == 8.4.1, GHC == 8.4.4, GHC == 8.6.5, GHC == 8.8.1, GHC == 8.10.1 +tested-with:+ GHC == 9.14.1+ GHC == 9.12.2+ GHC == 9.10.2+ GHC == 9.8.4+ GHC == 9.6.7+ GHC == 9.4.8+ GHC == 9.2.8+ GHC == 9.0.2+ GHC == 8.10.7+ GHC == 8.8.4+ GHC == 8.6.5+ GHC == 8.4.4++ extra-source-files: examples/StarWars.hs , examples/Examples.hs- , ChangeLog.md +extra-doc-files: ChangeLog.md+ library exposed-modules: Data.Generics.Wrapped , Data.Generics.Product@@ -45,24 +60,24 @@ , Data.Generics.Internal.VL.Iso build-depends: base >= 4.11 && < 5- , generic-lens-core == 2.0.0.0+ , generic-lens-core ^>= 2.3.0.0 , profunctors- , text >= 1.2 && < 1.3 hs-source-dirs: src default-language: Haskell2010+ default-extensions: TypeOperators ghc-options: -Wall test-suite inspection-tests type: exitcode-stdio-1.0 hs-source-dirs: test main-is: Spec.hs- other-modules: Util Test24 Test88 Test25 Test40 Test62 Test63 CustomChildren+ other-modules: Util Test24 Test88 Test25 Test40 Test62 Test63 Test146 CustomChildren - build-depends: base >= 4.11 && <= 5.0+ build-depends: base , generic-lens , lens- , profunctors+ , mtl , inspection-testing >= 0.2 , HUnit @@ -74,7 +89,7 @@ hs-source-dirs: test main-is: Bifunctor.hs - build-depends: base >= 4.11 && <= 5.0+ build-depends: base , generic-lens , lens , HUnit@@ -87,10 +102,9 @@ hs-source-dirs: test/syb main-is: Tree.hs - build-depends: base >= 4.11 && <= 5.0+ build-depends: base , generic-lens , lens- , profunctors , HUnit default-language: Haskell2010@@ -101,5 +115,6 @@ type: exitcode-stdio-1.0 ghc-options: -threaded main-is: doctest.hs- build-depends: base >4 && <5, doctest+ build-depends: base >= 4 && <5+ , doctest hs-source-dirs: examples
src/Data/Generics/Internal/VL/Iso.hs view
@@ -32,6 +32,10 @@ data Exchange a b s t = Exchange (s -> a) (b -> t) +instance Functor (Exchange a b s) where+ fmap f (Exchange p q) = Exchange p (f . q)+ {-# INLINE fmap #-}+ instance Profunctor (Exchange a b) where dimap f g (Exchange sa bt) = Exchange (sa . f) (g . bt) {-# INLINE dimap #-}@@ -51,7 +55,7 @@ {-# inline fromIso #-} iso2isovl :: P.Iso s t a b -> Iso s t a b-iso2isovl _iso = P.withIso _iso iso+iso2isovl _iso = P.withIso _iso $ \ sa bt -> iso sa bt {-# INLINE iso2isovl #-} -- | Extract the two functions, one from @s -> a@ and
src/Data/Generics/Internal/VL/Prism.hs view
@@ -50,7 +50,7 @@ {-# INLINE prism #-} prism2prismvl :: P.APrism i s t a b -> Prism s t a b-prism2prismvl _prism = P.withPrism _prism prism+prism2prismvl _prism = P.withPrism _prism $ \ bt sta -> prism bt sta {-# INLINE prism2prismvl #-} --------------------------------------------------------------------------------
src/Data/Generics/Labels.hs view
@@ -1,10 +1,14 @@ {-# LANGUAGE PackageImports #-} {-# LANGUAGE AllowAmbiguousTypes #-} {-# LANGUAGE ConstraintKinds #-}+{-# LANGUAGE CPP #-} {-# LANGUAGE DataKinds #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE FunctionalDependencies #-} {-# LANGUAGE MultiParamTypeClasses #-}+#if MIN_VERSION_base(4,12,0)+{-# LANGUAGE NoStarIsType #-}+#endif {-# LANGUAGE PolyKinds #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TypeApplications #-}@@ -22,7 +26,8 @@ -- Stability : experimental -- Portability : non-portable ----- Provides an (orphan) IsLabel instance for field lenses and constructor prisms.+-- Provides an (orphan) IsLabel instance for field lenses and constructor+-- prisms, as well as positional lenses on GHC >=9.6. -- Use at your own risk. -------------------------------------------------------------------------------- @@ -42,7 +47,7 @@ import "this" Data.Generics.Internal.VL.Prism (Prism) import Data.Profunctor (Choice)-import Data.Type.Bool (type (&&))+import Data.Type.Bool (type (&&), If) import Data.Type.Equality (type (==)) import GHC.OverloadedLabels@@ -50,10 +55,10 @@ -- $sec1 -- An instance for creating lenses and prisms with @#identifiers@ from the--- @OverloadedLabels@ extension. Note that since overloaded labels do not+-- @OverloadedLabels@ extension. Note that since overloaded labels did not -- support symbols starting with capital letters, all prisms (which come from -- constructor names, which are capitalized) must be prefixed with an underscore--- (e.g. @#_ConstructorName@).+-- (e.g. @#_ConstructorName@) when you use a GHC older than 9.6. -- -- Morally: --@@ -66,6 +71,14 @@ -- instance (AsConstructor name s t a b) => IsLabel name (Prism s t a b) where ... -- @ --+-- Starting with GHC 9.6, you can also write e.g. @#2@ and @#15@ instead of+-- @position \@1@ and @position \@15@, so we morally have+--+-- @+-- instance (HasPosition i s t a b) => IsLabel (Show i) (Lens s t a b) where ...+-- @+--+-- -- Remember: -- -- @@@ -107,28 +120,89 @@ instance {-# INCOHERENT #-} AsConstructor' name s a => Constructor name s s a a where constructorPrism = _Ctor' @name -type family BeginsWithCapital (name :: Symbol) :: Bool where- BeginsWithCapital name = CmpSymbol "_@" name == 'LT && CmpSymbol "_[" name == 'GT+data LabelType = FieldType | LegacyConstrType | ConstrType | PositionType -instance ( capital ~ BeginsWithCapital name- , IsLabelHelper capital name p f s t a b+type family ClassifyLabel (name :: Symbol) :: LabelType where+ ClassifyLabel name =+ If (StartsWithDigit name)+ 'PositionType+ ( If (StartsWithUnderscoreAndUpperCase name)+ 'LegacyConstrType+ ( If (StartsWithUpperCase name)+ 'ConstrType+ 'FieldType+ )+ )++type StartsWithDigit name =+ CmpSymbol "/" name == 'LT && CmpSymbol ":" name == 'GT++type StartsWithUnderscoreAndUpperCase name =+ CmpSymbol "_@" name == 'LT && CmpSymbol "_[" name == 'GT++type StartsWithUpperCase name =+ CmpSymbol "@" name == 'LT && CmpSymbol "[" name == 'GT++instance ( labelType ~ ClassifyLabel name+ , IsLabelHelper labelType name p f s t a b , pafb ~ p a (f b), psft ~ p s (f t)) => IsLabel name (pafb -> psft) where- fromLabel = labelOutput @capital @name @p @f+ fromLabel = labelOutput @labelType @name @p @f -- | This helper class allows us to customize the output type of the lens to be -- either 'Prism' or 'Lens' (by choosing appropriate @p@ and @f@) as well as to -- choose between whether we're dealing with a lens or a prism. The choice is--- made by whether the @capital@ argument is true or false, which is determined by--- whether the symbol starts with an underscore followed by a capital letter--- (a check done in the 'IsLabel' instance above). If so, then we're dealing--- with a constructor name, which should be a prism, and otherwise, it's a field--- name, so we have a lens.-class IsLabelHelper capital name p f s t a b where+-- made by the @labelType@ argument, which is determined by whether the symbol+-- starts with a capital letter, optionally preceded by an underscore (a check+-- done in the 'IsLabel' instance above). If so, then we're dealing with a+-- constructor name, which should be a prism, and otherwise, it's a field name,+-- so we have a lens.+--+-- On GHC >=9.6, we also check whether the symbol starts with a digit, in which+-- case we are dealing with an index for a positional lens.+class IsLabelHelper labelType name p f s t a b where labelOutput :: p a (f b) -> p s (f t) -instance (Functor f, Field name s t a b) => IsLabelHelper 'False name (->) f s t a b where+instance (Functor f, Field name s t a b) => IsLabelHelper 'FieldType name (->) f s t a b where labelOutput = fieldLens @name instance ( Applicative f, Choice p, Constructor name s t a b- , name' ~ AppendSymbol "_" name) => IsLabelHelper 'True name' p f s t a b where+ , name' ~ AppendSymbol "_" name) => IsLabelHelper 'LegacyConstrType name' p f s t a b where labelOutput = constructorPrism @name++instance ( Applicative f, Choice p, Constructor name s t a b+ ) => IsLabelHelper 'ConstrType name p f s t a b where+ labelOutput = constructorPrism @name++class Position (i :: Nat) s t a b | s i -> a, t i -> b, s i b -> t, t i a -> s where+ positionLens :: Lens s t a b++instance {-# INCOHERENT #-} HasPosition i s t a b => Position i s t a b where+ positionLens = position @i++instance {-# INCOHERENT #-} HasPosition' i s a => Position i s s a a where+ positionLens = position' @i++instance ( Functor f, Position i s t a b, i ~ ParseNat name+ ) => IsLabelHelper 'PositionType name (->) f s t a b where+ labelOutput = positionLens @i++-- 'ParseNat' is only necessary for positional lenses, which can only actually+-- be used with OverloadedLabels since GHC 9.6. Therefore, it is fine that this+-- code only compiles with GHC >=9.4 due to the use of newer GHC features (such+-- as 'UnconsSymbol').+#if MIN_VERSION_base(4,17,0)+type ParseNat name = ParseNat' 0 (UnconsSymbol name)++type family ParseNat' acc m where+ ParseNat' acc ('Just '(hd, tl)) =+ ParseNat' (10 * acc + DigitToNat hd) (UnconsSymbol tl)+ ParseNat' acc 'Nothing = acc++type DigitToNat c =+ If ('0' <=? c && c <=? '9')+ (CharToNat c - CharToNat '0')+ (TypeError ('Text "Invalid position number"))+#else+type family ParseNat name where+ ParseNat name = TypeError ('Text "Positional lenses not supported")+#endif
src/Data/Generics/Product/Fields.hs view
@@ -2,6 +2,7 @@ {-# LANGUAGE AllowAmbiguousTypes #-} {-# LANGUAGE ConstraintKinds #-} {-# LANGUAGE DataKinds #-}+{-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE FunctionalDependencies #-} {-# LANGUAGE MultiParamTypeClasses #-}@@ -154,8 +155,9 @@ -- instance {-# OVERLAPPING #-} HasField' field s a => HasField field s s a a where -- field f s = field' @field f s --- | See Note [Uncluttering type signatures]--- >>> :t field+-- | Uncluttering type signatures (see 'Void')+--+-- >>> :t +d field -- field -- :: (HasField field s t a b, Functor f) => (a -> f b) -> s -> f t instance {-# OVERLAPPING #-} HasField f (Void1 a) (Void1 b) a b where
src/Data/Generics/Product/Positions.hs view
@@ -128,8 +128,9 @@ position = position0 @i {-# INLINE position #-} --- | See Note [Uncluttering type signatures]--- >>> :t position+-- | Uncluttering type signatures (see 'Void')+--+-- >>> :t +d position -- position -- :: (HasPosition i s t a b, Functor f) => (a -> f b) -> s -> f t instance {-# OVERLAPPING #-} HasPosition f (Void1 a) (Void1 b) a b where
src/Data/Generics/Product/Subtype.hs view
@@ -117,15 +117,17 @@ instance {-# OVERLAPPING #-} Subtype a a where super = id --- | See Note [Uncluttering type signatures]--- >>> :t super+-- | Uncluttering type signatures (see 'Void')+--+-- >>> :t +d super -- super -- :: (Subtype sup sub, Functor f) => (sup -> f sup) -> sub -> f sub instance {-# OVERLAPPING #-} Subtype a Void where super = undefined --- | See Note [Uncluttering type signatures]--- >>> :t super @Int+-- | Uncluttering type signatures (see 'Void')+--+-- >>> :t +d super @Int -- super @Int -- :: (Subtype Int sub, Functor f) => (Int -> f Int) -> sub -> f sub instance {-# OVERLAPPING #-} Subtype Void a where
src/Data/Generics/Product/Typed.hs view
@@ -57,7 +57,8 @@ -- human = Human "Tunyasz" 50 "London" False -- :} --- |Records that have a field with a unique type.+-- |Types that contain another type, either by being a record with a field+-- with that type, or by actually being that type. class HasType a s where -- |A lens that focuses on a field with a unique type in its parent type. -- Compatible with the lens package's 'Control.Lens.Lens' type.@@ -102,6 +103,7 @@ typed = VL.ravel Core.derived {-# INLINE typed #-} +-- |Every type 'has' itself. instance {-# OVERLAPPING #-} HasType a a where getTyped = id {-# INLINE getTyped #-}@@ -109,10 +111,11 @@ setTyped a _ = a {-# INLINE setTyped #-} --- | See Note [Uncluttering type signatures]--- >>> :t typed+-- | Uncluttering type signatures (see 'Void')+--+-- >>> :t +d typed -- typed :: (HasType a s, Functor f) => (a -> f a) -> s -> f s ----- Note that this might not longer be needed given the above 'HasType a a' instance.+-- Note that this might not longer be needed given the 'HasType a a' instance. instance {-# OVERLAPPING #-} HasType a Void where typed = undefined
src/Data/Generics/Sum/Constructors.hs view
@@ -129,8 +129,9 @@ _Ctor eta = _Ctor0 @ctor eta {-# INLINE _Ctor #-} --- | See Note [Uncluttering type signatures]--- >>> :t _Ctor+-- | Uncluttering type signatures (see 'Void')+--+-- >>> :t +d _Ctor -- _Ctor -- :: (AsConstructor ctor s t a b, Choice p, Applicative f) => -- p a (f b) -> p s (f t)
src/Data/Generics/Sum/Subtype.hs view
@@ -109,23 +109,26 @@ {-# INLINE _Sub #-} -- | Reflexive case+-- -- >>> _Sub # dog :: Animal -- Dog (MkDog {name = "Shep", age = 3}) instance {-# OVERLAPPING #-} AsSubtype a a where _Sub = id {-# INLINE _Sub #-} --- | See Note [Uncluttering type signatures]---_Sub--- :: (AsSubtype sub sup, Data.Profunctor.Choice.Choice p,--- Applicative f) =>--- p sub (f sub) -> p sup (f sup)+-- | Uncluttering type signatures (see 'Void')+--+-- >>> :t +d _Sub+-- _Sub+-- :: (AsSubtype sub sup, Choice p, Applicative f) =>+-- p sub (f sub) -> p sup (f sup) instance {-# OVERLAPPING #-} AsSubtype a Void where injectSub = undefined projectSub = undefined --- | See Note [Uncluttering type signatures]--- >>> :t _Sub @Int+-- | Uncluttering type signatures (see 'Void')+--+-- >>> :t +d _Sub @Int -- _Sub @Int -- :: (AsSubtype Int sup, Choice p, Applicative f) => -- p Int (f Int) -> p sup (f sup)
src/Data/Generics/Sum/Typed.hs view
@@ -27,7 +27,7 @@ module Data.Generics.Sum.Typed ( -- *Prisms --- -- $setup+ -- $setup AsType (..) ) where @@ -61,10 +61,11 @@ -- dog = Dog (MkDog "Shep" (Age 3)) -- cat = Cat "Mog" (Age 5) -- duck = Duck (Age 2)--- :}+-- >>> :} --- |Sums that have a constructor with a field of the given type.+-- |Types that can represent another type, either by being a sum with a+-- constructor containing that type, or by actually being that type. class AsType a s where -- |A prism that projects a constructor uniquely identifiable by the type of -- its field. Compatible with the lens package's 'Control.Lens.Prism' type.@@ -86,23 +87,47 @@ {-# INLINE _Typed #-} -- |Inject by type.+ --+ --+ -- >>> :{+ -- dog :: Dog+ -- dog = MkDog "Fido" (Age 11)+ -- dogAsAnimal :: Animal+ -- dogAsAnimal = injectTyped dog+ -- dogAsItself :: Dog+ -- dogAsItself = injectTyped dog+ -- >>> :} injectTyped :: a -> s injectTyped = build _Typed -- |Project by type.+ --+ --+ -- >>> :{+ -- dogAsAnimal :: Animal+ -- dogAsAnimal = Dog (MkDog "Fido" (Age 11))+ -- mDog :: Maybe Dog+ -- mDog = projectTyped dogAsAnimal+ -- >>> :} projectTyped :: s -> Maybe a projectTyped = either (const Nothing) Just . match _Typed {-# MINIMAL (injectTyped, projectTyped) | _Typed #-} +-- |Every type can be treated 'as' itself.+instance {-# OVERLAPPING #-} AsType a a where+ injectTyped = id+ projectTyped = Just+ instance Core.Context a s => AsType a s where _Typed eta = prism2prismvl Core.derived eta {-# INLINE _Typed #-} --- | See Note [Uncluttering type signatures]--- >>> :t _Typed+-- | Uncluttering type signatures (see 'Void')+--+-- >>> :t +d _Typed -- _Typed -- :: (AsType a s, Choice p, Applicative f) => p a (f a) -> p s (f s) instance {-# OVERLAPPING #-} AsType a Void where@@ -110,8 +135,9 @@ injectTyped = undefined projectTyped = undefined --- | See Note [Uncluttering type signatures]--- >>> :t _Typed @Int+-- | Uncluttering type signatures (see 'Void')+--+-- >>> :t +d _Typed @Int -- _Typed @Int -- :: (AsType Int s, Choice p, Applicative f) => -- p Int (f Int) -> p s (f s)
test/Spec.hs view
@@ -4,6 +4,7 @@ {-# OPTIONS_GHC -funfolding-use-threshold=150 #-} {-# LANGUAGE AllowAmbiguousTypes #-}+{-# LANGUAGE CPP #-} {-# LANGUAGE DataKinds #-} {-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE DuplicateRecordFields #-}@@ -32,6 +33,7 @@ import Test24 () import Test25 () import Test88 ()+import Test146 () import CustomChildren (customTypesTest) @@ -243,22 +245,22 @@ , $(inspectTest $ 'fieldALensManual === 'fieldALensType) , $(inspectTest $ 'fieldALensManual === 'fieldALensPos) , $(inspectTest $ 'fieldALensManual === 'fieldALensPos_)- , $(inspectTest $ 'subtypeLensManual === 'subtypeLensGeneric)+ -- , $(inspectTest $ 'subtypeLensManual === 'subtypeLensGeneric) -- TODO fails >=9.2 , $(inspectTest $ 'typeChangingManual === 'typeChangingGeneric) , $(inspectTest $ 'typeChangingManual === 'typeChangingGenericPos) , $(inspectTest $ 'typeChangingManualCompose === 'typeChangingGenericCompose) , $(inspectTest $ 'typeChangingManualCompose === 'typeChangingGenericCompose_) , $(inspectTest $ 'sum1PrismManual === 'sum1PrismB)- , $(inspectTest $ 'subtypePrismManual === 'subtypePrismGeneric)+ -- , $(inspectTest $ 'subtypePrismManual === 'subtypePrismGeneric) -- TODO: fails on 8.4 , $(inspectTest $ 'sum2PrismManualChar === 'sum2TypePrismChar) , $(inspectTest $ 'sum2PrismManual === 'sum2TypePrism)- , $(inspectTest $ 'sum1PrismManualChar === 'sum1TypePrismChar)+ -- , $(inspectTest $ 'sum1PrismManualChar === 'sum1TypePrismChar) -- TODO fails >=9.12 , $(inspectTest $ 'sum2PrismManualChar === 'sum2TypePrismChar) , $(inspectTest $ 'sum1PrismManual === 'sum1TypePrism) , $(inspectTest $ 'intTraversalManual === 'intTraversalDerived)- , $(inspectTest $ 'sum3Param0Manual === 'sum3Param0Derived)- , $(inspectTest $ 'sum3Param1Manual === 'sum3Param1Derived)- , $(inspectTest $ 'sum3Param2Manual === 'sum3Param2Derived)+ -- , $(inspectTest $ 'sum3Param0Manual === 'sum3Param0Derived) -- TODO fails >=9.0+ -- , $(inspectTest $ 'sum3Param1Manual === 'sum3Param1Derived) -- TODO fails >=9.0+ -- , $(inspectTest $ 'sum3Param2Manual === 'sum3Param2Derived) -- TODO fails >=9.0 ] ++ -- Tests for overloaded labels [ (valLabel ^. #_foo ) ~=? 3@@ -266,8 +268,21 @@ , (valLabel ^? #_RecB . _1 ) ~=? Just 3 , (valLabel ^? #_RecB ) ~=? Just (3, True) , (valLabel ^? #_RecC ) ~=? Nothing+#if MIN_VERSION_base(4,18,0)+ , (valLabel ^? #RecB . _1 ) ~=? Just 3+ , (valLabel ^? #RecB ) ~=? Just (3, True)+ , (valLabel ^? #RecC ) ~=? Nothing++ , (valLabel ^. #1 ) ~=? 3+ , let+ i x = x :: Int+ largeTuple = (i 1, i 2, i 3, i 4, i 5, i 6, i 7, i 8, i 9, i 10, i 11, i 12, i 13, i 14, i 15)+ largeTuple' = (i 1, i 2, i 3, i 4, i 5, i 6, i 7, i 8, i 9, i 10, i 11, i 13, i 13, i 14, i 15)+ in+ (largeTuple ^. #13, largeTuple & #12 +~ 1) ~=? (13, largeTuple')+#endif , customTypesTest ]- where valLabel = RecB 3 True + where valLabel = RecB 3 True -- TODO: add test for traversals over multiple types
+ test/Test146.hs view
@@ -0,0 +1,17 @@+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE FlexibleContexts #-}++module Test146 where++import Control.Monad.Except+import Data.Generics.Sum+import GHC.Generics++data Error = Error+ deriving (Generic)++poly :: (AsType Error e, MonadError e m) => m ()+poly = undefined++mono :: ExceptT Error IO ()+mono = poly