some 1.0.3 → 1.0.4
raw patch · 8 files changed
+195/−17 lines, 8 filesdep ~base
Dependency ranges changed: base
Files
- ChangeLog.md +7/−0
- some.cabal +10/−9
- src/Data/GADT/Compare.hs +1/−0
- src/Data/GADT/DeepSeq.hs +28/−0
- src/Data/GADT/Internal.hs +146/−8
- src/Data/GADT/Show.hs +1/−0
- src/Data/Some/GADT.hs +1/−0
- src/Data/Some/Newtype.hs +1/−0
ChangeLog.md view
@@ -1,3 +1,10 @@+# 1.0.4++- Add instances for `(:~~:)`+- Add instances for `:+:` and `:*:`+- Add `defaultGeq :: GCompare f => f a -> f b -> Maybe (a :~: b)`+- Add `defaultGshowsPrec :: Show (t a) => Int -> t a -> ShowS`+ # 1.0.3 - Make `GNFData` PolyKinded.
some.cabal view
@@ -1,6 +1,5 @@ name: some-version: 1.0.3-stability: provisional+version: 1.0.4 cabal-version: >=1.10 build-type: Simple author:@@ -9,7 +8,7 @@ maintainer: Oleg Grenrus <oleg.grenrus@iki.fi> license: BSD3 license-file: LICENSE-homepage: https://github.com/phadej/some+homepage: https://github.com/haskellari/some category: Data, Dependent Types synopsis: Existential type: Some description:@@ -38,6 +37,8 @@ || ==8.8.4 || ==8.10.4 || ==9.0.1+ || ==9.2.3+ || ==9.4.1 extra-source-files: ChangeLog.md @@ -50,7 +51,7 @@ source-repository head type: git- location: git://github.com/phadej/some.git+ location: git://github.com/haskellari/some.git subdir: some library@@ -72,17 +73,17 @@ other-modules: Data.GADT.Internal build-depends:- base >=4.3 && <4.16+ base >=4.3 && <4.17 , deepseq >=1.3.0.0 && <1.5 - if !impl(ghc >=7.8)+ if !impl(ghc >=8.2) build-depends: type-equality >=1 && <1.1 if !impl(ghc >=8.0) build-depends:- semigroups >=0.18.5 && <0.20- , transformers >=0.3 && <0.6- , transformers-compat >=0.6 && <0.7+ semigroups >=0.18.5 && <0.21+ , transformers >=0.3 && <0.7+ , transformers-compat >=0.6 && <0.8 if impl(ghc >=9.0) -- these flags may abort compilation with GHC-8.10
src/Data/GADT/Compare.hs view
@@ -7,6 +7,7 @@ module Data.GADT.Compare ( -- * Equality GEq (..),+ defaultGeq, defaultEq, defaultNeq, -- * Total order comparison
src/Data/GADT/DeepSeq.hs view
@@ -1,5 +1,6 @@ {-# LANGUAGE CPP #-} {-# LANGUAGE GADTs #-}+{-# LANGUAGE TypeOperators #-} #if __GLASGOW_HASKELL__ >= 706 {-# LANGUAGE PolyKinds #-} #endif@@ -19,7 +20,19 @@ import Data.Functor.Sum (Sum (..)) import Data.Type.Equality ((:~:) (..)) +#if MIN_VERSION_base(4,6,0)+import GHC.Generics ((:+:) (..), (:*:) (..))+#endif++#if MIN_VERSION_base(4,9,0) #if MIN_VERSION_base(4,10,0)+import Data.Type.Equality ((:~~:) (..))+#else+import Data.Type.Equality.Hetero ((:~~:) (..))+#endif+#endif++#if MIN_VERSION_base(4,10,0) import qualified Type.Reflection as TR #endif @@ -41,9 +54,24 @@ grnf (InL x) = grnf x grnf (InR y) = grnf y +#if MIN_VERSION_base(4,6,0)+instance (GNFData a, GNFData b) => GNFData (a :*: b) where+ grnf (a :*: b) = grnf a `seq` grnf b++instance (GNFData a, GNFData b) => GNFData (a :+: b) where+ grnf (L1 x) = grnf x+ grnf (R1 y) = grnf y+#endif+ -- | @since 1.0.3 instance GNFData ((:~:) a) where grnf Refl = ()++#if MIN_VERSION_base(4,9,0)+-- | @since 1.0.4+instance GNFData ((:~~:) a) where+ grnf HRefl = ()+#endif #if MIN_VERSION_base(4,10,0) -- | @since 1.0.3
src/Data/GADT/Internal.hs view
@@ -13,8 +13,11 @@ #if __GLASGOW_HASKELL__ >= 810 {-# LANGUAGE StandaloneKindSignatures #-} #endif+#if __GLASGOW_HASKELL__ >= 800 && __GLASGOW_HASKELL__ < 805+{-# LANGUAGE TypeInType #-}+#endif #if (__GLASGOW_HASKELL__ >= 704 && __GLASGOW_HASKELL__ < 707) || __GLASGOW_HASKELL__ >= 801-{-# LANGUAGE Safe #-}+{-# LANGUAGE Safe #-} #elif __GLASGOW_HASKELL__ >= 702 {-# LANGUAGE Trustworthy #-} #endif@@ -27,34 +30,59 @@ import Data.Monoid (Monoid (..)) import Data.Semigroup (Semigroup (..)) import Data.Type.Equality ((:~:) (..))+#if MIN_VERSION_base(4,6,0)+import GHC.Generics ((:+:) (..), (:*:) (..))+#endif #if __GLASGOW_HASKELL__ >=708 import Data.Typeable (Typeable) #endif +#if MIN_VERSION_base(4,9,0) #if MIN_VERSION_base(4,10,0)+import Data.Type.Equality ((:~~:) (..))+#else+import Data.Type.Equality.Hetero ((:~~:) (..))+#endif+#endif++#if MIN_VERSION_base(4,10,0) import Data.Type.Equality (testEquality) import qualified Type.Reflection as TR #endif +#if __GLASGOW_HASKELL__ >= 800+import Data.Kind (Type)+#endif+ #if __GLASGOW_HASKELL__ >= 810-import Data.Kind (Type, Constraint)+import Data.Kind (Constraint) #endif -- $setup--- >>> :set -XKindSignatures -XGADTs+-- >>> :set -XKindSignatures -XGADTs -XTypeOperators+-- >>> import Data.Type.Equality+-- >>> import Data.Functor.Sum+-- >>> import GHC.Generics -- |'Show'-like class for 1-type-parameter GADTs. @GShow t => ...@ is equivalent to something -- like @(forall a. Show (t a)) => ...@. The easiest way to create instances would probably be -- to write (or derive) an @instance Show (T a)@, and then simply say: ----- > instance GShow t where gshowsPrec = showsPrec+-- > 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 +-- |If 'f' has a 'Show (f a)' instance, this function makes a suitable default+-- implementation of 'gshowsPrec'.+--+-- @since 1.0.4+defaultGshowsPrec :: Show (t a) => Int -> t a -> ShowS+defaultGshowsPrec = showsPrec+ gshows :: GShow t => t a -> ShowS gshows = gshowsPrec (-1) @@ -64,6 +92,12 @@ instance GShow ((:~:) a) where gshowsPrec _ Refl = showString "Refl" +#if MIN_VERSION_base(4,9,0)+-- | @since 1.0.4+instance GShow ((:~~:) a) where+ gshowsPrec _ HRefl = showString "HRefl"+#endif+ #if MIN_VERSION_base(4,10,0) instance GShow TR.TypeRep where gshowsPrec = showsPrec@@ -86,6 +120,28 @@ . showChar ' ' . gshowsPrec 11 y +#if MIN_VERSION_base(4,6,0)+--+-- | >>> gshow (L1 Refl :: ((:~:) Int :+: (:~:) Bool) Int)+-- "L1 Refl"+--+-- @since 1.0.4+instance (GShow a, GShow b) => GShow (a :+: b) where+ gshowsPrec d = \s -> case s of+ L1 x -> showParen (d > 10) (showString "L1 " . gshowsPrec 11 x)+ R1 x -> showParen (d > 10) (showString "R1 " . gshowsPrec 11 x)++-- | >>> gshow (Pair Refl Refl :: Product ((:~:) Int) ((:~:) Int) Int)+-- "Refl :*: Refl"+--+-- @since 1.0.4+instance (GShow a, GShow b) => GShow (a :*: b) where+ gshowsPrec d (x :*: y) = showParen (d > 6)+ $ gshowsPrec 6 x+ . showString " :*: "+ . gshowsPrec 6 y+#endif+ -- |@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@@ -121,6 +177,9 @@ -- >>> greadMaybe "InL Refl" mkSome :: Maybe (Some (Sum ((:~:) Int) ((:~:) Bool))) -- Just (mkSome (InL Refl)) --+-- >>> greadMaybe "L1 Refl" mkSome :: Maybe (Some ((:~:) Int :+: (:~:) Bool))+-- Just (mkSome (L1 Refl))+-- -- >>> greadMaybe "garbage" mkSome :: Maybe (Some ((:~:) Int)) -- Nothing --@@ -130,11 +189,20 @@ _ -> Nothing instance GRead ((:~:) a) where- greadsPrec p s = readsPrec p s >>= f- where- f :: forall x. (x :~: x, String) -> [(Some ((:~:) x), String)]- f (Refl, rest) = return (mkSome Refl, rest)+ greadsPrec _ = readParen False (\s ->+ [ (S $ \k -> k (Refl :: a :~: a), t)+ | ("Refl", t) <- lex s+ ]) +#if MIN_VERSION_base(4,9,0)+-- | @since 1.0.4+instance k1 ~ k2 => GRead ((:~~:) (a :: k1) :: k2 -> Type) where+ greadsPrec _ = readParen False (\s ->+ [ (S $ \k -> k (HRefl :: a :~~: a), t)+ | ("HRefl", t) <- lex s+ ])+#endif+ instance (GRead a, GRead b) => GRead (Sum a b) where greadsPrec d s = readParen (d > 10)@@ -147,6 +215,21 @@ | ("InR", s2) <- lex s1 , (r, t) <- greadsPrec 11 s2 ]) s +#if MIN_VERSION_base(4,6,0)+-- | @since 1.0.4+instance (GRead a, GRead b) => GRead (a :+: b) where+ greadsPrec d s =+ readParen (d > 10)+ (\s1 -> [ (S $ \k -> withSome r (k . L1), t)+ | ("L1", s2) <- lex s1+ , (r, t) <- greadsPrec 11 s2 ]) s+ +++ readParen (d > 10)+ (\s1 -> [ (S $ \k -> withSome r (k . R1), t)+ | ("R1", s2) <- lex s1+ , (r, t) <- greadsPrec 11 s2 ]) s+#endif+ ------------------------------------------------------------------------------- -- GEq -------------------------------------------------------------------------------@@ -175,6 +258,15 @@ -- (Making use of the 'DSum' type from <https://hackage.haskell.org/package/dependent-sum/docs/Data-Dependent-Sum.html Data.Dependent.Sum> in both examples) geq :: f a -> f b -> Maybe (a :~: b) +-- |If 'f' has a 'GCompare' instance, this function makes a suitable default+-- implementation of 'geq'.+--+-- @since 1.0.4+defaultGeq :: GCompare f => f a -> f b -> Maybe (a :~: b)+defaultGeq a b = case gcompare a b of+ GEQ -> Just Refl+ _ -> Nothing+ -- |If 'f' has a 'GEq' instance, this function makes a suitable default -- implementation of '(==)'. defaultEq :: GEq f => f a -> f b -> Bool@@ -188,6 +280,12 @@ instance GEq ((:~:) a) where geq (Refl :: a :~: b) (Refl :: a :~: c) = Just (Refl :: b :~: c) +#if MIN_VERSION_base(4,9,0)+-- | @since 1.0.4+instance GEq ((:~~:) a) where+ geq (HRefl :: a :~~: b) (HRefl :: a :~~: c) = Just (Refl :: b :~: c)+#endif+ instance (GEq a, GEq b) => GEq (Sum a b) where geq (InL x) (InL y) = geq x y geq (InR x) (InR y) = geq x y@@ -199,6 +297,21 @@ Refl <- geq y y' return Refl +#if MIN_VERSION_base(4,6,0)+-- | @since 1.0.4+instance (GEq f, GEq g) => GEq (f :+: g) where+ geq (L1 x) (L1 y) = geq x y+ geq (R1 x) (R1 y) = geq x y+ geq _ _ = Nothing++-- | @since 1.0.4+instance (GEq a, GEq b) => GEq (a :*: b) where+ geq (x :*: y) (x' :*: y') = do+ Refl <- geq x x'+ Refl <- geq y y'+ return Refl+#endif+ #if MIN_VERSION_base(4,10,0) instance GEq TR.TypeRep where geq = testEquality@@ -289,6 +402,12 @@ instance GCompare ((:~:) a) where gcompare Refl Refl = GEQ +#if MIN_VERSION_base(4,9,0)+-- | @since 1.0.4+instance GCompare ((:~~:) a) where+ gcompare HRefl HRefl = GEQ+#endif+ #if MIN_VERSION_base(4,10,0) instance GCompare TR.TypeRep where gcompare t1 t2 =@@ -320,6 +439,25 @@ GLT -> GLT GEQ -> GEQ GGT -> GGT++#if MIN_VERSION_base(4,6,0)+-- | @since 1.0.4+instance (GCompare f, GCompare g) => GCompare (f :+: g) where+ gcompare (L1 x) (L1 y) = gcompare x y+ gcompare (L1 _) (R1 _) = GLT+ gcompare (R1 _) (L1 _) = GGT+ gcompare (R1 x) (R1 y) = gcompare x y++-- | @since 1.0.4+instance (GCompare a, GCompare b) => GCompare (a :*: b) where+ gcompare (x :*: y) (x' :*: y') = case gcompare x x' of+ GLT -> GLT+ GGT -> GGT+ GEQ -> case gcompare y y' of+ GLT -> GLT+ GEQ -> GEQ+ GGT -> GGT+#endif ------------------------------------------------------------------------------- -- Some
src/Data/GADT/Show.hs view
@@ -7,6 +7,7 @@ module Data.GADT.Show ( -- * Showing GShow (..),+ defaultGshowsPrec, gshows, gshow, -- * Reading
src/Data/Some/GADT.hs view
@@ -41,6 +41,7 @@ -- $setup -- >>> :set -XKindSignatures -XGADTs+-- >>> import Data.GADT.Show -- | Existential. This is type is useful to hide GADTs' parameters. --
src/Data/Some/Newtype.hs view
@@ -47,6 +47,7 @@ -- $setup -- >>> :set -XKindSignatures -XGADTs+-- >>> import Data.GADT.Show -- | Existential. This is type is useful to hide GADTs' parameters. --