{-# LANGUAGE FlexibleInstances #-}

-- | An extension of 'HFunctor' for parameterized 'Hyper.Type.HyperType's
module Hyper.Class.Morph
    ( HMorph (..)
    , HMorphWithConstraint
    , morphTraverse
    , (#?>)
    , HIs2
    , morphMapped1
    , morphTraverse1
    ) where

import Control.Lens (Setter, sets)
import Data.Kind (Type)
import Hyper.Class.Traversable (ContainedH (..), HTraversable (..))
import Hyper.Type (HyperType, type (#))

import Hyper.Internal.Prelude

-- | A type-varying variant of 'HFunctor' which can modify type parameters of the mapped 'HyperType'
class HMorph s t where
    type MorphConstraint s t (c :: (HyperType -> HyperType -> Constraint)) :: Constraint

    data MorphWitness s t :: HyperType -> HyperType -> Type

    morphMap ::
        (forall a b. MorphWitness s t a b -> p # a -> q # b) ->
        s # p ->
        t # q

    morphLiftConstraint ::
        MorphConstraint s t c =>
        MorphWitness s t a b ->
        Proxy c ->
        (c a b => r) ->
        r

type HMorphWithConstraint s t c = (HMorph s t, MorphConstraint s t c)

-- | 'HTraversable' extended with support of changing type parameters of the 'HyperType'
morphTraverse ::
    (Applicative f, HMorph s t, HTraversable t) =>
    (forall a b. MorphWitness s t a b -> p # a -> f (q # b)) ->
    s # p ->
    f (t # q)
morphTraverse :: forall (f :: * -> *) (s :: AHyperType -> *) (t :: AHyperType -> *)
       (p :: AHyperType -> *) (q :: AHyperType -> *).
(Applicative f, HMorph s t, HTraversable t) =>
(forall (a :: AHyperType -> *) (b :: AHyperType -> *).
 MorphWitness s t a b -> (p # a) -> f (q # b))
-> (s # p) -> f (t # q)
morphTraverse forall (a :: AHyperType -> *) (b :: AHyperType -> *).
MorphWitness s t a b -> (p # a) -> f (q # b)
f = forall (h :: AHyperType -> *) (f :: * -> *) (p :: AHyperType -> *).
(HTraversable h, Applicative f) =>
(h # ContainedH f p) -> f (h # p)
hsequence forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (s :: AHyperType -> *) (t :: AHyperType -> *)
       (p :: AHyperType -> *) (q :: AHyperType -> *).
HMorph s t =>
(forall (a :: AHyperType -> *) (b :: AHyperType -> *).
 MorphWitness s t a b -> (p # a) -> q # b)
-> (s # p) -> t # q
morphMap (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall (f :: * -> *) (p :: AHyperType -> *) (h :: AHyperType).
f (p h) -> ContainedH f p h
MkContainedH forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (a :: AHyperType -> *) (b :: AHyperType -> *).
MorphWitness s t a b -> (p # a) -> f (q # b)
f)

(#?>) ::
    (HMorph s t, MorphConstraint s t c) =>
    Proxy c ->
    (c a b => r) ->
    MorphWitness s t a b ->
    r
#?> :: forall (s :: AHyperType -> *) (t :: AHyperType -> *)
       (c :: (AHyperType -> *) -> (AHyperType -> *) -> Constraint)
       (a :: AHyperType -> *) (b :: AHyperType -> *) r.
(HMorph s t, MorphConstraint s t c) =>
Proxy c -> (c a b => r) -> MorphWitness s t a b -> r
(#?>) Proxy c
p c a b => r
r MorphWitness s t a b
w = forall (s :: AHyperType -> *) (t :: AHyperType -> *)
       (c :: (AHyperType -> *) -> (AHyperType -> *) -> Constraint)
       (a :: AHyperType -> *) (b :: AHyperType -> *) r.
(HMorph s t, MorphConstraint s t c) =>
MorphWitness s t a b -> Proxy c -> (c a b => r) -> r
morphLiftConstraint MorphWitness s t a b
w Proxy c
p c a b => r
r

class (i0 ~ t0, i1 ~ t1) => HIs2 (i0 :: HyperType) (i1 :: HyperType) t0 t1
instance HIs2 a b a b

morphMapped1 ::
    forall a b s t p q.
    HMorphWithConstraint s t (HIs2 a b) =>
    Setter (s # p) (t # q) (p # a) (q # b)
morphMapped1 :: forall (a :: AHyperType -> *) (b :: AHyperType -> *)
       (s :: AHyperType -> *) (t :: AHyperType -> *)
       (p :: AHyperType -> *) (q :: AHyperType -> *).
HMorphWithConstraint s t (HIs2 a b) =>
Setter (s # p) (t # q) (p # a) (q # b)
morphMapped1 = forall (p :: * -> * -> *) (q :: * -> * -> *) (f :: * -> *) a b s t.
(Profunctor p, Profunctor q, Settable f) =>
(p a b -> q s t) -> Optical p q f s t a b
sets (\(p # a) -> q # b
f -> forall (s :: AHyperType -> *) (t :: AHyperType -> *)
       (p :: AHyperType -> *) (q :: AHyperType -> *).
HMorph s t =>
(forall (a :: AHyperType -> *) (b :: AHyperType -> *).
 MorphWitness s t a b -> (p # a) -> q # b)
-> (s # p) -> t # q
morphMap (forall {k} (t :: k). Proxy t
Proxy @(HIs2 a b) forall (s :: AHyperType -> *) (t :: AHyperType -> *)
       (c :: (AHyperType -> *) -> (AHyperType -> *) -> Constraint)
       (a :: AHyperType -> *) (b :: AHyperType -> *) r.
(HMorph s t, MorphConstraint s t c) =>
Proxy c -> (c a b => r) -> MorphWitness s t a b -> r
#?> (p # a) -> q # b
f))

morphTraverse1 ::
    (HMorphWithConstraint s t (HIs2 a b), HTraversable t) =>
    Traversal (s # p) (t # q) (p # a) (q # b)
morphTraverse1 :: forall (s :: AHyperType -> *) (t :: AHyperType -> *)
       (a :: AHyperType -> *) (b :: AHyperType -> *)
       (p :: AHyperType -> *) (q :: AHyperType -> *).
(HMorphWithConstraint s t (HIs2 a b), HTraversable t) =>
Traversal (s # p) (t # q) (p # a) (q # b)
morphTraverse1 (p # a) -> f (q # b)
f = forall (h :: AHyperType -> *) (f :: * -> *) (p :: AHyperType -> *).
(HTraversable h, Applicative f) =>
(h # ContainedH f p) -> f (h # p)
hsequence forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall (a :: AHyperType -> *) (b :: AHyperType -> *)
       (s :: AHyperType -> *) (t :: AHyperType -> *)
       (p :: AHyperType -> *) (q :: AHyperType -> *).
HMorphWithConstraint s t (HIs2 a b) =>
Setter (s # p) (t # q) (p # a) (q # b)
morphMapped1 forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ forall (f :: * -> *) (p :: AHyperType -> *) (h :: AHyperType).
f (p h) -> ContainedH f p h
MkContainedH forall b c a. (b -> c) -> (a -> b) -> a -> c
. (p # a) -> f (q # b)
f)