{-# Language Haskell2010, DefaultSignatures, DeriveDataTypeable,
             FlexibleContexts, FlexibleInstances, MultiParamTypeClasses, RankNTypes,
             ScopedTypeVariables, TypeFamilies, TypeOperators, UndecidableInstances #-}

-- | A special case of an attribute grammar where every node has only a single inherited and a single synthesized
-- attribute of the same monoidal type. The synthesized attributes of child nodes are all 'mconcat`ted together.

module Transformation.AG.Dimorphic where

import Data.Data (Data, Typeable)
import Data.Functor.Const (Const(..))
import Data.Kind (Type)
import Data.Semigroup (Semigroup(..))
import Unsafe.Coerce (unsafeCoerce)
import qualified Rank2
import Transformation (Transformation, Domain, Codomain)
import qualified Transformation
import qualified Transformation.Deep as Deep
import qualified Transformation.Full as Full
import qualified Transformation.AG as AG

-- | Wrapper that provides a 'Transformation' instance for any 'Attribution'
newtype T t = T t

-- | Wrapper that provides a default 'AG.Attribution' and (via AG.Knit) 'Transformation' instance for any 'Attribution'
newtype Auto t = Auto t

-- | Node attributes
data Atts a b = Atts{
   -- | inherited
   forall a b. Atts a b -> a
inh :: a,
   -- | synthesized
   forall a b. Atts a b -> b
syn :: b}
   deriving (Typeable (Atts a b)
Typeable (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 (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c (Atts a b))
-> (Atts a b -> Constr)
-> (Atts a b -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (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)))
-> ((forall b. Data b => b -> b) -> Atts a b -> Atts a b)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> Atts a b -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> Atts a b -> r)
-> (forall u. (forall d. Data d => d -> u) -> Atts a b -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> Atts a b -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> Atts a b -> m (Atts a b))
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Atts a b -> m (Atts a b))
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Atts a b -> m (Atts a b))
-> Data (Atts a b)
Atts a b -> Constr
Atts a b -> DataType
(forall b. Data b => b -> b) -> Atts a b -> Atts a b
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 u. Int -> (forall d. Data d => d -> u) -> Atts a b -> u
forall u. (forall d. Data d => d -> u) -> Atts a b -> [u]
forall a b. (Data a, Data b) => Typeable (Atts a b)
forall a b. (Data a, Data b) => Atts a b -> Constr
forall a b. (Data a, Data b) => Atts a b -> DataType
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 r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Atts a b -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Atts a b -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Atts a b -> m (Atts a b)
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Atts a b -> m (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. Data d => c (t d)) -> Maybe (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))
$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)
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)
$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)
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (Atts a b)
$ctoConstr :: forall a b. (Data a, Data b) => Atts a b -> Constr
toConstr :: Atts a b -> Constr
$cdataTypeOf :: forall a b. (Data a, Data b) => Atts a b -> DataType
dataTypeOf :: Atts a b -> DataType
$cdataCast1 :: forall a b (t :: * -> *) (c :: * -> *).
(Data a, Data b, Typeable t) =>
(forall d. Data d => c (t d)) -> Maybe (c (Atts a b))
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> 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))
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c (Atts a b))
$cgmapT :: forall a b.
(Data a, Data b) =>
(forall b. Data b => b -> b) -> Atts a b -> Atts a b
gmapT :: (forall b. Data b => b -> b) -> Atts a b -> Atts a b
$cgmapQl :: 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
$cgmapQr :: forall a b r r'.
(Data a, Data b) =>
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Atts a b -> r
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Atts a b -> r
$cgmapQ :: forall a b u.
(Data a, Data b) =>
(forall d. Data d => d -> u) -> Atts a b -> [u]
gmapQ :: forall u. (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
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Atts a b -> u
$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)
gmapM :: forall (m :: * -> *).
Monad 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)
gmapMp :: 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)
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Atts a b -> m (Atts a b)
Data, Typeable, Int -> Atts a b -> ShowS
[Atts a b] -> ShowS
Atts a b -> String
(Int -> Atts a b -> ShowS)
-> (Atts a b -> String) -> ([Atts a b] -> ShowS) -> Show (Atts a b)
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
$cshowsPrec :: forall a b. (Show a, Show b) => Int -> Atts a b -> ShowS
showsPrec :: Int -> Atts a b -> ShowS
$cshow :: forall a b. (Show a, Show b) => Atts a b -> String
show :: Atts a b -> String
$cshowList :: forall a b. (Show a, Show b) => [Atts a b] -> ShowS
showList :: [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 = a -> b -> Atts a b
forall a b. a -> b -> Atts a b
Atts (a
i1 a -> a -> a
forall a. Semigroup a => a -> a -> a
<> a
i2) (b
s1 b -> b -> b
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 = Atts a b -> Atts a b -> Atts a b
forall a. Semigroup a => a -> a -> a
(<>)
   mempty :: Atts a b
mempty = a -> b -> Atts a b
forall a b. a -> b -> Atts a b
Atts a
forall a. Monoid a => a
mempty b
forall a. Monoid a => a
mempty

-- | A node's 'Semantics' maps its inherited attribute to its synthesized attribute.
type Semantics a b = Const (a -> b)

-- | An attribution rule maps a node's inherited attribute and its child nodes' synthesized attributes to the node's
-- synthesized attribute and the children nodes' inherited attributes.
type Rule a b = Atts a b -> Atts a b

-- | Class of transformations that assign the same type of inherited and synthesized attributes to every node.
class Attribution t where
   type Origin t :: Type -> Type
   type Inherited t :: Type
   type Synthesized t :: Type
   -- | Unwrap the value from the original attribution domain
   unwrap :: t -> Origin t x -> x

-- | The core type class for defining the attribute grammar. The instances of this class typically have a form like
--
-- > instance MyAttGrammar `At` MyNode where
-- >   attribution MyAttGrammar{} (Identity MyNode{})
-- >               Atts{inh= fromParent,
-- >                    syn= fromChildren}
-- >             = Atts{syn= toParent,
-- >                    inh= toChildren}
class Attribution t => At t (g :: (Type -> Type) -> (Type -> Type) -> Type) where
   -- | The attribution rule for a given transformation and node.
   attribution :: forall f. Rank2.Functor (g f) => t -> Origin t (g f f) -> Rule (Inherited t) (Synthesized t)

instance {-# overlappable #-} Attribution t => At t g where
   attribution :: forall (f :: * -> *).
Functor (g f) =>
t -> Origin t (g f f) -> Rule (Inherited t) (Synthesized t)
attribution = (Origin t (g f f) -> Rule (Inherited t) (Synthesized t))
-> t -> Origin t (g f f) -> Rule (Inherited t) (Synthesized t)
forall a b. a -> b -> a
const (Rule (Inherited t) (Synthesized t)
-> Origin t (g f f) -> Rule (Inherited t) (Synthesized t)
forall a b. a -> b -> a
const Rule (Inherited t) (Synthesized t)
forall a. a -> a
id)

instance {-# overlappable #-} (Attribution t, p ~ Origin t, a ~ Inherited t, b ~ Synthesized t,
                               q ~ Semantics a b, Rank2.Foldable (g q), Rank2.Functor (g q),
                               Monoid a, Monoid b, Foldable p, At t g) =>
                              T t `Transformation.At` g (Semantics a b) (Semantics a b) where
   T t
t $ :: T t
-> Domain (T t) (g (Semantics a b) (Semantics a b))
-> Codomain (T t) (g (Semantics a b) (Semantics a b))
$ Domain (T t) (g (Semantics a b) (Semantics a b))
x = Rule a b
-> g (Semantics a b) (Semantics a b)
-> Semantics a b (g (Semantics a b) (Semantics a b))
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 (t
-> Origin t (g (Semantics a b) (Semantics a b))
-> Rule (Inherited t) (Synthesized t)
forall t (g :: (* -> *) -> (* -> *) -> *) (f :: * -> *).
(At t g, Functor (g f)) =>
t -> Origin t (g f f) -> Rule (Inherited t) (Synthesized t)
forall (f :: * -> *).
Functor (g f) =>
t -> Origin t (g f f) -> Rule (Inherited t) (Synthesized t)
attribution t
t Domain (T t) (g (Semantics a b) (Semantics a b))
Origin t (g (Semantics a b) (Semantics a b))
x) (t
-> Origin t (g (Semantics a b) (Semantics a b))
-> g (Semantics a b) (Semantics a b)
forall x. t -> Origin t x -> x
forall t x. Attribution t => t -> Origin t x -> x
unwrap t
t Domain (T t) (g (Semantics a b) (Semantics a b))
Origin t (g (Semantics a b) (Semantics a b))
x)
   {-# INLINE ($) #-}

instance (Attribution t, At t g, p ~ Origin t, a ~ Inherited t, b ~ Synthesized t, q ~ Semantics a b,
          Monoid a, Monoid b, Foldable p, Functor p,
          Rank2.Foldable (g q), Rank2.Functor (g p), Rank2.Functor (g q), Deep.Functor (T t) g) =>
         Full.Functor (T t) g where
   <$> :: T t
-> Domain (T t) (g (Domain (T t)) (Domain (T t)))
-> Codomain (T t) (g (Codomain (T t)) (Codomain (T t)))
(<$>) = T t
-> Domain (T t) (g (Domain (T t)) (Domain (T t)))
-> Codomain (T t) (g (Codomain (T t)) (Codomain (T 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

-- | The core function to tie the recursive knot, turning a 'Rule' for a node into its 'Semantics'.
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 = (a -> b) -> Const (a -> b) (g sem sem)
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 a. sem a -> b) -> g sem sem -> b
forall m (p :: * -> *).
Monoid m =>
(forall a. p a -> m) -> g sem p -> m
forall {k} (g :: (k -> *) -> *) m (p :: k -> *).
(Foldable g, Monoid m) =>
(forall (a :: k). p a -> m) -> g p -> m
Rank2.foldMap (((a -> b) -> a -> b
forall a b. (a -> b) -> a -> b
$ a
chInh) ((a -> b) -> b) -> (sem a -> a -> b) -> sem a -> b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. sem a -> a -> b
Const (a -> b) a -> a -> b
forall {k} a (b :: k). Const a b -> a
getConst) g sem sem
chSem

instance Attribution t => Transformation (T t) where
   type Domain (T t) = Origin t
   type Codomain (T t) = Semantics (Inherited t) (Synthesized t)

instance (Attribution t, Foldable (Origin t)) => AG.Attribution (Auto t) where
   type Origin (Auto t) = Origin t
   unwrap :: forall x. Auto t -> Origin (Auto t) x -> x
unwrap Auto t
_ = (x -> x -> x) -> Origin t x -> x
forall a. (a -> a -> a) -> Origin t a -> a
forall (t :: * -> *) a. Foldable t => (a -> a -> a) -> t a -> a
foldr1 x -> x -> x
forall a b. a -> b -> a
const

type instance AG.Atts (AG.Inherited (Auto t)) g = Inherited t
type instance AG.Atts (AG.Synthesized (Auto t)) g = Synthesized t

instance (Attribution t, f ~ Origin t, Foldable f, At t g,
          Rank2.Foldable (g (AG.Semantics (Auto t))), Rank2.Functor (g (AG.Semantics (Auto t))),
          Monoid (Synthesized t)) => Auto t `AG.At` g where
   attribution :: forall (sem :: * -> *).
Traversable (g sem) =>
Auto t
-> Origin (Auto t) (g sem sem)
-> (Inherited (Auto t) (g sem sem), g sem (Synthesized (Auto t)))
-> (Synthesized (Auto t) (g sem sem), g sem (Inherited (Auto t)))
attribution (Auto t
t) Origin (Auto t) (g sem sem)
x (Inherited (Auto t) (g sem sem)
inherited, g sem (Synthesized (Auto t))
chSyn) = (Atts (Synthesized (Auto t)) (NodeConstructor (g sem sem))
-> Synthesized (Auto t) (g sem sem)
forall t a.
Atts (Synthesized t) (NodeConstructor a) -> Synthesized t a
AG.Synthesized (Atts (Synthesized (Auto t)) (NodeConstructor (g sem sem))
 -> Synthesized (Auto t) (g sem sem))
-> Atts (Synthesized (Auto t)) (NodeConstructor (g sem sem))
-> Synthesized (Auto t) (g sem sem)
forall a b. (a -> b) -> a -> b
$ Synthesized t
-> Atts (Synthesized (Auto t)) (NodeConstructor (g sem sem))
forall a b. a -> b
unsafeCoerce (Synthesized t
 -> Atts (Synthesized (Auto t)) (NodeConstructor (g sem sem)))
-> Synthesized t
-> Atts (Synthesized (Auto t)) (NodeConstructor (g sem sem))
forall a b. (a -> b) -> a -> b
$ Atts (Inherited t) (Synthesized t) -> Synthesized t
forall a b. Atts a b -> b
syn Atts (Inherited t) (Synthesized t)
result, g sem (Inherited (Auto t)) -> g sem (Inherited (Auto t))
forall a b. a -> b
unsafeCoerce g sem (Inherited (Auto t))
chInh)
      where result :: Atts (Inherited t) (Synthesized t)
result = t -> Origin t (g sem sem) -> Rule (Inherited t) (Synthesized t)
forall t (g :: (* -> *) -> (* -> *) -> *) (f :: * -> *).
(At t g, Functor (g f)) =>
t -> Origin t (g f f) -> Rule (Inherited t) (Synthesized t)
forall (f :: * -> *).
Functor (g f) =>
t -> Origin t (g f f) -> Rule (Inherited t) (Synthesized t)
attribution t
t Origin (Auto t) (g sem sem)
Origin t (g sem sem)
x Atts{inh :: Inherited t
inh=Inherited (Auto t) (g sem sem)
-> Atts (Inherited (Auto t)) (NodeConstructor (g sem sem))
forall t a. Inherited t a -> Atts (Inherited t) (NodeConstructor a)
AG.inh Inherited (Auto t) (g sem sem)
inherited, syn :: Synthesized t
syn=(forall a. Synthesized (Auto t) a -> Synthesized t)
-> g sem (Synthesized (Auto t)) -> Synthesized t
forall m (p :: * -> *).
Monoid m =>
(forall a. p a -> m) -> g sem p -> m
forall {k} (g :: (k -> *) -> *) m (p :: k -> *).
(Foldable g, Monoid m) =>
(forall (a :: k). p a -> m) -> g p -> m
Rank2.foldMap Synthesized (Auto t) a
-> Atts (Synthesized (Auto t)) (NodeConstructor a)
Synthesized (Auto t) a -> Synthesized t
forall a. Synthesized (Auto t) a -> Synthesized t
forall t a.
Synthesized t a -> Atts (Synthesized t) (NodeConstructor a)
AG.syn g sem (Synthesized (Auto t))
chSyn}
            chInh :: g sem (Inherited (Auto t))
chInh = sem a -> Inherited (Auto t) a
forall {a}. sem a -> Inherited (Auto t) a
forall (p :: * -> *) a. p a -> Inherited (Auto t) a
uniformInheritance (forall {a}. sem a -> Inherited (Auto t) a)
-> g sem sem -> g sem (Inherited (Auto t))
forall {k} (g :: (k -> *) -> *) (p :: k -> *) (q :: k -> *).
Functor g =>
(forall (a :: k). p a -> q a) -> g p -> g q
forall (p :: * -> *) (q :: * -> *).
(forall a. p a -> q a) -> g sem p -> g sem q
Rank2.<$> (g sem sem -> g sem sem -> g sem sem)
-> g sem sem -> f (g sem sem) -> g sem sem
forall a b. (a -> b -> b) -> b -> f a -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr g sem sem -> g sem sem -> g sem sem
forall a b. a -> b -> a
const (String -> g sem sem
forall a. HasCallStack => String -> a
error String
"Missing node") f (g sem sem)
Origin (Auto t) (g sem sem)
x
            uniformInheritance :: forall p a. p a -> AG.Inherited (Auto t) a
            uniformInheritance :: forall (p :: * -> *) a. p a -> Inherited (Auto t) a
uniformInheritance = Inherited (Auto t) a -> p a -> Inherited (Auto t) a
forall a b. a -> b -> a
const (Inherited (Auto t) a -> p a -> Inherited (Auto t) a)
-> Inherited (Auto t) a -> p a -> Inherited (Auto t) a
forall a b. (a -> b) -> a -> b
$ Atts (Inherited (Auto t)) (NodeConstructor a)
-> Inherited (Auto t) a
forall t a. Atts (Inherited t) (NodeConstructor a) -> Inherited t a
AG.Inherited (Inherited (Auto t) (g sem sem)
-> Atts (Inherited (Auto t)) (NodeConstructor (g sem sem))
forall t a. Inherited t a -> Atts (Inherited t) (NodeConstructor a)
AG.inh Inherited (Auto t) (g sem sem)
inherited)