some 1.0.5 → 1.0.6
raw patch · 5 files changed
+112/−14 lines, 5 filesdep +base-orphansdep ~base
Dependencies added: base-orphans
Dependency ranges changed: base
Files
- ChangeLog.md +4/−0
- some.cabal +15/−4
- src/Data/EqP.hs +17/−0
- src/Data/GADT/Internal.hs +59/−10
- src/Data/OrdP.hs +17/−0
ChangeLog.md view
@@ -1,3 +1,7 @@+# 1.0.6++- Add instances for `SSymbol`, `SNat` and `SChar` from `base >=4.18.0.0'+ # 1.0.5 - Add EqP and OrdP classes.
some.cabal view
@@ -1,5 +1,5 @@ name: some-version: 1.0.5+version: 1.0.6 cabal-version: >=1.10 build-type: Simple author:@@ -24,7 +24,14 @@ 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.7|| ==9.4.4 || ==9.6.1+ GHC ==8.6.5+ || ==8.8.4+ || ==8.10.4+ || ==9.0.2+ || ==9.2.8+ || ==9.4.7+ || ==9.6.3+ || ==9.8.1 extra-source-files: ChangeLog.md @@ -61,8 +68,12 @@ other-modules: Data.GADT.Internal build-depends:- base >=4.12 && <4.19- , deepseq >=1.4.4.0 && <1.5+ base >=4.12 && <4.20+ , deepseq >=1.4.4.0 && <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
src/Data/EqP.hs view
@@ -20,8 +20,14 @@ #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 ()+#endif+ import qualified Type.Reflection as TR #if __GLASGOW_HASKELL__ >= 810@@ -87,6 +93,17 @@ 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++instance EqP TL.SSymbol where+ eqp x y = TL.fromSSymbol x == TL.fromSSymbol y++instance EqP TN.SNat where+ eqp x y = TN.fromSNat x == TN.fromSNat y+#endif instance EqP Proxy where eqp _ _ = True
src/Data/GADT/Internal.hs view
@@ -27,6 +27,11 @@ 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+ -- $setup -- >>> :set -XKindSignatures -XGADTs -XTypeOperators -XStandaloneDeriving -XQuantifiedConstraints -- >>> import Data.Type.Equality@@ -68,6 +73,17 @@ instance GShow TR.TypeRep where gshowsPrec = showsPrec +#if MIN_VERSION_base(4,18,0)+instance GShow TL.SChar where+ gshowsPrec = showsPrec++instance GShow TL.SSymbol where+ gshowsPrec = showsPrec++instance GShow TN.SNat where+ gshowsPrec = showsPrec+#endif+ -- -- | >>> gshow (InL Refl :: Sum ((:~:) Int) ((:~:) Bool) Int) -- "InL Refl"@@ -339,6 +355,17 @@ instance GEq TR.TypeRep where geq = testEquality +#if MIN_VERSION_base(4,18,0)+instance GEq TL.SChar where+ geq = testEquality++instance GEq TL.SSymbol where+ geq = testEquality++instance GEq TN.SNat where+ geq = testEquality+#endif+ ------------------------------------------------------------------------------- -- GCompare -------------------------------------------------------------------------------@@ -426,19 +453,41 @@ gcompare HRefl HRefl = GEQ instance GCompare TR.TypeRep where- gcompare t1 t2 =- case testEquality t1 t2 of- Just Refl -> GEQ- Nothing ->- case compare (TR.SomeTypeRep t1) (TR.SomeTypeRep t2) of- LT -> GLT- GT -> GGT- EQ -> error "impossible: 'testEquality' and 'compare' \- \are inconsistent for TypeRep; report this \- \as a GHC bug"+ gcompare = gcompareSing "TypeRep" TR.SomeTypeRep +#if MIN_VERSION_base(4,18,0)+instance GCompare TL.SChar where+ gcompare = gcompareSing "SChar" TL.fromSChar++instance GCompare TL.SSymbol where+ gcompare = gcompareSing "SSymbol" TL.fromSSymbol++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)++-- | An implementation of 'gcompare' for a singleton type.+gcompareSing :: (TestEquality f, Ord c)+ => String+ -- ^ The name of the singleton type.+ -- (Only used for error message purposes.)+ -> (forall x. f x -> c)+ -- ^ How to turn the singleton type into a value that can be+ -- compared with 'Ord'.+ -> f a -> f b -> GOrdering a b+gcompareSing singName toOrd t1 t2 =+ case testEquality t1 t2 of+ Just Refl -> GEQ+ Nothing ->+ case compare (toOrd t1) (toOrd t2) of+ LT -> GLT+ GT -> GGT+ EQ -> error $ "impossible: 'testEquality' and 'compare' are inconsistent for "+ ++ singName+ ++ "; report this as a GHC bug" instance (GCompare a, GCompare b) => GCompare (Sum a b) where gcompare (InL x) (InL y) = gcompare x y
src/Data/OrdP.hs view
@@ -20,8 +20,14 @@ #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 ()+#endif+ import qualified Type.Reflection as TR #if __GLASGOW_HASKELL__ >= 810@@ -74,6 +80,17 @@ 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)++instance OrdP TL.SSymbol where+ comparep x y = compare (TL.fromSSymbol x) (TL.fromSSymbol y)++instance OrdP TN.SNat where+ comparep x y = compare (TN.fromSNat x) (TN.fromSNat y)+#endif instance OrdP Proxy where comparep _ _ = EQ