{-# LANGUAGE CPP #-}
#if __GLASGOW_HASKELL__ >= 702
{-# LANGUAGE Trustworthy #-}
#endif
{-# LANGUAGE MultiParamTypeClasses, FunctionalDependencies, FlexibleContexts, UndecidableInstances, FlexibleInstances #-}
#if __GLASGOW_HASKELL__ >= 708
{-# LANGUAGE DeriveDataTypeable #-}
#endif
module Control.Categorical.Functor
( Functor(fmap)
, Endofunctor
, LiftedFunctor(..)
, LoweredFunctor(..)
) where
#ifndef MIN_VERSION_base
#define MIN_VERSION_base(x,y,z) 1
#endif
import Control.Category
import Prelude hiding (id, (.), Functor(..))
import qualified Prelude
#ifdef __GLASGOW_HASKELL__
import Data.Data (Data(..), mkDataType, DataType, mkConstr, Constr, constrIndex, Fixity(..))
#if __GLASGOW_HASKELL__ < 708
#if MIN_VERSION_base(4,4,0)
import Data.Typeable (Typeable1(..), TyCon, mkTyCon3, mkTyConApp, gcast1)
#else
import Data.Typeable (Typeable1(..), TyCon, mkTyCon, mkTyConApp, gcast1)
#endif
#else
import Data.Typeable (Typeable, gcast1)
#endif
#endif
newtype LiftedFunctor f a = LiftedFunctor (f a) deriving
( Int -> LiftedFunctor f a -> ShowS
[LiftedFunctor f a] -> ShowS
LiftedFunctor f a -> String
(Int -> LiftedFunctor f a -> ShowS)
-> (LiftedFunctor f a -> String)
-> ([LiftedFunctor f a] -> ShowS)
-> Show (LiftedFunctor f a)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall (f :: * -> *) a.
Show (f a) =>
Int -> LiftedFunctor f a -> ShowS
forall (f :: * -> *) a. Show (f a) => [LiftedFunctor f a] -> ShowS
forall (f :: * -> *) a. Show (f a) => LiftedFunctor f a -> String
$cshowsPrec :: forall (f :: * -> *) a.
Show (f a) =>
Int -> LiftedFunctor f a -> ShowS
showsPrec :: Int -> LiftedFunctor f a -> ShowS
$cshow :: forall (f :: * -> *) a. Show (f a) => LiftedFunctor f a -> String
show :: LiftedFunctor f a -> String
$cshowList :: forall (f :: * -> *) a. Show (f a) => [LiftedFunctor f a] -> ShowS
showList :: [LiftedFunctor f a] -> ShowS
Show
, ReadPrec [LiftedFunctor f a]
ReadPrec (LiftedFunctor f a)
Int -> ReadS (LiftedFunctor f a)
ReadS [LiftedFunctor f a]
(Int -> ReadS (LiftedFunctor f a))
-> ReadS [LiftedFunctor f a]
-> ReadPrec (LiftedFunctor f a)
-> ReadPrec [LiftedFunctor f a]
-> Read (LiftedFunctor f a)
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
forall (f :: * -> *) a. Read (f a) => ReadPrec [LiftedFunctor f a]
forall (f :: * -> *) a. Read (f a) => ReadPrec (LiftedFunctor f a)
forall (f :: * -> *) a.
Read (f a) =>
Int -> ReadS (LiftedFunctor f a)
forall (f :: * -> *) a. Read (f a) => ReadS [LiftedFunctor f a]
$creadsPrec :: forall (f :: * -> *) a.
Read (f a) =>
Int -> ReadS (LiftedFunctor f a)
readsPrec :: Int -> ReadS (LiftedFunctor f a)
$creadList :: forall (f :: * -> *) a. Read (f a) => ReadS [LiftedFunctor f a]
readList :: ReadS [LiftedFunctor f a]
$creadPrec :: forall (f :: * -> *) a. Read (f a) => ReadPrec (LiftedFunctor f a)
readPrec :: ReadPrec (LiftedFunctor f a)
$creadListPrec :: forall (f :: * -> *) a. Read (f a) => ReadPrec [LiftedFunctor f a]
readListPrec :: ReadPrec [LiftedFunctor f a]
Read
#if __GLASGOW_HASKELL__ >= 708
, Typeable
#endif
)
#ifdef __GLASGOW_HASKELL__
liftedConstr :: Constr
liftedConstr :: Constr
liftedConstr = DataType -> String -> [String] -> Fixity -> Constr
mkConstr DataType
liftedDataType String
"LiftedFunctor" [] Fixity
Prefix
{-# NOINLINE liftedConstr #-}
liftedDataType :: DataType
liftedDataType :: DataType
liftedDataType = String -> [Constr] -> DataType
mkDataType String
"Control.Categorical.Fucntor.LiftedFunctor" [Constr
liftedConstr]
{-# NOINLINE liftedDataType #-}
#if __GLASGOW_HASKELL__ < 708
instance Typeable1 f => Typeable1 (LiftedFunctor f) where
typeOf1 tfa = mkTyConApp liftedTyCon [typeOf1 (undefined `asArgsType` tfa)]
where asArgsType :: f a -> t f a -> f a
asArgsType = const
liftedTyCon :: TyCon
#if MIN_VERSION_base(4,4,0)
liftedTyCon = mkTyCon3 "categories" "Control.Categorical.Functor" "LiftedFunctor"
#else
liftedTyCon = mkTyCon "Control.Categorical.Functor.LiftedFunctor"
#endif
{-# NOINLINE liftedTyCon #-}
#else
#define Typeable1 Typeable
#endif
instance (Typeable1 f, Data (f a), Data a) => Data (LiftedFunctor f a) where
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> LiftedFunctor f a
-> c (LiftedFunctor f a)
gfoldl forall d b. Data d => c (d -> b) -> d -> c b
f forall g. g -> c g
z (LiftedFunctor f a
a) = (f a -> LiftedFunctor f a) -> c (f a -> LiftedFunctor f a)
forall g. g -> c g
z f a -> LiftedFunctor f a
forall (f :: * -> *) a. f a -> LiftedFunctor f a
LiftedFunctor c (f a -> LiftedFunctor f a) -> f a -> c (LiftedFunctor f a)
forall d b. Data d => c (d -> b) -> d -> c b
`f` f a
a
toConstr :: LiftedFunctor f a -> Constr
toConstr LiftedFunctor f a
_ = Constr
liftedConstr
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (LiftedFunctor f a)
gunfold forall b r. Data b => c (b -> r) -> c r
k forall r. r -> c r
z Constr
c = case Constr -> Int
constrIndex Constr
c of
Int
1 -> c (f a -> LiftedFunctor f a) -> c (LiftedFunctor f a)
forall b r. Data b => c (b -> r) -> c r
k ((f a -> LiftedFunctor f a) -> c (f a -> LiftedFunctor f a)
forall r. r -> c r
z f a -> LiftedFunctor f a
forall (f :: * -> *) a. f a -> LiftedFunctor f a
LiftedFunctor)
Int
_ -> String -> c (LiftedFunctor f a)
forall a. HasCallStack => String -> a
error String
"gunfold"
dataTypeOf :: LiftedFunctor f a -> DataType
dataTypeOf LiftedFunctor f a
_ = DataType
liftedDataType
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c (LiftedFunctor f a))
dataCast1 forall d. Data d => c (t d)
f = c (t a) -> Maybe (c (LiftedFunctor f a))
forall {k1} {k2} (c :: k1 -> *) (t :: k2 -> k1) (t' :: k2 -> k1)
(a :: k2).
(Typeable t, Typeable t') =>
c (t a) -> Maybe (c (t' a))
gcast1 c (t a)
forall d. Data d => c (t d)
f
#endif
newtype LoweredFunctor f a = LoweredFunctor (f a) deriving
( Int -> LoweredFunctor f a -> ShowS
[LoweredFunctor f a] -> ShowS
LoweredFunctor f a -> String
(Int -> LoweredFunctor f a -> ShowS)
-> (LoweredFunctor f a -> String)
-> ([LoweredFunctor f a] -> ShowS)
-> Show (LoweredFunctor f a)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall (f :: * -> *) a.
Show (f a) =>
Int -> LoweredFunctor f a -> ShowS
forall (f :: * -> *) a. Show (f a) => [LoweredFunctor f a] -> ShowS
forall (f :: * -> *) a. Show (f a) => LoweredFunctor f a -> String
$cshowsPrec :: forall (f :: * -> *) a.
Show (f a) =>
Int -> LoweredFunctor f a -> ShowS
showsPrec :: Int -> LoweredFunctor f a -> ShowS
$cshow :: forall (f :: * -> *) a. Show (f a) => LoweredFunctor f a -> String
show :: LoweredFunctor f a -> String
$cshowList :: forall (f :: * -> *) a. Show (f a) => [LoweredFunctor f a] -> ShowS
showList :: [LoweredFunctor f a] -> ShowS
Show
, ReadPrec [LoweredFunctor f a]
ReadPrec (LoweredFunctor f a)
Int -> ReadS (LoweredFunctor f a)
ReadS [LoweredFunctor f a]
(Int -> ReadS (LoweredFunctor f a))
-> ReadS [LoweredFunctor f a]
-> ReadPrec (LoweredFunctor f a)
-> ReadPrec [LoweredFunctor f a]
-> Read (LoweredFunctor f a)
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
forall (f :: * -> *) a. Read (f a) => ReadPrec [LoweredFunctor f a]
forall (f :: * -> *) a. Read (f a) => ReadPrec (LoweredFunctor f a)
forall (f :: * -> *) a.
Read (f a) =>
Int -> ReadS (LoweredFunctor f a)
forall (f :: * -> *) a. Read (f a) => ReadS [LoweredFunctor f a]
$creadsPrec :: forall (f :: * -> *) a.
Read (f a) =>
Int -> ReadS (LoweredFunctor f a)
readsPrec :: Int -> ReadS (LoweredFunctor f a)
$creadList :: forall (f :: * -> *) a. Read (f a) => ReadS [LoweredFunctor f a]
readList :: ReadS [LoweredFunctor f a]
$creadPrec :: forall (f :: * -> *) a. Read (f a) => ReadPrec (LoweredFunctor f a)
readPrec :: ReadPrec (LoweredFunctor f a)
$creadListPrec :: forall (f :: * -> *) a. Read (f a) => ReadPrec [LoweredFunctor f a]
readListPrec :: ReadPrec [LoweredFunctor f a]
Read
#if __GLASGOW_HASKELL__ >= 708
, Typeable
#endif
)
#ifdef __GLASGOW_HASKELL__
loweredConstr :: Constr
loweredConstr :: Constr
loweredConstr = DataType -> String -> [String] -> Fixity -> Constr
mkConstr DataType
loweredDataType String
"LoweredFunctor" [] Fixity
Prefix
{-# NOINLINE loweredConstr #-}
loweredDataType :: DataType
loweredDataType :: DataType
loweredDataType = String -> [Constr] -> DataType
mkDataType String
"Control.Categorical.Fucntor.LoweredFunctor" [Constr
loweredConstr]
{-# NOINLINE loweredDataType #-}
#if __GLASGOW_HASKELL__ < 708
instance Typeable1 f => Typeable1 (LoweredFunctor f) where
typeOf1 tfa = mkTyConApp loweredTyCon [typeOf1 (undefined `asArgsType` tfa)]
where asArgsType :: f a -> t f a -> f a
asArgsType = const
loweredTyCon :: TyCon
#if MIN_VERSION_base(4,4,0)
loweredTyCon = mkTyCon3 "categories" "Control.Categorical.Functor" "LoweredFunctor"
#else
loweredTyCon = mkTyCon "Control.Categorical.Functor.LoweredFunctor"
#endif
{-# NOINLINE loweredTyCon #-}
#endif
instance (Typeable1 f, Data (f a), Data a) => Data (LoweredFunctor f a) where
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> LoweredFunctor f a
-> c (LoweredFunctor f a)
gfoldl forall d b. Data d => c (d -> b) -> d -> c b
f forall g. g -> c g
z (LoweredFunctor f a
a) = (f a -> LoweredFunctor f a) -> c (f a -> LoweredFunctor f a)
forall g. g -> c g
z f a -> LoweredFunctor f a
forall (f :: * -> *) a. f a -> LoweredFunctor f a
LoweredFunctor c (f a -> LoweredFunctor f a) -> f a -> c (LoweredFunctor f a)
forall d b. Data d => c (d -> b) -> d -> c b
`f` f a
a
toConstr :: LoweredFunctor f a -> Constr
toConstr LoweredFunctor f a
_ = Constr
loweredConstr
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (LoweredFunctor f a)
gunfold forall b r. Data b => c (b -> r) -> c r
k forall r. r -> c r
z Constr
c = case Constr -> Int
constrIndex Constr
c of
Int
1 -> c (f a -> LoweredFunctor f a) -> c (LoweredFunctor f a)
forall b r. Data b => c (b -> r) -> c r
k ((f a -> LoweredFunctor f a) -> c (f a -> LoweredFunctor f a)
forall r. r -> c r
z f a -> LoweredFunctor f a
forall (f :: * -> *) a. f a -> LoweredFunctor f a
LoweredFunctor)
Int
_ -> String -> c (LoweredFunctor f a)
forall a. HasCallStack => String -> a
error String
"gunfold"
dataTypeOf :: LoweredFunctor f a -> DataType
dataTypeOf LoweredFunctor f a
_ = DataType
loweredDataType
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c (LoweredFunctor f a))
dataCast1 forall d. Data d => c (t d)
f = c (t a) -> Maybe (c (LoweredFunctor f a))
forall {k1} {k2} (c :: k1 -> *) (t :: k2 -> k1) (t' :: k2 -> k1)
(a :: k2).
(Typeable t, Typeable t') =>
c (t a) -> Maybe (c (t' a))
gcast1 c (t a)
forall d. Data d => c (t d)
f
#endif
class (Category r, Category t) => Functor f r t | f r -> t, f t -> r where
fmap :: r a b -> t (f a) (f b)
instance Functor f (->) (->) => Prelude.Functor (LoweredFunctor f) where
fmap :: forall a b. (a -> b) -> LoweredFunctor f a -> LoweredFunctor f b
fmap a -> b
f (LoweredFunctor f a
a) = f b -> LoweredFunctor f b
forall (f :: * -> *) a. f a -> LoweredFunctor f a
LoweredFunctor ((a -> b) -> f a -> f b
forall a b. (a -> b) -> f a -> f b
forall (f :: * -> *) (r :: * -> * -> *) (t :: * -> * -> *) a b.
Functor f r t =>
r a b -> t (f a) (f b)
Control.Categorical.Functor.fmap a -> b
f f a
a)
instance Prelude.Functor f => Functor (LiftedFunctor f) (->) (->) where
fmap :: forall a b. (a -> b) -> LiftedFunctor f a -> LiftedFunctor f b
fmap a -> b
f (LiftedFunctor f a
a) = f b -> LiftedFunctor f b
forall (f :: * -> *) a. f a -> LiftedFunctor f a
LiftedFunctor ((a -> b) -> f a -> f b
forall a b. (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.fmap a -> b
f f a
a)
instance Functor ((,) a) (->) (->) where
fmap :: forall a b. (a -> b) -> (a, a) -> (a, b)
fmap a -> b
f (a
a, a
b) = (a
a, a -> b
f a
b)
instance Functor (Either a) (->) (->) where
fmap :: forall a b. (a -> b) -> Either a a -> Either a b
fmap a -> b
_ (Left a
a) = a -> Either a b
forall a b. a -> Either a b
Left a
a
fmap a -> b
f (Right a
a) = b -> Either a b
forall a b. b -> Either a b
Right (a -> b
f a
a)
instance Functor Maybe (->) (->) where
fmap :: forall a b. (a -> b) -> Maybe a -> Maybe b
fmap = (a -> b) -> Maybe a -> Maybe b
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.fmap
instance Functor [] (->) (->) where
fmap :: forall a b. (a -> b) -> [a] -> [b]
fmap = (a -> b) -> [a] -> [b]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.fmap
instance Functor IO (->) (->) where
fmap :: forall a b. (a -> b) -> IO a -> IO b
fmap = (a -> b) -> IO a -> IO b
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.fmap
class Functor f a a => Endofunctor f a
instance Functor f a a => Endofunctor f a