{-# LANGUAGE CPP #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE TypeOperators #-}

#if __GLASGOW_HASKELL__ >= 704
{-# LANGUAGE Safe #-}
#elif __GLASGOW_HASKELL__ >= 702
{-# LANGUAGE Trustworthy #-}
#endif

#if __GLASGOW_HASKELL__ >= 706
{-# LANGUAGE PolyKinds #-}
#endif

module Data.Bifunctor.Functor
  ( (:->)
  , BifunctorFunctor(..)
  , BifunctorMonad(..)
  , biliftM
  , BifunctorComonad(..)
  , biliftW
  ) where

-- | Using parametricity as an approximation of a natural transformation in two arguments.

type (:->) p q = forall a b. p a b -> q a b
infixr 0 :->

class BifunctorFunctor t where
  bifmap :: (p :-> q) -> t p :-> t q

class BifunctorFunctor t => BifunctorMonad t where
  bireturn :: p :-> t p
  bibind   :: (p :-> t q) -> t p :-> t q
  bibind p :-> t q
f = t (t q) a b -> t q a b
forall k k (t :: (k -> k -> *) -> k -> k -> *) (p :: k -> k -> *).
BifunctorMonad t =>
t (t p) :-> t p
bijoin (t (t q) a b -> t q a b)
-> (t p a b -> t (t q) a b) -> t p a b -> t q a b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (p :-> t q) -> t p :-> t (t q)
forall k k k k (t :: (k -> k -> *) -> k -> k -> *)
       (p :: k -> k -> *) (q :: k -> k -> *).
BifunctorFunctor t =>
(p :-> q) -> t p :-> t q
bifmap p :-> t q
f
  bijoin   :: t (t p) :-> t p
  bijoin = (t p :-> t p) -> t (t p) :-> t p
forall k k (t :: (k -> k -> *) -> k -> k -> *) (p :: k -> k -> *)
       (q :: k -> k -> *).
BifunctorMonad t =>
(p :-> t q) -> t p :-> t q
bibind t p :-> t p
forall a. a -> a
id
#if __GLASGOW_HASKELL__ >= 708
  {-# MINIMAL bireturn, (bibind | bijoin) #-}
#endif

biliftM :: BifunctorMonad t => (p :-> q) -> t p :-> t q
biliftM :: (p :-> q) -> t p :-> t q
biliftM p :-> q
f = (p :-> t q) -> t p :-> t q
forall k k (t :: (k -> k -> *) -> k -> k -> *) (p :: k -> k -> *)
       (q :: k -> k -> *).
BifunctorMonad t =>
(p :-> t q) -> t p :-> t q
bibind (q a b -> t q a b
forall k k (t :: (k -> k -> *) -> k -> k -> *) (p :: k -> k -> *).
BifunctorMonad t =>
p :-> t p
bireturn (q a b -> t q a b) -> (p a b -> q a b) -> p a b -> t q a b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. p a b -> q a b
p :-> q
f)
{-# INLINE biliftM #-}

class BifunctorFunctor t => BifunctorComonad t where
  biextract :: t p :-> p
  biextend :: (t p :-> q) -> t p :-> t q
  biextend t p :-> q
f = (t p :-> q) -> t (t p) :-> t q
forall k k k k (t :: (k -> k -> *) -> k -> k -> *)
       (p :: k -> k -> *) (q :: k -> k -> *).
BifunctorFunctor t =>
(p :-> q) -> t p :-> t q
bifmap t p :-> q
f (t (t p) a b -> t q a b)
-> (t p a b -> t (t p) a b) -> t p a b -> t q a b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. t p a b -> t (t p) a b
forall k k (t :: (k -> k -> *) -> k -> k -> *) (p :: k -> k -> *).
BifunctorComonad t =>
t p :-> t (t p)
biduplicate
  biduplicate :: t p :-> t (t p)
  biduplicate =  (t p :-> t p) -> t p :-> t (t p)
forall k k (t :: (k -> k -> *) -> k -> k -> *) (p :: k -> k -> *)
       (q :: k -> k -> *).
BifunctorComonad t =>
(t p :-> q) -> t p :-> t q
biextend t p :-> t p
forall a. a -> a
id
#if __GLASGOW_HASKELL__ >= 708
  {-# MINIMAL biextract, (biextend | biduplicate) #-}
#endif

biliftW :: BifunctorComonad t => (p :-> q) -> t p :-> t q
biliftW :: (p :-> q) -> t p :-> t q
biliftW p :-> q
f = (t p :-> q) -> t p :-> t q
forall k k (t :: (k -> k -> *) -> k -> k -> *) (p :: k -> k -> *)
       (q :: k -> k -> *).
BifunctorComonad t =>
(t p :-> q) -> t p :-> t q
biextend (p a b -> q a b
p :-> q
f (p a b -> q a b) -> (t p a b -> p a b) -> t p a b -> q a b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. t p a b -> p a b
forall k k (t :: (k -> k -> *) -> k -> k -> *) (p :: k -> k -> *).
BifunctorComonad t =>
t p :-> p
biextract)
{-# INLINE biliftW #-}