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 +7/−0
- README.md +1/−1
- deep-transformations.cabal +5/−4
- src/Transformation.hs +43/−2
- src/Transformation/AG.hs +2/−1
- src/Transformation/AG/Dimorphic.hs +154/−0
- src/Transformation/AG/Generics.hs +1/−2
- src/Transformation/AG/Monomorphic.hs +19/−58
- src/Transformation/Deep.hs +9/−6
- src/Transformation/Deep.hs-boot +1/−1
- src/Transformation/Rank2.hs +1/−1
- src/Transformation/Shallow.hs +1/−1
- test/README.lhs +1/−1
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.