11{-# LANGUAGE CPP #-}
22{-# LANGUAGE DeriveDataTypeable #-}
33{-# LANGUAGE GADTs #-}
4+ {-# LANGUAGE QuantifiedConstraints #-}
45{-# LANGUAGE RankNTypes #-}
56{-# LANGUAGE ScopedTypeVariables #-}
67{-# LANGUAGE TypeOperators #-}
7- #if __GLASGOW_HASKELL__ >= 706
88{-# LANGUAGE PolyKinds #-}
9- #endif
10- #if __GLASGOW_HASKELL__ >= 708
119{-# LANGUAGE RoleAnnotations #-}
12- #endif
1310#if __GLASGOW_HASKELL__ >= 810
1411{-# LANGUAGE StandaloneKindSignatures #-}
1512#endif
1613#if __GLASGOW_HASKELL__ >= 800 && __GLASGOW_HASKELL__ < 805
1714{-# LANGUAGE TypeInType #-}
1815#endif
19- #if (__GLASGOW_HASKELL__ >= 704 && __GLASGOW_HASKELL__ < 707) || __GLASGOW_HASKELL__ >= 801
20- {-# LANGUAGE Safe #-}
21- #elif __GLASGOW_HASKELL__ >= 702
22- {-# LANGUAGE Trustworthy #-}
23- #endif
16+ {-# LANGUAGE StandaloneDeriving #-}
17+ {-# LANGUAGE Safe #-}
18+
19+ -- For GShow
20+ {-# LANGUAGE FlexibleInstances #-}
21+ {-# LANGUAGE UndecidableInstances #-}
22+
2423module Data.GADT.Internal where
2524
2625import Control.Applicative (Applicative (.. ))
@@ -34,9 +33,7 @@ import Data.Type.Equality ((:~:) (..))
3433import GHC.Generics ((:+:) (.. ), (:*:) (.. ))
3534#endif
3635
37- #if __GLASGOW_HASKELL__ >=708
3836import Data.Typeable (Typeable )
39- #endif
4037
4138#if MIN_VERSION_base(4,9,0)
4239#if MIN_VERSION_base(4,10,0)
@@ -59,6 +56,7 @@ import Data.Kind (Type)
5956import Data.Kind (Constraint )
6057#endif
6158
59+ {-# DEPRECATED GShow "Just use the underlying quantified constraint" #-}
6260-- $setup
6361-- >>> :set -XKindSignatures -XGADTs -XTypeOperators
6462-- >>> import Data.Type.Equality
@@ -69,12 +67,12 @@ import Data.Kind (Constraint)
6967-- like @(forall a. Show (t a)) => ...@. The easiest way to create instances would probably be
7068-- to write (or derive) an @instance Show (T a)@, and then simply say:
7169--
72- -- > instance GShow t where gshowsPrec = defaultGshowsPrec
73- #if __GLASGOW_HASKELL__ >= 810
74- type GShow :: ( k -> Type ) -> Constraint
75- #endif
76- class GShow t where
77- gshowsPrec :: Int -> t a -> ShowS
70+ -- > instance GShow t
71+ class ( forall a . Show ( t a )) => GShow t
72+ instance ( forall a . Show ( t a )) => GShow t
73+
74+ gshowsPrec :: GShow t => Int -> t a -> ShowS
75+ gshowsPrec = showsPrec
7876
7977-- | If 'f' has a 'Show (f a)' instance, this function makes a suitable default
8078-- implementation of 'gshowsPrec'.
@@ -89,59 +87,6 @@ gshows = gshowsPrec (-1)
8987gshow :: (GShow t ) => t a -> String
9088gshow x = gshows x " "
9189
92- instance GShow ((:~: ) a ) where
93- gshowsPrec _ Refl = showString " Refl"
94-
95- #if MIN_VERSION_base(4,9,0)
96- -- | @since 1.0.4
97- instance GShow ((:~~: ) a ) where
98- gshowsPrec _ HRefl = showString " HRefl"
99- #endif
100-
101- #if MIN_VERSION_base(4,10,0)
102- instance GShow TR. TypeRep where
103- gshowsPrec = showsPrec
104- #endif
105-
106- --
107- -- | >>> gshow (InL Refl :: Sum ((:~:) Int) ((:~:) Bool) Int)
108- -- "InL Refl"
109- instance (GShow a , GShow b ) => GShow (Sum a b ) where
110- gshowsPrec d = \ s -> case s of
111- InL x -> showParen (d > 10 ) (showString " InL " . gshowsPrec 11 x)
112- InR x -> showParen (d > 10 ) (showString " InR " . gshowsPrec 11 x)
113-
114- -- | >>> gshow (Pair Refl Refl :: Product ((:~:) Int) ((:~:) Int) Int)
115- -- "Pair Refl Refl"
116- instance (GShow a , GShow b ) => GShow (Product a b ) where
117- gshowsPrec d (Pair x y) = showParen (d > 10 )
118- $ showString " Pair "
119- . gshowsPrec 11 x
120- . showChar ' '
121- . gshowsPrec 11 y
122-
123- #if MIN_VERSION_base(4,6,0)
124- --
125- -- | >>> gshow (L1 Refl :: ((:~:) Int :+: (:~:) Bool) Int)
126- -- "L1 Refl"
127- --
128- -- @since 1.0.4
129- instance (GShow a , GShow b ) => GShow (a :+: b ) where
130- gshowsPrec d = \ s -> case s of
131- L1 x -> showParen (d > 10 ) (showString " L1 " . gshowsPrec 11 x)
132- R1 x -> showParen (d > 10 ) (showString " R1 " . gshowsPrec 11 x)
133-
134- -- | >>> gshow (Pair Refl Refl :: Product ((:~:) Int) ((:~:) Int) Int)
135- -- "Refl :*: Refl"
136- --
137- -- @since 1.0.4
138- instance (GShow a , GShow b ) => GShow (a :*: b ) where
139- gshowsPrec d (x :*: y) = showParen (d > 6 )
140- $ gshowsPrec 6 x
141- . showString " :*: "
142- . gshowsPrec 6 y
143- #endif
144-
14590-- | @GReadS t@ is equivalent to @ReadS (forall b. (forall a. t a -> b) -> b)@, which is
14691-- in turn equivalent to @ReadS (Exists t)@ (with @data Exists t where Exists :: t a -> Exists t@)
14792#if __GLASGOW_HASKELL__ >= 810
@@ -164,6 +109,9 @@ type GRead :: (k -> Type) -> Constraint
164109class GRead t where
165110 greadsPrec :: Int -> GReadS t
166111
112+ -- (forall a. Read (t a)) =>
113+ -- Skipping because it is rather misleading to use.
114+
167115greads :: GRead t => GReadS t
168116greads = greadsPrec (- 1 )
169117
@@ -240,7 +188,7 @@ instance (GRead a, GRead b) => GRead (a :+: b) where
240188#if __GLASGOW_HASKELL__ >= 810
241189type GEq :: (k -> Type ) -> Constraint
242190#endif
243- class GEq f where
191+ class ( forall a . Eq ( f a )) => GEq f where
244192 -- | Produce a witness of type-equality, if one exists.
245193 --
246194 -- A handy idiom for using this would be to pattern-bind in the Maybe monad, eg.:
@@ -357,9 +305,21 @@ data GOrdering a b where
357305 GLT :: GOrdering a b
358306 GEQ :: GOrdering t t
359307 GGT :: GOrdering a b
360- #if __GLASGOW_HASKELL__ >=708
361308 deriving Typeable
362- #endif
309+
310+ deriving instance Eq (GOrdering a b )
311+ deriving instance Ord (GOrdering a b )
312+ deriving instance Show (GOrdering a b )
313+
314+ {-
315+ instance Read (GOrdering a b) where
316+ readsPrec _ s = case con of
317+ "GGT" -> [(GGT, rest)]
318+ "GEQ" -> [] -- cannot read without evidence of equality
319+ "GLT" -> [(GLT, rest)]
320+ _ -> []
321+ where (con, rest) = splitAt 3 s
322+ -}
363323
364324-- | TODO: Think of a better name
365325--
@@ -369,20 +329,6 @@ weakenOrdering GLT = LT
369329weakenOrdering GEQ = EQ
370330weakenOrdering GGT = GT
371331
372- instance Eq (GOrdering a b ) where
373- x == y = weakenOrdering x == weakenOrdering y
374-
375- instance Ord (GOrdering a b ) where
376- compare x y = compare (weakenOrdering x) (weakenOrdering y)
377-
378- instance Show (GOrdering a b ) where
379- showsPrec _ GGT = showString " GGT"
380- showsPrec _ GEQ = showString " GEQ"
381- showsPrec _ GLT = showString " GLT"
382-
383- instance GShow (GOrdering a ) where
384- gshowsPrec = showsPrec
385-
386332instance GRead (GOrdering a ) where
387333 greadsPrec _ s = case con of
388334 " GGT" -> [(mkSome GGT , rest)]
@@ -396,7 +342,7 @@ instance GRead (GOrdering a) where
396342#if __GLASGOW_HASKELL__ >= 810
397343type GCompare :: (k -> Type ) -> Constraint
398344#endif
399- class GEq f => GCompare f where
345+ class ( GEq f , forall a . Ord ( f a )) => GCompare f where
400346 gcompare :: f a -> f b -> GOrdering a b
401347
402348instance GCompare ((:~: ) a ) where
@@ -513,9 +459,7 @@ newtype Some tag = S
513459 withSome :: forall r . (forall a . tag a -> r ) -> r
514460 }
515461
516- #if __GLASGOW_HASKELL__ >= 708
517462type role Some representational
518- #endif
519463
520464-- | Constructor.
521465mkSome :: tag a -> Some tag
0 commit comments