testsuite: Assert that testsuite ways are known
[ghc.git] / testsuite / tests / typecheck / should_compile / T11339b.hs
1 {-# LANGUAGE NoMonomorphismRestriction, RankNTypes, ScopedTypeVariables #-}
2
3 module T11339b where
4
5 import Control.Applicative ( Const(Const, getConst) )
6 import Data.Functor.Identity ( Identity(Identity) )
7
8 type Traversal s t a b = forall f. Applicative f => (a -> f b) -> s -> f t
9
10 failing :: forall s t a b . Traversal s t a b -> Traversal s t a b -> Traversal s t a b
11 failing left right afb s = case pins t of
12 [] -> right afb s
13 _ -> t afb
14 where
15 t :: Applicative f => (a -> f b) -> f t
16 -- Works because of NoMonomorphismRestriction
17 Bazaar { getBazaar = t } = left sell s
18
19 sell :: a -> Bazaar a b b
20 sell w = Bazaar ($ w)
21
22 pins :: ((a -> Const [Identity a] b) -> Const [Identity a] t) -> [Identity a]
23 pins f = getConst (f (\ra -> Const [Identity ra]))
24
25 newtype Bazaar a b t = Bazaar { getBazaar :: (forall f. Applicative f => (a -> f b) -> f t) }
26
27 instance Functor (Bazaar a b) where
28 fmap f (Bazaar k) = Bazaar (fmap f . k)
29
30 instance Applicative (Bazaar a b) where
31 pure a = Bazaar $ \_ -> pure a
32 Bazaar mf <*> Bazaar ma = Bazaar $ \afb -> mf afb <*> ma afb