Skip to content

Commit 18e1b46

Browse files
committed
WIP: Add quantified constraint superclasses
This will not work unless haskell/core-libraries-committee#10 is accepted.
1 parent 05fc62a commit 18e1b46

File tree

10 files changed

+35
-168
lines changed

10 files changed

+35
-168
lines changed

.github/workflows/haskell-ci.yml

Lines changed: 0 additions & 45 deletions
Original file line numberDiff line numberDiff line change
@@ -55,51 +55,6 @@ jobs:
5555
compilerVersion: 8.6.5
5656
setup-method: hvr-ppa
5757
allow-failure: false
58-
- compiler: ghc-8.4.4
59-
compilerKind: ghc
60-
compilerVersion: 8.4.4
61-
setup-method: hvr-ppa
62-
allow-failure: false
63-
- compiler: ghc-8.2.2
64-
compilerKind: ghc
65-
compilerVersion: 8.2.2
66-
setup-method: hvr-ppa
67-
allow-failure: false
68-
- compiler: ghc-8.0.2
69-
compilerKind: ghc
70-
compilerVersion: 8.0.2
71-
setup-method: hvr-ppa
72-
allow-failure: false
73-
- compiler: ghc-7.10.3
74-
compilerKind: ghc
75-
compilerVersion: 7.10.3
76-
setup-method: hvr-ppa
77-
allow-failure: false
78-
- compiler: ghc-7.8.4
79-
compilerKind: ghc
80-
compilerVersion: 7.8.4
81-
setup-method: hvr-ppa
82-
allow-failure: false
83-
- compiler: ghc-7.6.3
84-
compilerKind: ghc
85-
compilerVersion: 7.6.3
86-
setup-method: hvr-ppa
87-
allow-failure: false
88-
- compiler: ghc-7.4.2
89-
compilerKind: ghc
90-
compilerVersion: 7.4.2
91-
setup-method: hvr-ppa
92-
allow-failure: false
93-
- compiler: ghc-7.2.2
94-
compilerKind: ghc
95-
compilerVersion: 7.2.2
96-
setup-method: hvr-ppa
97-
allow-failure: false
98-
- compiler: ghc-7.0.4
99-
compilerKind: ghc
100-
compilerVersion: 7.0.4
101-
setup-method: hvr-ppa
102-
allow-failure: false
10358
fail-fast: false
10459
steps:
10560
- name: apt

some.cabal

Lines changed: 3 additions & 12 deletions
Original file line numberDiff line numberDiff line change
@@ -1,5 +1,5 @@
11
name: some
2-
version: 1.0.3
2+
version: 1.1.0
33
x-revision: 2
44
stability: provisional
55
cabal-version: >=1.10
@@ -26,16 +26,7 @@ description:
2626
If you are unsure which variant to use, use the one in "Data.Some" module.
2727

2828
tested-with:
29-
GHC ==7.0.4
30-
|| ==7.2.2
31-
|| ==7.4.2
32-
|| ==7.6.3
33-
|| ==7.8.4
34-
|| ==7.10.3
35-
|| ==8.0.2
36-
|| ==8.2.2
37-
|| ==8.4.4
38-
|| ==8.6.5
29+
GHC ==8.6.5
3930
|| ==8.8.4
4031
|| ==8.10.4
4132
|| ==9.0.1
@@ -74,7 +65,7 @@ library
7465

7566
other-modules: Data.GADT.Internal
7667
build-depends:
77-
base >=4.3 && <4.17
68+
base >=4.12 && <4.17
7869
, deepseq >=1.3.0.0 && <1.5
7970

8071
if !impl(ghc >=7.8)

src/Data/GADT/Compare.hs

Lines changed: 0 additions & 4 deletions
Original file line numberDiff line numberDiff line change
@@ -1,9 +1,5 @@
11
{-# LANGUAGE CPP #-}
2-
#if __GLASGOW_HASKELL__ >= 704
32
{-# LANGUAGE Safe #-}
4-
#elif __GLASGOW_HASKELL__ >= 702
5-
{-# LANGUAGE Trustworthy #-}
6-
#endif
73
module Data.GADT.Compare (
84
-- * Equality
95
GEq (..),

src/Data/GADT/DeepSeq.hs

Lines changed: 0 additions & 6 deletions
Original file line numberDiff line numberDiff line change
@@ -1,16 +1,10 @@
11
{-# LANGUAGE CPP #-}
22
{-# LANGUAGE GADTs #-}
3-
#if __GLASGOW_HASKELL__ >= 706
43
{-# LANGUAGE PolyKinds #-}
5-
#endif
64
#if __GLASGOW_HASKELL__ >= 810
75
{-# LANGUAGE StandaloneKindSignatures #-}
86
#endif
9-
#if (__GLASGOW_HASKELL__ >= 704 && __GLASGOW_HASKELL__ < 707) || __GLASGOW_HASKELL__ >= 801
107
{-# LANGUAGE Safe #-}
11-
#elif __GLASGOW_HASKELL__ >= 702
12-
{-# LANGUAGE Trustworthy #-}
13-
#endif
148
module Data.GADT.DeepSeq (
159
GNFData (..),
1610
) where

src/Data/GADT/Internal.hs

Lines changed: 31 additions & 64 deletions
Original file line numberDiff line numberDiff line change
@@ -1,23 +1,22 @@
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
16-
#if (__GLASGOW_HASKELL__ >= 704 && __GLASGOW_HASKELL__ < 707) || __GLASGOW_HASKELL__ >= 801
13+
{-# LANGUAGE StandaloneDeriving #-}
1714
{-# LANGUAGE Safe #-}
18-
#elif __GLASGOW_HASKELL__ >= 702
19-
{-# LANGUAGE Trustworthy #-}
20-
#endif
15+
16+
-- For GShow
17+
{-# LANGUAGE FlexibleInstances #-}
18+
{-# LANGUAGE UndecidableInstances #-}
19+
2120
module Data.GADT.Internal where
2221

2322
import Control.Applicative (Applicative (..))
@@ -28,9 +27,7 @@ import Data.Monoid (Monoid (..))
2827
import Data.Semigroup (Semigroup (..))
2928
import Data.Type.Equality ((:~:) (..))
3029

31-
#if __GLASGOW_HASKELL__ >=708
3230
import Data.Typeable (Typeable)
33-
#endif
3431

3532
#if MIN_VERSION_base(4,10,0)
3633
import Data.Type.Equality (testEquality)
@@ -41,6 +38,7 @@ import qualified Type.Reflection as TR
4138
import Data.Kind (Type, Constraint)
4239
#endif
4340

41+
{-# DEPRECATED GShow "Just use the underlying quantified constraint" #-}
4442
-- $setup
4543
-- >>> :set -XKindSignatures -XGADTs
4644

@@ -49,48 +47,18 @@ import Data.Kind (Type, Constraint)
4947
-- to write (or derive) an @instance Show (T a)@, and then simply say:
5048
--
5149
-- > instance GShow t where gshowsPrec = showsPrec
52-
#if __GLASGOW_HASKELL__ >= 810
53-
type GShow :: (k -> Type) -> Constraint
54-
#endif
55-
class GShow t where
56-
gshowsPrec :: Int -> t a -> ShowS
50+
class (forall a. Show (t a)) => GShow t
51+
instance (forall a. Show (t a)) => GShow t
5752

58-
-- |If 'f' has a 'Show (f a)' instance, this function makes a suitable default
59-
-- implementation of 'gshowsPrec'.
60-
defaultGshowsPrec :: Show (t a) => Int -> t a -> ShowS
61-
defaultGshowsPrec = showsPrec
53+
gshowsPrec :: GShow t => Int -> t a -> ShowS
54+
gshowsPrec = showsPrec
6255

6356
gshows :: GShow t => t a -> ShowS
6457
gshows = gshowsPrec (-1)
6558

6659
gshow :: (GShow t) => t a -> String
6760
gshow x = gshows x ""
6861

69-
instance GShow ((:~:) a) where
70-
gshowsPrec _ Refl = showString "Refl"
71-
72-
#if MIN_VERSION_base(4,10,0)
73-
instance GShow TR.TypeRep where
74-
gshowsPrec = showsPrec
75-
#endif
76-
77-
--
78-
-- | >>> gshow (InL Refl :: Sum ((:~:) Int) ((:~:) Bool) Int)
79-
-- "InL Refl"
80-
instance (GShow a, GShow b) => GShow (Sum a b) where
81-
gshowsPrec d = \s -> case s of
82-
InL x -> showParen (d > 10) (showString "InL " . gshowsPrec 11 x)
83-
InR x -> showParen (d > 10) (showString "InR " . gshowsPrec 11 x)
84-
85-
-- | >>> gshow (Pair Refl Refl :: Product ((:~:) Int) ((:~:) Int) Int)
86-
-- "Pair Refl Refl"
87-
instance (GShow a, GShow b) => GShow (Product a b) where
88-
gshowsPrec d (Pair x y) = showParen (d > 10)
89-
$ showString "Pair "
90-
. gshowsPrec 11 x
91-
. showChar ' '
92-
. gshowsPrec 11 y
93-
9462
-- |@GReadS t@ is equivalent to @ReadS (forall b. (forall a. t a -> b) -> b)@, which is
9563
-- in turn equivalent to @ReadS (Exists t)@ (with @data Exists t where Exists :: t a -> Exists t@)
9664
#if __GLASGOW_HASKELL__ >= 810
@@ -113,6 +81,9 @@ type GRead :: (k -> Type) -> Constraint
11381
class GRead t where
11482
greadsPrec :: Int -> GReadS t
11583

84+
-- (forall a. Read (t a)) =>
85+
-- Skipping because it is rather misleading to use.
86+
11687
greads :: GRead t => GReadS t
11788
greads = greadsPrec (-1)
11889

@@ -162,7 +133,7 @@ instance (GRead a, GRead b) => GRead (Sum a b) where
162133
#if __GLASGOW_HASKELL__ >= 810
163134
type GEq :: (k -> Type) -> Constraint
164135
#endif
165-
class GEq f where
136+
class (forall a. Eq (f a)) => GEq f where
166137
-- |Produce a witness of type-equality, if one exists.
167138
--
168139
-- A handy idiom for using this would be to pattern-bind in the Maybe monad, eg.:
@@ -249,9 +220,21 @@ data GOrdering a b where
249220
GLT :: GOrdering a b
250221
GEQ :: GOrdering t t
251222
GGT :: GOrdering a b
252-
#if __GLASGOW_HASKELL__ >=708
253223
deriving Typeable
254-
#endif
224+
225+
deriving instance Eq (GOrdering a b)
226+
deriving instance Ord (GOrdering a b)
227+
deriving instance Show (GOrdering a b)
228+
229+
{-
230+
instance Read (GOrdering a b) where
231+
readsPrec _ s = case con of
232+
"GGT" -> [(GGT, rest)]
233+
"GEQ" -> [] -- cannot read without evidence of equality
234+
"GLT" -> [(GLT, rest)]
235+
_ -> []
236+
where (con, rest) = splitAt 3 s
237+
-}
255238

256239
-- |TODO: Think of a better name
257240
--
@@ -261,20 +244,6 @@ weakenOrdering GLT = LT
261244
weakenOrdering GEQ = EQ
262245
weakenOrdering GGT = GT
263246

264-
instance Eq (GOrdering a b) where
265-
x == y = weakenOrdering x == weakenOrdering y
266-
267-
instance Ord (GOrdering a b) where
268-
compare x y = compare (weakenOrdering x) (weakenOrdering y)
269-
270-
instance Show (GOrdering a b) where
271-
showsPrec _ GGT = showString "GGT"
272-
showsPrec _ GEQ = showString "GEQ"
273-
showsPrec _ GLT = showString "GLT"
274-
275-
instance GShow (GOrdering a) where
276-
gshowsPrec = showsPrec
277-
278247
instance GRead (GOrdering a) where
279248
greadsPrec _ s = case con of
280249
"GGT" -> [(mkSome GGT, rest)]
@@ -288,7 +257,7 @@ instance GRead (GOrdering a) where
288257
#if __GLASGOW_HASKELL__ >= 810
289258
type GCompare :: (k -> Type) -> Constraint
290259
#endif
291-
class GEq f => GCompare f where
260+
class (GEq f, forall a. Ord (f a)) => GCompare f where
292261
gcompare :: f a -> f b -> GOrdering a b
293262

294263
instance GCompare ((:~:) a) where
@@ -380,9 +349,7 @@ newtype Some tag = S
380349
withSome :: forall r. (forall a. tag a -> r) -> r
381350
}
382351

383-
#if __GLASGOW_HASKELL__ >= 708
384352
type role Some representational
385-
#endif
386353

387354
-- | Constructor.
388355
mkSome :: tag a -> Some tag

src/Data/GADT/Show.hs

Lines changed: 0 additions & 4 deletions
Original file line numberDiff line numberDiff line change
@@ -1,9 +1,5 @@
11
{-# LANGUAGE CPP #-}
2-
#if __GLASGOW_HASKELL__ >= 704
32
{-# LANGUAGE Safe #-}
4-
#elif __GLASGOW_HASKELL__ >= 702
5-
{-# LANGUAGE Trustworthy #-}
6-
#endif
73
module Data.GADT.Show (
84
-- * Showing
95
GShow (..),

src/Data/Some.hs

Lines changed: 0 additions & 8 deletions
Original file line numberDiff line numberDiff line change
@@ -1,18 +1,10 @@
11
{-# LANGUAGE CPP #-}
2-
#if __GLASGOW_HASKELL__ >= 704
32
{-# LANGUAGE Safe #-}
4-
#elif __GLASGOW_HASKELL__ >= 702
5-
{-# LANGUAGE Trustworthy #-}
6-
#endif
73
-- | An existential type.
84
--
95
-- The constructor is exported only on GHC-8 and later.
106
module Data.Some (
11-
#if __GLASGOW_HASKELL__ >= 801
127
Some(Some),
13-
#else
14-
Some,
15-
#endif
168
mkSome,
179
withSome,
1810
withSomeM,

src/Data/Some/Church.hs

Lines changed: 0 additions & 4 deletions
Original file line numberDiff line numberDiff line change
@@ -1,9 +1,5 @@
11
{-# LANGUAGE CPP #-}
2-
#if __GLASGOW_HASKELL__ >= 704
32
{-# LANGUAGE Safe #-}
4-
#elif __GLASGOW_HASKELL__ >= 702
5-
{-# LANGUAGE Trustworthy #-}
6-
#endif
73
module Data.Some.Church (
84
Some(..),
95
mkSome,

src/Data/Some/GADT.hs

Lines changed: 0 additions & 10 deletions
Original file line numberDiff line numberDiff line change
@@ -1,20 +1,12 @@
11
{-# LANGUAGE CPP #-}
22
{-# LANGUAGE GADTs #-}
33
{-# LANGUAGE RankNTypes #-}
4-
#if __GLASGOW_HASKELL__ >= 706
54
{-# LANGUAGE PolyKinds #-}
6-
#endif
7-
#if __GLASGOW_HASKELL__ >= 708
85
{-# LANGUAGE RoleAnnotations #-}
9-
#endif
106
#if __GLASGOW_HASKELL__ >= 810
117
{-# LANGUAGE StandaloneKindSignatures #-}
128
#endif
13-
#if __GLASGOW_HASKELL__ >= 704
149
{-# LANGUAGE Safe #-}
15-
#elif __GLASGOW_HASKELL__ >= 702
16-
{-# LANGUAGE Trustworthy #-}
17-
#endif
1810
module Data.Some.GADT (
1911
Some(Some),
2012
mkSome,
@@ -90,9 +82,7 @@ type Some :: (k -> Type) -> Type
9082
data Some tag where
9183
Some :: tag a -> Some tag
9284

93-
#if __GLASGOW_HASKELL__ >= 708
9485
type role Some representational
95-
#endif
9686

9787
-- | Constructor.
9888
mkSome :: tag a -> Some tag

0 commit comments

Comments
 (0)