{-# LANGUAGE CPP #-}
{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE FunctionalDependencies #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE PolyKinds #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE Safe #-}
{-# LANGUAGE TypeOperators #-}
module Control.Natural
(
(:~>)(..)
, type (~>)
, wrapNT
, unwrapNT
, Transformation(..)
) where
import qualified Control.Category as C (Category(..))
#if !(MIN_VERSION_base(4,8,0))
import Data.Monoid (Monoid(..))
#endif
import Data.Semigroup (Semigroup(..))
import Data.Typeable
infixr 0 ~>
type f ~> g = forall x. f x -> g x
infixr 0 :~>, $$
newtype f :~> g = NT { forall {k} (f :: k -> *) (g :: k -> *). (f :~> g) -> f ~> g
($$) :: f ~> g }
deriving Typeable
instance C.Category (:~>) where
id :: forall (a :: k -> *). a :~> a
id = forall {k} (f :: k -> *) (g :: k -> *). (f ~> g) -> f :~> g
NT forall a. a -> a
id
NT b ~> c
f . :: forall (b :: k -> *) (c :: k -> *) (a :: k -> *).
(b :~> c) -> (a :~> b) -> a :~> c
. NT a ~> b
g = forall {k} (f :: k -> *) (g :: k -> *). (f ~> g) -> f :~> g
NT (b ~> c
f forall b c a. (b -> c) -> (a -> b) -> a -> c
. a ~> b
g)
instance f ~ g => Semigroup (f :~> g) where
NT f ~> g
f <> :: (f :~> g) -> (f :~> g) -> f :~> g
<> NT f ~> g
g = forall {k} (f :: k -> *) (g :: k -> *). (f ~> g) -> f :~> g
NT (f ~> g
f forall b c a. (b -> c) -> (a -> b) -> a -> c
. f ~> g
g)
instance f ~ g => Monoid (f :~> g) where
mempty :: f :~> g
mempty = forall {k} (f :: k -> *) (g :: k -> *). (f ~> g) -> f :~> g
NT forall a. a -> a
id
mappend :: (f :~> g) -> (f :~> g) -> f :~> g
mappend = forall a. Semigroup a => a -> a -> a
(<>)
infix 0 #
class Transformation f g t | t -> f g where
(#) :: t -> forall a . f a -> g a
instance Transformation f g (f :~> g) where
NT forall (a :: k). f a -> g a
f # :: (f :~> g) -> forall (a :: k). f a -> g a
# f a
g = forall (a :: k). f a -> g a
f f a
g
wrapNT :: (forall a . f a -> g a) -> f :~> g
wrapNT :: forall {k} (f :: k -> *) (g :: k -> *). (f ~> g) -> f :~> g
wrapNT = forall {k} (f :: k -> *) (g :: k -> *). (f ~> g) -> f :~> g
NT
unwrapNT :: Transformation f g t => t -> (forall a . f a -> g a)
unwrapNT :: forall {k} (f :: k -> *) (g :: k -> *) t.
Transformation f g t =>
t -> forall (a :: k). f a -> g a
unwrapNT = forall {k} (f :: k -> *) (g :: k -> *) t.
Transformation f g t =>
t -> forall (a :: k). f a -> g a
(#)