{-# Language DeriveDataTypeable, FlexibleContexts, FlexibleInstances, MultiParamTypeClasses, RankNTypes,
ScopedTypeVariables, TypeFamilies, TypeOperators, UndecidableInstances #-}
module Transformation.AG.Dimorphic where
import Data.Data (Data, Typeable)
import Data.Functor.Compose (Compose(..))
import Data.Functor.Const (Const(..))
import Data.Kind (Type)
import Data.Semigroup (Semigroup(..))
import qualified Rank2
import Transformation (Transformation, Domain, Codomain, At)
import qualified Transformation
import qualified Transformation.Deep as Deep
import qualified Transformation.Full as Full
newtype Auto t = Auto t
newtype Keep t = Keep t
data Atts a b = Atts{
forall a b. Atts a b -> a
inh :: a,
forall a b. Atts a b -> b
syn :: b}
deriving (Atts a b -> DataType
Atts a b -> Constr
forall a.
Typeable a
-> (forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall {a} {b}. (Data a, Data b) => Typeable (Atts a b)
forall a b. (Data a, Data b) => Atts a b -> DataType
forall a b. (Data a, Data b) => Atts a b -> Constr
forall a b.
(Data a, Data b) =>
(forall b. Data b => b -> b) -> Atts a b -> Atts a b
forall a b u.
(Data a, Data b) =>
Int -> (forall d. Data d => d -> u) -> Atts a b -> u
forall a b u.
(Data a, Data b) =>
(forall d. Data d => d -> u) -> Atts a b -> [u]
forall a b r r'.
(Data a, Data b) =>
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Atts a b -> r
forall a b r r'.
(Data a, Data b) =>
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Atts a b -> r
forall a b (m :: * -> *).
(Data a, Data b, Monad m) =>
(forall d. Data d => d -> m d) -> Atts a b -> m (Atts a b)
forall a b (m :: * -> *).
(Data a, Data b, MonadPlus m) =>
(forall d. Data d => d -> m d) -> Atts a b -> m (Atts a b)
forall a b (c :: * -> *).
(Data a, Data b) =>
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (Atts a b)
forall a b (c :: * -> *).
(Data a, Data b) =>
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Atts a b -> c (Atts a b)
forall a b (t :: * -> *) (c :: * -> *).
(Data a, Data b, Typeable t) =>
(forall d. Data d => c (t d)) -> Maybe (c (Atts a b))
forall a b (t :: * -> * -> *) (c :: * -> *).
(Data a, Data b, Typeable t) =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c (Atts a b))
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (Atts a b)
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Atts a b -> c (Atts a b)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c (Atts a b))
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Atts a b -> m (Atts a b)
$cgmapMo :: forall a b (m :: * -> *).
(Data a, Data b, MonadPlus m) =>
(forall d. Data d => d -> m d) -> Atts a b -> m (Atts a b)
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Atts a b -> m (Atts a b)
$cgmapMp :: forall a b (m :: * -> *).
(Data a, Data b, MonadPlus m) =>
(forall d. Data d => d -> m d) -> Atts a b -> m (Atts a b)
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Atts a b -> m (Atts a b)
$cgmapM :: forall a b (m :: * -> *).
(Data a, Data b, Monad m) =>
(forall d. Data d => d -> m d) -> Atts a b -> m (Atts a b)
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Atts a b -> u
$cgmapQi :: forall a b u.
(Data a, Data b) =>
Int -> (forall d. Data d => d -> u) -> Atts a b -> u
gmapQ :: forall u. (forall d. Data d => d -> u) -> Atts a b -> [u]
$cgmapQ :: forall a b u.
(Data a, Data b) =>
(forall d. Data d => d -> u) -> Atts a b -> [u]
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Atts a b -> r
$cgmapQr :: forall a b r r'.
(Data a, Data b) =>
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Atts a b -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Atts a b -> r
$cgmapQl :: forall a b r r'.
(Data a, Data b) =>
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Atts a b -> r
gmapT :: (forall b. Data b => b -> b) -> Atts a b -> Atts a b
$cgmapT :: forall a b.
(Data a, Data b) =>
(forall b. Data b => b -> b) -> Atts a b -> Atts a b
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c (Atts a b))
$cdataCast2 :: forall a b (t :: * -> * -> *) (c :: * -> *).
(Data a, Data b, Typeable t) =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c (Atts a b))
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c (Atts a b))
$cdataCast1 :: forall a b (t :: * -> *) (c :: * -> *).
(Data a, Data b, Typeable t) =>
(forall d. Data d => c (t d)) -> Maybe (c (Atts a b))
dataTypeOf :: Atts a b -> DataType
$cdataTypeOf :: forall a b. (Data a, Data b) => Atts a b -> DataType
toConstr :: Atts a b -> Constr
$ctoConstr :: forall a b. (Data a, Data b) => Atts a b -> Constr
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (Atts a b)
$cgunfold :: forall a b (c :: * -> *).
(Data a, Data b) =>
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (Atts a b)
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Atts a b -> c (Atts a b)
$cgfoldl :: forall a b (c :: * -> *).
(Data a, Data b) =>
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Atts a b -> c (Atts a b)
Data, Typeable, Int -> Atts a b -> ShowS
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall a b. (Show a, Show b) => Int -> Atts a b -> ShowS
forall a b. (Show a, Show b) => [Atts a b] -> ShowS
forall a b. (Show a, Show b) => Atts a b -> String
showList :: [Atts a b] -> ShowS
$cshowList :: forall a b. (Show a, Show b) => [Atts a b] -> ShowS
show :: Atts a b -> String
$cshow :: forall a b. (Show a, Show b) => Atts a b -> String
showsPrec :: Int -> Atts a b -> ShowS
$cshowsPrec :: forall a b. (Show a, Show b) => Int -> Atts a b -> ShowS
Show)
instance (Semigroup a, Semigroup b) => Semigroup (Atts a b) where
Atts a
i1 b
s1 <> :: Atts a b -> Atts a b -> Atts a b
<> Atts a
i2 b
s2 = forall a b. a -> b -> Atts a b
Atts (a
i1 forall a. Semigroup a => a -> a -> a
<> a
i2) (b
s1 forall a. Semigroup a => a -> a -> a
<> b
s2)
instance (Monoid a, Monoid b) => Monoid (Atts a b) where
mappend :: Atts a b -> Atts a b -> Atts a b
mappend = forall a. Semigroup a => a -> a -> a
(<>)
mempty :: Atts a b
mempty = forall a b. a -> b -> Atts a b
Atts forall a. Monoid a => a
mempty forall a. Monoid a => a
mempty
type Semantics a b = Const (a -> b)
type PreservingSemantics f a b = Compose ((->) a) (Compose ((,) (Atts a b)) f)
type Rule a b = Atts a b -> Atts a b
instance {-# overlappable #-} Attribution t a b g deep shallow where
attribution :: t -> shallow (g deep deep) -> Rule a b
attribution = forall a b. a -> b -> a
const (forall a b. a -> b -> a
const forall a. a -> a
id)
instance {-# overlappable #-} (Transformation (Auto t), p ~ Domain (Auto t), q ~ Codomain (Auto t), q ~ Semantics a b,
Rank2.Foldable (g q), Monoid a, Monoid b, Foldable p, Attribution (Auto t) a b g q p) =>
(Auto t) `At` g (Semantics a b) (Semantics a b) where
$ :: Auto t
-> Domain (Auto t) (g (Semantics a b) (Semantics a b))
-> Codomain (Auto t) (g (Semantics a b) (Semantics a b))
($) = forall (p :: * -> *) t (q :: * -> *) a b x
(g :: (* -> *) -> (* -> *) -> *).
(p ~ Domain t, q ~ Semantics a b, x ~ g q q, Foldable (g q),
Attribution t a b g q p, Monoid a, Monoid b) =>
(forall y. p y -> y) -> t -> p x -> q x
applyDefault (forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr forall a b. a -> b -> a
const forall a b. (a -> b) -> a -> b
$ forall a. HasCallStack => String -> a
error String
"Missing node")
{-# INLINE ($) #-}
instance {-# overlappable #-} (Transformation (Keep t), p ~ Domain (Keep t), q ~ Codomain (Keep t),
q ~ PreservingSemantics p a b, Rank2.Foldable (g q), Monoid a, Monoid b,
Foldable p, Functor p, Attribution (Keep t) a b g q p) =>
(Keep t) `At` g (PreservingSemantics p a b) (PreservingSemantics p a b) where
$ :: Keep t
-> Domain
(Keep t)
(g (PreservingSemantics p a b) (PreservingSemantics p a b))
-> Codomain
(Keep t)
(g (PreservingSemantics p a b) (PreservingSemantics p a b))
($) = forall (p :: * -> *) t (q :: * -> *) a b x
(g :: (* -> *) -> (* -> *) -> *).
(p ~ Domain t, q ~ PreservingSemantics p a b, x ~ g q q,
Attribution t a b g q p, Foldable (g q), Monoid a, Monoid b,
Foldable p, Functor p) =>
t -> p x -> q x
applyDefaultWithAttributes
{-# INLINE ($) #-}
instance (Transformation (Auto t), Domain (Auto t) ~ f, Functor f, Codomain (Auto t) ~ Semantics a b,
Deep.Functor (Auto t) g, Auto t `At` g (Semantics a b) (Semantics a b)) =>
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 f a b,
Functor f, Deep.Functor (Keep t) g,
Keep t `At` g (PreservingSemantics f a b) (PreservingSemantics f a b)) =>
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 (Transformation (Keep t), Domain (Keep t) ~ f, Traversable f, Rank2.Traversable (g f),
Codomain (Keep t) ~ PreservingSemantics f a b, Deep.Traversable (Feeder a b f) g, Full.Functor (Keep t) g,
Keep t `At` g (PreservingSemantics f a b) (PreservingSemantics f a b)) =>
Full.Traversable (Keep t) g where
traverse :: forall (m :: * -> *) (f :: * -> *).
(Codomain (Keep t) ~ Compose m f) =>
Keep t
-> Domain (Keep t) (g (Domain (Keep t)) (Domain (Keep t)))
-> m (f (g f f))
traverse = forall t (p :: * -> *) (q :: * -> *) (r :: * -> *) a b
(g :: (* -> *) -> (* -> *) -> *).
(Transformation t, Domain t ~ p, Codomain t ~ Compose ((->) a) q,
q ~ Compose ((,) (Atts a b)) p, r ~ Compose ((->) a) q,
Traversable p, Functor t g, Traversable (Feeder a b p) g,
At t (g r r)) =>
t -> p (g p p) -> a -> q (g q q)
traverseDefaultWithAttributes
knit :: (Rank2.Foldable (g sem), sem ~ Semantics a b, Monoid a, Monoid b)
=> Rule a b -> g sem sem -> sem (g sem sem)
knit :: forall (g :: (* -> *) -> (* -> *) -> *) (sem :: * -> *) a b.
(Foldable (g sem), sem ~ Semantics a b, Monoid a, Monoid b) =>
Rule a b -> g sem sem -> sem (g sem sem)
knit Rule a b
r g sem sem
chSem = forall {k} a (b :: k). a -> Const a b
Const a -> b
knitted
where knitted :: a -> b
knitted a
inherited = b
synthesized
where Atts{syn :: forall a b. Atts a b -> b
syn= b
synthesized, inh :: forall a b. Atts a b -> a
inh= a
chInh} = Rule a b
r Atts{inh :: a
inh= a
inherited, syn :: b
syn= b
chSyn}
chSyn :: b
chSyn = forall {k} (g :: (k -> *) -> *) m (p :: k -> *).
(Foldable g, Monoid m) =>
(forall (a :: k). p a -> m) -> g p -> m
Rank2.foldMap ((forall a b. (a -> b) -> a -> b
$ a
chInh) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {k} a (b :: k). Const a b -> a
getConst) g sem sem
chSem
knitKeeping :: forall a b f g sem. (Rank2.Foldable (g sem), sem ~ PreservingSemantics f a b,
Monoid a, Monoid b, Foldable f, Functor f)
=> Rule a b -> f (g sem sem) -> sem (g sem sem)
knitKeeping :: forall a b (f :: * -> *) (g :: (* -> *) -> (* -> *) -> *)
(sem :: * -> *).
(Foldable (g sem), sem ~ PreservingSemantics f a b, Monoid a,
Monoid b, Foldable f, Functor f) =>
Rule a b -> f (g sem sem) -> sem (g sem sem)
knitKeeping Rule a b
r f (g sem sem)
x = forall {k} {k1} (f :: k -> *) (g :: k1 -> k) (a :: k1).
f (g a) -> Compose f g a
Compose a -> Compose ((,) (Atts a b)) f (g sem sem)
knitted
where knitted :: a -> Compose ((,) (Atts a b)) f (g sem sem)
knitted :: a -> Compose ((,) (Atts a b)) f (g sem sem)
knitted a
inherited = forall {k} {k1} (f :: k -> *) (g :: k1 -> k) (a :: k1).
f (g a) -> Compose f g a
Compose (Atts a b
results, f (g sem sem)
x)
where results :: Atts a b
results@Atts{inh :: forall a b. Atts a b -> a
inh= a
chInh} = Rule a b
r Atts{inh :: a
inh= a
inherited, syn :: b
syn= b
chSyn}
chSyn :: b
chSyn = forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (forall {k} (g :: (k -> *) -> *) m (p :: k -> *).
(Foldable g, Monoid m) =>
(forall (a :: k). p a -> m) -> g p -> m
Rank2.foldMap (forall a b. Atts a b -> b
syn forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> a
fst forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {k1} {k2} (f :: k1 -> *) (g :: k2 -> k1) (a :: k2).
Compose f g a -> f (g a)
getCompose forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall a b. (a -> b) -> a -> b
$ a
chInh) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {k1} {k2} (f :: k1 -> *) (g :: k2 -> k1) (a :: k2).
Compose f g a -> f (g a)
getCompose)) f (g sem sem)
x
class Attribution t a b g (deep :: Type -> Type) shallow where
attribution :: t -> shallow (g deep deep) -> Rule a b
applyDefault :: (p ~ Domain t, q ~ Semantics a b, x ~ g q q,
Rank2.Foldable (g q), Attribution t a b g q p, Monoid a, Monoid b)
=> (forall y. p y -> y) -> t -> p x -> q x
applyDefault :: forall (p :: * -> *) t (q :: * -> *) a b x
(g :: (* -> *) -> (* -> *) -> *).
(p ~ Domain t, q ~ Semantics a b, x ~ g q q, Foldable (g q),
Attribution t a b g q p, Monoid a, Monoid b) =>
(forall y. p y -> y) -> t -> p x -> q x
applyDefault forall y. p y -> y
extract t
t p x
x = forall (g :: (* -> *) -> (* -> *) -> *) (sem :: * -> *) a b.
(Foldable (g sem), sem ~ Semantics a b, Monoid a, Monoid b) =>
Rule a b -> g sem sem -> sem (g sem sem)
knit (forall t a b (g :: (* -> *) -> (* -> *) -> *) (deep :: * -> *)
(shallow :: * -> *).
Attribution t a b g deep shallow =>
t -> shallow (g deep deep) -> Rule a b
attribution t
t p x
x) (forall y. p y -> y
extract p x
x)
{-# INLINE applyDefault #-}
fullMapDefault :: (p ~ Domain t, q ~ Semantics a b, q ~ Codomain t, x ~ g q q, Rank2.Foldable (g q),
Deep.Functor t g, Attribution t a b g p p, Monoid a, Monoid b)
=> (forall y. p y -> y) -> t -> p (g p p) -> q (g q q)
fullMapDefault :: forall (p :: * -> *) t (q :: * -> *) a b x
(g :: (* -> *) -> (* -> *) -> *).
(p ~ Domain t, q ~ Semantics a b, q ~ Codomain t, x ~ g q q,
Foldable (g q), Functor t g, Attribution t a b g p p, Monoid a,
Monoid b) =>
(forall y. p y -> y) -> t -> p (g p p) -> q (g q q)
fullMapDefault forall y. p y -> y
extract t
t p (g p p)
local = forall (g :: (* -> *) -> (* -> *) -> *) (sem :: * -> *) a b.
(Foldable (g sem), sem ~ Semantics a b, Monoid a, Monoid b) =>
Rule a b -> g sem sem -> sem (g sem sem)
knit (forall t a b (g :: (* -> *) -> (* -> *) -> *) (deep :: * -> *)
(shallow :: * -> *).
Attribution t a b g deep shallow =>
t -> shallow (g deep deep) -> Rule a b
attribution t
t p (g p p)
local) (t
t forall t (g :: (* -> *) -> (* -> *) -> *).
Functor t g =>
t -> g (Domain t) (Domain t) -> g (Codomain t) (Codomain t)
Deep.<$> forall y. p y -> y
extract p (g p p)
local)
{-# INLINE fullMapDefault #-}
applyDefaultWithAttributes :: (p ~ Domain t, q ~ PreservingSemantics p a b, x ~ g q q,
Attribution t a b g q p, Rank2.Foldable (g q), Monoid a, Monoid b, Foldable p, Functor p)
=> t -> p x -> q x
applyDefaultWithAttributes :: forall (p :: * -> *) t (q :: * -> *) a b x
(g :: (* -> *) -> (* -> *) -> *).
(p ~ Domain t, q ~ PreservingSemantics p a b, x ~ g q q,
Attribution t a b g q p, Foldable (g q), Monoid a, Monoid b,
Foldable p, Functor p) =>
t -> p x -> q x
applyDefaultWithAttributes t
t p x
x = forall a b (f :: * -> *) (g :: (* -> *) -> (* -> *) -> *)
(sem :: * -> *).
(Foldable (g sem), sem ~ PreservingSemantics f a b, Monoid a,
Monoid b, Foldable f, Functor f) =>
Rule a b -> f (g sem sem) -> sem (g sem sem)
knitKeeping (forall t a b (g :: (* -> *) -> (* -> *) -> *) (deep :: * -> *)
(shallow :: * -> *).
Attribution t a b g deep shallow =>
t -> shallow (g deep deep) -> Rule a b
attribution t
t p x
x) p x
x
{-# INLINE applyDefaultWithAttributes #-}
traverseDefaultWithAttributes :: forall t p q r a b g.
(Transformation t, Domain t ~ p, Codomain t ~ Compose ((->) a) q,
q ~ Compose ((,) (Atts a b)) p, r ~ Compose ((->) a) q,
Traversable p, Full.Functor t g, Deep.Traversable (Feeder a b p) g,
Transformation.At t (g r r))
=> t -> p (g p p) -> a -> q (g q q)
traverseDefaultWithAttributes :: forall t (p :: * -> *) (q :: * -> *) (r :: * -> *) a b
(g :: (* -> *) -> (* -> *) -> *).
(Transformation t, Domain t ~ p, Codomain t ~ Compose ((->) a) q,
q ~ Compose ((,) (Atts a b)) p, r ~ Compose ((->) a) q,
Traversable p, Functor t g, Traversable (Feeder a b p) g,
At t (g r r)) =>
t -> p (g p p) -> a -> q (g q q)
traverseDefaultWithAttributes t
t p (g p p)
x a
rootInheritance = forall t (g :: (* -> *) -> (* -> *) -> *) (m :: * -> *)
(f :: * -> *).
(Traversable t g, Codomain t ~ Compose m f) =>
t -> Domain t (g (Domain t) (Domain t)) -> m (f (g f f))
Full.traverse forall a b (f :: * -> *). Feeder a b f
Feeder (t
t forall t (g :: (* -> *) -> (* -> *) -> *).
Functor t g =>
t
-> Domain t (g (Domain t) (Domain t))
-> Codomain t (g (Codomain t) (Codomain t))
Full.<$> p (g p p)
x) a
rootInheritance
{-# INLINE traverseDefaultWithAttributes #-}
data Feeder a b (f :: Type -> Type) = Feeder
instance Transformation (Feeder a b f) where
type Domain (Feeder a b f) = Compose ((->) a) (Compose ((,) (Atts a b)) f)
type Codomain (Feeder a b f) = Compose ((->) a) (Compose ((,) (Atts a b)) f)
instance Transformation.At (Feeder a b f) g where
Feeder a b f
Feeder $ :: Feeder a b f
-> Domain (Feeder a b f) g -> Codomain (Feeder a b f) g
$ Domain (Feeder a b f) g
x = Domain (Feeder a b f) g
x
instance (Traversable f, Deep.Traversable (Feeder a b f) g) => Full.Traversable (Feeder a b f) g where
traverse :: forall (m :: * -> *) (f :: * -> *).
(Codomain (Feeder a b f) ~ Compose m f) =>
Feeder a b f
-> Domain
(Feeder a b f) (g (Domain (Feeder a b f)) (Domain (Feeder a b f)))
-> m (f (g f f))
traverse Feeder a b f
t Domain
(Feeder a b f) (g (Domain (Feeder a b f)) (Domain (Feeder a b f)))
x a
inheritance = forall {k} {k1} (f :: k -> *) (g :: k1 -> k) (a :: k1).
f (g a) -> Compose f g a
Compose (Atts a b
atts{inh :: a
inh= a
inheritance}, forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse (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 Feeder a b f
t) f (g (Compose ((->) a) (Compose ((,) (Atts a b)) f))
(Compose ((->) a) (Compose ((,) (Atts a b)) f)))
y (forall a b. Atts a b -> a
inh Atts a b
atts))
where Compose (Atts a b
atts, f (g (Compose ((->) a) (Compose ((,) (Atts a b)) f))
(Compose ((->) a) (Compose ((,) (Atts a b)) f)))
y) = forall {k1} {k2} (f :: k1 -> *) (g :: k2 -> k1) (a :: k2).
Compose f g a -> f (g a)
getCompose Domain
(Feeder a b f) (g (Domain (Feeder a b f)) (Domain (Feeder a b f)))
x a
inheritance