1{-# LANGUAGE GADTs, NamedWildCards, ScopedTypeVariables #-}
2
3bar :: Int -> _ Int
4bar x = Foo True () x
5
6addAndOr1 :: _
7addAndOr1 (a, b) (c, d) = (a `plus` d, b || c)
8  where plus :: Int -> Int -> Int
9        x `plus` y = x + y
10
11addAndOr2 :: _ -> _
12addAndOr2 (a, b) (c, d) = (a `plus` d, b || c)
13  where plus :: Int -> Int -> Int
14        x `plus` y = x + y
15
16addAndOr3 :: _ -> _ -> _
17addAndOr3 (a, b) (c, d) = (a `plus` d, b || c)
18  where plus :: Int -> Int -> Int
19        x `plus` y = x + y
20
21addAndOr4 :: (_ _ _) -> (_ _ _) -> (_ _ _)
22addAndOr4 (a, b) (c, d) = (a `plus` d, b || c)
23  where plus :: Int -> Int -> Int
24        x `plus` y = x + y
25
26addAndOr5 :: (_, _) -> (_, _) -> (_, _)
27addAndOr5 (a, b) (c, d) = (a `plus` d, b || c)
28  where plus :: Int -> Int -> Int
29        x `plus` y = x + y
30
31addAndOr6 :: (Int, _) -> (Bool, _) -> (_ Int Bool)
32addAndOr6 (a, b) (c, d) = (a `plus` d, b || c)
33  where plus :: Int -> Int -> Int
34        x `plus` y = x + y
35
36bar :: _ -> _
37bar x = not x
38
39alpha :: _
40alpha = 3
41
42bravo :: _ => _
43bravo = 3
44
45bravo :: _ => _
46bravo = 3
47
48barry :: _a -> (_b _a, _b _)
49barry x = (Left "x", Right x)
50
51foo :: a ~ Bool => (a, _)
52foo = (True, False)
53
54every :: _ -> _ -> Bool
55every _ [] = True
56every p (x : xs) = p x && every p xs
57
58every :: (_a -> Bool) -> [_a] -> Bool
59every _ [] = True
60every p (x : xs) = p x && every p xs
61
62bar :: Bool -> Bool
63bar x = (x :: _)
64
65bar :: _a -> _a
66bar True = (False :: _a)
67bar False = (True :: _a)
68
69arbitCs1 :: _ => a -> String
70arbitCs1 x = show (succ x) ++ show (x == x)
71
72arbitCs2 :: (Show a, _) => a -> String
73arbitCs2 x = arbitCs1 x
74
75arbitCs3 :: (Show a, Enum a, _) => a -> String
76arbitCs3 x = arbitCs1 x
77
78arbitCs4 :: (Eq a, _) => a -> String
79arbitCs4 x = arbitCs1 x
80
81arbitCs5 :: (Eq a, Enum a, Show a, _) => a -> String
82arbitCs5 x = arbitCs1 x
83
84foo :: _ => String
85foo = "x"
86
87foo :: _ => a
88foo = 3
89
90foo :: _ => a
91foo = 3
92
93fall :: forall a . _ -> a
94fall v = v
95
96bar :: _a -> _a
97bar x = not x
98
99foo :: (forall a . [a] -> [a]) -> _
100foo x = (x [True, False], x ['a', 'b'])
101
102foo :: (forall a . [a] -> [a]) -> (_, _ _)
103foo x = (x [True, False], x ['a', 'b'])
104
105monoLoc :: forall a . a -> ((a, String), (a, _))
106monoLoc x = (g True, g False)
107  where g :: t -> (a, String)
108        g _ = (x, "foo")
109
110data NukeMonad a b c
111
112instance Functor (NukeMonad a b) where
113        fmap = undefined
114
115instance Applicative (NukeMonad a b) where
116        pure = undefined
117        (<*>) = undefined
118
119instance Monad (NukeMonad a b) where
120        return = undefined
121        (>>=) = undefined
122
123isMeltdown :: NukeMonad param1 param2 Bool
124isMeltdown = undefined
125
126unlessMeltdown :: _nm () -> _nm ()
127unlessMeltdown c
128  = do m <- isMeltdown
129       if m then return () else c
130
131monoLoc :: forall a . a -> ((a, String), (a, String))
132monoLoc x = (g True, g 'v')
133  where g :: b -> (a, _)
134        g y = (x, "foo")
135
136foo :: (_a, b) -> (a, _b)
137foo (x, y) = (x, y)
138
139f :: (_) => a -> a -> Bool
140f x y = x == y
141
142foo :: _
143Just foo = Just id
144
145foo :: Bool -> _
146Just foo = Just id
147
148bar :: Bool -> Bool
149bar (x :: _) = True
150
151orr :: a -> a -> a
152orr = undefined
153
154g :: _
155g = f `orr` True
156
157f :: _
158f = g
159
160test3 :: _
161test3 x
162  = const
163      (let x :: _b
164           x = True
165         in False)
166      $
167      const
168        (let x :: _b
169             x = 'a'
170           in True)
171        $ not x
172
173foo :: _a -> _
174foo x
175  = let v = not x
176
177        g :: _a -> _a
178        g x = x
179      in (g 'x')
180
181showTwo :: Show _a => _a -> String
182showTwo x = show x
183
184bar :: _ -> Bool
185bar _ = True
186
187data GenParser tok st a = GenParser tok st a
188
189skipMany' :: GenParser tok st a -> GenParser tok st ()
190skipMany' = undefined
191
192skipMany :: _ -> _ ()
193skipMany = skipMany'
194
195somethingShowable :: Show _x => _x -> _
196somethingShowable x = show (not x)
197
198data I a = I a
199
200instance Functor I where
201        fmap f (I a) = I (f a)
202
203newtype B t a = B a
204
205instance Functor (B t) where
206        fmap f (B a) = B (f a)
207
208newtype H f = H (f ())
209
210h1 :: _ => _
211h1 f b = (H . fmap (const ())) (fmap f b)
212
213h2 :: _
214h2 f b = (H . fmap (const ())) (fmap f b)
215
216app1 :: H (B t)
217app1 = h1 (H . I) (B ())
218
219app2 :: H (B t)
220app2 = h2 (H . I) (B ())
221foo f = g
222  where g r = x
223          where x :: _
224                x = r
225
226unc :: (_ -> _ -> _) -> (_, _) -> _
227unc = uncurry
228
229unc :: (_a -> _b -> _c) -> (_a, _b) -> _c
230unc = uncurry
231
232foo :: (Show _a, _) => _a -> _
233foo x = show (succ x)
234
235bar :: _ -> _ -> _
236bar x y = y x
237