1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
|
{-# LANGUAGE GADTs #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TemplateHaskell #-}
module FooGADT where
import Data.Dependent.Sum
import Data.Functor.Identity
import Data.GADT.Show
import Data.GADT.Compare
import Data.Constraint.Extras
import Data.Constraint.Extras.TH
import Data.List (sort)
data Foo a where
Foo :: Foo Double
Bar :: Foo Int
Baz :: Foo String
Qux :: Foo Double
deriveArgDict ''Foo
{-
-- NB: The instance for ArgDict could be manually written as:
instance ArgDict Foo where
type ConstraintsFor Foo c = (c Double, c Int, c String)
argDict x = case x of
Foo -> Dict
Bar -> Dict
Baz -> Dict
Qux -> Dict
-}
instance Eq (Foo a) where
(==) = defaultEq
instance GEq Foo where
geq Foo Foo = Just Refl
geq Bar Bar = Just Refl
geq Baz Baz = Just Refl
geq Qux Qux = Just Refl
geq _ _ = Nothing
instance GCompare Foo where
gcompare Foo Foo = GEQ
gcompare Foo _ = GLT
gcompare _ Foo = GGT
gcompare Bar Bar = GEQ
gcompare Bar _ = GLT
gcompare _ Bar = GGT
gcompare Baz Baz = GEQ
gcompare Baz _ = GLT
gcompare _ Baz = GGT
gcompare Qux Qux = GEQ
instance Show (Foo a) where
showsPrec _ Foo = showString "Foo"
showsPrec _ Bar = showString "Bar"
showsPrec _ Baz = showString "Baz"
showsPrec _ Qux = showString "Qux"
instance GShow Foo where
gshowsPrec = showsPrec
instance GRead Foo where
greadsPrec _ str = case tag of
"Foo" -> [(GReadResult (\k -> k Foo), rest)]
"Bar" -> [(GReadResult (\k -> k Bar), rest)]
"Baz" -> [(GReadResult (\k -> k Baz), rest)]
"Qux" -> [(GReadResult (\k -> k Qux), rest)]
_ -> []
where (tag, rest) = splitAt 3 str
foo :: Double -> DSum Foo Identity
foo x = Foo ==> x
bar :: Int -> DSum Foo Identity
bar x = Bar ==> x
baz :: String -> DSum Foo Identity
baz x = Baz ==> x
qux :: Double -> DSum Foo Identity
qux x = Qux ==> x
xs, xs', xs'' :: [DSum Foo Identity]
xs = [bar 100, foo pi, qux (exp 1), baz "hello world"]
xs' = read (show xs) `asTypeOf` xs
xs'' = sort xs
|
