blob: e623b1cb0a432ec105af94c3d34cbcf003e9cf9a (
plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
|
{-# OPTIONS_GHC -fdefer-type-errors -fno-warn-deferred-type-errors #-}
{-# LANGUAGE ImpredicativeTypes #-}
module T9834 where
import Control.Applicative
import Data.Functor.Identity
type Nat f g = forall a. f a -> g a
newtype Comp p q a = Comp (p (q a))
liftOuter :: (Functor p, Applicative q) => p a -> (Comp p q) a
liftOuter pa = Comp (pure <$> pa)
runIdComp :: Functor p => Comp p Identity a -> p a
runIdComp (Comp p) = runIdentity <$> p
wrapIdComp :: Applicative p => (forall q. Applicative q => Nat (Comp p q) (Comp p q)) -> p a -> p a
wrapIdComp f = runIdComp . f . liftOuter
class Applicative p => ApplicativeFix p where
afix :: (forall q. Applicative q => (Comp p q) a -> (Comp p q) a) -> p a
afix = wrapIdComp
|
