{-# LANGUAGE FlexibleContexts #-}
module Hyper.Class.Functor
( HFunctor (..)
, hmapped1
, hiso
) where
import Control.Lens (AnIso', Iso', Setter, cloneIso, iso, sets, _Wrapped)
import GHC.Generics
import GHC.Generics.Lens (generic1)
import Hyper.Class.Nodes (HNodes (..), HWitness (..), (#>), _HWitness)
import Hyper.Type (type (#))
import Hyper.Internal.Prelude
class HNodes h => HFunctor h where
hmap ::
(forall n. HWitness h n -> p # n -> q # n) ->
h # p ->
h # q
{-# INLINE hmap #-}
default hmap ::
(Generic1 h, HFunctor (Rep1 h), HWitnessType h ~ HWitnessType (Rep1 h)) =>
(forall n. HWitness h n -> p # n -> q # n) ->
h # p ->
h # q
hmap forall (n :: HyperType). HWitness h n -> (p # n) -> q # n
f = forall {k1} {k2} (f :: k1 -> *) (g :: k2 -> *) (a :: k1) (b :: k2).
(Generic1 f, Generic1 g) =>
Iso (f a) (g b) (Rep1 f a) (Rep1 g b)
generic1 forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ forall (h :: HyperType) (p :: HyperType) (q :: HyperType).
HFunctor h =>
(forall (n :: HyperType). HWitness h n -> (p # n) -> q # n)
-> (h # p) -> h # q
hmap (forall (n :: HyperType). HWitness h n -> (p # n) -> q # n
f forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall (h1 :: HyperType) (n1 :: HyperType) (h2 :: HyperType)
(n2 :: HyperType).
Iso
(HWitness h1 n1)
(HWitness h2 n2)
(HWitnessType h1 n1)
(HWitnessType h2 n2)
_HWitness forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ forall a. a -> a
id))
instance HFunctor (Const a) where
{-# INLINE hmap #-}
hmap :: forall (p :: HyperType) (q :: HyperType).
(forall (n :: HyperType). HWitness (Const a) n -> (p # n) -> q # n)
-> (Const a # p) -> Const a # q
hmap forall (n :: HyperType). HWitness (Const a) n -> (p # n) -> q # n
_ = forall s t. Rewrapping s t => Iso s t (Unwrapped s) (Unwrapped t)
_Wrapped forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ forall a. a -> a
id
instance (HFunctor a, HFunctor b) => HFunctor (a :*: b) where
{-# INLINE hmap #-}
hmap :: forall (p :: HyperType) (q :: HyperType).
(forall (n :: HyperType). HWitness (a :*: b) n -> (p # n) -> q # n)
-> ((a :*: b) # p) -> (a :*: b) # q
hmap forall (n :: HyperType). HWitness (a :*: b) n -> (p # n) -> q # n
f (a ('AHyperType p)
x :*: b ('AHyperType p)
y) =
forall (h :: HyperType) (p :: HyperType) (q :: HyperType).
HFunctor h =>
(forall (n :: HyperType). HWitness h n -> (p # n) -> q # n)
-> (h # p) -> h # q
hmap (forall (n :: HyperType). HWitness (a :*: b) n -> (p # n) -> q # n
f forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (h :: HyperType) (n :: HyperType).
HWitnessType h n -> HWitness h n
HWitness forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall k (f :: k -> *) (g :: k -> *) (p :: k). f p -> (:+:) f g p
L1) a ('AHyperType p)
x
forall k (f :: k -> *) (g :: k -> *) (p :: k).
f p -> g p -> (:*:) f g p
:*: forall (h :: HyperType) (p :: HyperType) (q :: HyperType).
HFunctor h =>
(forall (n :: HyperType). HWitness h n -> (p # n) -> q # n)
-> (h # p) -> h # q
hmap (forall (n :: HyperType). HWitness (a :*: b) n -> (p # n) -> q # n
f forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (h :: HyperType) (n :: HyperType).
HWitnessType h n -> HWitness h n
HWitness forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall k (f :: k -> *) (g :: k -> *) (p :: k). g p -> (:+:) f g p
R1) b ('AHyperType p)
y
instance (HFunctor a, HFunctor b) => HFunctor (a :+: b) where
{-# INLINE hmap #-}
hmap :: forall (p :: HyperType) (q :: HyperType).
(forall (n :: HyperType). HWitness (a :+: b) n -> (p # n) -> q # n)
-> ((a :+: b) # p) -> (a :+: b) # q
hmap forall (n :: HyperType). HWitness (a :+: b) n -> (p # n) -> q # n
f (L1 a ('AHyperType p)
x) = forall k (f :: k -> *) (g :: k -> *) (p :: k). f p -> (:+:) f g p
L1 (forall (h :: HyperType) (p :: HyperType) (q :: HyperType).
HFunctor h =>
(forall (n :: HyperType). HWitness h n -> (p # n) -> q # n)
-> (h # p) -> h # q
hmap (forall (n :: HyperType). HWitness (a :+: b) n -> (p # n) -> q # n
f forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (h :: HyperType) (n :: HyperType).
HWitnessType h n -> HWitness h n
HWitness forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall k (f :: k -> *) (g :: k -> *) (p :: k). f p -> (:+:) f g p
L1) a ('AHyperType p)
x)
hmap forall (n :: HyperType). HWitness (a :+: b) n -> (p # n) -> q # n
f (R1 b ('AHyperType p)
x) = forall k (f :: k -> *) (g :: k -> *) (p :: k). g p -> (:+:) f g p
R1 (forall (h :: HyperType) (p :: HyperType) (q :: HyperType).
HFunctor h =>
(forall (n :: HyperType). HWitness h n -> (p # n) -> q # n)
-> (h # p) -> h # q
hmap (forall (n :: HyperType). HWitness (a :+: b) n -> (p # n) -> q # n
f forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (h :: HyperType) (n :: HyperType).
HWitnessType h n -> HWitness h n
HWitness forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall k (f :: k -> *) (g :: k -> *) (p :: k). g p -> (:+:) f g p
R1) b ('AHyperType p)
x)
deriving newtype instance HFunctor h => HFunctor (M1 i m h)
deriving newtype instance HFunctor h => HFunctor (Rec1 h)
{-# INLINE hmapped1 #-}
hmapped1 ::
forall h n p q.
(HFunctor h, HNodesConstraint h ((~) n)) =>
Setter (h # p) (h # q) (p # n) (q # n)
hmapped1 :: forall (h :: HyperType) (n :: HyperType) (p :: HyperType)
(q :: HyperType).
(HFunctor h, HNodesConstraint h ((~) n)) =>
Setter (h # p) (h # q) (p # n) (q # n)
hmapped1 = 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 # n) -> q # n
f -> forall (h :: HyperType) (p :: HyperType) (q :: HyperType).
HFunctor h =>
(forall (n :: HyperType). HWitness h n -> (p # n) -> q # n)
-> (h # p) -> h # q
hmap (forall {k} (t :: k). Proxy t
Proxy @((~) n) forall (h :: HyperType) (c :: HyperType -> Constraint)
(n :: HyperType) r.
(HNodes h, HNodesConstraint h c) =>
Proxy c -> (c n => r) -> HWitness h n -> r
#> (p # n) -> q # n
f))
hiso ::
HFunctor h =>
(forall n. HWitness h n -> AnIso' (p # n) (q # n)) ->
Iso' (h # p) (h # q)
hiso :: forall (h :: HyperType) (p :: HyperType) (q :: HyperType).
HFunctor h =>
(forall (n :: HyperType). HWitness h n -> AnIso' (p # n) (q # n))
-> Iso' (h # p) (h # q)
hiso forall (n :: HyperType). HWitness h n -> AnIso' (p # n) (q # n)
f = forall s a b t. (s -> a) -> (b -> t) -> Iso s t a b
iso (forall (h :: HyperType) (p :: HyperType) (q :: HyperType).
HFunctor h =>
(forall (n :: HyperType). HWitness h n -> (p # n) -> q # n)
-> (h # p) -> h # q
hmap (\HWitness h n
w -> (forall s a. s -> Getting a s a -> a
^. forall s t a b. AnIso s t a b -> Iso s t a b
cloneIso (forall (n :: HyperType). HWitness h n -> AnIso' (p # n) (q # n)
f HWitness h n
w)))) (forall (h :: HyperType) (p :: HyperType) (q :: HyperType).
HFunctor h =>
(forall (n :: HyperType). HWitness h n -> (p # n) -> q # n)
-> (h # p) -> h # q
hmap (\HWitness h n
w -> (forall s t a b. AnIso s t a b -> Iso s t a b
cloneIso (forall (n :: HyperType). HWitness h n -> AnIso' (p # n) (q # n)
f HWitness h n
w) forall t b. AReview t b -> b -> t
#)))