Ticket #3731: Bug.hs

File Bug.hs, 1.7 KB (added by dsf, 5 years ago)
Line 
1{-# LANGUAGE DeriveDataTypeable, FlexibleContexts, FlexibleInstances, MultiParamTypeClasses, UndecidableInstances, RankNTypes, ScopedTypeVariables, KindSignatures, EmptyDataDecls, NoMonomorphismRestriction #-}
2
3module Main where
4
5import qualified Data.Data as Data
6import Data.Typeable
7
8--- syb-with-class
9
10data Constr = Constr deriving (Eq, Show)
11
12data Proxy (a :: * -> *)
13
14class Sat a where
15   dict :: a
16
17class (Typeable a, Sat (ctx a)) => Data ctx a where
18    gunfold :: Proxy ctx
19            -> (forall b r. Data ctx b => c (b -> r) -> c r)
20            -> (forall r. r -> c r)
21            -> Constr
22            -> c a
23
24instance (Sat (ctx [a]),Data ctx a) => Data ctx [a]
25
26--- Default
27
28class (Data DefaultD a) => Default a where
29   defaultValue :: a
30
31data DefaultD a = DefaultD { defaultValueD :: a }
32
33instance Default t => Sat (DefaultD t) where
34   dict = error "Sat (DefaultD t) not implemented"
35
36instance Default a => Default [a] where
37   defaultValue = error "Default [a] not implemented"
38
39--- Trouble
40
41
42data Proposition = Proposition Expression  deriving (Show, Data.Data, Typeable)
43data Expression = Conjunction Expression deriving (Show, Data.Data, Typeable)
44
45
46-- instance (Sat (ctx [Expression]), Sat (ctx Expression), Sat (ctx Proposition)) => Data ctx Proposition where
47instance Data DefaultD Proposition  where
48   gunfold _ k z c = k (z Proposition)
49--    gunfold _ k z c = error "gunfold"
50
51instance Default Proposition
52
53-- Change Data ctx [Expression] to Data ctx Expression and main works.
54
55instance ( Data ctx [Expression]
56        , Sat (ctx Expression)
57        ) => Data ctx Expression
58
59
60instance Default Expression
61
62e :: Expression
63e = defaultValueD (dict :: DefaultD Expression)
64
65main = print e