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

module Transformation.Rank2 where

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

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

(<$>) :: 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)

foldMap :: (Deep.Functor (Fold p m) g, Rank2.Foldable (g (Const m)), 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 = (forall a. Const m a -> m) -> g (Const m) (Const m) -> m
forall k (g :: (k -> *) -> *) m (p :: k -> *).
(Foldable g, Monoid m) =>
(forall (a :: k). p a -> m) -> g p -> m
Rank2.foldMap forall a. Const m a -> m
forall a k (b :: k). Const a b -> a
getConst (g (Const m) (Const m) -> m)
-> (g p p -> g (Const m) (Const m)) -> g p p -> m
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Fold p m
-> g (Domain (Fold p m)) (Domain (Fold p m))
-> g (Codomain (Fold p m)) (Codomain (Fold p m))
forall t (g :: (* -> *) -> (* -> *) -> *).
Functor t g =>
t -> g (Domain t) (Domain t) -> g (Codomain t) (Codomain t)
Deep.fmap ((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 :: 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)

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