{-# LANGUAGE KindSignatures #-}
{-# LANGUAGE DeriveTraversable #-}
{-# LANGUAGE DeriveFoldable #-}
{-# LANGUAGE DeriveFunctor #-}
{-# LANGUAGE ExistentialQuantification #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE Rank2Types #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE UndecidableInstances #-}
{-# LANGUAGE IncoherentInstances #-}
module Data.Comp.Multi.HFunctor
(
HFunctor (..),
(:->),
(:=>),
NatM,
I (..),
K (..),
A (..),
E (..),
runE,
(:.:)(..)
) where
import Data.Functor.Compose
newtype I a = I {unI :: a} deriving (Functor, Foldable, Traversable)
newtype K a i = K {unK :: a} deriving (Functor, Foldable, Traversable)
data E f = forall i. E {unE :: f i}
runE :: (f :=> b) -> E f -> b
runE f (E x) = f x
data A f = A {unA :: forall i. f i}
instance Eq a => Eq (K a i) where
K x == K y = x == y
K x /= K y = x /= y
instance Ord a => Ord (K a i) where
K x < K y = x < y
K x > K y = x > y
K x <= K y = x <= y
K x >= K y = x >= y
min (K x) (K y) = K $ min x y
max (K x) (K y) = K $ max x y
compare (K x) (K y) = compare x y
infixr 0 :->
infixr 0 :=>
type f :-> g = forall i . f i -> g i
type f :=> a = forall i . f i -> a
type NatM m f g = forall i. f i -> m (g i)
class HFunctor h where
hfmap :: (f :-> g) -> h f :-> h g
instance (Functor f) => HFunctor (Compose f) where hfmap f (Compose xs) = Compose (fmap f xs)
infixl 5 :.:
data (:.:) f (g :: (* -> *) -> (* -> *)) (e :: * -> *) t = Comp (f (g e) t)