diff --git a/.github/workflows/haskell-ci.yml b/.github/workflows/haskell-ci.yml index b19c593..b679d04 100644 --- a/.github/workflows/haskell-ci.yml +++ b/.github/workflows/haskell-ci.yml @@ -8,9 +8,9 @@ # # For more information, see https://github.com/haskell-CI/haskell-ci # -# version: 0.19.20260209 +# version: 0.19.20260331 # -# REGENDATA ("0.19.20260209",["github","cabal.project"]) +# REGENDATA ("0.19.20260331",["github","cabal.project"]) # name: Haskell-CI on: @@ -62,36 +62,6 @@ jobs: compilerVersion: 9.6.7 setup-method: ghcup allow-failure: false - - compiler: ghc-9.4.8 - compilerKind: ghc - compilerVersion: 9.4.8 - setup-method: ghcup - allow-failure: false - - compiler: ghc-9.2.8 - compilerKind: ghc - compilerVersion: 9.2.8 - setup-method: ghcup - allow-failure: false - - compiler: ghc-9.0.2 - compilerKind: ghc - compilerVersion: 9.0.2 - setup-method: ghcup - allow-failure: false - - compiler: ghc-8.10.4 - compilerKind: ghc - compilerVersion: 8.10.4 - setup-method: ghcup - allow-failure: false - - compiler: ghc-8.8.4 - compilerKind: ghc - compilerVersion: 8.8.4 - setup-method: ghcup - allow-failure: false - - compiler: ghc-8.6.5 - compilerKind: ghc - compilerVersion: 8.6.5 - setup-method: ghcup - allow-failure: false fail-fast: false steps: - name: apt-get install @@ -217,10 +187,10 @@ jobs: echo "packages: ${PKGDIR_some}" >> cabal.project echo "package some" >> cabal.project echo " ghc-options: -Werror=missing-methods -Werror=missing-fields" >> cabal.project - if [ $((HCNUMVER >= 90400)) -ne 0 ] ; then echo "package some" >> cabal.project ; fi - if [ $((HCNUMVER >= 90400)) -ne 0 ] ; then echo " ghc-options: -Werror=unused-packages" >> cabal.project ; fi - if [ $((HCNUMVER >= 90000)) -ne 0 ] ; then echo "package some" >> cabal.project ; fi - if [ $((HCNUMVER >= 90000)) -ne 0 ] ; then echo " ghc-options: -Werror=incomplete-patterns -Werror=incomplete-uni-patterns" >> cabal.project ; fi + echo "package some" >> cabal.project + echo " ghc-options: -Werror=unused-packages" >> cabal.project + echo "package some" >> cabal.project + echo " ghc-options: -Werror=incomplete-patterns -Werror=incomplete-uni-patterns" >> cabal.project cat >> cabal.project <> cabal.project.local diff --git a/ChangeLog.md b/ChangeLog.md index 6b09b9e..2bcd92f 100644 --- a/ChangeLog.md +++ b/ChangeLog.md @@ -1,3 +1,8 @@ +# 1.1 + +- Add `EqP` as a superclass of `GEq`, and `OrdP` as a superclass of `GCompare`. +- Relax `Eq` and `Ord` instances of `Some` to require just `EqP` and `OrdP`. + # 1.0.6 - Add instances for `SSymbol`, `SNat` and `SChar` from `base >=4.18.0.0' diff --git a/some.cabal b/some.cabal index e20f176..da989df 100644 --- a/some.cabal +++ b/some.cabal @@ -1,13 +1,12 @@ +cabal-version: 2.4 name: some -version: 1.0.6 -x-revision: 3 -cabal-version: >=1.10 +version: 1.1 build-type: Simple author: James Cook , Oleg Grenrus maintainer: Oleg Grenrus -license: BSD3 +license: BSD-3-Clause license-file: LICENSE homepage: https://github.com/haskellari/some category: Data, Dependent Types @@ -25,19 +24,13 @@ description: If you are unsure which variant to use, use the one in "Data.Some" module. tested-with: - GHC ==8.6.5 - || ==8.8.4 - || ==8.10.4 - || ==9.0.2 - || ==9.2.8 - || ==9.4.8 - || ==9.6.7 + GHC ==9.6.7 || ==9.8.4 || ==9.10.2 || ==9.12.2 || ==9.14.1 -extra-source-files: ChangeLog.md +extra-doc-files: ChangeLog.md flag newtype-unsafe description: @@ -72,20 +65,15 @@ library other-modules: Data.GADT.Internal build-depends: - base >=4.12 && <4.23 - , deepseq >=1.4.4.0 && <1.6 + base >=4.18 && <4.23 + , deepseq >=1.4.8.1 && <1.6 if !impl(ghc >= 9.8) build-depends: base-orphans >= 0.9.1 && <0.10 - if impl(ghc >=9.0) - -- these flags may abort compilation with GHC-8.10 - -- https://gitlab.haskell.org/ghc/ghc/-/merge_requests/3295 - ghc-options: -Winferred-safe-imports -Wmissing-safe-haskell-mode - - if impl(ghc >=9.1) - ghc-options: -Wmissing-kind-signatures + ghc-options: -Winferred-safe-imports -Wmissing-safe-haskell-mode + ghc-options: -Wmissing-kind-signatures test-suite hkd-example default-language: Haskell2010 diff --git a/src/Data/EqP.hs b/src/Data/EqP.hs index d172b83..ed2a3ce 100644 --- a/src/Data/EqP.hs +++ b/src/Data/EqP.hs @@ -1,28 +1,24 @@ -{-# LANGUAGE CPP #-} -{-# LANGUAGE PolyKinds #-} -{-# LANGUAGE QuantifiedConstraints #-} -{-# LANGUAGE Safe #-} -{-# LANGUAGE TypeOperators #-} -#if __GLASGOW_HASKELL__ >= 810 +{-# LANGUAGE CPP #-} +{-# LANGUAGE PolyKinds #-} +{-# LANGUAGE QuantifiedConstraints #-} +{-# LANGUAGE Safe #-} {-# LANGUAGE StandaloneKindSignatures #-} -#endif +{-# LANGUAGE TypeOperators #-} module Data.EqP ( EqP (..), ) where import Control.Applicative (Const (..)) -import Data.Kind (Type) +import Data.Kind (Constraint, Type) import Data.Proxy (Proxy (..)) import Data.Type.Equality ((:~:) (..), (:~~:) (..)) import GHC.Generics ((:*:) (..), (:+:) (..)) import System.Mem.StableName (StableName, eqStableName) +import Data.Functor.Product (Product (..)) +import Data.Functor.Sum (Sum (..)) -#if MIN_VERSION_base(4,18,0) -import Data.Functor.Product (Product (..)) -import Data.Functor.Sum (Sum (..)) -import qualified GHC.TypeLits as TL -import qualified GHC.TypeNats as TN -#endif +import qualified GHC.TypeLits as TL +import qualified GHC.TypeNats as TN #if !MIN_VERSION_base(4,19,0) import Data.Orphans () @@ -30,9 +26,6 @@ import Data.Orphans () import qualified Type.Reflection as TR -#if __GLASGOW_HASKELL__ >= 810 -import Data.Kind (Constraint) -#endif -- | Heterogenous lifted equality. -- @@ -60,9 +53,7 @@ import Data.Kind (Constraint) -- /Note:/ P stands for phantom. -- -- @since 1.0.5 -#if __GLASGOW_HASKELL__ >= 810 type EqP :: (k -> Type) -> Constraint -#endif class (forall a. Eq (f a)) => EqP (f :: k -> Type) where eqp :: f a -> f b -> Bool @@ -72,8 +63,6 @@ instance EqP ((:~:) a) where instance EqP ((:~~:) a) where eqp _ _ = True - -#if MIN_VERSION_base(4,18,0) instance (EqP a, EqP b) => EqP (Sum a b) where eqp (InL x) (InL y) = eqp x y eqp (InR x) (InR y) = eqp x y @@ -81,7 +70,6 @@ instance (EqP a, EqP b) => EqP (Sum a b) where instance (EqP a, EqP b) => EqP (Product a b) where eqp (Pair x y) (Pair x' y') = eqp x x' && eqp y y' -#endif instance (EqP f, EqP g) => EqP (f :+: g) where eqp (L1 x) (L1 y) = eqp x y @@ -94,7 +82,6 @@ instance (EqP a, EqP b) => EqP (a :*: b) where instance EqP TR.TypeRep where eqp x y = TR.SomeTypeRep x == TR.SomeTypeRep y -#if MIN_VERSION_base(4,18,0) instance EqP TL.SChar where eqp x y = TL.fromSChar x == TL.fromSChar y @@ -103,7 +90,6 @@ instance EqP TL.SSymbol where instance EqP TN.SNat where eqp x y = TN.fromSNat x == TN.fromSNat y -#endif instance EqP Proxy where eqp _ _ = True diff --git a/src/Data/GADT/Compare.hs b/src/Data/GADT/Compare.hs index 77145d3..e0638bf 100644 --- a/src/Data/GADT/Compare.hs +++ b/src/Data/GADT/Compare.hs @@ -1,4 +1,3 @@ -{-# LANGUAGE CPP #-} {-# LANGUAGE Safe #-} module Data.GADT.Compare ( -- * Equality diff --git a/src/Data/GADT/DeepSeq.hs b/src/Data/GADT/DeepSeq.hs index c2ffbf9..fe7dd2b 100644 --- a/src/Data/GADT/DeepSeq.hs +++ b/src/Data/GADT/DeepSeq.hs @@ -1,30 +1,21 @@ -{-# LANGUAGE CPP #-} {-# LANGUAGE GADTs #-} {-# LANGUAGE PolyKinds #-} {-# LANGUAGE Safe #-} -{-# LANGUAGE TypeOperators #-} -#if __GLASGOW_HASKELL__ >= 810 {-# LANGUAGE StandaloneKindSignatures #-} -#endif +{-# LANGUAGE TypeOperators #-} module Data.GADT.DeepSeq ( GNFData (..), ) where import Data.Functor.Product (Product (..)) import Data.Functor.Sum (Sum (..)) +import Data.Kind (Constraint, Type) import Data.Type.Equality ((:~:) (..), (:~~:) (..)) import GHC.Generics ((:*:) (..), (:+:) (..)) import qualified Type.Reflection as TR -#if __GLASGOW_HASKELL__ >= 810 -import Data.Kind (Constraint, Type) -#endif - -#if __GLASGOW_HASKELL__ >= 810 type GNFData :: (k -> Type) -> Constraint -#endif - class GNFData f where grnf :: f a -> () diff --git a/src/Data/GADT/Internal.hs b/src/Data/GADT/Internal.hs index 785ff21..89fe2b6 100644 --- a/src/Data/GADT/Internal.hs +++ b/src/Data/GADT/Internal.hs @@ -1,36 +1,29 @@ -{-# LANGUAGE CPP #-} {-# LANGUAGE GADTs #-} {-# LANGUAGE PolyKinds #-} {-# LANGUAGE RankNTypes #-} {-# LANGUAGE RoleAnnotations #-} {-# LANGUAGE Safe #-} {-# LANGUAGE ScopedTypeVariables #-} -{-# LANGUAGE TypeOperators #-} -#if __GLASGOW_HASKELL__ >= 810 {-# LANGUAGE StandaloneKindSignatures #-} -#endif +{-# LANGUAGE TypeOperators #-} module Data.GADT.Internal where import Control.Applicative (Applicative (..)) import Data.Functor.Product (Product (..)) import Data.Functor.Sum (Sum (..)) -import Data.Kind (Type) +import Data.Kind (Constraint, Type) import Data.Maybe (isJust, isNothing) import Data.Monoid (Monoid (..)) import Data.Semigroup (Semigroup (..)) import Data.Type.Equality (TestEquality (..), (:~:) (..), (:~~:) (..)) import GHC.Generics ((:*:) (..), (:+:) (..)) -import qualified Type.Reflection as TR +import Data.EqP +import Data.OrdP -#if __GLASGOW_HASKELL__ >= 810 -import Data.Kind (Constraint) -#endif - -#if MIN_VERSION_base(4,18,0) -import qualified GHC.TypeLits as TL -import qualified GHC.TypeNats as TN -#endif +import qualified GHC.TypeLits as TL +import qualified GHC.TypeNats as TN +import qualified Type.Reflection as TR -- $setup -- >>> :set -XKindSignatures -XGADTs -XTypeOperators -XStandaloneDeriving -XQuantifiedConstraints @@ -44,9 +37,7 @@ import qualified GHC.TypeNats as TN -- to write (or derive) an @instance Show (T a)@, and then simply say: -- -- > instance GShow t where gshowsPrec = defaultGshowsPrec -#if __GLASGOW_HASKELL__ >= 810 type GShow :: (k -> Type) -> Constraint -#endif class GShow t where gshowsPrec :: Int -> t a -> ShowS @@ -73,7 +64,6 @@ instance GShow ((:~~:) a) where instance GShow TR.TypeRep where gshowsPrec = showsPrec -#if MIN_VERSION_base(4,18,0) instance GShow TL.SChar where gshowsPrec = showsPrec @@ -82,7 +72,6 @@ instance GShow TL.SSymbol where instance GShow TN.SNat where gshowsPrec = showsPrec -#endif -- -- | >>> gshow (InL Refl :: Sum ((:~:) Int) ((:~:) Bool) Int) @@ -123,9 +112,7 @@ instance (GShow a, GShow b) => GShow (a :*: b) where -- |@GReadS t@ is equivalent to @ReadS (forall b. (forall a. t a -> b) -> b)@, which is -- in turn equivalent to @ReadS (Exists t)@ (with @data Exists t where Exists :: t a -> Exists t@) -#if __GLASGOW_HASKELL__ >= 810 type GReadS :: (k -> Type) -> Type -#endif type GReadS t = String -> [(Some t, String)] getGReadResult :: Some tag -> (forall a. tag a -> b) -> b @@ -137,9 +124,7 @@ mkGReadResult = mkSome -- |'Read'-like class for 1-type-parameter GADTs. Unlike 'GShow', this one cannot be -- mechanically derived from a 'Read' instance because 'greadsPrec' must choose the phantom -- type based on the 'String' being parsed. -#if __GLASGOW_HASKELL__ >= 810 type GRead :: (k -> Type) -> Constraint -#endif class GRead t where greadsPrec :: Int -> GReadS t @@ -281,10 +266,8 @@ instance (GRead a, GRead b) => GRead (a :+: b) where -- >>> (checkBwdGEq TagInt1 TagInt1, checkBwdGEq TagInt1 TagInt2, checkBwdGEq TagInt2 TagInt1, checkBwdGEq TagInt2 TagInt2) -- (True,True,True,True) -- -#if __GLASGOW_HASKELL__ >= 810 type GEq :: (k -> Type) -> Constraint -#endif -class GEq f where +class EqP f => GEq f where -- |Produce a witness of type-equality, if one exists. -- -- A handy idiom for using this would be to pattern-bind in the Maybe monad, eg.: @@ -355,7 +338,6 @@ instance (GEq a, GEq b) => GEq (a :*: b) where instance GEq TR.TypeRep where geq = testEquality -#if MIN_VERSION_base(4,18,0) instance GEq TL.SChar where geq = testEquality @@ -364,7 +346,6 @@ instance GEq TL.SSymbol where instance GEq TN.SNat where geq = testEquality -#endif ------------------------------------------------------------------------------- -- GCompare @@ -399,9 +380,7 @@ instance GEq TN.SNat where -- |A type for the result of comparing GADT constructors; the type parameters -- of the GADT values being compared are included so that in the case where -- they are equal their parameter types can be unified. -#if __GLASGOW_HASKELL__ >= 810 type GOrdering :: k -> k -> Type -#endif data GOrdering a b where GLT :: GOrdering a b GEQ :: GOrdering t t @@ -439,10 +418,8 @@ instance GRead (GOrdering a) where -- |Type class for comparable GADT-like structures. When 2 things are equal, -- must return a witness that their parameter types are equal as well ('GEQ'). -#if __GLASGOW_HASKELL__ >= 810 type GCompare :: (k -> Type) -> Constraint -#endif -class GEq f => GCompare f where +class (GEq f, OrdP f) => GCompare f where gcompare :: f a -> f b -> GOrdering a b instance GCompare ((:~:) a) where @@ -455,7 +432,6 @@ instance GCompare ((:~~:) a) where instance GCompare TR.TypeRep where gcompare = gcompareSing "TypeRep" TR.SomeTypeRep -#if MIN_VERSION_base(4,18,0) instance GCompare TL.SChar where gcompare = gcompareSing "SChar" TL.fromSChar @@ -464,7 +440,6 @@ instance GCompare TL.SSymbol where instance GCompare TN.SNat where gcompare = gcompareSing "SNat" TN.fromSNat -#endif defaultCompare :: GCompare f => f a -> f b -> Ordering defaultCompare x y = weakenOrdering (gcompare x y) @@ -567,9 +542,7 @@ instance (GCompare a, GCompare b) => GCompare (a :*: b) where -- >>> read "mkSome TagInt" :: Some Tag -- mkSome TagInt -- -#if __GLASGOW_HASKELL__ >= 810 type Some :: (k -> Type) -> Type -#endif newtype Some tag = S { -- | Eliminator. withSome :: forall r. (forall a. tag a -> r) -> r @@ -617,15 +590,15 @@ instance GRead f => Read (Some f) where , (withTag, rest') <- greadsPrec 11 rest ] -instance GEq tag => Eq (Some tag) where +instance EqP tag => Eq (Some tag) where x == y = withSome x $ \x' -> - withSome y $ \y' -> defaultEq x' y' + withSome y $ \y' -> eqp x' y' -instance GCompare tag => Ord (Some tag) where +instance OrdP tag => Ord (Some tag) where compare x y = withSome x $ \x' -> - withSome y $ \y' -> defaultCompare x' y' + withSome y $ \y' -> comparep x' y' instance Control.Applicative.Applicative m => Data.Semigroup.Semigroup (Some m) where m <> n = diff --git a/src/Data/GADT/Show.hs b/src/Data/GADT/Show.hs index 80e6f14..a4fa7b1 100644 --- a/src/Data/GADT/Show.hs +++ b/src/Data/GADT/Show.hs @@ -1,4 +1,3 @@ -{-# LANGUAGE CPP #-} {-# LANGUAGE Safe #-} module Data.GADT.Show ( -- * Showing diff --git a/src/Data/OrdP.hs b/src/Data/OrdP.hs index d68f735..78b02b5 100644 --- a/src/Data/OrdP.hs +++ b/src/Data/OrdP.hs @@ -1,28 +1,23 @@ -{-# LANGUAGE CPP #-} -{-# LANGUAGE PolyKinds #-} -{-# LANGUAGE QuantifiedConstraints #-} -{-# LANGUAGE Safe #-} -{-# LANGUAGE TypeOperators #-} -#if __GLASGOW_HASKELL__ >= 810 +{-# LANGUAGE CPP #-} +{-# LANGUAGE PolyKinds #-} +{-# LANGUAGE QuantifiedConstraints #-} +{-# LANGUAGE Safe #-} {-# LANGUAGE StandaloneKindSignatures #-} -#endif +{-# LANGUAGE TypeOperators #-} module Data.OrdP ( OrdP (..), ) where import Control.Applicative (Const (..)) -import Data.Kind (Type) +import Data.Functor.Product (Product (..)) +import Data.Functor.Sum (Sum (..)) +import Data.Kind (Constraint, Type) import Data.Proxy (Proxy (..)) -import Data.Semigroup ((<>)) import Data.Type.Equality ((:~:) (..), (:~~:) (..)) import GHC.Generics ((:*:) (..), (:+:) (..)) -#if MIN_VERSION_base(4,18,0) -import Data.Functor.Product (Product (..)) -import Data.Functor.Sum (Sum (..)) import qualified GHC.TypeLits as TL import qualified GHC.TypeNats as TN -#endif #if !MIN_VERSION_base(4,19,0) import Data.Orphans () @@ -30,9 +25,6 @@ import Data.Orphans () import qualified Type.Reflection as TR -#if __GLASGOW_HASKELL__ >= 810 -import Data.Kind (Constraint) -#endif import Data.EqP @@ -46,9 +38,7 @@ import Data.EqP -- @ -- -- @since 1.0.5 -#if __GLASGOW_HASKELL__ >= 810 type OrdP :: (k -> Type) -> Constraint -#endif class (EqP f, forall a. Ord (f a)) => OrdP (f :: k -> Type) where comparep :: f a -> f b -> Ordering @@ -58,7 +48,6 @@ instance OrdP ((:~:) a) where instance OrdP ((:~~:) a) where comparep _ _ = EQ -#if MIN_VERSION_base(4,18,0) instance (OrdP a, OrdP b) => OrdP (Sum a b) where comparep (InL x) (InL y) = comparep x y comparep (InL _) (InR _) = LT @@ -67,7 +56,6 @@ instance (OrdP a, OrdP b) => OrdP (Sum a b) where instance (OrdP a, OrdP b) => OrdP (Product a b) where comparep (Pair x y) (Pair x' y') = comparep x x' <> comparep y y' -#endif instance (OrdP f, OrdP g) => OrdP (f :+: g) where comparep (L1 x) (L1 y) = comparep x y @@ -81,7 +69,6 @@ instance (OrdP a, OrdP b) => OrdP (a :*: b) where instance OrdP TR.TypeRep where comparep x y = compare (TR.SomeTypeRep x) (TR.SomeTypeRep y) -#if MIN_VERSION_base(4,18,0) instance OrdP TL.SChar where comparep x y = compare (TL.fromSChar x) (TL.fromSChar y) @@ -90,7 +77,6 @@ instance OrdP TL.SSymbol where instance OrdP TN.SNat where comparep x y = compare (TN.fromSNat x) (TN.fromSNat y) -#endif instance OrdP Proxy where comparep _ _ = EQ diff --git a/src/Data/Some/Church.hs b/src/Data/Some/Church.hs index a54f034..52ef317 100644 --- a/src/Data/Some/Church.hs +++ b/src/Data/Some/Church.hs @@ -1,4 +1,3 @@ -{-# LANGUAGE CPP #-} {-# LANGUAGE Safe #-} module Data.Some.Church ( Some(..), diff --git a/src/Data/Some/GADT.hs b/src/Data/Some/GADT.hs index 53d6497..ea5a325 100644 --- a/src/Data/Some/GADT.hs +++ b/src/Data/Some/GADT.hs @@ -1,12 +1,9 @@ -{-# LANGUAGE CPP #-} {-# LANGUAGE GADTs #-} {-# LANGUAGE PolyKinds #-} {-# LANGUAGE RankNTypes #-} {-# LANGUAGE RoleAnnotations #-} {-# LANGUAGE Safe #-} -#if __GLASGOW_HASKELL__ >= 810 {-# LANGUAGE StandaloneKindSignatures #-} -#endif module Data.Some.GADT ( Some(Some), mkSome, @@ -19,14 +16,12 @@ module Data.Some.GADT ( import Control.Applicative (Applicative (..)) import Control.DeepSeq (NFData (..)) +import Data.Kind (Type) import Data.Monoid (Monoid (..)) import Data.Semigroup (Semigroup (..)) -#if __GLASGOW_HASKELL__ >= 810 -import Data.Kind (Type) -#endif - -import Data.GADT.Compare +import Data.EqP +import Data.OrdP import Data.GADT.DeepSeq import Data.GADT.Show @@ -78,9 +73,7 @@ import Data.GADT.Show -- >>> read "mkSome TagInt" :: Some Tag -- Some TagInt -- -#if __GLASGOW_HASKELL__ >= 810 type Some :: (k -> Type) -> Type -#endif data Some tag where Some :: tag a -> Some tag @@ -126,11 +119,11 @@ instance GRead f => Read (Some f) where , (withTag, rest') <- greadsPrec 11 rest ] -instance GEq tag => Eq (Some tag) where - Some x == Some y = defaultEq x y +instance EqP tag => Eq (Some tag) where + Some x == Some y = eqp x y -instance GCompare tag => Ord (Some tag) where - compare (Some x) (Some y) = defaultCompare x y +instance OrdP tag => Ord (Some tag) where + compare (Some x) (Some y) = comparep x y instance GNFData tag => NFData (Some tag) where rnf (Some x) = grnf x diff --git a/src/Data/Some/Newtype.hs b/src/Data/Some/Newtype.hs index 3a46a54..70fe39a 100644 --- a/src/Data/Some/Newtype.hs +++ b/src/Data/Some/Newtype.hs @@ -1,13 +1,10 @@ -{-# LANGUAGE CPP #-} -{-# LANGUAGE GADTs #-} -{-# LANGUAGE RankNTypes #-} -{-# LANGUAGE PatternSynonyms #-} -{-# LANGUAGE RoleAnnotations #-} -{-# LANGUAGE PolyKinds #-} -{-# LANGUAGE Trustworthy #-} -#if __GLASGOW_HASKELL__ >= 810 +{-# LANGUAGE GADTs #-} +{-# LANGUAGE PatternSynonyms #-} +{-# LANGUAGE PolyKinds #-} +{-# LANGUAGE RankNTypes #-} +{-# LANGUAGE RoleAnnotations #-} {-# LANGUAGE StandaloneKindSignatures #-} -#endif +{-# LANGUAGE Trustworthy #-} module Data.Some.Newtype ( Some(Some), mkSome, @@ -20,18 +17,16 @@ module Data.Some.Newtype ( import Control.Applicative (Applicative (..)) import Control.DeepSeq (NFData (..)) +import Data.Kind (Type) import Data.Monoid (Monoid (..)) import Data.Semigroup (Semigroup (..)) import GHC.Exts (Any) import Unsafe.Coerce (unsafeCoerce) -#if __GLASGOW_HASKELL__ >= 810 -import Data.Kind (Type) -#endif - -import Data.GADT.Compare +import Data.EqP import Data.GADT.DeepSeq import Data.GADT.Show +import Data.OrdP -- $setup -- >>> :set -XKindSignatures -XGADTs @@ -80,13 +75,11 @@ import Data.GADT.Show -- >>> read "mkSome TagInt" :: Some Tag -- Some TagInt -- -#if __GLASGOW_HASKELL__ >= 810 type Some :: (k -> Type) -> Type -#endif newtype Some tag = UnsafeSome (tag Any) type role Some representational - + {-# COMPLETE Some #-} pattern Some :: tag a -> Some tag pattern Some x <- UnsafeSome x @@ -132,15 +125,15 @@ instance GRead f => Read (Some f) where , (withTag, rest') <- greadsPrec 11 rest ] -instance GEq tag => Eq (Some tag) where +instance EqP tag => Eq (Some tag) where x == y = withSome x $ \x' -> - withSome y $ \y' -> defaultEq x' y' + withSome y $ \y' -> eqp x' y' -instance GCompare tag => Ord (Some tag) where +instance OrdP tag => Ord (Some tag) where compare x y = withSome x $ \x' -> - withSome y $ \y' -> defaultCompare x' y' + withSome y $ \y' -> comparep x' y' instance GNFData tag => NFData (Some tag) where rnf x = withSome x grnf