{-# 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) -> g p p -> g q q
(<$>) forall a. p a -> q a
f = Map p q
-> g (Domain (Map p q)) (Domain (Map p q))
-> g (Codomain (Map p q)) (Codomain (Map p q))
forall t (g :: (* -> *) -> (* -> *) -> *).
Functor t g =>
t -> g (Domain t) (Domain t) -> g (Codomain t) (Codomain t)
(Deep.<$>) ((forall a. p a -> q a) -> Map p q
forall (p :: * -> *) (q :: * -> *).
(forall x. p x -> q x) -> Map p q
Map forall a. p a -> q a
f)

-- | 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 a. p a -> m) -> g p p -> m
foldMap forall a. p a -> m
f = Fold p m -> g (Domain (Fold p m)) (Domain (Fold p m)) -> m
forall t (g :: (* -> *) -> (* -> *) -> *) m.
(Foldable t g, Codomain t ~ Const m, Monoid m) =>
t -> g (Domain t) (Domain t) -> m
Deep.foldMap ((forall a. p a -> m) -> Fold p m
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 a. p a -> m (q a)) -> g p p -> m (g q q)
traverse forall a. p a -> m (q a)
f = Traversal p q m
-> g (Domain (Traversal p q m)) (Domain (Traversal p q m))
-> m (g q q)
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 a. p a -> m (q a)) -> Traversal p q m
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) = Domain (Map p q) x -> Codomain (Map p q) x
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) = m -> Const m x
forall k a (b :: k). a -> Const a b
Const (m -> Const m x) -> (p x -> m) -> p x -> Const m x
forall b c a. (b -> c) -> (a -> b) -> a -> c
. p x -> m
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) = m (q x) -> Compose m q x
forall k k1 (f :: k -> *) (g :: k1 -> k) (a :: k1).
f (g a) -> Compose f g a
Compose (m (q x) -> Compose m q x)
-> (p x -> m (q x)) -> p x -> Compose m q x
forall b c a. (b -> c) -> (a -> b) -> a -> c
. p x -> m (q x)
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)))
(<$>) = 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