diff --git a/generic-lens/generic-lens.cabal b/generic-lens/generic-lens.cabal index acfddf3..5c0fe3e 100644 --- a/generic-lens/generic-lens.cabal +++ b/generic-lens/generic-lens.cabal @@ -57,11 +57,12 @@ 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 , generic-lens , lens + , mtl , profunctors , inspection-testing >= 0.2 , HUnit diff --git a/generic-lens/src/Data/Generics/Sum/Typed.hs b/generic-lens/src/Data/Generics/Sum/Typed.hs index 54f37eb..f0b9a93 100644 --- a/generic-lens/src/Data/Generics/Sum/Typed.hs +++ b/generic-lens/src/Data/Generics/Sum/Typed.hs @@ -97,6 +97,10 @@ class AsType a s where {-# MINIMAL (injectTyped, projectTyped) | _Typed #-} +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 #-} diff --git a/generic-lens/test/Spec.hs b/generic-lens/test/Spec.hs index c30de6f..53bff01 100644 --- a/generic-lens/test/Spec.hs +++ b/generic-lens/test/Spec.hs @@ -32,6 +32,7 @@ import Data.Generics.Labels () import Test24 () import Test25 () import Test88 () +import Test146 () import CustomChildren (customTypesTest) diff --git a/generic-lens/test/Test146.hs b/generic-lens/test/Test146.hs new file mode 100644 index 0000000..c89aba4 --- /dev/null +++ b/generic-lens/test/Test146.hs @@ -0,0 +1,19 @@ +{-# 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 + + diff --git a/generic-optics/generic-optics.cabal b/generic-optics/generic-optics.cabal index 71286fe..53dbe18 100644 --- a/generic-optics/generic-optics.cabal +++ b/generic-optics/generic-optics.cabal @@ -54,10 +54,11 @@ test-suite generic-optics-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 , generic-optics + , mtl , optics-core , inspection-testing >= 0.2 , HUnit diff --git a/generic-optics/src/Data/Generics/Sum/Typed.hs b/generic-optics/src/Data/Generics/Sum/Typed.hs index 56db6a4..84997e2 100644 --- a/generic-optics/src/Data/Generics/Sum/Typed.hs +++ b/generic-optics/src/Data/Generics/Sum/Typed.hs @@ -97,6 +97,10 @@ class AsType a s where {-# MINIMAL (injectTyped, projectTyped) | _Typed #-} +instance {-# OVERLAPPING #-} AsType a a where + injectTyped = id + projectTyped = Just + instance Core.Context a s => AsType a s where _Typed = normalisePrism (Optic Core.derived) {-# INLINE _Typed #-} diff --git a/generic-optics/test/Spec.hs b/generic-optics/test/Spec.hs index 62bfa24..a5b7604 100644 --- a/generic-optics/test/Spec.hs +++ b/generic-optics/test/Spec.hs @@ -29,6 +29,7 @@ import Optics.Core -- This is sufficient at we only want to test that they typecheck import Test24 () import Test25 () +import Test146 () -- import CustomChildren (customTypesTest) diff --git a/generic-optics/test/Test146.hs b/generic-optics/test/Test146.hs new file mode 100644 index 0000000..cc9e5df --- /dev/null +++ b/generic-optics/test/Test146.hs @@ -0,0 +1,20 @@ +{-# 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 + + +