{-# 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 Data.Kind (Type)
import qualified Rank2
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 a. p a -> q a) -> Map p q
forall (p :: * -> *) (q :: * -> *).
(forall x. p x -> q x) -> Map p q
Map p x -> q x
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.<$> g p p
g (Domain (Map p q)) (Domain (Map p q))
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 = Fold p m -> g (Domain (Fold p m)) (Domain (Fold p m)) -> m
forall m.
(Codomain (Fold p m) ~ Const m, Monoid m) =>
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 p x -> m
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 = 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)
forall (m :: * -> *) (f :: * -> *).
(Codomain (Traversal p q m) ~ Compose m f) =>
Traversal p q m
-> g (Domain (Traversal p q m)) (Domain (Traversal p q m))
-> 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 p x -> m (q x)
forall a. p a -> m (q a)
f)

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

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

newtype Traversal (p :: Type -> Type) (q :: Type -> Type) 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) = p x -> q x
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 (Rank2.Functor (g p), 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