Make Applicative a superclass of Monad
[ghc.git] / testsuite / tests / typecheck / should_compile / T4969.hs
1 {-# OPTIONS_GHC -w #-}
2 {-# LANGUAGE MultiParamTypeClasses, FunctionalDependencies,
3 FlexibleContexts, FlexibleInstances,
4 OverlappingInstances, UndecidableInstances,
5 KindSignatures #-}
6
7 -- Cut down from a larger core-lint error
8
9 module Q where
10
11 import Control.Monad (foldM, liftM, ap)
12
13 data NameId = NameId
14 data Named name a = Named
15 data Arg e = Arg
16
17 data Range = Range
18 data Name = Name
19 data ALetBinding = ALetBinding
20 data APattern a = APattern
21 data CExpr = CExpr
22 data CPattern = CPattern
23 data NiceDeclaration = QQ
24 data TypeError = NotAValidLetBinding NiceDeclaration
25 data TCState = TCSt { stFreshThings :: FreshThings }
26 data FreshThings = Fresh
27
28 newtype NewName a = NewName a
29 newtype LetDef = LetDef NiceDeclaration
30 newtype TCMT (m :: * -> *) a = TCM ()
31
32 localToAbstract :: ToAbstract c a => c -> (a -> TCMT IO b) -> TCMT IO b
33 localToAbstract = undefined
34
35 typeError :: MonadTCM tcm => TypeError -> tcm a
36 typeError = undefined
37
38 lhsArgs :: [Arg (Named String CPattern)]
39 lhsArgs = undefined
40
41 freshNoName :: (MonadState s m, HasFresh NameId s) => Range -> m Name
42 freshNoName = undefined
43
44 class (Monad m) => MonadState s m | m -> s
45 class (Monad m) => MonadIO m
46
47 class ToAbstract concrete abstract | concrete -> abstract where
48 toAbstract :: concrete -> TCMT IO abstract
49
50 class (MonadState TCState tcm) => MonadTCM tcm where
51 liftTCM :: TCMT IO a -> tcm a
52
53 class HasFresh i a where
54 nextFresh :: a -> (i,a)
55
56 instance ToAbstract c a => ToAbstract [c] [a] where
57 instance ToAbstract c a => ToAbstract (Arg c) (Arg a) where
58 instance ToAbstract c a => ToAbstract (Named name c) (Named name a) where
59 instance ToAbstract CPattern (APattern CExpr) where
60
61 instance ToAbstract LetDef [ALetBinding] where
62 toAbstract (LetDef d) = do _ <- letToAbstract
63 undefined
64 where letToAbstract = do
65 localToAbstract lhsArgs $ \args ->
66 foldM lambda undefined undefined
67 lambda _ _ = do x <- freshNoName undefined
68 return undefined
69 lambda _ _ = typeError $ NotAValidLetBinding d
70
71 instance HasFresh NameId FreshThings where
72 nextFresh = undefined
73
74 instance HasFresh i FreshThings => HasFresh i TCState where
75 nextFresh = undefined
76
77 instance Monad m => MonadState TCState (TCMT m) where
78
79 instance Monad m => MonadTCM (TCMT m) where
80 liftTCM = undefined
81
82 instance Functor (TCMT m) where
83 fmap = liftM
84
85 instance Applicative (TCMT m) where
86 pure = return
87 (<*>) = ap
88
89 instance Monad (TCMT m) where
90 return = undefined
91 (>>=) = undefined
92 fail = undefined
93
94 instance Monad m => MonadIO (TCMT m) where
95