{-# Language FlexibleContexts, FlexibleInstances, MultiParamTypeClasses, RankNTypes, TypeFamilies, UndecidableInstances #-}

-- | This module provides natural transformations 'Map', 'Fold', and 'Traversal', as well as three rank-2 functions
-- that wrap them in a convenient interface.

module Transformation.Rank2 where

import Data.Functor.Compose (Compose(Compose))
import Data.Functor.Const (Const(Const))
import           Transformation (Transformation, Domain, Codomain)
import qualified Transformation
import qualified Transformation.Deep as Deep
import qualified Transformation.Full as Full

-- | Transform (naturally) the containing functor of every node in the given tree.
(<$>) :: Deep.Functor (Map p q) g => (forall a. p a -> q a) -> g p p -> g q q
forall a. p a -> q a
f <$> :: forall (p :: * -> *) (q :: * -> *)
       (g :: (* -> *) -> (* -> *) -> *).
Functor (Map p q) g =>
(forall a. p a -> q a) -> g p p -> g q q
<$> g p p
x = forall (p :: * -> *) (q :: * -> *).
(forall x. p x -> q x) -> Map p q
Map forall a. p a -> q a
f forall t (g :: (* -> *) -> (* -> *) -> *).
Functor t g =>
t -> g (Domain t) (Domain t) -> g (Codomain t) (Codomain t)
Deep.<$> g p p
x
infixl 4 <$>

-- | Fold the containing functor of every node in the given tree.
foldMap :: (Deep.Foldable (Fold p m) g, Monoid m) => (forall a. p a -> m) -> g p p -> m
foldMap :: forall (p :: * -> *) m (g :: (* -> *) -> (* -> *) -> *).
(Foldable (Fold p m) g, Monoid m) =>
(forall a. p a -> m) -> g p p -> m
foldMap forall a. p a -> m
f = forall t (g :: (* -> *) -> (* -> *) -> *) m.
(Foldable t g, Codomain t ~ Const m, Monoid m) =>
t -> g (Domain t) (Domain t) -> m
Deep.foldMap (forall (p :: * -> *) m. (forall x. p x -> m) -> Fold p m
Fold forall a. p a -> m
f)

-- | Traverse the containing functors of all nodes in the given tree.
traverse :: Deep.Traversable (Traversal p q m) g => (forall a. p a -> m (q a)) -> g p p -> m (g q q)
traverse :: forall (p :: * -> *) (q :: * -> *) (m :: * -> *)
       (g :: (* -> *) -> (* -> *) -> *).
Traversable (Traversal p q m) g =>
(forall a. p a -> m (q a)) -> g p p -> m (g q q)
traverse forall a. p a -> m (q a)
f = forall t (g :: (* -> *) -> (* -> *) -> *) (m :: * -> *)
       (f :: * -> *).
(Traversable t g, Codomain t ~ Compose m f) =>
t -> g (Domain t) (Domain t) -> m (g f f)
Deep.traverse (forall (p :: * -> *) (q :: * -> *) (m :: * -> *).
(forall x. p x -> m (q x)) -> Traversal p q m
Traversal forall a. p a -> m (q a)
f)

newtype Map p q = Map (forall x. p x -> q x)

newtype Fold p m = Fold (forall x. p x -> m)

newtype Traversal p q m = Traversal (forall x. p x -> m (q x))

instance Transformation (Map p q) where
   type Domain (Map p q) = p
   type Codomain (Map p q) = q

instance Transformation (Fold p m) where
   type Domain (Fold p m) = p
   type Codomain (Fold p m) = Const m

instance Transformation (Traversal p q m) where
   type Domain (Traversal p q m) = p
   type Codomain (Traversal p q m) = Compose m q

instance Transformation.At (Map p q) x where
   $ :: Map p q -> Domain (Map p q) x -> Codomain (Map p q) x
($) (Map forall x. p x -> q x
f) = forall x. p x -> q x
f

instance Transformation.At (Fold p m) x where
   $ :: Fold p m -> Domain (Fold p m) x -> Codomain (Fold p m) x
($) (Fold forall x. p x -> m
f) = forall {k} a (b :: k). a -> Const a b
Const forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall x. p x -> m
f

instance Transformation.At (Traversal p q m) x where
   $ :: Traversal p q m
-> Domain (Traversal p q m) x -> Codomain (Traversal p q m) x
($) (Traversal forall x. p x -> m (q x)
f) = forall {k} {k1} (f :: k -> *) (g :: k1 -> k) (a :: k1).
f (g a) -> Compose f g a
Compose forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall x. p x -> m (q x)
f

instance (Deep.Functor (Map p q) g, Functor p) => Full.Functor (Map p q) g where
  <$> :: Map p q
-> Domain (Map p q) (g (Domain (Map p q)) (Domain (Map p q)))
-> Codomain (Map p q) (g (Codomain (Map p q)) (Codomain (Map p q)))
(<$>) = forall t (g :: (* -> *) -> (* -> *) -> *).
(Functor t g, At t (g (Codomain t) (Codomain t)),
 Functor (Domain t)) =>
t
-> Domain t (g (Domain t) (Domain t))
-> Codomain t (g (Codomain t) (Codomain t))
Full.mapUpDefault