packages feed

deep-transformations 0.2 → 0.2.1

raw patch · 13 files changed

+245/−78 lines, 13 filesdep ~template-haskellPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependency ranges changed: template-haskell

API changes (from Hackage documentation)

- Transformation.AG.Monomorphic: Atts :: a -> a -> Atts a
- Transformation.AG.Monomorphic: Feeder :: Feeder a (f :: Type -> Type)
- Transformation.AG.Monomorphic: [inh] :: Atts a -> a
- Transformation.AG.Monomorphic: [syn] :: Atts a -> a
- Transformation.AG.Monomorphic: data Atts a
- Transformation.AG.Monomorphic: data Feeder a (f :: Type -> Type)
- Transformation.AG.Monomorphic: instance (Data.Traversable.Traversable f, Transformation.Deep.Traversable (Transformation.AG.Monomorphic.Feeder a f) g) => Transformation.Full.Traversable (Transformation.AG.Monomorphic.Feeder a f) g
- Transformation.AG.Monomorphic: instance (Transformation.Transformation (Transformation.AG.Monomorphic.Auto t), Transformation.Domain (Transformation.AG.Monomorphic.Auto t) GHC.Types.~ f, GHC.Base.Functor f, Transformation.Codomain (Transformation.AG.Monomorphic.Auto t) GHC.Types.~ Transformation.AG.Monomorphic.Semantics (Transformation.AG.Monomorphic.Auto t), Transformation.Deep.Functor (Transformation.AG.Monomorphic.Auto t) g, Transformation.At (Transformation.AG.Monomorphic.Auto t) (g (Transformation.AG.Monomorphic.Semantics (Transformation.AG.Monomorphic.Auto t)) (Transformation.AG.Monomorphic.Semantics (Transformation.AG.Monomorphic.Auto t)))) => Transformation.Full.Functor (Transformation.AG.Monomorphic.Auto t) g
- Transformation.AG.Monomorphic: instance Data.Data.Data a => Data.Data.Data (Transformation.AG.Monomorphic.Atts a)
- Transformation.AG.Monomorphic: instance GHC.Base.Monoid a => GHC.Base.Monoid (Transformation.AG.Monomorphic.Atts a)
- Transformation.AG.Monomorphic: instance GHC.Base.Semigroup a => GHC.Base.Semigroup (Transformation.AG.Monomorphic.Atts a)
- Transformation.AG.Monomorphic: instance GHC.Show.Show a => GHC.Show.Show (Transformation.AG.Monomorphic.Atts a)
- Transformation.AG.Monomorphic: instance Transformation.At (Transformation.AG.Monomorphic.Feeder a f) g
- Transformation.AG.Monomorphic: instance Transformation.Transformation (Transformation.AG.Monomorphic.Feeder a f)
+ Transformation: Folded :: t -> Folded (f :: Type -> Type) t
+ Transformation: Mapped :: t -> Mapped (f :: Type -> Type) t
+ Transformation: Traversed :: t -> Traversed (f :: Type -> Type) t
+ Transformation: instance (Transformation.At t x, Data.Foldable.Foldable f, Transformation.Codomain t GHC.Types.~ Data.Functor.Const.Const m, GHC.Base.Monoid m) => Transformation.At (Transformation.Folded f t) x
+ Transformation: instance (Transformation.At t x, Data.Traversable.Traversable f, Transformation.Codomain t GHC.Types.~ Data.Functor.Compose.Compose m n, GHC.Base.Applicative m) => Transformation.At (Transformation.Traversed f t) x
+ Transformation: instance (Transformation.At t x, GHC.Base.Functor f) => Transformation.At (Transformation.Mapped f t) x
+ Transformation: instance (Transformation.Transformation t, Transformation.Codomain t GHC.Types.~ Data.Functor.Compose.Compose m n) => Transformation.Transformation (Transformation.Traversed f t)
+ Transformation: instance Transformation.Transformation t => Transformation.Transformation (Transformation.Folded f t)
+ Transformation: instance Transformation.Transformation t => Transformation.Transformation (Transformation.Mapped f t)
+ Transformation: newtype Folded (f :: Type -> Type) t
+ Transformation: newtype Mapped (f :: Type -> Type) t
+ Transformation: newtype Traversed (f :: Type -> Type) t
+ Transformation: type Codomain t :: Type -> Type;
+ Transformation: type Domain t :: Type -> Type;
+ Transformation.AG.Dimorphic: Atts :: a -> b -> Atts a b
+ Transformation.AG.Dimorphic: Auto :: t -> Auto t
+ Transformation.AG.Dimorphic: Feeder :: Feeder a b (f :: Type -> Type)
+ Transformation.AG.Dimorphic: Keep :: t -> Keep t
+ Transformation.AG.Dimorphic: [inh] :: Atts a b -> a
+ Transformation.AG.Dimorphic: [syn] :: Atts a b -> b
+ Transformation.AG.Dimorphic: applyDefault :: (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
+ Transformation.AG.Dimorphic: applyDefaultWithAttributes :: (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
+ Transformation.AG.Dimorphic: attribution :: Attribution t a b g deep shallow => t -> shallow (g deep deep) -> Rule a b
+ Transformation.AG.Dimorphic: class Attribution t a b g (deep :: Type -> Type) shallow
+ Transformation.AG.Dimorphic: data Atts a b
+ Transformation.AG.Dimorphic: data Feeder a b (f :: Type -> Type)
+ Transformation.AG.Dimorphic: fullMapDefault :: (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)
+ Transformation.AG.Dimorphic: instance (Data.Data.Data a, Data.Data.Data b) => Data.Data.Data (Transformation.AG.Dimorphic.Atts a b)
+ Transformation.AG.Dimorphic: instance (Data.Traversable.Traversable f, Transformation.Deep.Traversable (Transformation.AG.Dimorphic.Feeder a b f) g) => Transformation.Full.Traversable (Transformation.AG.Dimorphic.Feeder a b f) g
+ Transformation.AG.Dimorphic: instance (GHC.Base.Monoid a, GHC.Base.Monoid b) => GHC.Base.Monoid (Transformation.AG.Dimorphic.Atts a b)
+ Transformation.AG.Dimorphic: instance (GHC.Base.Semigroup a, GHC.Base.Semigroup b) => GHC.Base.Semigroup (Transformation.AG.Dimorphic.Atts a b)
+ Transformation.AG.Dimorphic: instance (GHC.Show.Show a, GHC.Show.Show b) => GHC.Show.Show (Transformation.AG.Dimorphic.Atts a b)
+ Transformation.AG.Dimorphic: instance (Transformation.Transformation (Transformation.AG.Dimorphic.Auto t), Transformation.Domain (Transformation.AG.Dimorphic.Auto t) GHC.Types.~ f, GHC.Base.Functor f, Transformation.Codomain (Transformation.AG.Dimorphic.Auto t) GHC.Types.~ Transformation.AG.Dimorphic.Semantics a b, Transformation.Deep.Functor (Transformation.AG.Dimorphic.Auto t) g, Transformation.At (Transformation.AG.Dimorphic.Auto t) (g (Transformation.AG.Dimorphic.Semantics a b) (Transformation.AG.Dimorphic.Semantics a b))) => Transformation.Full.Functor (Transformation.AG.Dimorphic.Auto t) g
+ Transformation.AG.Dimorphic: instance (Transformation.Transformation (Transformation.AG.Dimorphic.Auto t), p GHC.Types.~ Transformation.Domain (Transformation.AG.Dimorphic.Auto t), q GHC.Types.~ Transformation.Codomain (Transformation.AG.Dimorphic.Auto t), q GHC.Types.~ Transformation.AG.Dimorphic.Semantics a b, Rank2.Foldable (g q), GHC.Base.Monoid a, GHC.Base.Monoid b, Data.Foldable.Foldable p, Transformation.AG.Dimorphic.Attribution (Transformation.AG.Dimorphic.Auto t) a b g q p) => Transformation.At (Transformation.AG.Dimorphic.Auto t) (g (Transformation.AG.Dimorphic.Semantics a b) (Transformation.AG.Dimorphic.Semantics a b))
+ Transformation.AG.Dimorphic: instance (Transformation.Transformation (Transformation.AG.Dimorphic.Keep t), Transformation.Domain (Transformation.AG.Dimorphic.Keep t) GHC.Types.~ f, Data.Traversable.Traversable f, Rank2.Traversable (g f), Transformation.Codomain (Transformation.AG.Dimorphic.Keep t) GHC.Types.~ Transformation.AG.Dimorphic.PreservingSemantics f a b, Transformation.Deep.Traversable (Transformation.AG.Dimorphic.Feeder a b f) g, Transformation.Full.Functor (Transformation.AG.Dimorphic.Keep t) g, Transformation.At (Transformation.AG.Dimorphic.Keep t) (g (Transformation.AG.Dimorphic.PreservingSemantics f a b) (Transformation.AG.Dimorphic.PreservingSemantics f a b))) => Transformation.Full.Traversable (Transformation.AG.Dimorphic.Keep t) g
+ Transformation.AG.Dimorphic: instance (Transformation.Transformation (Transformation.AG.Dimorphic.Keep t), Transformation.Domain (Transformation.AG.Dimorphic.Keep t) GHC.Types.~ f, GHC.Base.Functor f, Transformation.Codomain (Transformation.AG.Dimorphic.Keep t) GHC.Types.~ Transformation.AG.Dimorphic.PreservingSemantics f a b, GHC.Base.Functor f, Transformation.Deep.Functor (Transformation.AG.Dimorphic.Keep t) g, Transformation.At (Transformation.AG.Dimorphic.Keep t) (g (Transformation.AG.Dimorphic.PreservingSemantics f a b) (Transformation.AG.Dimorphic.PreservingSemantics f a b))) => Transformation.Full.Functor (Transformation.AG.Dimorphic.Keep t) g
+ Transformation.AG.Dimorphic: instance (Transformation.Transformation (Transformation.AG.Dimorphic.Keep t), p GHC.Types.~ Transformation.Domain (Transformation.AG.Dimorphic.Keep t), q GHC.Types.~ Transformation.Codomain (Transformation.AG.Dimorphic.Keep t), q GHC.Types.~ Transformation.AG.Dimorphic.PreservingSemantics p a b, Rank2.Foldable (g q), GHC.Base.Monoid a, GHC.Base.Monoid b, Data.Foldable.Foldable p, GHC.Base.Functor p, Transformation.AG.Dimorphic.Attribution (Transformation.AG.Dimorphic.Keep t) a b g q p) => Transformation.At (Transformation.AG.Dimorphic.Keep t) (g (Transformation.AG.Dimorphic.PreservingSemantics p a b) (Transformation.AG.Dimorphic.PreservingSemantics p a b))
+ Transformation.AG.Dimorphic: instance Transformation.AG.Dimorphic.Attribution t a b g deep shallow
+ Transformation.AG.Dimorphic: instance Transformation.At (Transformation.AG.Dimorphic.Feeder a b f) g
+ Transformation.AG.Dimorphic: instance Transformation.Transformation (Transformation.AG.Dimorphic.Feeder a b f)
+ Transformation.AG.Dimorphic: knit :: (Foldable (g sem), sem ~ Semantics a b, Monoid a, Monoid b) => Rule a b -> g sem sem -> sem (g sem sem)
+ Transformation.AG.Dimorphic: 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)
+ Transformation.AG.Dimorphic: newtype Auto t
+ Transformation.AG.Dimorphic: newtype Keep t
+ Transformation.AG.Dimorphic: 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)
+ Transformation.AG.Dimorphic: type PreservingSemantics f a b = Compose ((->) a) (Compose ((,) (Atts a b)) f)
+ Transformation.AG.Dimorphic: type Rule a b = Atts a b -> Atts a b
+ Transformation.AG.Dimorphic: type Semantics a b = Const (a -> b)
+ Transformation.AG.Monomorphic: inh :: Atts a -> a
+ Transformation.AG.Monomorphic: instance (Transformation.Transformation (Transformation.AG.Monomorphic.Auto t), Transformation.Domain (Transformation.AG.Monomorphic.Auto t) GHC.Types.~ f, GHC.Base.Functor f, Transformation.Codomain (Transformation.AG.Monomorphic.Auto t) GHC.Types.~ Transformation.AG.Monomorphic.Semantics a, Transformation.Deep.Functor (Transformation.AG.Monomorphic.Auto t) g, Transformation.At (Transformation.AG.Monomorphic.Auto t) (g (Transformation.AG.Monomorphic.Semantics a) (Transformation.AG.Monomorphic.Semantics a))) => Transformation.Full.Functor (Transformation.AG.Monomorphic.Auto t) g
+ Transformation.AG.Monomorphic: pattern Atts :: a -> a -> Atts a
+ Transformation.AG.Monomorphic: syn :: Atts a -> a
+ Transformation.AG.Monomorphic: type Atts a = Atts a a
+ Transformation.AG.Monomorphic: type Feeder a = Feeder a a
- Transformation: type family Codomain t :: Type -> Type;
+ Transformation: type family ComposeInner (c :: Type -> Type) :: Type -> Type
- Transformation.AG: type family Atts (f :: * -> *) a
+ Transformation.AG: type family Atts (f :: Type -> Type) a
- Transformation.AG.Monomorphic: knit :: (Foldable (g sem), sem ~ Semantics a, Monoid a) => Rule a -> g sem sem -> sem (g sem sem)
+ Transformation.AG.Monomorphic: knit :: (Foldable (g sem), sem ~ Semantics a b, Monoid a, Monoid b) => Rule a b -> g sem sem -> sem (g sem sem)
- Transformation.AG.Monomorphic: knitKeeping :: forall a f g sem. (Foldable (g sem), sem ~ PreservingSemantics f a, Monoid a, Foldable f, Functor f) => Rule a -> f (g sem sem) -> sem (g sem sem)
+ Transformation.AG.Monomorphic: 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)
- Transformation.AG.Monomorphic: traverseDefaultWithAttributes :: forall t p q r a g. (Transformation t, Domain t ~ p, Codomain t ~ Compose ((->) a) q, q ~ Compose ((,) (Atts a)) p, r ~ Compose ((->) a) q, Traversable p, Functor t g, Traversable (Feeder a p) g, At t (g r r)) => t -> p (g p p) -> a -> q (g q q)
+ Transformation.AG.Monomorphic: 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)
- Transformation.Deep: InL :: s (g d d) -> Sum g h (d :: * -> *) (s :: * -> *)
+ Transformation.Deep: InL :: s (g d d) -> Sum g h (d :: Type -> Type) (s :: Type -> Type)
- Transformation.Deep: InR :: s (h d d) -> Sum g h (d :: * -> *) (s :: * -> *)
+ Transformation.Deep: InR :: s (h d d) -> Sum g h (d :: Type -> Type) (s :: Type -> Type)
- Transformation.Deep: Pair :: s (g d d) -> s (h d d) -> Product g h (d :: * -> *) (s :: * -> *)
+ Transformation.Deep: Pair :: s (g d d) -> s (h d d) -> Product g h (d :: Type -> Type) (s :: Type -> Type)
- Transformation.Deep: [fst] :: Product g h (d :: * -> *) (s :: * -> *) -> s (g d d)
+ Transformation.Deep: [fst] :: Product g h (d :: Type -> Type) (s :: Type -> Type) -> s (g d d)
- Transformation.Deep: [snd] :: Product g h (d :: * -> *) (s :: * -> *) -> s (h d d)
+ Transformation.Deep: [snd] :: Product g h (d :: Type -> Type) (s :: Type -> Type) -> s (h d d)
- Transformation.Deep: data Product g h (d :: * -> *) (s :: * -> *)
+ Transformation.Deep: data Product g h (d :: Type -> Type) (s :: Type -> Type)
- Transformation.Deep: data Sum g h (d :: * -> *) (s :: * -> *)
+ Transformation.Deep: data Sum g h (d :: Type -> Type) (s :: Type -> Type)

Files

CHANGELOG.md view
@@ -1,10 +1,17 @@ # Revision history for deep-transformations +## 0.2.1 -- 2023-01-07++* Added AG.Dimorphic+* Added combinators `Transformation.Mapped`, `Folded`, and `Traversed`+* Compiling with GHC 9.4+ ## 0.2 -- 2022-03-27  * Changes necessary to compile with GHC 9.2.2 * Excluded GHC 8.2.2 from `deep-transformations` and GitHub CI * Increased the `deep-transformations`' bottom bound of base dependency+* Relaxed the bounds of the `generic-lens` dependency * Fixed `deep-transformations` compilation with GHC 9.0.1 * Added an explicit implementation `mappend = (<>)` * Used haskell-ci to generate GitHub CI
README.md view
@@ -154,7 +154,7 @@ Folding ------- -Suppose we we want to get a list of all variables used in an expression. To do this we would declare the appropriate+Suppose we want to get a list of all variables used in an expression. To do this we would declare the appropriate  [`Transformation`](https://hackage.haskell.org/package/deep-transformations/docs/Transformation.html) instance for an  arbitrary data type. We'll give this data type an evocative name. 
deep-transformations.cabal view
@@ -2,7 +2,7 @@ -- documentation, see http://haskell.org/cabal/users-guide/  name:                deep-transformations-version:             0.2+version:             0.2.1 synopsis:            Deep natural and unnatural tree transformations, including attribute grammars description: @@ -30,7 +30,7 @@ custom-setup  setup-depends:    base >= 4 && <5,-   Cabal,+   Cabal < 4,    cabal-doctest >= 1 && <1.1   library@@ -40,11 +40,12 @@                         Transformation.Deep, Transformation.Deep.TH,                         Transformation.Full, Transformation.Full.TH,                         Transformation.Rank2,-                        Transformation.AG, Transformation.AG.Monomorphic, Transformation.AG.Generics+                        Transformation.AG, Transformation.AG.Generics,+                        Transformation.AG.Monomorphic, Transformation.AG.Dimorphic   ghc-options:         -Wall   build-depends:        base >= 4.11 && < 5, rank2classes >= 1.4.1 && < 1.5,                         transformers >= 0.5 && < 0.7,-                        template-haskell >= 2.11 && < 2.19, generic-lens >= 1.2 && < 2.3+                        template-haskell >= 2.11 && < 2.20, generic-lens >= 1.2 && < 2.3   default-language:     Haskell2010  test-suite doctests
src/Transformation.hs view
@@ -1,4 +1,4 @@-{-# Language FlexibleInstances, MultiParamTypeClasses, ScopedTypeVariables,+{-# Language DataKinds, FlexibleContexts, FlexibleInstances, MultiParamTypeClasses, ScopedTypeVariables,              TypeFamilies, TypeOperators, UndecidableInstances #-}  -- | A /natural transformation/ is a concept from category theory for a mapping between two functors and their objects@@ -24,9 +24,13 @@  module Transformation where +import Data.Coerce (coerce)+import qualified Data.Functor.Compose as Functor+import Data.Functor.Const (Const) import Data.Functor.Product (Product(Pair)) import Data.Functor.Sum (Sum(InL, InR)) import Data.Kind (Type)+import GHC.TypeLits (ErrorMessage (Text, ShowType, (:<>:)), TypeError) import qualified Rank2  import Prelude hiding (($))@@ -49,12 +53,49 @@ -- | Composition of two transformations data Compose t u = Compose t u +-- | Transformation under a 'Data.Functor.Functor'+newtype Mapped (f :: Type -> Type) t = Mapped t++-- | Transformation under a 'Foldable'+newtype Folded (f :: Type -> Type) t = Folded t++-- | Transformation under a 'Traversable'+newtype Traversed (f :: Type -> Type) t = Traversed t+ instance (Transformation t, Transformation u, Domain t ~ Codomain u) => Transformation (Compose t u) where    type Domain (Compose t u) = Domain u    type Codomain (Compose t u) = Codomain t +instance Transformation t => Transformation (Mapped f t) where+   type Domain (Mapped f t) = Functor.Compose f (Domain t)+   type Codomain (Mapped f t) = Functor.Compose f (Codomain t)++instance Transformation t => Transformation (Folded f t) where+   type Domain (Folded f t) = Functor.Compose f (Domain t)+   type Codomain (Folded f t) = Codomain t++instance (Transformation t, Codomain t ~ Functor.Compose m n) => Transformation (Traversed f t) where+   type Domain (Traversed f t) = Functor.Compose f (Domain t)+   type Codomain (Traversed f t) =+      Functor.Compose (ComposeOuter (Codomain t)) (Functor.Compose f (ComposeInner (Codomain t)))++type family ComposeOuter (c :: Type -> Type) :: Type -> Type where+   ComposeOuter (Functor.Compose p q) = p++type family ComposeInner (c :: Type -> Type) :: Type -> Type where+   ComposeInner (Functor.Compose p q) = q+ instance (t `At` x, u `At` x, Domain t ~ Codomain u) => Compose t u `At` x where-   Compose t u $ x =  t $ (u $ x)+   Compose t u $ x =  t $ u $ x++instance (t `At` x, Functor f) => Mapped f t `At` x where+   Mapped t $ Functor.Compose x = Functor.Compose ((t $) <$> x)++instance (t `At` x, Foldable f, Codomain t ~ Const m, Monoid m) => Folded f t `At` x where+   Folded t $ Functor.Compose x = foldMap (t $) x++instance (t `At` x, Traversable f, Codomain t ~ Functor.Compose m n, Applicative m) => Traversed f t `At` x where+   Traversed t $ Functor.Compose x = Functor.Compose (Functor.Compose <$> traverse (Functor.getCompose . (t $)) x)  instance Transformation (Rank2.Arrow (p :: Type -> Type) q x) where    type Domain (Rank2.Arrow p q x) = p
src/Transformation/AG.hs view
@@ -8,13 +8,14 @@  module Transformation.AG where +import Data.Kind (Type) import Unsafe.Coerce (unsafeCoerce)  import qualified Rank2 import qualified Transformation  -- | Type family that maps a node type to the type of its attributes, indexed per type constructor.-type family Atts (f :: * -> *) a+type family Atts (f :: Type -> Type) a  -- | Type constructor wrapping the inherited attributes for the given transformation. newtype Inherited t a = Inherited{inh :: Atts (Inherited t) a}
+ src/Transformation/AG/Dimorphic.hs view
@@ -0,0 +1,154 @@+{-# Language 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.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++-- | Transformation wrapper that allows automatic inference of attribute rules.+newtype Auto t = Auto t++-- | Transformation wrapper that allows automatic inference of attribute rules and preservation of the attribute with+-- the original nodes.+newtype Keep t = Keep t++data Atts a b = Atts{+   inh :: a,+   syn :: b}+   deriving (Data, Typeable, Show)++instance (Semigroup a, Semigroup b) => Semigroup (Atts a b) where+   Atts i1 s1 <> Atts i2 s2 = Atts (i1 <> i2) (s1 <> s2)++instance (Monoid a, Monoid b) => Monoid (Atts a b) where+   mappend = (<>)+   mempty = Atts mempty mempty++-- | A node's 'Semantics' maps its inherited attribute to its synthesized attribute.+type Semantics a b = Const (a -> b)++-- | A node's 'PreservingSemantics' maps its inherited attribute to its synthesized attribute.+type PreservingSemantics f a b = Compose ((->) a) (Compose ((,) (Atts a b)) f)++-- | An attribution rule maps a node's inherited attribute and its child nodes' synthesized attribute to the node's+-- synthesized attribute and the children nodes' inherited attributes.+type Rule a b = Atts a b -> Atts a b++instance {-# overlappable #-} Attribution t a b g deep shallow where+   attribution = const (const 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+   ($) = applyDefault (foldr const $ error "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+   ($) = 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+   (<$>) = 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+   (<$>) = 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 = traverseDefaultWithAttributes++-- | 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 r chSem = Const knitted+   where knitted inherited = synthesized+            where Atts{syn= synthesized, inh= chInh} = r Atts{inh= inherited, syn= chSyn}+                  chSyn = Rank2.foldMap (($ chInh) . getConst) chSem++-- | Another way to tie the recursive knot, using a 'Rule' to add attributes to every node througha stateful calculation+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 r x = Compose knitted+   where knitted :: a -> Compose ((,) (Atts a b)) f (g sem sem)+         knitted inherited = Compose (results, x)+            where results@Atts{inh= chInh} = r Atts{inh= inherited, syn= chSyn}+                  chSyn = foldMap (Rank2.foldMap (syn . fst . getCompose . ($ chInh) . getCompose)) x++-- | The core type class for defining the attribute grammar. The instances of this class typically have a form like+--+-- > instance Attribution MyAttGrammar MyMonoid MyNode (Semantics MyAttGrammar) Identity where+-- >   attribution MyAttGrammar{} (Identity MyNode{})+-- >               Atts{inh= fromParent,+-- >                    syn= fromChildren}+-- >             = Atts{syn= toParent,+-- >                    inh= toChildren}+class Attribution t a b g (deep :: Type -> Type) shallow where+   -- | The attribution rule for a given transformation and node.+   attribution :: t -> shallow (g deep deep) -> Rule a b++-- | Drop-in implementation of 'Transformation.$'+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 extract t x = knit (attribution t x) (extract x)+{-# INLINE applyDefault #-}++-- | Drop-in implementation of 'Full.<$>'+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 extract t local = knit (attribution t local) (t Deep.<$> extract local)+{-# INLINE fullMapDefault #-}++-- | Drop-in implementation of 'Transformation.$' that stores all attributes with every original node+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 t x = knitKeeping (attribution t x) x+{-# INLINE applyDefaultWithAttributes #-}++-- | Drop-in implementation of 'Full.traverse' that stores all attributes with every original node+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 t x rootInheritance = Full.traverse Feeder (t Full.<$> x) 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 $ x = x++instance (Traversable f, Deep.Traversable (Feeder a b f) g) => Full.Traversable (Feeder a b f) g where+   traverse t x inheritance = Compose (atts{inh= inheritance}, traverse (Deep.traverse t) y (inh atts))+      where Compose (atts, y) = getCompose x inheritance
src/Transformation/AG/Generics.hs view
@@ -23,7 +23,6 @@  import Data.Functor.Compose (Compose(..)) import Data.Functor.Const (Const(..))-import Data.Functor.Identity (Identity(..)) import Data.Kind (Type) import Data.Generics.Product.Subtype (Subtype(upcast)) import Data.Proxy (Proxy(..))@@ -144,7 +143,7 @@ -- * Generic transformations  -- | Internal transformation for passing down the inherited attributes.-newtype PassDown (t :: Type) (f :: * -> *) a = PassDown a+newtype PassDown (t :: Type) (f :: Type -> Type) a = PassDown a -- | Internal transformation for accumulating the 'Folded' attributes. data Accumulator (t :: Type) (name :: Symbol) (a :: Type) = Accumulator -- | Internal transformation for replicating the 'Mapped' attributes.
src/Transformation/AG/Monomorphic.hs view
@@ -1,22 +1,29 @@-{-# Language DeriveDataTypeable, FlexibleContexts, FlexibleInstances, MultiParamTypeClasses, RankNTypes,-             ScopedTypeVariables, TypeFamilies, TypeOperators, UndecidableInstances #-}+{-# Language FlexibleContexts, FlexibleInstances, KindSignatures, MultiParamTypeClasses, PatternSynonyms, RankNTypes,+             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.Monomorphic where+module Transformation.AG.Monomorphic (+  Auto (Auto), Keep (Keep), Atts, pattern Atts, inh, syn,+  Semantics, PreservingSemantics, Rule, Attribution (attribution), Feeder,+  Dimorphic.knit, Dimorphic.knitKeeping,+  applyDefault, applyDefaultWithAttributes,+  fullMapDefault, Dimorphic.traverseDefaultWithAttributes) 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 +import qualified Transformation.AG.Dimorphic as Dimorphic+import Transformation.AG.Dimorphic (knit, knitKeeping)++ -- | Transformation wrapper that allows automatic inference of attribute rules. newtype Auto t = Auto t @@ -24,17 +31,10 @@ -- the original nodes. newtype Keep t = Keep t -data Atts a = Atts{-   inh :: a,-   syn :: a}-   deriving (Data, Typeable, Show)--instance Semigroup a => Semigroup (Atts a) where-   Atts i1 s1 <> Atts i2 s2 = Atts (i1 <> i2) (s1 <> s2)+type Atts a = Dimorphic.Atts a a -instance Monoid a => Monoid (Atts a) where-   mappend = (<>)-   mempty = Atts mempty mempty+pattern Atts :: a -> a -> Atts a+pattern Atts{inh, syn} = Dimorphic.Atts inh syn  -- | A node's 'Semantics' maps its inherited attribute to its synthesized attribute. type Semantics a = Const (a -> a)@@ -62,8 +62,8 @@    ($) = applyDefaultWithAttributes    {-# 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))) =>+instance (Transformation (Auto t), Domain (Auto t) ~ f, Functor f, Codomain (Auto t) ~ Semantics a,+          Deep.Functor (Auto t) g, Auto t `At` g (Semantics a) (Semantics a)) =>          Full.Functor (Auto t) g where    (<$>) = Full.mapUpDefault @@ -77,25 +77,7 @@           Codomain (Keep t) ~ PreservingSemantics f a, Deep.Traversable (Feeder a f) g, Full.Functor (Keep t) g,           Keep t `At` g (PreservingSemantics f a) (PreservingSemantics f a)) =>          Full.Traversable (Keep t) g where-   traverse = traverseDefaultWithAttributes---- | 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, Monoid a)-     => Rule a -> g sem sem -> sem (g sem sem)-knit r chSem = Const knitted-   where knitted inherited = synthesized-            where Atts{syn= synthesized, inh= chInh} = r Atts{inh= inherited, syn= chSyn}-                  chSyn = Rank2.foldMap (($ chInh) . getConst) chSem---- | Another way to tie the recursive knot, using a 'Rule' to add attributes to every node througha stateful calculation-knitKeeping :: forall a f g sem. (Rank2.Foldable (g sem), sem ~ PreservingSemantics f a,-                              Monoid a, Foldable f, Functor f)-            => Rule a -> f (g sem sem) -> sem (g sem sem)-knitKeeping r x = Compose knitted-   where knitted :: a -> Compose ((,) (Atts a)) f (g sem sem)-         knitted inherited = Compose (results, x)-            where results@Atts{inh= chInh} = r Atts{inh= inherited, syn= chSyn}-                  chSyn = foldMap (Rank2.foldMap (syn . fst . getCompose . ($ chInh) . getCompose)) x+   traverse = Dimorphic.traverseDefaultWithAttributes  -- | The core type class for defining the attribute grammar. The instances of this class typically have a form like --@@ -129,25 +111,4 @@ applyDefaultWithAttributes t x = knitKeeping (attribution t x) x {-# INLINE applyDefaultWithAttributes #-} --- | Drop-in implementation of 'Full.traverse' that stores all attributes with every original node-traverseDefaultWithAttributes :: forall t p q r a g.-                                 (Transformation t, Domain t ~ p, Codomain t ~ Compose ((->) a) q,-                                 q ~ Compose ((,) (Atts a)) p, r ~ Compose ((->) a) q,-                                 Traversable p, Full.Functor t g, Deep.Traversable (Feeder a p) g,-                                 Transformation.At t (g r r))-                              => t -> p (g p p) -> a -> q (g q q)-traverseDefaultWithAttributes t x rootInheritance = Full.traverse Feeder (t Full.<$> x) rootInheritance-{-# INLINE traverseDefaultWithAttributes #-}--data Feeder a (f :: Type -> Type) = Feeder--instance Transformation (Feeder a f) where-   type Domain (Feeder a f) = Compose ((->) a) (Compose ((,) (Atts a)) f)-   type Codomain (Feeder a f) = Compose ((->) a) (Compose ((,) (Atts a)) f)--instance Transformation.At (Feeder a f) g where-   Feeder $ x = x--instance (Traversable f, Deep.Traversable (Feeder a f) g) => Full.Traversable (Feeder a f) g where-   traverse t x inheritance = Compose (atts{inh= inheritance}, traverse (Deep.traverse t) y (inh atts))-      where Compose (atts, y) = getCompose x inheritance+type Feeder a = Dimorphic.Feeder a a
src/Transformation/Deep.hs view
@@ -1,5 +1,5 @@ {-# Language DeriveDataTypeable, FlexibleInstances, KindSignatures, MultiParamTypeClasses, RankNTypes,-             StandaloneDeriving, TypeFamilies, UndecidableInstances #-}+             StandaloneDeriving, TypeFamilies, TypeOperators, UndecidableInstances #-}  -- | Type classes 'Functor', 'Foldable', and 'Traversable' that correspond to the standard type classes of the same -- name, but applying the given transformation to every descendant of the given tree node. The corresponding classes@@ -13,8 +13,9 @@ import Data.Functor.Compose (Compose) import Data.Functor.Const (Const) import qualified Data.Functor as Rank1-import qualified Rank2 import qualified Data.Functor+import Data.Kind (Type)+import qualified Rank2 import           Transformation (Transformation, Domain, Codomain) import qualified Transformation.Full as Full @@ -34,12 +35,14 @@    traverse :: Codomain t ~ Compose m f => t -> g (Domain t) (Domain t) -> m (g f f)  -- | Like 'Data.Functor.Product.Product' for data types with two type constructor parameters-data Product g h (d :: * -> *) (s :: * -> *) = Pair{fst :: s (g d d),-                                                    snd :: s (h d d)}+data Product g h (d :: Type -> Type) (s :: Type -> Type) =+   Pair{fst :: s (g d d),+        snd :: s (h d d)}  -- | Like 'Data.Functor.Sum.Sum' for data types with two type constructor parameters-data Sum g h (d :: * -> *) (s :: * -> *) = InL (s (g d d))-                                         | InR (s (h d d))+data Sum g h (d :: Type -> Type) (s :: Type -> Type) =+   InL (s (g d d))+   | InR (s (h d d))  instance Rank2.Functor (Product g h p) where    f <$> ~(Pair left right) = Pair (f left) (f right)
src/Transformation/Deep.hs-boot view
@@ -1,4 +1,4 @@-{-# Language MultiParamTypeClasses, RankNTypes, TypeFamilies #-}+{-# Language MultiParamTypeClasses, RankNTypes, TypeFamilies, TypeOperators #-}  module Transformation.Deep where 
src/Transformation/Rank2.hs view
@@ -14,7 +14,7 @@  -- | Transform (naturally) the containing functor of every node in the given tree. (<$>) :: Deep.Functor (Map p q) g => (forall a. p a -> q a) -> g p p -> g q q-(<$>) f = (Deep.<$>) (Map f)+f <$> x = Map f Deep.<$> x infixl 4 <$>  -- | Fold the containing functor of every node in the given tree.
src/Transformation/Shallow.hs view
@@ -1,5 +1,5 @@ {-# Language DeriveDataTypeable, FlexibleInstances, KindSignatures, MultiParamTypeClasses, RankNTypes,-             StandaloneDeriving, TypeFamilies, UndecidableInstances #-}+             StandaloneDeriving, TypeFamilies, TypeOperators, UndecidableInstances #-}  -- | Type classes 'Functor', 'Foldable', and 'Traversable' that correspond to the standard type classes of the same -- name. The [rank2classes](https://hackage.haskell.org/package/rank2classes) package provides the equivalent set
test/README.lhs view
@@ -154,7 +154,7 @@ Folding ------- -Suppose we we want to get a list of all variables used in an expression. To do this we would declare the appropriate+Suppose we want to get a list of all variables used in an expression. To do this we would declare the appropriate  [`Transformation`](https://hackage.haskell.org/package/deep-transformations/docs/Transformation.html) instance for an  arbitrary data type. We'll give this data type an evocative name.