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