{-# Language DeriveDataTypeable, FlexibleInstances, KindSignatures, MultiParamTypeClasses, RankNTypes,
             StandaloneDeriving, TypeFamilies, UndecidableInstances #-}

-- | Type classes 'Functor', 'Foldable', and 'Traversable' that correspond to the standard type classes of the same
-- name. The [rank2classes](https://hackage.haskell.org/package/rank2classes) package provides the equivalent set
-- of classes for natural transformations.

module Transformation.Shallow where

import Control.Applicative (Applicative, (<*>), liftA2)
import Data.Data (Data, Typeable)
import Data.Functor.Compose (Compose)
import Data.Functor.Const (Const)
import Data.Kind (Type)
import qualified Rank2
import qualified Data.Functor
import           Transformation (Transformation, Domain, Codomain)

import Prelude hiding (Foldable(..), Traversable(..), Functor(..), Applicative(..), (<$>), fst, snd)

-- | Like 'Rank2.Functor' except it takes a 'Transformation' instead of a polymorphic function
class (Transformation t, Rank2.Functor g) => Functor t g where
   (<$>) :: t -> g (Domain t) -> g (Codomain t)

-- | Like 'Rank2.Foldable' except it takes a 'Transformation' instead of a polymorphic function
class (Transformation t, Rank2.Foldable g) => Foldable t g where
   foldMap :: (Codomain t ~ Const m, Monoid m) => t -> g (Domain t) -> m

-- | Like 'Rank2.Traversable' except it takes a 'Transformation' instead of a polymorphic function
class (Transformation t, Rank2.Traversable g) => Traversable t g where
   traverse :: Codomain t ~ Compose m f => t -> g (Domain t) -> m (g f)

instance (Functor t g, Functor t h) => Functor t (Rank2.Product g h) where
   t
t <$> :: t -> Product g h (Domain t) -> Product g h (Codomain t)
<$> Rank2.Pair g (Domain t)
left h (Domain t)
right = g (Codomain t) -> h (Codomain t) -> Product g h (Codomain t)
forall k (f :: k -> *) (g :: k -> *) (a :: k).
f a -> g a -> Product f g a
Rank2.Pair (t
t t -> g (Domain t) -> g (Codomain t)
forall t (g :: (* -> *) -> *).
Functor t g =>
t -> g (Domain t) -> g (Codomain t)
<$> g (Domain t)
left) (t
t t -> h (Domain t) -> h (Codomain t)
forall t (g :: (* -> *) -> *).
Functor t g =>
t -> g (Domain t) -> g (Codomain t)
<$> h (Domain t)
right)

instance (Foldable t g, Foldable t h, Codomain t ~ Const m, Monoid m) => Foldable t (Rank2.Product g h) where
   foldMap :: t -> Product g h (Domain t) -> m
foldMap t
t (Rank2.Pair g (Domain t)
left h (Domain t)
right) = t -> g (Domain t) -> m
forall t (g :: (* -> *) -> *) m.
(Foldable t g, Codomain t ~ Const m, Monoid m) =>
t -> g (Domain t) -> m
foldMap t
t g (Domain t)
left m -> m -> m
forall a. Semigroup a => a -> a -> a
<> t -> h (Domain t) -> m
forall t (g :: (* -> *) -> *) m.
(Foldable t g, Codomain t ~ Const m, Monoid m) =>
t -> g (Domain t) -> m
foldMap t
t h (Domain t)
right

instance (Traversable t g, Traversable t h, Codomain t ~ Compose m f, Applicative m) => Traversable t (Rank2.Product g h) where
   traverse :: t -> Product g h (Domain t) -> m (Product g h f)
traverse t
t (Rank2.Pair g (Domain t)
left h (Domain t)
right) = (g f -> h f -> Product g h f)
-> m (g f) -> m (h f) -> m (Product g h f)
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 g f -> h f -> Product g h f
forall k (f :: k -> *) (g :: k -> *) (a :: k).
f a -> g a -> Product f g a
Rank2.Pair (t -> g (Domain t) -> m (g f)
forall t (g :: (* -> *) -> *) (m :: * -> *) (f :: * -> *).
(Traversable t g, Codomain t ~ Compose m f) =>
t -> g (Domain t) -> m (g f)
traverse t
t g (Domain t)
left) (t -> h (Domain t) -> m (h f)
forall t (g :: (* -> *) -> *) (m :: * -> *) (f :: * -> *).
(Traversable t g, Codomain t ~ Compose m f) =>
t -> g (Domain t) -> m (g f)
traverse t
t h (Domain t)
right)

-- | Alphabetical synonym for '<$>'
fmap :: Functor t g => t -> g (Domain t) -> g (Codomain t)
fmap :: t -> g (Domain t) -> g (Codomain t)
fmap = t -> g (Domain t) -> g (Codomain t)
forall t (g :: (* -> *) -> *).
Functor t g =>
t -> g (Domain t) -> g (Codomain t)
(<$>)