{-# LANGUAGE CPP #-}
{-# LANGUAGE TypeOperators, FlexibleContexts #-}
#if __GLASGOW_HASKELL__ >= 702
{-# LANGUAGE Trustworthy #-}
#endif
#if __GLASGOW_HASKELL__ >= 708
{-# LANGUAGE DeriveDataTypeable #-}
#endif
-------------------------------------------------------------------------------------------
-- |
-- Module   : Control.Category.Dual
-- Copyright: 2008-2010 Edward Kmett
-- License  : BSD
--
-- Maintainer : Edward Kmett <ekmett@gmail.com>
-- Stability  : experimental
-- Portability: portable
--
-------------------------------------------------------------------------------------------
module Control.Category.Dual
  ( Dual(..)
  ) where

#ifndef MIN_VERSION_base
#define MIN_VERSION_base(x,y,z) 1
#endif

import Control.Category

#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 (Typeable2(..), TyCon, mkTyCon3, mkTyConApp, gcast1)
#else
import Data.Typeable (Typeable2(..), TyCon, mkTyCon, mkTyConApp, gcast1)
#endif
import Prelude (undefined,const,error)
#else
import Prelude (error)
import Data.Typeable (Typeable, gcast1)
#endif
#endif

data Dual k a b = Dual { forall (k :: * -> * -> *) a b. Dual k a b -> k b a
runDual :: k b a }
#if __GLASGOW_HASKELL__ >= 708
  deriving Typeable

#define Typeable2 Typeable
#endif

instance Category k => Category (Dual k) where
  id :: forall a. Dual k a a
id = k a a -> Dual k a a
forall (k :: * -> * -> *) a b. k b a -> Dual k a b
Dual k a a
forall a. k a a
forall {k} (cat :: k -> k -> *) (a :: k). Category cat => cat a a
id
  Dual k c b
f . :: forall b c a. Dual k b c -> Dual k a b -> Dual k a c
. Dual k b a
g = k c a -> Dual k a c
forall (k :: * -> * -> *) a b. k b a -> Dual k a b
Dual (k b a
g k b a -> k c b -> k c a
forall b c a. k b c -> k a b -> k a c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. k c b
f)

#ifdef __GLASGOW_HASKELL__

#if __GLASGOW_HASKELL__ < 707
instance Typeable2 k => Typeable2 (Dual k) where
  typeOf2 tfab = mkTyConApp dataTyCon [typeOf2 (undefined `asDualArgsType` tfab)]
    where asDualArgsType :: f b a -> t f a b -> f b a
          asDualArgsType = const

dataTyCon :: TyCon
#if MIN_VERSION_base(4,4,0)
dataTyCon = mkTyCon3 "categories" "Control.Category.Dual" "Dual"
#else
dataTyCon = mkTyCon "Control.Category.Dual.Dual"
#endif
{-# NOINLINE dataTyCon #-}
#endif

dualConstr :: Constr
dualConstr :: Constr
dualConstr = DataType -> String -> [String] -> Fixity -> Constr
mkConstr DataType
dataDataType String
"Dual" [] Fixity
Prefix
{-# NOINLINE dualConstr #-}

dataDataType :: DataType
dataDataType :: DataType
dataDataType = String -> [Constr] -> DataType
mkDataType String
"Control.Category.Dual.Dual" [Constr
dualConstr]
{-# NOINLINE dataDataType #-}

instance (Typeable2 k, Data a, Data b, Data (k b a)) => Data (Dual k a b) where
  gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Dual k a b -> c (Dual k a b)
gfoldl forall d b. Data d => c (d -> b) -> d -> c b
f forall g. g -> c g
z (Dual k b a
a) = (k b a -> Dual k a b) -> c (k b a -> Dual k a b)
forall g. g -> c g
z k b a -> Dual k a b
forall (k :: * -> * -> *) a b. k b a -> Dual k a b
Dual c (k b a -> Dual k a b) -> k b a -> c (Dual k a b)
forall d b. Data d => c (d -> b) -> d -> c b
`f` k b a
a
  toConstr :: Dual k a b -> Constr
toConstr Dual k a b
_ = Constr
dualConstr
  gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (Dual k a b)
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 (k b a -> Dual k a b) -> c (Dual k a b)
forall b r. Data b => c (b -> r) -> c r
k ((k b a -> Dual k a b) -> c (k b a -> Dual k a b)
forall r. r -> c r
z k b a -> Dual k a b
forall (k :: * -> * -> *) a b. k b a -> Dual k a b
Dual)
    Int
_ -> String -> c (Dual k a b)
forall a. HasCallStack => String -> a
error String
"gunfold"
  dataTypeOf :: Dual k a b -> DataType
dataTypeOf Dual k a b
_ = DataType
dataDataType
  dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c (Dual k a b))
dataCast1 forall d. Data d => c (t d)
f = c (t b) -> Maybe (c (Dual k a b))
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 b)
forall d. Data d => c (t d)
f
#endif