Fold integer-simple.git into ghc.git (re #8545)
[ghc.git] / testsuite / tests / typecheck / should_run / tcrun021.hs
1 {-# LANGUAGE MultiParamTypeClasses, FunctionalDependencies,
2 TypeSynonymInstances, FlexibleInstances #-}
3
4 -- This bizarre program failed because TcSimplify built a loop of
5 -- dictionaries, due to an obscure bug in the way in which superclasses
6 -- were added
7
8 module Main where
9
10 import Data.List
11 import Data.Map
12
13 class (Ord oid) => Object o oid | o -> oid where
14
15 data Access oid
16
17 class (Object o oid) => SecurityModel model o oid | model -> o
18
19 class (SecurityModel model o oid) => SecurityPolicy policy model o oid where
20 checkAccess :: policy -> model -> Access oid -> Bool
21 checkAccess _ _ _ = True
22 checkModel :: policy -> model -> Bool
23 checkModel _ _ = True
24
25 ------------------------------------------------------------
26 -- The Linux instance
27 ------------------------------------------------------------
28
29 type LinuxObjectId = Either [String] String
30
31 data LinuxObject = File [String] deriving (Eq, Show)
32
33 instance Object LinuxObject LinuxObjectId
34
35 data LinuxSecurityModel =
36 LinuxSecurityModel { lsmObjectSet :: Map LinuxObjectId LinuxObject }
37
38
39 -- Now defined in Data.Map, don't think this affects the bug:
40 -- instance (Show a, Show b) => Show (Map a b) where
41 -- show fm = show (fmToList fm)
42
43 instance Show LinuxSecurityModel where
44 show lsm = "LSM:" ++ "\tObjects: " ++ show (lsmObjectSet lsm)
45
46 instance SecurityModel LinuxSecurityModel LinuxObject LinuxObjectId
47
48 data LinuxSecurityPolicy = LinuxSecurityPolicy
49 instance SecurityPolicy LinuxSecurityPolicy LinuxSecurityModel LinuxObject LinuxObjectId
50
51 model :: Map LinuxObjectId LinuxObject
52 model = fromList [ (Left [], File []), (Left ["home"], File ["home"]) ]
53
54
55 -- works
56 -- model :: (LinuxObjectId, LinuxObject)
57 -- model = (Left [], File [])
58
59 main :: IO ()
60 main = do { putStrLn (show model) }