diff --git a/generic-lens/ChangeLog.md b/generic-lens/ChangeLog.md index 08cc599..6ad73f8 100644 --- a/generic-lens/ChangeLog.md +++ b/generic-lens/ChangeLog.md @@ -2,6 +2,10 @@ - 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) diff --git a/generic-lens/generic-lens.cabal b/generic-lens/generic-lens.cabal index b7bc101..2b05ed8 100644 --- a/generic-lens/generic-lens.cabal +++ b/generic-lens/generic-lens.cabal @@ -69,11 +69,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 , generic-lens , lens + , mtl , profunctors , inspection-testing >= 0.2 , HUnit diff --git a/generic-lens/src/Data/Generics/Product/Typed.hs b/generic-lens/src/Data/Generics/Product/Typed.hs index 969ddf8..b543b04 100644 --- a/generic-lens/src/Data/Generics/Product/Typed.hs +++ b/generic-lens/src/Data/Generics/Product/Typed.hs @@ -57,7 +57,8 @@ import "generic-lens-core" Data.Generics.Internal.Void -- 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 @@ instance Core.Context a s => HasType a s where typed = VL.ravel Core.derived {-# INLINE typed #-} +-- |Every type 'has' itself. instance {-# OVERLAPPING #-} HasType a a where getTyped = id {-# INLINE getTyped #-} diff --git a/generic-lens/src/Data/Generics/Sum/Typed.hs b/generic-lens/src/Data/Generics/Sum/Typed.hs index 54f37eb..ca3c79d 100644 --- a/generic-lens/src/Data/Generics/Sum/Typed.hs +++ b/generic-lens/src/Data/Generics/Sum/Typed.hs @@ -64,7 +64,8 @@ import "generic-lens-core" Data.Generics.Internal.Void -- :} --- |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. @@ -97,6 +98,11 @@ class AsType a s where {-# 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 #-} diff --git a/generic-lens/test/Spec.hs b/generic-lens/test/Spec.hs index 0f64a86..7414026 100644 --- a/generic-lens/test/Spec.hs +++ b/generic-lens/test/Spec.hs @@ -33,6 +33,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..0b31f95 --- /dev/null +++ b/generic-lens/test/Test146.hs @@ -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 diff --git a/generic-optics/ChangeLog.md b/generic-optics/ChangeLog.md index 5d7f9ad..6d29789 100644 --- a/generic-optics/ChangeLog.md +++ b/generic-optics/ChangeLog.md @@ -1,3 +1,9 @@ +## Unreleased + +### Breaking API changes: +- `AsType` now includes a reflexive case for consistency with `HasType`: every + type can be treated 'as' itself. + ## generic-optics-2.2.1.0 (2022-01-22) - GHC 9.2 compatibility diff --git a/generic-optics/generic-optics.cabal b/generic-optics/generic-optics.cabal index 53a3444..96135b0 100644 --- a/generic-optics/generic-optics.cabal +++ b/generic-optics/generic-optics.cabal @@ -65,10 +65,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 , generic-optics + , mtl , optics-core , inspection-testing >= 0.2 , HUnit diff --git a/generic-optics/src/Data/Generics/Product/Typed.hs b/generic-optics/src/Data/Generics/Product/Typed.hs index 3b3f5a9..0945f74 100644 --- a/generic-optics/src/Data/Generics/Product/Typed.hs +++ b/generic-optics/src/Data/Generics/Product/Typed.hs @@ -59,7 +59,8 @@ import "generic-lens-core" Data.Generics.Internal.Void -- 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. -- @@ -103,6 +104,7 @@ instance Core.Context a s => HasType a s where typed = normaliseLens (Optic Core.derived) {-# INLINE typed #-} +-- |Every type 'has' itself. instance {-# OVERLAPPING #-} HasType a a where getTyped = id {-# INLINE getTyped #-} diff --git a/generic-optics/src/Data/Generics/Sum/Typed.hs b/generic-optics/src/Data/Generics/Sum/Typed.hs index 56db6a4..3d77103 100644 --- a/generic-optics/src/Data/Generics/Sum/Typed.hs +++ b/generic-optics/src/Data/Generics/Sum/Typed.hs @@ -64,7 +64,8 @@ import "generic-lens-core" Data.Generics.Internal.Void -- :} --- |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. @@ -97,6 +98,11 @@ class AsType a s where {-# 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 = 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..0b31f95 --- /dev/null +++ b/generic-optics/test/Test146.hs @@ -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