{-# Language DataKinds, DefaultSignatures, FlexibleContexts, FlexibleInstances, GeneralizedNewtypeDeriving,
InstanceSigs, MultiParamTypeClasses, PolyKinds, RankNTypes, ScopedTypeVariables, StandaloneDeriving,
TypeApplications, TypeFamilies, TypeOperators, UndecidableInstances #-}
module Transformation.AG.Generics (
Auto(..), Keep(..), Folded(..), Mapped(..), Traversed(..),
Bequether(..), Synthesizer(..), SynthesizedField(..), Revelation(..),
foldedField, mappedField, passDown, bequestDefault)
where
import Data.Functor.Compose (Compose(..))
import Data.Functor.Const (Const(..))
import Data.Kind (Type)
import Data.Generics.Product.Subtype (Subtype(upcast))
import Data.Proxy (Proxy(..))
import Data.Semigroup (Semigroup(..))
import GHC.Generics
import GHC.Records
import GHC.TypeLits (Symbol, ErrorMessage (Text), TypeError)
import Unsafe.Coerce (unsafeCoerce)
import qualified Rank2
import Transformation (Transformation, Domain, Codomain, At)
import Transformation.AG
import qualified Transformation
import qualified Transformation.Shallow as Shallow
import qualified Transformation.Deep as Deep
import qualified Transformation.Full as Full
newtype Auto t = Auto t
newtype Keep t = Keep t
type instance Atts (Inherited (Auto t)) x = Atts (Inherited t) x
type instance Atts (Synthesized (Auto t)) x = Atts (Synthesized t) x
type instance Atts (Inherited (Keep t)) x = Atts (Inherited t) x
type instance Atts (Synthesized (Keep t)) x = Atts (Synthesized t) x
instance {-# overlappable #-} (Revelation (Auto t), Domain (Auto t) ~ f, Codomain (Auto t) ~ Semantics (Auto t),
Rank2.Apply (g (Semantics (Auto t))), Attribution (Auto t) g (Semantics (Auto t)) f) =>
Auto t `At` g (Semantics (Auto t)) (Semantics (Auto t)) where
Auto t
t $ :: Auto t
-> Domain (Auto t) (g (Semantics (Auto t)) (Semantics (Auto t)))
-> Codomain (Auto t) (g (Semantics (Auto t)) (Semantics (Auto t)))
$ Domain (Auto t) (g (Semantics (Auto t)) (Semantics (Auto t)))
x = forall (q :: * -> *) t x (g :: (* -> *) -> (* -> *) -> *)
(p :: * -> *).
(q ~ Semantics t, x ~ g q q, Apply (g q), Attribution t g q p) =>
(forall a. p a -> a) -> t -> p x -> q x
applyDefault (forall t x. Revelation t => t -> Domain t x -> x
reveal Auto t
t) Auto t
t Domain (Auto t) (g (Semantics (Auto t)) (Semantics (Auto t)))
x
{-# INLINE ($) #-}
instance {-# overlappable #-}
(Revelation (Keep t), p ~ Transformation.Domain (Keep t), Rank2.Apply (g q),
q ~ Transformation.Codomain (Keep t), q ~ PreservingSemantics (Keep t) p, s ~ Semantics (Keep t),
Atts (Inherited (Keep t)) (g q q) ~ Atts (Inherited (Keep t)) (g s s),
Atts (Synthesized (Keep t)) (g q q) ~ Atts (Synthesized (Keep t)) (g s s),
g q (Synthesized (Keep t)) ~ g s (Synthesized (Keep t)),
g q (Inherited (Keep t)) ~ g s (Inherited (Keep t)), Attribution (Keep t) g q p) =>
Keep t `At` g (PreservingSemantics (Keep t) p) (PreservingSemantics (Keep t) p) where
($) :: Keep t -> p (g (PreservingSemantics (Keep t) p) (PreservingSemantics (Keep t) p))
-> PreservingSemantics (Keep t) p (g (PreservingSemantics (Keep t) p) (PreservingSemantics (Keep t) p))
Keep t
t $ :: Keep t
-> p (g (PreservingSemantics (Keep t) p)
(PreservingSemantics (Keep t) p))
-> PreservingSemantics
(Keep t)
p
(g (PreservingSemantics (Keep t) p)
(PreservingSemantics (Keep t) p))
$ p (g (PreservingSemantics (Keep t) p)
(PreservingSemantics (Keep t) p))
x = forall (p :: * -> *) t (q :: * -> *) x
(g :: (* -> *) -> (* -> *) -> *).
(p ~ Domain t, q ~ PreservingSemantics t p, x ~ g q q, Apply (g q),
Atts (Inherited t) (g q q)
~ Atts (Inherited t) (g (Semantics t) (Semantics t)),
Atts (Synthesized t) (g q q)
~ Atts (Synthesized t) (g (Semantics t) (Semantics t)),
g q (Synthesized t) ~ g (Semantics t) (Synthesized t),
g q (Inherited t) ~ g (Semantics t) (Inherited t),
Attribution t g (PreservingSemantics t p) p) =>
(forall a. p a -> a)
-> t
-> p (g (PreservingSemantics t p) (PreservingSemantics t p))
-> PreservingSemantics
t p (g (PreservingSemantics t p) (PreservingSemantics t p))
applyDefaultWithAttributes (forall t x. Revelation t => t -> Domain t x -> x
reveal Keep t
t) Keep t
t p (g (PreservingSemantics (Keep t) p)
(PreservingSemantics (Keep t) p))
x
{-# INLINE ($) #-}
instance (Transformation (Auto t), Domain (Auto t) ~ f, Functor f, Codomain (Auto t) ~ Semantics (Auto t),
Deep.Functor (Auto t) g, Auto t `At` g (Semantics (Auto t)) (Semantics (Auto t))) =>
Full.Functor (Auto t) g where
<$> :: Auto t
-> Domain (Auto t) (g (Domain (Auto t)) (Domain (Auto t)))
-> Codomain (Auto t) (g (Codomain (Auto t)) (Codomain (Auto t)))
(<$>) = 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
instance (Transformation (Keep t), Domain (Keep t) ~ f, Functor f, Codomain (Keep t) ~ PreservingSemantics (Keep t) f,
Functor f, Deep.Functor (Keep t) g,
Keep t `At` g (PreservingSemantics (Keep t) f) (PreservingSemantics (Keep t) f)) =>
Full.Functor (Keep t) g where
<$> :: Keep t
-> Domain (Keep t) (g (Domain (Keep t)) (Domain (Keep t)))
-> Codomain (Keep t) (g (Codomain (Keep t)) (Codomain (Keep t)))
(<$>) = 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
instance {-# overlappable #-} (Bequether (Auto t) g d s, Synthesizer (Auto t) g d s) => Attribution (Auto t) g d s where
attribution :: Auto t -> s (g d d) -> Rule (Auto t) g
attribution Auto t
t s (g d d)
l (Inherited Atts (Inherited (Auto t)) (g sem (Semantics (Auto t)))
i, g sem (Synthesized (Auto t))
s) = (forall t a. Atts (Synthesized t) a -> Synthesized t a
Synthesized forall a b. (a -> b) -> a -> b
$ forall t (g :: (* -> *) -> (* -> *) -> *) (deep :: * -> *)
(shallow :: * -> *) (sem :: * -> *).
(Synthesizer t g deep shallow, sem ~ Semantics t) =>
t
-> shallow (g deep deep)
-> Atts (Inherited t) (g sem sem)
-> g sem (Synthesized t)
-> Atts (Synthesized t) (g sem sem)
synthesis Auto t
t s (g d d)
l Atts (Inherited (Auto t)) (g sem (Semantics (Auto t)))
i g sem (Synthesized (Auto t))
s, forall t (g :: (* -> *) -> (* -> *) -> *) (deep :: * -> *)
(shallow :: * -> *) (sem :: * -> *).
(Bequether t g deep shallow, sem ~ Semantics t) =>
t
-> shallow (g deep deep)
-> Atts (Inherited t) (g sem sem)
-> g sem (Synthesized t)
-> g sem (Inherited t)
bequest Auto t
t s (g d d)
l Atts (Inherited (Auto t)) (g sem (Semantics (Auto t)))
i g sem (Synthesized (Auto t))
s)
class Transformation t => Revelation t where
reveal :: t -> Domain t x -> x
class Bequether t g deep shallow where
bequest :: forall sem. sem ~ Semantics t =>
t
-> shallow (g deep deep)
-> Atts (Inherited t) (g sem sem)
-> g sem (Synthesized t)
-> g sem (Inherited t)
class Synthesizer t g deep shallow where
synthesis :: forall sem. sem ~ Semantics t =>
t
-> shallow (g deep deep)
-> Atts (Inherited t) (g sem sem)
-> g sem (Synthesized t)
-> Atts (Synthesized t) (g sem sem)
class SynthesizedField (name :: Symbol) result t g deep shallow where
synthesizedField :: forall sem. sem ~ Semantics t =>
Proxy name
-> t
-> shallow (g deep deep)
-> Atts (Inherited t) (g sem sem)
-> g sem (Synthesized t)
-> result
instance {-# overlappable #-} (sem ~ Semantics t, Domain t ~ shallow, Revelation t,
Shallow.Functor (PassDown t sem (Atts (Inherited t) (g sem sem))) (g sem)) =>
Bequether t g (Semantics t) shallow where
bequest :: forall (sem :: * -> *).
(sem ~ Semantics t) =>
t
-> shallow (g (Semantics t) (Semantics t))
-> Atts (Inherited t) (g sem sem)
-> g sem (Synthesized t)
-> g sem (Inherited t)
bequest = forall t (g :: (* -> *) -> (* -> *) -> *) (shallow :: * -> *)
(sem :: * -> *).
(sem ~ Semantics t, Domain t ~ shallow, Revelation t,
Functor
(PassDown t sem (Atts (Inherited t) (g sem sem))) (g sem)) =>
t
-> shallow (g sem sem)
-> Atts (Inherited t) (g sem sem)
-> g sem (Synthesized t)
-> g sem (Inherited t)
bequestDefault
instance {-# overlappable #-} (Atts (Synthesized t) (g sem sem) ~ result, Generic result, sem ~ Semantics t,
GenericSynthesizer t g d s (Rep result)) => Synthesizer t g d s where
synthesis :: forall (sem :: * -> *).
(sem ~ Semantics t) =>
t
-> s (g d d)
-> Atts (Inherited t) (g sem sem)
-> g sem (Synthesized t)
-> Atts (Synthesized t) (g sem sem)
synthesis t
t s (g d d)
node Atts (Inherited t) (g sem sem)
i g sem (Synthesized t)
s = forall a x. Generic a => Rep a x -> a
to (forall {k} t (g :: (* -> *) -> (* -> *) -> *) (deep :: * -> *)
(shallow :: * -> *) (result :: k -> *) (a :: k) (sem :: * -> *).
(GenericSynthesizer t g deep shallow result, sem ~ Semantics t) =>
t
-> shallow (g deep deep)
-> Atts (Inherited t) (g sem sem)
-> g sem (Synthesized t)
-> result a
genericSynthesis t
t s (g d d)
node Atts (Inherited t) (g sem sem)
i g sem (Synthesized t)
s)
newtype Folded a = Folded{forall a. Folded a -> a
getFolded :: a} deriving (Folded a -> Folded a -> Bool
forall a. Eq a => Folded a -> Folded a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Folded a -> Folded a -> Bool
$c/= :: forall a. Eq a => Folded a -> Folded a -> Bool
== :: Folded a -> Folded a -> Bool
$c== :: forall a. Eq a => Folded a -> Folded a -> Bool
Eq, Folded a -> Folded a -> Bool
Folded a -> Folded a -> Ordering
Folded a -> Folded a -> Folded a
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall {a}. Ord a => Eq (Folded a)
forall a. Ord a => Folded a -> Folded a -> Bool
forall a. Ord a => Folded a -> Folded a -> Ordering
forall a. Ord a => Folded a -> Folded a -> Folded a
min :: Folded a -> Folded a -> Folded a
$cmin :: forall a. Ord a => Folded a -> Folded a -> Folded a
max :: Folded a -> Folded a -> Folded a
$cmax :: forall a. Ord a => Folded a -> Folded a -> Folded a
>= :: Folded a -> Folded a -> Bool
$c>= :: forall a. Ord a => Folded a -> Folded a -> Bool
> :: Folded a -> Folded a -> Bool
$c> :: forall a. Ord a => Folded a -> Folded a -> Bool
<= :: Folded a -> Folded a -> Bool
$c<= :: forall a. Ord a => Folded a -> Folded a -> Bool
< :: Folded a -> Folded a -> Bool
$c< :: forall a. Ord a => Folded a -> Folded a -> Bool
compare :: Folded a -> Folded a -> Ordering
$ccompare :: forall a. Ord a => Folded a -> Folded a -> Ordering
Ord, Int -> Folded a -> ShowS
forall a. Show a => Int -> Folded a -> ShowS
forall a. Show a => [Folded a] -> ShowS
forall a. Show a => Folded a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Folded a] -> ShowS
$cshowList :: forall a. Show a => [Folded a] -> ShowS
show :: Folded a -> String
$cshow :: forall a. Show a => Folded a -> String
showsPrec :: Int -> Folded a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> Folded a -> ShowS
Show, NonEmpty (Folded a) -> Folded a
Folded a -> Folded a -> Folded a
forall b. Integral b => b -> Folded a -> Folded a
forall a. Semigroup a => NonEmpty (Folded a) -> Folded a
forall a. Semigroup a => Folded a -> Folded a -> Folded a
forall a b. (Semigroup a, Integral b) => b -> Folded a -> Folded a
forall a.
(a -> a -> a)
-> (NonEmpty a -> a)
-> (forall b. Integral b => b -> a -> a)
-> Semigroup a
stimes :: forall b. Integral b => b -> Folded a -> Folded a
$cstimes :: forall a b. (Semigroup a, Integral b) => b -> Folded a -> Folded a
sconcat :: NonEmpty (Folded a) -> Folded a
$csconcat :: forall a. Semigroup a => NonEmpty (Folded a) -> Folded a
<> :: Folded a -> Folded a -> Folded a
$c<> :: forall a. Semigroup a => Folded a -> Folded a -> Folded a
Semigroup, Folded a
[Folded a] -> Folded a
Folded a -> Folded a -> Folded a
forall a.
Semigroup a -> a -> (a -> a -> a) -> ([a] -> a) -> Monoid a
forall {a}. Monoid a => Semigroup (Folded a)
forall a. Monoid a => Folded a
forall a. Monoid a => [Folded a] -> Folded a
forall a. Monoid a => Folded a -> Folded a -> Folded a
mconcat :: [Folded a] -> Folded a
$cmconcat :: forall a. Monoid a => [Folded a] -> Folded a
mappend :: Folded a -> Folded a -> Folded a
$cmappend :: forall a. Monoid a => Folded a -> Folded a -> Folded a
mempty :: Folded a
$cmempty :: forall a. Monoid a => Folded a
Monoid)
newtype Mapped f a = Mapped{forall {k} (f :: k -> *) (a :: k). Mapped f a -> f a
getMapped :: f a}
deriving (Mapped f a -> Mapped f a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall k (f :: k -> *) (a :: k).
Eq (f a) =>
Mapped f a -> Mapped f a -> Bool
/= :: Mapped f a -> Mapped f a -> Bool
$c/= :: forall k (f :: k -> *) (a :: k).
Eq (f a) =>
Mapped f a -> Mapped f a -> Bool
== :: Mapped f a -> Mapped f a -> Bool
$c== :: forall k (f :: k -> *) (a :: k).
Eq (f a) =>
Mapped f a -> Mapped f a -> Bool
Eq, Mapped f a -> Mapped f a -> Bool
Mapped f a -> Mapped f a -> Ordering
Mapped f a -> Mapped f a -> Mapped f a
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall {k} {f :: k -> *} {a :: k}. Ord (f a) => Eq (Mapped f a)
forall k (f :: k -> *) (a :: k).
Ord (f a) =>
Mapped f a -> Mapped f a -> Bool
forall k (f :: k -> *) (a :: k).
Ord (f a) =>
Mapped f a -> Mapped f a -> Ordering
forall k (f :: k -> *) (a :: k).
Ord (f a) =>
Mapped f a -> Mapped f a -> Mapped f a
min :: Mapped f a -> Mapped f a -> Mapped f a
$cmin :: forall k (f :: k -> *) (a :: k).
Ord (f a) =>
Mapped f a -> Mapped f a -> Mapped f a
max :: Mapped f a -> Mapped f a -> Mapped f a
$cmax :: forall k (f :: k -> *) (a :: k).
Ord (f a) =>
Mapped f a -> Mapped f a -> Mapped f a
>= :: Mapped f a -> Mapped f a -> Bool
$c>= :: forall k (f :: k -> *) (a :: k).
Ord (f a) =>
Mapped f a -> Mapped f a -> Bool
> :: Mapped f a -> Mapped f a -> Bool
$c> :: forall k (f :: k -> *) (a :: k).
Ord (f a) =>
Mapped f a -> Mapped f a -> Bool
<= :: Mapped f a -> Mapped f a -> Bool
$c<= :: forall k (f :: k -> *) (a :: k).
Ord (f a) =>
Mapped f a -> Mapped f a -> Bool
< :: Mapped f a -> Mapped f a -> Bool
$c< :: forall k (f :: k -> *) (a :: k).
Ord (f a) =>
Mapped f a -> Mapped f a -> Bool
compare :: Mapped f a -> Mapped f a -> Ordering
$ccompare :: forall k (f :: k -> *) (a :: k).
Ord (f a) =>
Mapped f a -> Mapped f a -> Ordering
Ord, Int -> Mapped f a -> ShowS
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall k (f :: k -> *) (a :: k).
Show (f a) =>
Int -> Mapped f a -> ShowS
forall k (f :: k -> *) (a :: k).
Show (f a) =>
[Mapped f a] -> ShowS
forall k (f :: k -> *) (a :: k). Show (f a) => Mapped f a -> String
showList :: [Mapped f a] -> ShowS
$cshowList :: forall k (f :: k -> *) (a :: k).
Show (f a) =>
[Mapped f a] -> ShowS
show :: Mapped f a -> String
$cshow :: forall k (f :: k -> *) (a :: k). Show (f a) => Mapped f a -> String
showsPrec :: Int -> Mapped f a -> ShowS
$cshowsPrec :: forall k (f :: k -> *) (a :: k).
Show (f a) =>
Int -> Mapped f a -> ShowS
Show, NonEmpty (Mapped f a) -> Mapped f a
Mapped f a -> Mapped f a -> Mapped f a
forall b. Integral b => b -> Mapped f a -> Mapped f a
forall a.
(a -> a -> a)
-> (NonEmpty a -> a)
-> (forall b. Integral b => b -> a -> a)
-> Semigroup a
forall k (f :: k -> *) (a :: k).
Semigroup (f a) =>
NonEmpty (Mapped f a) -> Mapped f a
forall k (f :: k -> *) (a :: k).
Semigroup (f a) =>
Mapped f a -> Mapped f a -> Mapped f a
forall k (f :: k -> *) (a :: k) b.
(Semigroup (f a), Integral b) =>
b -> Mapped f a -> Mapped f a
stimes :: forall b. Integral b => b -> Mapped f a -> Mapped f a
$cstimes :: forall k (f :: k -> *) (a :: k) b.
(Semigroup (f a), Integral b) =>
b -> Mapped f a -> Mapped f a
sconcat :: NonEmpty (Mapped f a) -> Mapped f a
$csconcat :: forall k (f :: k -> *) (a :: k).
Semigroup (f a) =>
NonEmpty (Mapped f a) -> Mapped f a
<> :: Mapped f a -> Mapped f a -> Mapped f a
$c<> :: forall k (f :: k -> *) (a :: k).
Semigroup (f a) =>
Mapped f a -> Mapped f a -> Mapped f a
Semigroup, Mapped f a
[Mapped f a] -> Mapped f a
Mapped f a -> Mapped f a -> Mapped f a
forall a.
Semigroup a -> a -> (a -> a -> a) -> ([a] -> a) -> Monoid a
forall {k} {f :: k -> *} {a :: k}.
Monoid (f a) =>
Semigroup (Mapped f a)
forall k (f :: k -> *) (a :: k). Monoid (f a) => Mapped f a
forall k (f :: k -> *) (a :: k).
Monoid (f a) =>
[Mapped f a] -> Mapped f a
forall k (f :: k -> *) (a :: k).
Monoid (f a) =>
Mapped f a -> Mapped f a -> Mapped f a
mconcat :: [Mapped f a] -> Mapped f a
$cmconcat :: forall k (f :: k -> *) (a :: k).
Monoid (f a) =>
[Mapped f a] -> Mapped f a
mappend :: Mapped f a -> Mapped f a -> Mapped f a
$cmappend :: forall k (f :: k -> *) (a :: k).
Monoid (f a) =>
Mapped f a -> Mapped f a -> Mapped f a
mempty :: Mapped f a
$cmempty :: forall k (f :: k -> *) (a :: k). Monoid (f a) => Mapped f a
Monoid, forall a b. a -> Mapped f b -> Mapped f a
forall a b. (a -> b) -> Mapped f a -> Mapped f b
forall (f :: * -> *) a b.
Functor f =>
a -> Mapped f b -> Mapped f a
forall (f :: * -> *) a b.
Functor f =>
(a -> b) -> Mapped f a -> Mapped f b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: forall a b. a -> Mapped f b -> Mapped f a
$c<$ :: forall (f :: * -> *) a b.
Functor f =>
a -> Mapped f b -> Mapped f a
fmap :: forall a b. (a -> b) -> Mapped f a -> Mapped f b
$cfmap :: forall (f :: * -> *) a b.
Functor f =>
(a -> b) -> Mapped f a -> Mapped f b
Functor, forall a. a -> Mapped f a
forall a b. Mapped f a -> Mapped f b -> Mapped f a
forall a b. Mapped f a -> Mapped f b -> Mapped f b
forall a b. Mapped f (a -> b) -> Mapped f a -> Mapped f b
forall a b c.
(a -> b -> c) -> Mapped f a -> Mapped f b -> Mapped f c
forall (f :: * -> *).
Functor f
-> (forall a. a -> f a)
-> (forall a b. f (a -> b) -> f a -> f b)
-> (forall a b c. (a -> b -> c) -> f a -> f b -> f c)
-> (forall a b. f a -> f b -> f b)
-> (forall a b. f a -> f b -> f a)
-> Applicative f
forall {f :: * -> *}. Applicative f => Functor (Mapped f)
forall (f :: * -> *) a. Applicative f => a -> Mapped f a
forall (f :: * -> *) a b.
Applicative f =>
Mapped f a -> Mapped f b -> Mapped f a
forall (f :: * -> *) a b.
Applicative f =>
Mapped f a -> Mapped f b -> Mapped f b
forall (f :: * -> *) a b.
Applicative f =>
Mapped f (a -> b) -> Mapped f a -> Mapped f b
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> Mapped f a -> Mapped f b -> Mapped f c
<* :: forall a b. Mapped f a -> Mapped f b -> Mapped f a
$c<* :: forall (f :: * -> *) a b.
Applicative f =>
Mapped f a -> Mapped f b -> Mapped f a
*> :: forall a b. Mapped f a -> Mapped f b -> Mapped f b
$c*> :: forall (f :: * -> *) a b.
Applicative f =>
Mapped f a -> Mapped f b -> Mapped f b
liftA2 :: forall a b c.
(a -> b -> c) -> Mapped f a -> Mapped f b -> Mapped f c
$cliftA2 :: forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> Mapped f a -> Mapped f b -> Mapped f c
<*> :: forall a b. Mapped f (a -> b) -> Mapped f a -> Mapped f b
$c<*> :: forall (f :: * -> *) a b.
Applicative f =>
Mapped f (a -> b) -> Mapped f a -> Mapped f b
pure :: forall a. a -> Mapped f a
$cpure :: forall (f :: * -> *) a. Applicative f => a -> Mapped f a
Applicative, forall a. a -> Mapped f a
forall a b. Mapped f a -> Mapped f b -> Mapped f b
forall a b. Mapped f a -> (a -> Mapped f b) -> Mapped f b
forall {f :: * -> *}. Monad f => Applicative (Mapped f)
forall (f :: * -> *) a. Monad f => a -> Mapped f a
forall (f :: * -> *) a b.
Monad f =>
Mapped f a -> Mapped f b -> Mapped f b
forall (f :: * -> *) a b.
Monad f =>
Mapped f a -> (a -> Mapped f b) -> Mapped f b
forall (m :: * -> *).
Applicative m
-> (forall a b. m a -> (a -> m b) -> m b)
-> (forall a b. m a -> m b -> m b)
-> (forall a. a -> m a)
-> Monad m
return :: forall a. a -> Mapped f a
$creturn :: forall (f :: * -> *) a. Monad f => a -> Mapped f a
>> :: forall a b. Mapped f a -> Mapped f b -> Mapped f b
$c>> :: forall (f :: * -> *) a b.
Monad f =>
Mapped f a -> Mapped f b -> Mapped f b
>>= :: forall a b. Mapped f a -> (a -> Mapped f b) -> Mapped f b
$c>>= :: forall (f :: * -> *) a b.
Monad f =>
Mapped f a -> (a -> Mapped f b) -> Mapped f b
Monad, forall a. Eq a => a -> Mapped f a -> Bool
forall a. Num a => Mapped f a -> a
forall a. Ord a => Mapped f a -> a
forall m. Monoid m => Mapped f m -> m
forall a. Mapped f a -> Bool
forall a. Mapped f a -> Int
forall a. Mapped f a -> [a]
forall a. (a -> a -> a) -> Mapped f a -> a
forall m a. Monoid m => (a -> m) -> Mapped f a -> m
forall b a. (b -> a -> b) -> b -> Mapped f a -> b
forall a b. (a -> b -> b) -> b -> Mapped f a -> b
forall (f :: * -> *) a.
(Foldable f, Eq a) =>
a -> Mapped f a -> Bool
forall (f :: * -> *) a. (Foldable f, Num a) => Mapped f a -> a
forall (f :: * -> *) a. (Foldable f, Ord a) => Mapped f a -> a
forall (f :: * -> *) m. (Foldable f, Monoid m) => Mapped f m -> m
forall (f :: * -> *) a. Foldable f => Mapped f a -> Bool
forall (f :: * -> *) a. Foldable f => Mapped f a -> Int
forall (f :: * -> *) a. Foldable f => Mapped f a -> [a]
forall (f :: * -> *) a.
Foldable f =>
(a -> a -> a) -> Mapped f a -> a
forall (f :: * -> *) m a.
(Foldable f, Monoid m) =>
(a -> m) -> Mapped f a -> m
forall (f :: * -> *) b a.
Foldable f =>
(b -> a -> b) -> b -> Mapped f a -> b
forall (f :: * -> *) a b.
Foldable f =>
(a -> b -> b) -> b -> Mapped f a -> b
forall (t :: * -> *).
(forall m. Monoid m => t m -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. t a -> [a])
-> (forall a. t a -> Bool)
-> (forall a. t a -> Int)
-> (forall a. Eq a => a -> t a -> Bool)
-> (forall a. Ord a => t a -> a)
-> (forall a. Ord a => t a -> a)
-> (forall a. Num a => t a -> a)
-> (forall a. Num a => t a -> a)
-> Foldable t
product :: forall a. Num a => Mapped f a -> a
$cproduct :: forall (f :: * -> *) a. (Foldable f, Num a) => Mapped f a -> a
sum :: forall a. Num a => Mapped f a -> a
$csum :: forall (f :: * -> *) a. (Foldable f, Num a) => Mapped f a -> a
minimum :: forall a. Ord a => Mapped f a -> a
$cminimum :: forall (f :: * -> *) a. (Foldable f, Ord a) => Mapped f a -> a
maximum :: forall a. Ord a => Mapped f a -> a
$cmaximum :: forall (f :: * -> *) a. (Foldable f, Ord a) => Mapped f a -> a
elem :: forall a. Eq a => a -> Mapped f a -> Bool
$celem :: forall (f :: * -> *) a.
(Foldable f, Eq a) =>
a -> Mapped f a -> Bool
length :: forall a. Mapped f a -> Int
$clength :: forall (f :: * -> *) a. Foldable f => Mapped f a -> Int
null :: forall a. Mapped f a -> Bool
$cnull :: forall (f :: * -> *) a. Foldable f => Mapped f a -> Bool
toList :: forall a. Mapped f a -> [a]
$ctoList :: forall (f :: * -> *) a. Foldable f => Mapped f a -> [a]
foldl1 :: forall a. (a -> a -> a) -> Mapped f a -> a
$cfoldl1 :: forall (f :: * -> *) a.
Foldable f =>
(a -> a -> a) -> Mapped f a -> a
foldr1 :: forall a. (a -> a -> a) -> Mapped f a -> a
$cfoldr1 :: forall (f :: * -> *) a.
Foldable f =>
(a -> a -> a) -> Mapped f a -> a
foldl' :: forall b a. (b -> a -> b) -> b -> Mapped f a -> b
$cfoldl' :: forall (f :: * -> *) b a.
Foldable f =>
(b -> a -> b) -> b -> Mapped f a -> b
foldl :: forall b a. (b -> a -> b) -> b -> Mapped f a -> b
$cfoldl :: forall (f :: * -> *) b a.
Foldable f =>
(b -> a -> b) -> b -> Mapped f a -> b
foldr' :: forall a b. (a -> b -> b) -> b -> Mapped f a -> b
$cfoldr' :: forall (f :: * -> *) a b.
Foldable f =>
(a -> b -> b) -> b -> Mapped f a -> b
foldr :: forall a b. (a -> b -> b) -> b -> Mapped f a -> b
$cfoldr :: forall (f :: * -> *) a b.
Foldable f =>
(a -> b -> b) -> b -> Mapped f a -> b
foldMap' :: forall m a. Monoid m => (a -> m) -> Mapped f a -> m
$cfoldMap' :: forall (f :: * -> *) m a.
(Foldable f, Monoid m) =>
(a -> m) -> Mapped f a -> m
foldMap :: forall m a. Monoid m => (a -> m) -> Mapped f a -> m
$cfoldMap :: forall (f :: * -> *) m a.
(Foldable f, Monoid m) =>
(a -> m) -> Mapped f a -> m
fold :: forall m. Monoid m => Mapped f m -> m
$cfold :: forall (f :: * -> *) m. (Foldable f, Monoid m) => Mapped f m -> m
Foldable)
newtype Traversed m f a = Traversed{forall {k} {k} (m :: k -> *) (f :: k -> k) (a :: k).
Traversed m f a -> m (f a)
getTraversed :: m (f a)} deriving (Traversed m f a -> Traversed m f a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall k (m :: k -> *) k (f :: k -> k) (a :: k).
Eq (m (f a)) =>
Traversed m f a -> Traversed m f a -> Bool
/= :: Traversed m f a -> Traversed m f a -> Bool
$c/= :: forall k (m :: k -> *) k (f :: k -> k) (a :: k).
Eq (m (f a)) =>
Traversed m f a -> Traversed m f a -> Bool
== :: Traversed m f a -> Traversed m f a -> Bool
$c== :: forall k (m :: k -> *) k (f :: k -> k) (a :: k).
Eq (m (f a)) =>
Traversed m f a -> Traversed m f a -> Bool
Eq, Traversed m f a -> Traversed m f a -> Bool
Traversed m f a -> Traversed m f a -> Ordering
Traversed m f a -> Traversed m f a -> Traversed m f a
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall {k} {m :: k -> *} {k} {f :: k -> k} {a :: k}.
Ord (m (f a)) =>
Eq (Traversed m f a)
forall k (m :: k -> *) k (f :: k -> k) (a :: k).
Ord (m (f a)) =>
Traversed m f a -> Traversed m f a -> Bool
forall k (m :: k -> *) k (f :: k -> k) (a :: k).
Ord (m (f a)) =>
Traversed m f a -> Traversed m f a -> Ordering
forall k (m :: k -> *) k (f :: k -> k) (a :: k).
Ord (m (f a)) =>
Traversed m f a -> Traversed m f a -> Traversed m f a
min :: Traversed m f a -> Traversed m f a -> Traversed m f a
$cmin :: forall k (m :: k -> *) k (f :: k -> k) (a :: k).
Ord (m (f a)) =>
Traversed m f a -> Traversed m f a -> Traversed m f a
max :: Traversed m f a -> Traversed m f a -> Traversed m f a
$cmax :: forall k (m :: k -> *) k (f :: k -> k) (a :: k).
Ord (m (f a)) =>
Traversed m f a -> Traversed m f a -> Traversed m f a
>= :: Traversed m f a -> Traversed m f a -> Bool
$c>= :: forall k (m :: k -> *) k (f :: k -> k) (a :: k).
Ord (m (f a)) =>
Traversed m f a -> Traversed m f a -> Bool
> :: Traversed m f a -> Traversed m f a -> Bool
$c> :: forall k (m :: k -> *) k (f :: k -> k) (a :: k).
Ord (m (f a)) =>
Traversed m f a -> Traversed m f a -> Bool
<= :: Traversed m f a -> Traversed m f a -> Bool
$c<= :: forall k (m :: k -> *) k (f :: k -> k) (a :: k).
Ord (m (f a)) =>
Traversed m f a -> Traversed m f a -> Bool
< :: Traversed m f a -> Traversed m f a -> Bool
$c< :: forall k (m :: k -> *) k (f :: k -> k) (a :: k).
Ord (m (f a)) =>
Traversed m f a -> Traversed m f a -> Bool
compare :: Traversed m f a -> Traversed m f a -> Ordering
$ccompare :: forall k (m :: k -> *) k (f :: k -> k) (a :: k).
Ord (m (f a)) =>
Traversed m f a -> Traversed m f a -> Ordering
Ord, Int -> Traversed m f a -> ShowS
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall k (m :: k -> *) k (f :: k -> k) (a :: k).
Show (m (f a)) =>
Int -> Traversed m f a -> ShowS
forall k (m :: k -> *) k (f :: k -> k) (a :: k).
Show (m (f a)) =>
[Traversed m f a] -> ShowS
forall k (m :: k -> *) k (f :: k -> k) (a :: k).
Show (m (f a)) =>
Traversed m f a -> String
showList :: [Traversed m f a] -> ShowS
$cshowList :: forall k (m :: k -> *) k (f :: k -> k) (a :: k).
Show (m (f a)) =>
[Traversed m f a] -> ShowS
show :: Traversed m f a -> String
$cshow :: forall k (m :: k -> *) k (f :: k -> k) (a :: k).
Show (m (f a)) =>
Traversed m f a -> String
showsPrec :: Int -> Traversed m f a -> ShowS
$cshowsPrec :: forall k (m :: k -> *) k (f :: k -> k) (a :: k).
Show (m (f a)) =>
Int -> Traversed m f a -> ShowS
Show, NonEmpty (Traversed m f a) -> Traversed m f a
Traversed m f a -> Traversed m f a -> Traversed m f a
forall b. Integral b => b -> Traversed m f a -> Traversed m f a
forall a.
(a -> a -> a)
-> (NonEmpty a -> a)
-> (forall b. Integral b => b -> a -> a)
-> Semigroup a
forall k (m :: k -> *) k (f :: k -> k) (a :: k).
Semigroup (m (f a)) =>
NonEmpty (Traversed m f a) -> Traversed m f a
forall k (m :: k -> *) k (f :: k -> k) (a :: k).
Semigroup (m (f a)) =>
Traversed m f a -> Traversed m f a -> Traversed m f a
forall k (m :: k -> *) k (f :: k -> k) (a :: k) b.
(Semigroup (m (f a)), Integral b) =>
b -> Traversed m f a -> Traversed m f a
stimes :: forall b. Integral b => b -> Traversed m f a -> Traversed m f a
$cstimes :: forall k (m :: k -> *) k (f :: k -> k) (a :: k) b.
(Semigroup (m (f a)), Integral b) =>
b -> Traversed m f a -> Traversed m f a
sconcat :: NonEmpty (Traversed m f a) -> Traversed m f a
$csconcat :: forall k (m :: k -> *) k (f :: k -> k) (a :: k).
Semigroup (m (f a)) =>
NonEmpty (Traversed m f a) -> Traversed m f a
<> :: Traversed m f a -> Traversed m f a -> Traversed m f a
$c<> :: forall k (m :: k -> *) k (f :: k -> k) (a :: k).
Semigroup (m (f a)) =>
Traversed m f a -> Traversed m f a -> Traversed m f a
Semigroup, Traversed m f a
[Traversed m f a] -> Traversed m f a
Traversed m f a -> Traversed m f a -> Traversed m f a
forall a.
Semigroup a -> a -> (a -> a -> a) -> ([a] -> a) -> Monoid a
forall {k} {m :: k -> *} {k} {f :: k -> k} {a :: k}.
Monoid (m (f a)) =>
Semigroup (Traversed m f a)
forall k (m :: k -> *) k (f :: k -> k) (a :: k).
Monoid (m (f a)) =>
Traversed m f a
forall k (m :: k -> *) k (f :: k -> k) (a :: k).
Monoid (m (f a)) =>
[Traversed m f a] -> Traversed m f a
forall k (m :: k -> *) k (f :: k -> k) (a :: k).
Monoid (m (f a)) =>
Traversed m f a -> Traversed m f a -> Traversed m f a
mconcat :: [Traversed m f a] -> Traversed m f a
$cmconcat :: forall k (m :: k -> *) k (f :: k -> k) (a :: k).
Monoid (m (f a)) =>
[Traversed m f a] -> Traversed m f a
mappend :: Traversed m f a -> Traversed m f a -> Traversed m f a
$cmappend :: forall k (m :: k -> *) k (f :: k -> k) (a :: k).
Monoid (m (f a)) =>
Traversed m f a -> Traversed m f a -> Traversed m f a
mempty :: Traversed m f a
$cmempty :: forall k (m :: k -> *) k (f :: k -> k) (a :: k).
Monoid (m (f a)) =>
Traversed m f a
Monoid)
instance (Functor m, Functor f) => Functor (Traversed m f) where
fmap :: forall a b. (a -> b) -> Traversed m f a -> Traversed m f b
fmap a -> b
f (Traversed m (f a)
x) = forall {k} {k} (m :: k -> *) (f :: k -> k) (a :: k).
m (f a) -> Traversed m f a
Traversed ((a -> b
f forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m (f a)
x)
newtype PassDown (t :: Type) (f :: Type -> Type) a = PassDown a
data Accumulator (t :: Type) (name :: Symbol) (a :: Type) = Accumulator
data Replicator (t :: Type) (f :: Type -> Type) (name :: Symbol) = Replicator
data Traverser (t :: Type) (m :: Type -> Type) (f :: Type -> Type) (name :: Symbol) = Traverser
instance Transformation (PassDown t f a) where
type Domain (PassDown t f a) = f
type Codomain (PassDown t f a) = Inherited t
instance Transformation (Accumulator t name a) where
type Domain (Accumulator t name a) = Synthesized t
type Codomain (Accumulator t name a) = Const (Folded a)
instance Transformation (Replicator t f name) where
type Domain (Replicator t f name) = Synthesized t
type Codomain (Replicator t f name) = f
instance Transformation (Traverser t m f name) where
type Domain (Traverser t m f name) = Synthesized t
type Codomain (Traverser t m f name) = Compose m f
instance Subtype (Atts (Inherited t) a) b => Transformation.At (PassDown t f b) a where
$ :: PassDown t f b
-> Domain (PassDown t f b) a -> Codomain (PassDown t f b) a
($) (PassDown b
i) Domain (PassDown t f b) a
_ = forall t a. Atts (Inherited t) a -> Inherited t a
Inherited (forall sup sub. Subtype sup sub => sub -> sup
upcast b
i)
instance (Monoid a, r ~ Atts (Synthesized t) x, Generic r, MayHaveMonoidalField name (Folded a) (Rep r)) =>
Transformation.At (Accumulator t name a) x where
Accumulator t name a
_ $ :: Accumulator t name a
-> Domain (Accumulator t name a) x
-> Codomain (Accumulator t name a) x
$ Synthesized Atts (Synthesized t) x
r = forall {k} a (b :: k). a -> Const a b
Const (forall {k} (name :: Symbol) a (f :: k -> *) (x :: k).
MayHaveMonoidalField name a f =>
Proxy name -> f x -> a
getMonoidalField (forall {k} (t :: k). Proxy t
Proxy :: Proxy name) forall a b. (a -> b) -> a -> b
$ forall a x. Generic a => a -> Rep a x
from Atts (Synthesized t) x
r)
instance (HasField name (Atts (Synthesized t) a) (Mapped f a)) => Transformation.At (Replicator t f name) a where
Replicator t f name
_ $ :: Replicator t f name
-> Domain (Replicator t f name) a
-> Codomain (Replicator t f name) a
$ Synthesized Atts (Synthesized t) a
r = forall {k} (f :: k -> *) (a :: k). Mapped f a -> f a
getMapped (forall {k} (x :: k) r a. HasField x r a => r -> a
getField @name Atts (Synthesized t) a
r)
instance (HasField name (Atts (Synthesized t) a) (Traversed m f a)) => Transformation.At (Traverser t m f name) a where
Traverser t m f name
_ $ :: Traverser t m f name
-> Domain (Traverser t m f name) a
-> Codomain (Traverser t m f name) a
$ Synthesized Atts (Synthesized t) a
r = forall {k} {k1} (f :: k -> *) (g :: k1 -> k) (a :: k1).
f (g a) -> Compose f g a
Compose (forall {k} {k} (m :: k -> *) (f :: k -> k) (a :: k).
Traversed m f a -> m (f a)
getTraversed forall a b. (a -> b) -> a -> b
$ forall {k} (x :: k) r a. HasField x r a => r -> a
getField @name Atts (Synthesized t) a
r)
class GenericSynthesizer t g deep shallow result where
genericSynthesis :: forall a sem. sem ~ Semantics t =>
t
-> shallow (g deep deep)
-> Atts (Inherited t) (g sem sem)
-> g sem (Synthesized t)
-> result a
class GenericSynthesizedField (name :: Symbol) result t g deep shallow where
genericSynthesizedField :: forall a sem. sem ~ Semantics t =>
Proxy name
-> t
-> shallow (g deep deep)
-> Atts (Inherited t) (g sem sem)
-> g sem (Synthesized t)
-> result a
class MayHaveMonoidalField (name :: Symbol) a f where
getMonoidalField :: Proxy name -> f x -> a
class FoundField a f where
getFoundField :: f x -> a
instance {-# overlaps #-} (MayHaveMonoidalField name a x, MayHaveMonoidalField name a y, Semigroup a) =>
MayHaveMonoidalField name a (x :*: y) where
getMonoidalField :: forall (x :: k). Proxy name -> (:*:) x y x -> a
getMonoidalField Proxy name
name (x x
x :*: y x
y) = forall {k} (name :: Symbol) a (f :: k -> *) (x :: k).
MayHaveMonoidalField name a f =>
Proxy name -> f x -> a
getMonoidalField Proxy name
name x x
x forall a. Semigroup a => a -> a -> a
<> forall {k} (name :: Symbol) a (f :: k -> *) (x :: k).
MayHaveMonoidalField name a f =>
Proxy name -> f x -> a
getMonoidalField Proxy name
name y x
y
instance {-# overlaps #-} TypeError ('Text "Cannot get a single field value from a sum type") =>
MayHaveMonoidalField name a (x :+: y) where
getMonoidalField :: forall (x :: k). Proxy name -> (:+:) x y x -> a
getMonoidalField Proxy name
_ (:+:) x y x
_ = forall a. HasCallStack => String -> a
error String
"getMonoidalField on sum type"
instance {-# overlaps #-} FoundField a f => MayHaveMonoidalField name a (M1 i ('MetaSel ('Just name) su ss ds) f) where
getMonoidalField :: forall (x :: k).
Proxy name -> M1 i ('MetaSel ('Just name) su ss ds) f x -> a
getMonoidalField Proxy name
_ (M1 f x
x) = forall {k} a (f :: k -> *) (x :: k). FoundField a f => f x -> a
getFoundField f x
x
instance {-# overlaps #-} Monoid a => MayHaveMonoidalField name a (M1 i ('MetaSel 'Nothing su ss ds) f) where
getMonoidalField :: forall (x :: k).
Proxy name -> M1 i ('MetaSel 'Nothing su ss ds) f x -> a
getMonoidalField Proxy name
_ M1 i ('MetaSel 'Nothing su ss ds) f x
_ = forall a. Monoid a => a
mempty
instance {-# overlaps #-} MayHaveMonoidalField name a f => MayHaveMonoidalField name a (M1 i ('MetaData n m p nt) f) where
getMonoidalField :: forall (x :: k). Proxy name -> M1 i ('MetaData n m p nt) f x -> a
getMonoidalField Proxy name
name (M1 f x
x) = forall {k} (name :: Symbol) a (f :: k -> *) (x :: k).
MayHaveMonoidalField name a f =>
Proxy name -> f x -> a
getMonoidalField Proxy name
name f x
x
instance {-# overlaps #-} MayHaveMonoidalField name a f => MayHaveMonoidalField name a (M1 i ('MetaCons n fi s) f) where
getMonoidalField :: forall (x :: k). Proxy name -> M1 i ('MetaCons n fi s) f x -> a
getMonoidalField Proxy name
name (M1 f x
x) = forall {k} (name :: Symbol) a (f :: k -> *) (x :: k).
MayHaveMonoidalField name a f =>
Proxy name -> f x -> a
getMonoidalField Proxy name
name f x
x
instance {-# overlappable #-} Monoid a => MayHaveMonoidalField name a f where
getMonoidalField :: forall (x :: k). Proxy name -> f x -> a
getMonoidalField Proxy name
_ f x
_ = forall a. Monoid a => a
mempty
instance FoundField a f => FoundField a (M1 i j f) where
getFoundField :: forall (x :: k). M1 i j f x -> a
getFoundField (M1 f x
f) = forall {k} a (f :: k -> *) (x :: k). FoundField a f => f x -> a
getFoundField f x
f
instance FoundField a (K1 i a) where
getFoundField :: forall (x :: k). K1 i a x -> a
getFoundField (K1 a
a) = a
a
instance (GenericSynthesizer t g deep shallow x, GenericSynthesizer t g deep shallow y) =>
GenericSynthesizer t g deep shallow (x :*: y) where
genericSynthesis :: forall (a :: k) (sem :: * -> *).
(sem ~ Semantics t) =>
t
-> shallow (g deep deep)
-> Atts (Inherited t) (g sem sem)
-> g sem (Synthesized t)
-> (:*:) x y a
genericSynthesis t
t shallow (g deep deep)
node Atts (Inherited t) (g sem sem)
i g sem (Synthesized t)
s = forall {k} t (g :: (* -> *) -> (* -> *) -> *) (deep :: * -> *)
(shallow :: * -> *) (result :: k -> *) (a :: k) (sem :: * -> *).
(GenericSynthesizer t g deep shallow result, sem ~ Semantics t) =>
t
-> shallow (g deep deep)
-> Atts (Inherited t) (g sem sem)
-> g sem (Synthesized t)
-> result a
genericSynthesis t
t shallow (g deep deep)
node Atts (Inherited t) (g sem sem)
i g sem (Synthesized t)
s forall k (f :: k -> *) (g :: k -> *) (p :: k).
f p -> g p -> (:*:) f g p
:*: forall {k} t (g :: (* -> *) -> (* -> *) -> *) (deep :: * -> *)
(shallow :: * -> *) (result :: k -> *) (a :: k) (sem :: * -> *).
(GenericSynthesizer t g deep shallow result, sem ~ Semantics t) =>
t
-> shallow (g deep deep)
-> Atts (Inherited t) (g sem sem)
-> g sem (Synthesized t)
-> result a
genericSynthesis t
t shallow (g deep deep)
node Atts (Inherited t) (g sem sem)
i g sem (Synthesized t)
s
instance {-# overlappable #-} GenericSynthesizer t g deep shallow f =>
GenericSynthesizer t g deep shallow (M1 i meta f) where
genericSynthesis :: forall (a :: k) (sem :: * -> *).
(sem ~ Semantics t) =>
t
-> shallow (g deep deep)
-> Atts (Inherited t) (g sem sem)
-> g sem (Synthesized t)
-> M1 i meta f a
genericSynthesis t
t shallow (g deep deep)
node Atts (Inherited t) (g sem sem)
i g sem (Synthesized t)
s = forall k i (c :: Meta) (f :: k -> *) (p :: k). f p -> M1 i c f p
M1 (forall {k} t (g :: (* -> *) -> (* -> *) -> *) (deep :: * -> *)
(shallow :: * -> *) (result :: k -> *) (a :: k) (sem :: * -> *).
(GenericSynthesizer t g deep shallow result, sem ~ Semantics t) =>
t
-> shallow (g deep deep)
-> Atts (Inherited t) (g sem sem)
-> g sem (Synthesized t)
-> result a
genericSynthesis t
t shallow (g deep deep)
node Atts (Inherited t) (g sem sem)
i g sem (Synthesized t)
s)
instance {-# overlaps #-} GenericSynthesizedField name f t g deep shallow =>
GenericSynthesizer t g deep shallow (M1 i ('MetaSel ('Just name) su ss ds) f) where
genericSynthesis :: forall (a :: k) (sem :: * -> *).
(sem ~ Semantics t) =>
t
-> shallow (g deep deep)
-> Atts (Inherited t) (g sem sem)
-> g sem (Synthesized t)
-> M1 i ('MetaSel ('Just name) su ss ds) f a
genericSynthesis t
t shallow (g deep deep)
node Atts (Inherited t) (g sem sem)
i g sem (Synthesized t)
s = forall k i (c :: Meta) (f :: k -> *) (p :: k). f p -> M1 i c f p
M1 (forall {k} (name :: Symbol) (result :: k -> *) t
(g :: (* -> *) -> (* -> *) -> *) (deep :: * -> *)
(shallow :: * -> *) (a :: k) (sem :: * -> *).
(GenericSynthesizedField name result t g deep shallow,
sem ~ Semantics t) =>
Proxy name
-> t
-> shallow (g deep deep)
-> Atts (Inherited t) (g sem sem)
-> g sem (Synthesized t)
-> result a
genericSynthesizedField (forall {k} (t :: k). Proxy t
Proxy :: Proxy name) t
t shallow (g deep deep)
node Atts (Inherited t) (g sem sem)
i g sem (Synthesized t)
s)
instance SynthesizedField name a t g deep shallow => GenericSynthesizedField name (K1 i a) t g deep shallow where
genericSynthesizedField :: forall (a :: k) (sem :: * -> *).
(sem ~ Semantics t) =>
Proxy name
-> t
-> shallow (g deep deep)
-> Atts (Inherited t) (g sem sem)
-> g sem (Synthesized t)
-> K1 i a a
genericSynthesizedField Proxy name
name t
t shallow (g deep deep)
node Atts (Inherited t) (g sem sem)
i g sem (Synthesized t)
s = forall k i c (p :: k). c -> K1 i c p
K1 (forall (name :: Symbol) result t (g :: (* -> *) -> (* -> *) -> *)
(deep :: * -> *) (shallow :: * -> *) (sem :: * -> *).
(SynthesizedField name result t g deep shallow,
sem ~ Semantics t) =>
Proxy name
-> t
-> shallow (g deep deep)
-> Atts (Inherited t) (g sem sem)
-> g sem (Synthesized t)
-> result
synthesizedField Proxy name
name t
t shallow (g deep deep)
node Atts (Inherited t) (g sem sem)
i g sem (Synthesized t)
s)
instance {-# overlappable #-} (Monoid a, Shallow.Foldable (Accumulator t name a) (g (Semantics t))) =>
SynthesizedField name (Folded a) t g deep shallow where
synthesizedField :: forall (sem :: * -> *).
(sem ~ Semantics t) =>
Proxy name
-> t
-> shallow (g deep deep)
-> Atts (Inherited t) (g sem sem)
-> g sem (Synthesized t)
-> Folded a
synthesizedField Proxy name
name t
t shallow (g deep deep)
_ Atts (Inherited t) (g sem sem)
_ g sem (Synthesized t)
s = forall {k} (name :: Symbol) t (g :: k -> (* -> *) -> *) a
(sem :: k).
(Monoid a, Foldable (Accumulator t name a) (g sem)) =>
Proxy name -> t -> g sem (Synthesized t) -> Folded a
foldedField Proxy name
name t
t g sem (Synthesized t)
s
instance {-# overlappable #-} (Functor f, Shallow.Functor (Replicator t f name) (g f),
Atts (Synthesized t) (g (Semantics t) (Semantics t)) ~ Atts (Synthesized t) (g f f)) =>
SynthesizedField name (Mapped f (g f f)) t g deep f where
synthesizedField :: forall (sem :: * -> *).
(sem ~ Semantics t) =>
Proxy name
-> t
-> f (g deep deep)
-> Atts (Inherited t) (g sem sem)
-> g sem (Synthesized t)
-> Mapped f (g f f)
synthesizedField Proxy name
name t
t f (g deep deep)
local Atts (Inherited t) (g sem sem)
_ g sem (Synthesized t)
s = forall {k} (f :: k -> *) (a :: k). f a -> Mapped f a
Mapped (forall (name :: Symbol) t (g :: (* -> *) -> (* -> *) -> *)
(f :: * -> *) (sem :: * -> *).
(Functor (Replicator t f name) (g f),
Atts (Synthesized t) (g sem sem) ~ Atts (Synthesized t) (g f f)) =>
Proxy name -> t -> g sem (Synthesized t) -> g f f
mappedField Proxy name
name t
t g sem (Synthesized t)
s forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ f (g deep deep)
local)
instance {-# overlappable #-} (Traversable f, Applicative m, Shallow.Traversable (Traverser t m f name) (g f),
Atts (Synthesized t) (g (Semantics t) (Semantics t)) ~ Atts (Synthesized t) (g f f)) =>
SynthesizedField name (Traversed m f (g f f)) t g deep f where
synthesizedField :: forall (sem :: * -> *).
(sem ~ Semantics t) =>
Proxy name
-> t
-> f (g deep deep)
-> Atts (Inherited t) (g sem sem)
-> g sem (Synthesized t)
-> Traversed m f (g f f)
synthesizedField Proxy name
name t
t f (g deep deep)
local Atts (Inherited t) (g sem sem)
_ g sem (Synthesized t)
s = forall {k} {k} (m :: k -> *) (f :: k -> k) (a :: k).
m (f a) -> Traversed m f a
Traversed (forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse (forall a b. a -> b -> a
const forall a b. (a -> b) -> a -> b
$ forall (name :: Symbol) t (g :: (* -> *) -> (* -> *) -> *)
(m :: * -> *) (f :: * -> *) (sem :: * -> *).
(Traversable (Traverser t m f name) (g f),
Atts (Synthesized t) (g sem sem) ~ Atts (Synthesized t) (g f f)) =>
Proxy name -> t -> g sem (Synthesized t) -> m (g f f)
traversedField Proxy name
name t
t g sem (Synthesized t)
s) f (g deep deep)
local)
bequestDefault :: forall t g shallow sem.
(sem ~ Semantics t, Domain t ~ shallow, Revelation t,
Shallow.Functor (PassDown t sem (Atts (Inherited t) (g sem sem))) (g sem))
=> t -> shallow (g sem sem) -> Atts (Inherited t) (g sem sem) -> g sem (Synthesized t)
-> g sem (Inherited t)
bequestDefault :: forall t (g :: (* -> *) -> (* -> *) -> *) (shallow :: * -> *)
(sem :: * -> *).
(sem ~ Semantics t, Domain t ~ shallow, Revelation t,
Functor
(PassDown t sem (Atts (Inherited t) (g sem sem))) (g sem)) =>
t
-> shallow (g sem sem)
-> Atts (Inherited t) (g sem sem)
-> g sem (Synthesized t)
-> g sem (Inherited t)
bequestDefault t
t shallow (g sem sem)
local Atts (Inherited t) (g sem sem)
inheritance g sem (Synthesized t)
_synthesized = forall {k} t (g :: k -> (* -> *) -> *) (shallow :: * -> *)
(deep :: k) atts.
Functor (PassDown t shallow atts) (g deep) =>
atts -> g deep shallow -> g deep (Inherited t)
passDown Atts (Inherited t) (g sem sem)
inheritance (forall t x. Revelation t => t -> Domain t x -> x
reveal t
t shallow (g sem sem)
local)
passDown :: forall t g shallow deep atts. (Shallow.Functor (PassDown t shallow atts) (g deep)) =>
atts -> g deep shallow -> g deep (Inherited t)
passDown :: forall {k} t (g :: k -> (* -> *) -> *) (shallow :: * -> *)
(deep :: k) atts.
Functor (PassDown t shallow atts) (g deep) =>
atts -> g deep shallow -> g deep (Inherited t)
passDown atts
inheritance g deep shallow
local = forall t (f :: * -> *) a. a -> PassDown t f a
PassDown atts
inheritance forall t (g :: (* -> *) -> *).
Functor t g =>
t -> g (Domain t) -> g (Codomain t)
Shallow.<$> g deep shallow
local
foldedField :: forall name t g a sem. (Monoid a, Shallow.Foldable (Accumulator t name a) (g sem)) =>
Proxy name -> t -> g sem (Synthesized t) -> Folded a
foldedField :: forall {k} (name :: Symbol) t (g :: k -> (* -> *) -> *) a
(sem :: k).
(Monoid a, Foldable (Accumulator t name a) (g sem)) =>
Proxy name -> t -> g sem (Synthesized t) -> Folded a
foldedField Proxy name
_name t
_t g sem (Synthesized t)
s = forall t (g :: (* -> *) -> *) m.
(Foldable t g, Codomain t ~ Const m, Monoid m) =>
t -> g (Domain t) -> m
Shallow.foldMap (forall t (name :: Symbol) a. Accumulator t name a
Accumulator :: Accumulator t name a) g sem (Synthesized t)
s
mappedField :: forall name t g f sem.
(Shallow.Functor (Replicator t f name) (g f),
Atts (Synthesized t) (g sem sem) ~ Atts (Synthesized t) (g f f)) =>
Proxy name -> t -> g sem (Synthesized t) -> g f f
mappedField :: forall (name :: Symbol) t (g :: (* -> *) -> (* -> *) -> *)
(f :: * -> *) (sem :: * -> *).
(Functor (Replicator t f name) (g f),
Atts (Synthesized t) (g sem sem) ~ Atts (Synthesized t) (g f f)) =>
Proxy name -> t -> g sem (Synthesized t) -> g f f
mappedField Proxy name
_name t
_t g sem (Synthesized t)
s = (forall t (f :: * -> *) (name :: Symbol). Replicator t f name
Replicator :: Replicator t f name) forall t (g :: (* -> *) -> *).
Functor t g =>
t -> g (Domain t) -> g (Codomain t)
Shallow.<$> (forall a b. a -> b
unsafeCoerce g sem (Synthesized t)
s :: g f (Synthesized t))
traversedField :: forall name t g m f sem.
(Shallow.Traversable (Traverser t m f name) (g f),
Atts (Synthesized t) (g sem sem) ~ Atts (Synthesized t) (g f f)) =>
Proxy name -> t -> g sem (Synthesized t) -> m (g f f)
traversedField :: forall (name :: Symbol) t (g :: (* -> *) -> (* -> *) -> *)
(m :: * -> *) (f :: * -> *) (sem :: * -> *).
(Traversable (Traverser t m f name) (g f),
Atts (Synthesized t) (g sem sem) ~ Atts (Synthesized t) (g f f)) =>
Proxy name -> t -> g sem (Synthesized t) -> m (g f f)
traversedField Proxy name
_name t
_t g sem (Synthesized t)
s = forall t (g :: (* -> *) -> *) (m :: * -> *) (f :: * -> *).
(Traversable t g, Codomain t ~ Compose m f) =>
t -> g (Domain t) -> m (g f)
Shallow.traverse (forall t (m :: * -> *) (f :: * -> *) (name :: Symbol).
Traverser t m f name
Traverser :: Traverser t m f name) (forall a b. a -> b
unsafeCoerce g sem (Synthesized t)
s :: g f (Synthesized t))