{-# 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. This module extends the functionality to unnatural transformations.

module Transformation.Shallow where

import Control.Applicative (Applicative, liftA2)
import Data.Functor.Compose (Compose)
import Data.Functor.Const (Const)
import qualified Rank2
import           Transformation (Transformation, Domain, Codomain)

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

-- | Like Rank2.'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)
   infixl 4 <$>

-- | Like Rank2.'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.'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. Monoid a => a -> a -> a
`mappend` 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)
(<$>)