{-# LANGUAGE CPP #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE TypeOperators #-}
#if MIN_VERSION_base(4,7,0)
# define LANGUAGE_PolyKinds
{-# LANGUAGE PolyKinds #-}
#endif
#if __GLASGOW_HASKELL__ >= 708
# define LANGUAGE_DeriveDataTypeable
{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE Safe #-}
#else
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE Trustworthy #-}
#endif
{-|
Module: Control.Natural
Copyright: (C) 2015 The University of Kansas
License: BSD-style (see the file LICENSE)
Maintainer: Andy Gill
Stability: Experimental
A data type for natural transformations.
-}
module Control.Natural ((~>)(), (:~>)(..)) where
#if defined(LANGUAGE_PolyKinds)
import qualified Control.Category as C (Category(..))
#endif
#if !(MIN_VERSION_base(4,8,0))
import Data.Monoid (Monoid(..))
#endif
import Data.Typeable
---------------------------------------------------------------------------
-- Code adapted, with permission, from Edward Kmett's @indexed@ package.
---------------------------------------------------------------------------
infixr 0 ~>
-- | A natural transformation from @f@ to @g@.
type f ~> g = forall x. f x -> g x
infixr 0 :~>, $$
-- | A natural transformation suitable for storing in a container.
newtype f :~> g = Nat { ($$) :: f ~> g }
#if defined(LANGUAGE_DeriveDataTypeable)
deriving Typeable
#else
instance (Typeable1 f, Typeable1 g) => Typeable (f :~> g) where
typeOf _ = mkTyConApp natTyCon [typeOf1 (undefined :: f a), typeOf1 (undefined :: g a)]
natTyCon :: TyCon
# if MIN_VERSION_base(4,4,0)
natTyCon = mkTyCon3 "natural-transformation" "Control.Natural" ":~>"
# else
natTyCon = mkTyCon ":~>"
# endif
{-# NOINLINE natTyCon #-}
#endif
#if defined(LANGUAGE_PolyKinds)
instance C.Category (:~>) where
id = Nat id
Nat f . Nat g = Nat (f . g)
#endif
instance f ~ g => Monoid (f :~> g) where
mempty = Nat id
mappend (Nat f) (Nat g) = Nat (f . g)