diff --git a/Data/Generics/Biplate.hs b/Data/Generics/Biplate.hs --- a/Data/Generics/Biplate.hs +++ b/Data/Generics/Biplate.hs @@ -2,6 +2,8 @@ {-# LANGUAGE MultiParamTypeClasses #-} {- | + /RECOMMENDATION/: Use "Data.Generics.Uniplate.Operations" instead. + Requires multi-parameter type classes, so is no longer Haskell 98. These operations are easier to use and construct than the equivalent "Data.Generics.UniplateStrOn" methods, but perform the same operation. diff --git a/Data/Generics/Compos.hs b/Data/Generics/Compos.hs --- a/Data/Generics/Compos.hs +++ b/Data/Generics/Compos.hs @@ -2,10 +2,10 @@ Compos compatibility layer. This module serves as a drop-in replacement in some situations for some of the Compos operations. Only the single-type traversals are supported, on normal - algebraic data types. Must be used in conjunction with - "Data.Generics.UniplateStr". + algebraic data types. Users should also import either "Data.Generics.Uniplate.Data" + or "Data.Generics.Uniplate.Direct". - From the paper: \"A Pattern for Almost Compositional Functions\" + Compos is described in the paper: \"A Pattern for Almost Compositional Functions\" by Bjorn Bringert and Aarne Ranta. * @@ -17,7 +17,7 @@ import Control.Monad import Data.Monoid -import Data.Generics.UniplateStr +import Data.Generics.Uniplate.Operations -- | If you want to keep an existing type class diff --git a/Data/Generics/PlateData.hs b/Data/Generics/PlateData.hs --- a/Data/Generics/PlateData.hs +++ b/Data/Generics/PlateData.hs @@ -1,13 +1,11 @@ -{-# OPTIONS_GHC -fglasgow-exts -cpp -fallow-undecidable-instances #-} -{-# LANGUAGE MultiParamTypeClasses, UndecidableInstances, ExistentialQuantification, Rank2Types, CPP #-} --- OPTIONS_GHC is required only for 6.4.2, not 6.6.1 +{-# LANGUAGE ScopedTypeVariables, FlexibleInstances, MultiParamTypeClasses, UndecidableInstances, ExistentialQuantification, Rank2Types, CPP #-} {- | + /RECOMMENDATION/: Use "Data.Generics.Uniplate.Data" instead. + This module exports 'Biplate' instances for everything with 'Data' defined. Using GHC the 'Data' instances can be constructed with @deriving Data@. -} - - module Data.Generics.PlateData( module Data.Generics.Biplate ) where diff --git a/Data/Generics/PlateDirect.hs b/Data/Generics/PlateDirect.hs --- a/Data/Generics/PlateDirect.hs +++ b/Data/Generics/PlateDirect.hs @@ -1,6 +1,8 @@ {-# LANGUAGE MultiParamTypeClasses #-} {- | + /RECOMMENDATION/: Use "Data.Generics.Uniplate.Direct" instead. + This module supplies a method for writing 'Biplate' instances more easily. This module requires fewest extensions, highest performance, and most instance definitions. diff --git a/Data/Generics/PlateTypeable.hs b/Data/Generics/PlateTypeable.hs --- a/Data/Generics/PlateTypeable.hs +++ b/Data/Generics/PlateTypeable.hs @@ -1,6 +1,8 @@ {-# LANGUAGE MultiParamTypeClasses, FlexibleInstances, UndecidableInstances #-} {- | + /RECOMMENDATION/: Use "Data.Generics.Uniplate.Typeable" instead. + This module supplies a method for writing 'Biplate' instances more easily. To take an example: diff --git a/Data/Generics/SYB.hs b/Data/Generics/SYB.hs --- a/Data/Generics/SYB.hs +++ b/Data/Generics/SYB.hs @@ -1,9 +1,9 @@ {-| SYB compatibility layer. This module serves as a drop-in replacement in some situations for some of the SYB operations. - Must be used in conjunction with "Data.Generics.Biplate". + Users should also import "Data.Generics.Uniplate.Data". - From the paper: \"Scrap your boilerplate: a practical design + SYB is described in the paper: \"Scrap your boilerplate: a practical design pattern for generic programming\" by Ralf Lammel and Simon Peyton Jones. @@ -16,7 +16,7 @@ module Data.Generics.SYB where -import Data.Generics.Biplate +import Data.Generics.Uniplate.Operations -- | @gmapT == 'descend'@ gmapT :: Uniplate a => (a -> a) -> a -> a diff --git a/Data/Generics/Str.hs b/Data/Generics/Str.hs --- a/Data/Generics/Str.hs +++ b/Data/Generics/Str.hs @@ -1,7 +1,7 @@ {- | This module provides the 'Str' data type, which is used by the underlying 'uniplate' and 'biplate' methods. It should not - be used directly under ordinary circumstances. + be used directly under normal circumstances. -} module Data.Generics.Str where diff --git a/Data/Generics/Uniplate.hs b/Data/Generics/Uniplate.hs --- a/Data/Generics/Uniplate.hs +++ b/Data/Generics/Uniplate.hs @@ -49,7 +49,7 @@ -- -- This method is often combined with a list comprehension, for example: -- --- > vals x = [Val i | i <- universe x] +-- > vals x = [i | Val i <- universe x] universe :: Uniplate on => on -> [on] universe x = builder (f x) where diff --git a/Data/Generics/Uniplate/Data.hs b/Data/Generics/Uniplate/Data.hs new file mode 100644 --- /dev/null +++ b/Data/Generics/Uniplate/Data.hs @@ -0,0 +1,24 @@ +{-# LANGUAGE ScopedTypeVariables, ExistentialQuantification, Rank2Types, CPP, + MultiParamTypeClasses, FlexibleInstances, UndecidableInstances #-} + +{- | + This module defines 'Uniplate' / 'Biplate' instances for every type with a + 'Data' instance. Using GHC, Data can be derived automatically with: + + > data Expr = Var Int | Neg Expr | Add Expr Expr + > deriving (Data,Typeable) + + All the Uniplate operations defined in "Data.Generics.Uniplate.Operations" + can be used. + + For faster performance (5x faster, but requires writing instances) switch to + "Data.Generics.Uniplate.Direct". If you get instance conflicts + when using both @Data@ and @Direct@, switch to "Data.Generics.Uniplate.DataOnly". +-} +module Data.Generics.Uniplate.Data( + module Data.Generics.Uniplate.Operations + ) where + +import Data.Generics.Uniplate.Operations + +#include "Internal/DataInc.hs" diff --git a/Data/Generics/Uniplate/DataOnly.hs b/Data/Generics/Uniplate/DataOnly.hs new file mode 100644 --- /dev/null +++ b/Data/Generics/Uniplate/DataOnly.hs @@ -0,0 +1,18 @@ +{-# LANGUAGE ScopedTypeVariables, ExistentialQuantification, Rank2Types, CPP, + MultiParamTypeClasses, FlexibleInstances, UndecidableInstances #-} + +{- | + This module functions identically to "Data.Generics.Uniplate.Data", but instead of + using the standard 'Uniplate' / 'Biplate' classes defined in + "Data.Generics.Uniplate.Operations" it uses a local copy. + + Only use this module if you are using both @Data@ and @Direct@ instances in + the same project and they are conflicting. +-} +module Data.Generics.Uniplate.DataOnly( + module Data.Generics.Uniplate.Internal.DataOnlyOperations + ) where + +import Data.Generics.Uniplate.Internal.DataOnlyOperations + +#include "Internal/DataInc.hs" diff --git a/Data/Generics/Uniplate/Direct.hs b/Data/Generics/Uniplate/Direct.hs new file mode 100644 --- /dev/null +++ b/Data/Generics/Uniplate/Direct.hs @@ -0,0 +1,139 @@ +{-# LANGUAGE MultiParamTypeClasses, FlexibleInstances #-} + +{- | + This module supplies a method for writing 'Uniplate' and 'Biplate' instances. + This moulde gives the highest performance, but requires many instance definitions. The + instances can be generated using Derive: . + + To take an example: + + > data Expr = Var Int | Pos Expr String | Neg Expr | Add Expr Expr + > data Stmt = Seq [Stmt] | Sel [Expr] | Let String Expr + > + > instance Uniplate Expr where + > uniplate (Var x ) = plate Var |- x + > uniplate (Pos x y) = plate Pos |* x |- y + > uniplate (Neg x ) = plate Neg |* x + > uniplate (Add x y) = plate Add |* x |* y + > + > instance Biplate Expr Expr where + > biplate = plateSelf + > + > instance Uniplate Stmt where + > uniplate (Seq x ) = plate Seq ||* x + > uniplate (Sel x ) = plate Sel ||+ x + > uniplate (Let x y) = plate Let |- x |- y + > + > instance Biplate Stmt Stmt where + > biplate = plateSelf + > + > instance Biplate Stmt Expr where + > biplate (Seq x ) = plate Seq ||+ x + > biplate (Sel x ) = plate Sel ||* x + > biplate (Let x y) = plate Let |- x |* y +-} + + +module Data.Generics.Uniplate.Direct( + module Data.Generics.Uniplate.Operations, + -- * The Combinators + plate, plateSelf, + (|+), (|-), (|*), (||+), (||*), + plateProject + ) where + +import Control.Arrow +import Data.Generics.Uniplate.Operations +import Data.Generics.Str +import Data.Ratio + + +type Type from to = (Str to, Str to -> from) + +-- | The main combinator used to start the chain. +-- +-- The following rule can be used for optimisation: +-- +-- > plate Ctor |- x == plate (Ctor x) +{-# INLINE plate #-} +plate :: from -> Type from to +plate f = (Zero, \_ -> f) + + +-- | The field to the right is the target. +{-# INLINE (|*) #-} +(|*) :: Type (to -> from) to -> to -> Type from to +(|*) (xs,x_) y = (Two xs (One y),\(Two xs (One y)) -> x_ xs y) + + + +-- | The field to the right may contain the target. +{-# INLINE (|+) #-} +(|+) :: Biplate item to => Type (item -> from) to -> item -> Type from to +(|+) (xs,x_) y = case biplate y of + (ys,y_) -> (Two xs ys, \(Two xs ys) -> x_ xs (y_ ys)) + + +-- | The field to the right /does not/ contain the target. +{-# INLINE (|-) #-} +(|-) :: Type (item -> from) to -> item -> Type from to +(|-) (xs,x_) y = (xs,\xs -> x_ xs y) + + +-- | The field to the right is a list of the type of the target +{-# INLINE (||*) #-} +(||*) :: Type ([to] -> from) to -> [to] -> Type from to +(||*) (xs,x_) y = (Two xs (listStr y), \(Two xs ys) -> x_ xs (strList ys)) + + +-- | The field to the right is a list of types which may contain the target +(||+) :: Biplate item to => Type ([item] -> from) to -> [item] -> Type from to +(||+) (xs,x_) [] = (xs, \xs -> x_ xs []) -- can eliminate a Two _ Zero in the base case +(||+) (xs,x_) (y:ys) = case plate (:) |+ y ||+ ys of + (ys,y_) -> (Two xs ys, \(Two xs ys) -> x_ xs (y_ ys)) + + +-- | Used for 'Biplate' definitions where both types are the same. +plateSelf :: to -> Type to to +plateSelf x = (One x, \(One x) -> x) + + +-- | Write an instance in terms of a projection/injection pair. Usually used to define instances +-- for abstract containers such as Map: +-- +-- > instance Biplate (Map.Map [Char] Int) Int where +-- > biplate = plateProject Map.toAscList Map.fromDistinctAscList +-- +-- Because we know that Uniplate operations will not change the keys, +-- we can use the 'fromDistictAscList' function to reconstruct it. +plateProject :: Biplate item to => (from -> item) -> (item -> from) -> from -> Type from to +plateProject into outof = second (outof . ) . biplate . into + + +instance Uniplate Int where uniplate x = plate x +instance Uniplate Bool where uniplate x = plate x +instance Uniplate Char where uniplate x = plate x +instance Uniplate Integer where uniplate x = plate x +instance Uniplate Double where uniplate x = plate x +instance Uniplate Float where uniplate x = plate x +instance Uniplate () where uniplate x = plate x + +instance Uniplate [Char] where + uniplate (x:xs) = plate (x:) |* xs + uniplate x = plate x + +instance Biplate [Char] Char where + biplate (x:xs) = plate (:) |* x ||* xs + biplate x = plate x + +instance Biplate [Char] [Char] where + biplate = plateSelf + +instance Uniplate (Ratio Integer) where + uniplate = plate + +instance Biplate (Ratio Integer) (Ratio Integer) where + biplate = plateSelf + +instance Biplate (Ratio Integer) Integer where + biplate x = (Two (One (numerator x)) (One (denominator x)), \(Two (One n) (One d)) -> n % d) diff --git a/Data/Generics/Uniplate/Internal/Data.hs b/Data/Generics/Uniplate/Internal/Data.hs new file mode 100644 --- /dev/null +++ b/Data/Generics/Uniplate/Internal/Data.hs @@ -0,0 +1,178 @@ +{-# LANGUAGE CPP, Rank2Types, MagicHash, UnboxedTuples, ExistentialQuantification, ScopedTypeVariables #-} + +{- | + Internal module, do not import or use. +-} + +module Data.Generics.Uniplate.Internal.Data where + +import Data.Generics.Str +import Data.Generics.Uniplate.Internal.Utils +import Data.Data +import Data.Maybe +import Data.List +import qualified Data.IntSet as IntSet +import Data.IntSet(IntSet) +import qualified Data.IntMap as IntMap +import Data.IntMap(IntMap) +import Data.IORef +import Control.Exception + + +--------------------------------------------------------------------- +-- HIT TEST + + +data Answer a = Hit {fromHit :: a} -- you just hit the element you were after (here is a cast) + | Follow -- go forward, you will find something + | Miss -- you failed to sink my battleship! + +data Oracle to = Oracle {fromOracle :: forall on . Typeable on => on -> Answer to} + +{-# INLINE hitTest #-} +hitTest :: (Data from, Data to) => from -> to -> Oracle to + + +#if __GLASGOW_HASKELL__ < 606 +-- GHC 6.4.2 does not export typeRepKey, so we can't do the trick +-- as efficiently, so we just give up and revert to always following + +hitTest _ _ = Oracle . maybe Follow Hit . cast + + +#else + + +hitTest from to = + let kto = typeKey to + in case hitTestQuery (dataBox from) kto of + Nothing -> Oracle $ \on -> if typeKey on == kto then Hit $ unsafeCoerce on else Follow + Just cache -> let test = cacheHitTest cache in + Oracle $ \on -> let kon = typeKey on in + if kon == kto then Hit $ unsafeCoerce on + else if test kon then Follow + else Miss + + +-- A cache hit test, but partially evaluated +{-# INLINE cacheHitTest #-} +cacheHitTest :: Cache -> TypeKey -> Bool +cacheHitTest (Cache hit miss) + | IntSet.null hit = const False + | IntSet.null miss = const True + | otherwise = \x -> x `IntSet.member` hit + + +-- hit means that this value may result in a hit +-- miss means that this value will never result in a hit +data Cache = Cache {hit :: IntSet, miss :: IntSet} deriving Show +newCache = Cache IntSet.empty IntSet.empty + + +-- Indexed by the @from@ type, then the @to@ type +-- Nothing means that we can't perform the trick on the set +{-# NOINLINE hitTestCache #-} +hitTestCache :: IORef (IntMap (IntMap (Maybe Cache))) +hitTestCache = unsafePerformIO $ newIORef IntMap.empty + + +hitTestQuery :: DataBox -> TypeKey -> Maybe Cache +hitTestQuery from@(DataBox kfrom _) kto = inlinePerformIO $ do + mp <- readIORef hitTestCache + let res = IntMap.lookup kfrom mp >>= IntMap.lookup kto + case res of + Just ans -> return ans + Nothing -> do + let res = toCache $ hitTestAdd from kto IntMap.empty + res2 <- Control.Exception.catch (return $! res) (\(_ :: SomeException) -> return Nothing) + let mp2 = IntMap.adjust (IntMap.insert kto res2) kfrom mp + writeIORef hitTestCache mp2 + return res2 + + +-- need to classify each item as one of the following +data Res = RHit | RMiss | RFollow | RBad deriving (Show,Eq) + + +toCache :: IntMap Res -> Maybe Cache +toCache res | not $ IntSet.null $ f RBad = Nothing + | otherwise = Just $ Cache (f RFollow) (f RMiss) + where f x = IntMap.keysSet $ IntMap.filter (== x) res + +hitTestAdd :: DataBox -> TypeKey -> IntMap Res -> IntMap Res +hitTestAdd (DataBox kfrom from) kto res = case sybChildren from of + _ | kfrom `IntMap.member` res -> res + Nothing -> IntMap.insert kfrom RBad res + + -- make an inductive hypothesis that this value is a miss + -- if it turns out you were wrong, start again + -- uses backtracking, so could be expensive + Just xs | kto == kfrom -> hitTestAdds xs kto $ IntMap.insert kfrom RHit res + | correct -> res2 + | otherwise -> hitTestAdds xs kto $ IntMap.insert kfrom RFollow res + where res2 = hitTestAdds xs kto $ IntMap.insert kfrom RMiss res + correct = all ((==) RMiss . (res2 IntMap.!) . dataBoxKey) xs + +hitTestAdds :: [DataBox] -> TypeKey -> IntMap Res -> IntMap Res +hitTestAdds [] kto res = res +hitTestAdds (x:xs) kto res = hitTestAdds xs kto $ hitTestAdd x kto res + + +type TypeKey = Int + +typeKey :: Typeable a => a -> Int +typeKey x = inlinePerformIO $ typeRepKey $ typeOf x + + +-- | An existential box representing a type which supports SYB +-- operations. +data DataBox = forall a . (Data a) => DataBox {dataBoxKey :: TypeKey, dataBoxVal :: a} + +dataBox :: Data a => a -> DataBox +dataBox x = DataBox (typeKey x) x + +-- return all the possible children of a node +-- if you can't do so, just return Nothing +sybChildren :: Data a => a -> Maybe [DataBox] +sybChildren x | isAlgType dtyp = Just $ concatMap f ctrs + | isNorepType dtyp = Nothing + | otherwise = Just [] + where + f ctr = gmapQ dataBox (asTypeOf (fromConstr ctr) x) + ctrs = dataTypeConstrs dtyp + dtyp = dataTypeOf x + +#endif + + +newtype C x a = C {fromC :: CC x a} + +type CC x a = (Str x, Str x -> a) + + +biplateData :: (Data on, Data with) => (forall a . Typeable a => a -> Answer with) -> on -> CC with on +biplateData oracle x = case oracle x of + Hit y -> (One y, \(One x) -> unsafeCoerce x) + Follow -> uniplateData oracle x + Miss -> (Zero, \_ -> x) + + +uniplateData :: forall on with . (Data on, Data with) => (forall a . Typeable a => a -> Answer with) -> on -> CC with on +uniplateData oracle item = fromC $ gfoldl combine create item + where + combine :: Data a => C with (a -> b) -> a -> C with b + combine (C (c,g)) x = case biplateData oracle x of + (c2, g2) -> C (Two c c2, \(Two c' c2') -> g c' (g2 c2')) + + create :: g -> C with g + create x = C (Zero, \_ -> x) + + +descendData :: Data on => (forall a . Typeable a => a -> Answer on) -> (on -> on) -> on -> on +descendData oracle op = gmapT (descendBiData oracle op) + +descendBiData :: (Data on, Data with) => (forall a . Typeable a => a -> Answer with) -> (with -> with) -> on -> on +descendBiData oracle op x = case oracle x of + Hit y -> unsafeCoerce $ op y + Follow -> gmapT (descendBiData oracle op) x + Miss -> x diff --git a/Data/Generics/Uniplate/Internal/DataInc.hs b/Data/Generics/Uniplate/Internal/DataInc.hs new file mode 100644 --- /dev/null +++ b/Data/Generics/Uniplate/Internal/DataInc.hs @@ -0,0 +1,17 @@ +import Data.Generics.Uniplate.Internal.Data +import Data.Data + +instance Data a => Uniplate a where + uniplate = uniplateData $ fromOracle answer + where answer = hitTest (undefined :: a) (undefined :: a) + + descend = descendData $ fromOracle answer + where answer = hitTest (undefined :: a) (undefined :: a) + +instance (Data a, Data b, Uniplate b) => Biplate a b where + biplate = biplateData $ fromOracle answer + where answer = hitTest (undefined :: a) (undefined :: b) + + descendBi = descendBiData $ fromOracle answer + where answer = hitTest (undefined :: a) (undefined :: b) + diff --git a/Data/Generics/Uniplate/Internal/DataOnlyOperations.hs b/Data/Generics/Uniplate/Internal/DataOnlyOperations.hs new file mode 100644 --- /dev/null +++ b/Data/Generics/Uniplate/Internal/DataOnlyOperations.hs @@ -0,0 +1,5 @@ +{-# LANGUAGE CPP, MultiParamTypeClasses #-} + +module Data.Generics.Uniplate.Internal.DataOnlyOperations where + +#include "OperationsInc.hs" diff --git a/Data/Generics/Uniplate/Internal/OperationsInc.hs b/Data/Generics/Uniplate/Internal/OperationsInc.hs new file mode 100644 --- /dev/null +++ b/Data/Generics/Uniplate/Internal/OperationsInc.hs @@ -0,0 +1,233 @@ +import Control.Monad(liftM) +import Data.List(inits,tails) +import Data.Traversable +import Prelude hiding (mapM) +import Data.Generics.Str +import Data.Generics.Uniplate.Internal.Utils + + +-- * The Classes + +-- | The standard Uniplate class, all operations require this. +class Uniplate on where + -- | The underlying method in the class. + -- Taking a value, the function should return all the immediate children + -- of the same type, and a function to replace them. + -- + -- Given @uniplate x = (cs, gen)@ + -- + -- @cs@ should be a @Str on@, constructed of @Zero@, @One@ and @Two@, + -- containing all @x@'s direct children of the same type as @x@. @gen@ + -- should take a @Str on@ with exactly the same structure as @cs@, + -- and generate a new element with the children replaced. + -- + -- Example instance: + -- + -- > instance Uniplate Expr where + -- > uniplate (Val i ) = (Zero , \Zero -> Val i ) + -- > uniplate (Neg a ) = (One a , \(One a) -> Neg a ) + -- > uniplate (Add a b) = (Two (One a) (One b), \(Two (One a) (One b)) -> Add a b) + uniplate :: on -> (Str on, Str on -> on) + + -- | Perform a transformation on all the immediate children, then combine them back. + -- This operation allows additional information to be passed downwards, and can be + -- used to provide a top-down transformation. + descend :: (on -> on) -> on -> on + descend f x = generate $ fmap f current + where (current, generate) = uniplate x + + -- | Monadic variant of 'descend' + descendM :: Monad m => (on -> m on) -> on -> m on + descendM f x = liftM generate $ mapM f current + where (current, generate) = uniplate x + + +-- | Children are defined as the top-most items of type to +-- /starting at the root/. +class Uniplate to => Biplate from to where + -- | Return all the top most children of type @to@ within @from@. + -- + -- If @from == to@ then this function should return the root as the single + -- child. + biplate :: from -> (Str to, Str to -> from) + + + descendBi :: (to -> to) -> from -> from + descendBi f x = generate $ fmap f current + where (current, generate) = biplate x + + + descendBiM :: Monad m => (to -> m to) -> from -> m from + descendBiM f x = liftM generate $ mapM f current + where (current, generate) = biplate x + + +-- * Single Type Operations + +-- ** Queries + +-- | Get all the children of a node, including itself and all children. +-- +-- > universe (Add (Val 1) (Neg (Val 2))) = +-- > [Add (Val 1) (Neg (Val 2)), Val 1, Neg (Val 2), Val 2] +-- +-- This method is often combined with a list comprehension, for example: +-- +-- > vals x = [i | Val i <- universe x] +{-# INLINE universe #-} +universe :: Uniplate on => on -> [on] +universe x = builder f + where + f cons nil = g cons nil (One x) nil + g cons nil Zero res = res + g cons nil (One x) res = x `cons` g cons nil (fst $ uniplate x) res + g cons nil (Two x y) res = g cons nil x (g cons nil y res) + + + +-- | Get the direct children of a node. Usually using 'universe' is more appropriate. +children :: Uniplate on => on -> [on] +children x = builder f + where + f cons nil = g cons nil (fst $ uniplate x) nil + g cons nil Zero res = res + g cons nil (One x) res = x `cons` res + g cons nil (Two x y) res = g cons nil x (g cons nil y res) + + +-- ** Transformations + + +-- | Transform every element in the tree, in a bottom-up manner. +-- +-- For example, replacing negative literals with literals: +-- +-- > negLits = transform f +-- > where f (Neg (Lit i)) = Lit (negate i) +-- > f x = x +transform :: Uniplate on => (on -> on) -> on -> on +transform f = g + where g = f . descend g + + +-- | Monadic variant of 'transform' +transformM :: (Monad m, Uniplate on) => (on -> m on) -> on -> m on +transformM f = g + where g x = f =<< descendM g x + +-- | Rewrite by applying a rule everywhere you can. Ensures that the rule cannot +-- be applied anywhere in the result: +-- +-- > propRewrite r x = all (isNothing . r) (universe (rewrite r x)) +-- +-- Usually 'transform' is more appropriate, but 'rewrite' can give better +-- compositionality. Given two single transformations @f@ and @g@, you can +-- construct @f `mplus` g@ which performs both rewrites until a fixed point. +rewrite :: Uniplate on => (on -> Maybe on) -> on -> on +rewrite f = transform g + where g x = maybe x (rewrite f) (f x) + + +-- | Monadic variant of 'rewrite' +rewriteM :: (Monad m, Uniplate on) => (on -> m (Maybe on)) -> on -> m on +rewriteM f = transformM g + where g x = f x >>= maybe (return x) (rewriteM f) + + +-- ** Others + +-- | Return all the contexts and holes. +-- +-- > propUniverse x = universe x == map fst (contexts x) +-- > propId x = all (== x) [b a | (a,b) <- contexts x] +contexts :: Uniplate on => on -> [(on, on -> on)] +contexts x = (x,id) : f (holes x) + where + f xs = [ (y, ctx . context) + | (child, ctx) <- xs + , (y, context) <- contexts child] + + +-- | The one depth version of 'contexts' +-- +-- > propChildren x = children x == map fst (holes x) +-- > propId x = all (== x) [b a | (a,b) <- holes x] +holes :: Uniplate on => on -> [(on, on -> on)] +holes x = uncurry f (uniplate x) + where f Zero _ = [] + f (One i) generate = [(i, generate . One)] + f (Two l r) gen = f l (gen . (\i -> Two i r)) + ++ f r (gen . (\i -> Two l i)) + +-- | Perform a fold-like computation on each value, +-- technically a paramorphism +para :: Uniplate on => (on -> [r] -> r) -> on -> r +para op x = op x $ map (para op) $ children x + + + +-- * Multiple Type Operations + +-- ** Queries + +{-# INLINE universeBi #-} +universeBi :: Biplate from to => from -> [to] +universeBi x = builder f + where + f cons nil = g cons nil (fst $ biplate x) nil + g cons nil Zero res = res + g cons nil (One x) res = x `cons` g cons nil (fst $ uniplate x) res + g cons nil (Two x y) res = g cons nil x (g cons nil y res) + + +-- | Return the children of a type. If @to == from@ then it returns the +-- original element (in contrast to 'children') +childrenBi :: Biplate from to => from -> [to] +childrenBi x = builder f + where + f cons nil = g cons nil (fst $ biplate x) nil + g cons nil Zero res = res + g cons nil (One x) res = x `cons` res + g cons nil (Two x y) res = g cons nil x (g cons nil y res) + + +-- ** Transformations + +{-# INLINE transformBi #-} +transformBi :: Biplate from to => (to -> to) -> from -> from +transformBi f x = generate $ fmap (transform f) current + where (current, generate) = biplate x + + +{-# INLINE transformBiM #-} +transformBiM :: (Monad m, Biplate from to) => (to -> m to) -> from -> m from +transformBiM f x = liftM generate $ mapM (transformM f) current + where (current, generate) = biplate x + + +rewriteBi :: Biplate from to => (to -> Maybe to) -> from -> from +rewriteBi f x = generate $ fmap (rewrite f) current + where (current, generate) = biplate x + + +rewriteBiM :: (Monad m, Biplate from to) => (to -> m (Maybe to)) -> from -> m from +rewriteBiM f x = liftM generate $ mapM (rewriteM f) current + where (current, generate) = biplate x + + +-- ** Others + +contextsBi:: Biplate from to => from -> [(to, to -> from)] +contextsBi = f . holesBi + where + f xs = [ (y, ctx . context) + | (child, ctx) <- xs + , (y, context) <- contexts child] + + +holesBi:: Biplate from to => from -> [(to, to -> from)] +holesBi = uncurry f . biplate + where f Zero _ = [] + f (One i) generate = [(i, generate . One)] + f (Two l r) gen = f l (gen . (\i -> Two i r)) + ++ f r (gen . (\i -> Two l i)) diff --git a/Data/Generics/Uniplate/Internal/Utils.hs b/Data/Generics/Uniplate/Internal/Utils.hs new file mode 100644 --- /dev/null +++ b/Data/Generics/Uniplate/Internal/Utils.hs @@ -0,0 +1,44 @@ +{-# LANGUAGE CPP, Rank2Types, MagicHash, UnboxedTuples, ExistentialQuantification #-} + +{- | + Internal module, do not import or use. +-} + +module Data.Generics.Uniplate.Internal.Utils( + unsafeCoerce, builder, unsafePerformIO, inlinePerformIO, concatCont + ) where + +import Foreign(unsafePerformIO) +import Unsafe.Coerce(unsafeCoerce) + +#ifdef __GLASGOW_HASKELL__ +import GHC.Exts(build, realWorld#) +import GHC.IOBase(IO(IO)) +#endif + + +{-# INLINE builder #-} +-- | GHCs @foldr@\/@build@ system, but on all platforms +#ifdef __GLASGOW_HASKELL__ +builder :: forall a . (forall b . (a -> b -> b) -> b -> b) -> [a] +builder = build +#else +builder :: ((x -> [x] -> [x]) -> [x] -> [x]) -> [x] +builder f = f (:) [] +#endif + + +{-# INLINE inlinePerformIO #-} +-- | 'unsafePerformIO', but suitable for inlining. Copied from "Data.ByteString.Base". +inlinePerformIO :: IO a -> a +#ifdef __GLASGOW_HASKELL__ +inlinePerformIO (IO m) = case m realWorld# of (# _, r #) -> r +#else +inlinePerformIO = unsafePerformIO +#endif + + +{-# INLINE concatCont #-} +-- | Perform concatentation of continuations +concatCont :: [a -> a] -> a -> a +concatCont xs rest = foldr ($) rest xs diff --git a/Data/Generics/Uniplate/Operations.hs b/Data/Generics/Uniplate/Operations.hs new file mode 100644 --- /dev/null +++ b/Data/Generics/Uniplate/Operations.hs @@ -0,0 +1,19 @@ +{-# LANGUAGE CPP, MultiParamTypeClasses #-} +{- | +Definitions of 'Uniplate' and 'Biplate' classes, along with all the standard operations. + +Import this module directly only if you are defining new Uniplate operations, otherwise +import one of "Data.Generics.Uniplate.Direct", "Data.Generics.Uniplate.Typeable" or +"Data.Generics.Uniplate.Data". + +Most functions have an example of a possible use for the function. +To illustate, I have used the @Expr@ type as below: + +> data Expr = Val Int +> | Neg Expr +> | Add Expr Expr +-} + +module Data.Generics.Uniplate.Operations where + +#include "Internal/OperationsInc.hs" diff --git a/Data/Generics/Uniplate/Typeable.hs b/Data/Generics/Uniplate/Typeable.hs new file mode 100644 --- /dev/null +++ b/Data/Generics/Uniplate/Typeable.hs @@ -0,0 +1,148 @@ +{-# LANGUAGE MultiParamTypeClasses, FlexibleInstances, UndecidableInstances #-} + +{- | + /RECOMMENDATION:/ Use "Data.Generics.Uniplate.Data" instead - it usually performs + faster (sometimes significantly so) and requires no special instance declarations. + + This module supplies a method for writing 'Uniplate' / 'Biplate' instances. One + instance declaration is required for each data type you wish to work with. The + instances can be generated using Derive: . + + To take an example: + + > data Expr = Var Int | Neg Expr | Add Expr Expr + > deriving Typeable + > + > instance (Typeable a, Uniplate a) => PlateAll Expr a where + > plateAll (Var x ) = plate Var |+ x + > plateAll (Neg x ) = plate Neg |+ x + > plateAll (Add x y) = plate Add |+ x |+ y +-} + +module Data.Generics.Uniplate.Typeable( + module Data.Generics.Uniplate.Operations, + module Data.Typeable, + -- * The Class + PlateAll(..), + -- * The Combinators + plate, (|+), (|-), plateProject + ) where + +import Control.Arrow +import Data.Generics.Uniplate.Operations +import Data.Generics.Uniplate.Internal.Utils +import Data.Generics.Str +import Data.Typeable +import Data.Ratio + + +instance (Typeable a, Typeable b, Uniplate b, PlateAll a b) => Biplate a b where + biplate = plateMore + +instance PlateAll a a => Uniplate a where + uniplate = plateAll + + +type Type from to = (Str to, Str to -> from) + + +plateMore :: (Typeable from, Typeable to, PlateAll from to) => from -> Type from to +plateMore x = res + where + res = case asTypeOf (cast x) (Just $ strType $ fst res) of + Nothing -> plateAll x + Just y -> (One y, \(One y) -> unsafeCoerce y) + + +-- | This class should be defined for each data type of interest. +class PlateAll from to where + -- | This method should be defined using 'plate' and '|+', '|-'. + plateAll :: from -> Type from to + + +-- | The main combinator used to start the chain. +plate :: from -> Type from to +plate x = (Zero, \_ -> x) + + +-- | The field to the right may contain the target. +(|+) :: (Typeable item, Typeable to, PlateAll item to) => Type (item -> from) to -> item -> Type from to +(|+) (xs,x_) y = case plateMore y of + (ys,y_) -> (Two xs ys,\(Two xs ys) -> x_ xs (y_ ys)) + +-- | The field to the right /does not/ contain the target. +-- This can be used as either an optimisation, or more commonly for excluding +-- primitives such as Int. +(|-) :: Type (item -> from) to -> item -> Type from to +(|-) (xs,x_) y = (xs,\xs -> x_ xs y) + + +-- | Write an instance in terms of a projection/injection pair. Usually used to define instances +-- for abstract containers such as Map: +-- +-- > instance (Ord a, Typeable a, PlateAll a c, Typeable b, PlateAll b c, +-- > Typeable c, PlateAll c c) => PlateAll (Map.Map a b) c where +-- > plateAll = plateProject Map.toList Map.fromList +plateProject :: (Typeable item, Typeable to, PlateAll item to) => (from -> item) -> (item -> from) -> from -> Type from to +plateProject into outof = second (outof . ) . plateAll . into + + +-- * Instances + +-- ** Primitive Types + +instance PlateAll Int to where plateAll x = plate x +instance PlateAll Bool to where plateAll x = plate x +instance PlateAll Char to where plateAll x = plate x +instance PlateAll Integer to where plateAll x = plate x +instance PlateAll Double to where plateAll x = plate x +instance PlateAll Float to where plateAll x = plate x +instance PlateAll () to where plateAll x = plate x + +-- ** Container Types + +instance (PlateAll from to, Typeable from, Typeable to, Uniplate to) => PlateAll [from] to where + plateAll [] = plate [] + plateAll (x:xs) = plate (:) |+ x |+ xs + +instance (PlateAll from to, Typeable from, Typeable to, Uniplate to) => PlateAll (Maybe from) to where + plateAll Nothing = plate Nothing + plateAll (Just x) = plate Just |+ x + +instance (PlateAll a to, Typeable a, PlateAll b to, Typeable b, Typeable to, Uniplate to) => + PlateAll (Either a b) to where + plateAll (Left x) = plate Left |+ x + plateAll (Right x) = plate Right |+ x + +instance (PlateAll a to, Typeable a + ,PlateAll b to, Typeable b + ,Typeable to, Uniplate to) => + PlateAll (a,b) to where + plateAll (a,b) = plate (,) |+ a |+ b + +instance (PlateAll a to, Typeable a + ,PlateAll b to, Typeable b + ,PlateAll c to, Typeable c + ,Typeable to, Uniplate to) => + PlateAll (a,b,c) to where + plateAll (a,b,c) = plate (,,) |+ a |+ b |+ c + +instance (PlateAll a to, Typeable a + ,PlateAll b to, Typeable b + ,PlateAll c to, Typeable c + ,PlateAll d to, Typeable d + ,Typeable to, Uniplate to) => + PlateAll (a,b,c,d) to where + plateAll (a,b,c,d) = plate (,,,) |+ a |+ b |+ c |+ d + +instance (PlateAll a to, Typeable a + ,PlateAll b to, Typeable b + ,PlateAll c to, Typeable c + ,PlateAll d to, Typeable d + ,PlateAll e to, Typeable e + ,Typeable to, Uniplate to) => + PlateAll (a,b,c,d,e) to where + plateAll (a,b,c,d,e) = plate (,,,,) |+ a |+ b |+ c |+ d |+ e + +instance (Integral a, PlateAll a to, Typeable a, Typeable to, Uniplate to) => PlateAll (Ratio a) to where + plateAll = plateProject (\x -> (numerator x, denominator x)) (uncurry (%)) diff --git a/Data/Generics/UniplateOn.hs b/Data/Generics/UniplateOn.hs --- a/Data/Generics/UniplateOn.hs +++ b/Data/Generics/UniplateOn.hs @@ -1,6 +1,6 @@ {-# OPTIONS_GHC -fno-warn-deprecations #-} {- | -/RECOMMENDATION/ Use "Data.Generics.UniplateStrOn" instead. +/RECOMMENDATION/: Use "Data.Generics.Uniplate.Operations" instead. This module retained Haskell 98 compatability, but users who are happy with multi-parameter type classes should look towards "Data.Generics.Biplate". diff --git a/Data/Generics/UniplateStr.hs b/Data/Generics/UniplateStr.hs --- a/Data/Generics/UniplateStr.hs +++ b/Data/Generics/UniplateStr.hs @@ -1,4 +1,6 @@ {- | +/RECOMMENDATION/: Use "Data.Generics.Uniplate.Operations" instead. + This is the main Uniplate module, which defines all the essential operations in a Haskell 98 compatible manner. @@ -73,7 +75,7 @@ -- -- This method is often combined with a list comprehension, for example: -- --- > vals x = [Val i | i <- universe x] +-- > vals x = [i | Val i <- universe x] universe :: Uniplate on => on -> [on] universe x = builder f where diff --git a/Data/Generics/UniplateStrOn.hs b/Data/Generics/UniplateStrOn.hs --- a/Data/Generics/UniplateStrOn.hs +++ b/Data/Generics/UniplateStrOn.hs @@ -1,4 +1,6 @@ {- | +/RECOMMENDATION/: Use "Data.Generics.Uniplate.Operations" instead. + This module retained Haskell 98 compatability, but users who are happy with multi-parameter type classes should look towards "Data.Generics.Biplate". diff --git a/uniplate.cabal b/uniplate.cabal --- a/uniplate.cabal +++ b/uniplate.cabal @@ -1,35 +1,66 @@ Cabal-Version: >= 1.2 Build-Type: Simple Name: uniplate -Version: 1.2.0.3 -Copyright: 2006-8, Neil Mitchell +Version: 1.3 +Copyright: 2006-9, Neil Mitchell Maintainer: ndmitchell@gmail.com -Homepage: http://www-users.cs.york.ac.uk/~ndm/uniplate/ +Homepage: http://community.haskell.org/~ndm/uniplate/ License: BSD3 License-File: LICENSE Author: Neil Mitchell -Synopsis: Uniform type generic traversals. +Synopsis: Help writing simple, consise and fast generic operations. +Category: Generics Description: - Uniplate is a boilerplate removal library, with similar goals to the - original Scrap Your Boilerplate work. It requires few extensions to - Haskell. -Category: Development + Uniplate is library for writing simple and concise generic operations. + Uniplate has similar goals to the original Scrap Your Boilerplate work, + but is substantially simpler and faster. + . + To get started with Uniplate you should import one of the three following + modules: + . + * "Data.Generics.Uniplate.Data" - to quickly start writing generic functions. + Most users should start by importing this module. + . + * "Data.Generics.Uniplate.Direct" - a replacement for "Data.Generics.Uniplate.Data" + with substantially higher performance (around 5 times), but requires writing + instance declarations. + . + * "Data.Generics.Uniplate.Operations" - definitions of all the operations defined + by Uniplate. Both the above two modules re-export this module. + . + In addition, some users may want to make use of the following modules: + . + * "Data.Generics.SYB" - users transitioning from the Scrap Your Boilerplate library. + . + * "Data.Generics.Compos" - users transitioning from the Compos library. + . + * "Data.Generics.Uniplate.DataOnly" - users making use of both @Data@ and @Direct@ + to avoid getting instance conflicts. + Extra-Source-Files: uniplate.htm + Data/Generics/Uniplate/Internal/DataInc.hs + Data/Generics/Uniplate/Internal/OperationsInc.hs Flag ghc_6_10 -Flag ghc_6_8 Library if flag(ghc_6_10) - build-depends: base >= 4, mtl, containers, syb + build-depends: base >=4 && <5, mtl, containers, syb else - if flag(ghc_6_8) - build-depends: base >= 3, mtl, containers - else - build-depends: base < 3, mtl + build-depends: base >=3 && <4, mtl, containers Exposed-modules: + Data.Generics.Str + Data.Generics.Compos + Data.Generics.SYB + Data.Generics.Uniplate.Operations + Data.Generics.Uniplate.Direct + Data.Generics.Uniplate.Typeable + Data.Generics.Uniplate.Data + Data.Generics.Uniplate.DataOnly + + -- DEPRECATED Data.Generics.Uniplate Data.Generics.UniplateOn Data.Generics.UniplateStr @@ -38,9 +69,11 @@ Data.Generics.PlateDirect Data.Generics.PlateTypeable Data.Generics.PlateData + + Other-modules: Data.Generics.PlateInternal - Data.Generics.Str - Data.Generics.Compos - Data.Generics.SYB + Data.Generics.Uniplate.Internal.Data + Data.Generics.Uniplate.Internal.DataOnlyOperations + Data.Generics.Uniplate.Internal.Utils - Extensions: CPP, FlexibleInstances + Extensions: CPP diff --git a/uniplate.htm b/uniplate.htm --- a/uniplate.htm +++ b/uniplate.htm @@ -52,35 +52,37 @@

Boilerplate Removal with Uniplate

- by Neil Mitchell + by Neil Mitchell

- Generic transformations and queries are often referred to as boilerplate code - they remain relatively similar as the action performed by the code changes, and can often outnumber the actual intent of the code in terms of lines. While other generic traversal schemes have shown how powerful new features can be added to compilers, and how the type system can be manipulated into accepting these operations, this document focuses on a conceptually simpler generic concept. The Uniplate class is introduced, which abstracts over common traversals and queries in a simple manner. A more complete document on the Uniplate class was published at the Haskell Workshop 2007, and is available from the project website, along with a video presentation, and the associated thesis chapter. -

-

- There have been several attempts at generic traversal/query methods in Haskell. One initial paper was "Scrap your boilerplate: a practical design pattern for generic programming" (free copy) - which I will refer to as SYB. Another mechanism is "A Pattern for Almost Compositional Functions" (free copy) - which I refer to as Compos (after the name of their class). A detailed comparison is given in the Uniplate paper. -

-

- The principle advantage of the Uniplate class over these two papers is that it requires no type system extensions, compared to rank-2 types for SYB and GADT's for Compos. The simplicity of the types required means that the user is free to concentrate on the operations within the class, without requiring thought as to the type trickery required. The Uniplate pattern has been implemented in Yhc for the Core data type, and in Catch on several data types within the program. + Generic transformations and queries are often referred to as boilerplate code - they remain relatively similar as the action performed by the code changes, and can often outnumber the actual intent of the code in terms of lines. While other generic traversal schemes have shown how powerful new features can be added to compilers, and how the type system can be manipulated into accepting these operations, the Uniplate library focuses on a conceptually simpler generic concept. A more complete document on Uniplate was published at the Haskell Workshop 2007, and is available from the project website, along with a video presentation, and the associated thesis chapter.

- This document proceeds as follows: + Uniplate is a simple, concise and fast generics library. To expand on that sentance:

    -
  1. The motivation and use cases for Uniplate
    2. -
  2. Extensions to Biplate
    3. -
  3. Uniplate and Biplate instances
    4. +
  4. A generics library is one which allows you to write functions that operate over a data structure without tying down all aspects of the data structure. In particular, when writing an operation, you don't need to give a case for each constructor, and you don't have to state which fields are recursive.
    5. +
  5. Uniplate is the simplest generics library. Using Uniplate is suitable for all Haskell programmers.
    6. +
  6. Uniplate is more concise than any other generics library.
    7. +
  7. Uniplate is fast, not always the absolute fastest, but massively faster than many generics libraries.
    8. +
  8. Uniplate is also less powerful than some other generics libraries, but if it does the job, you should use it.

- The libraries is available through Hackage or darcs: + The Uniplate library can be installed with the standard sequence of cabal commands: 

-darcs get --partial http://www.cs.york.ac.uk/fp/darcs/uniplate
+cabal update
+cabal install uniplate

- If you only wish to read a small fraction of this document, can I suggest you pay particular attention to transform and universe - these are by far the most common traversal patterns. + This document proceeds as follows:

+
    +
  1. Using Uniplate
    2. +
  2. Using Biplate
    3. +
  3. Making Uniplate Faster
    4. +

Acknowledgements

@@ -89,27 +91,6 @@

-

Motivation and Use Cases

- -

- The idea behind the Uniplate class is that there exists a data structure, usually with a reasonable number of constructors, which is often transformed or analysed. The usual example of this would be a compiler, which has at its core an expression type. This can be seen as a form of generic programming. -

-

- The Uniplate class has the following goals: -

-
    -
  • Adding a new constructor should require very few changes
    • -
  • Traversals should have a minimal amount of boiler plate
    • -
  • The obvious code should "just work"
    • -
  • Haskell 98, where possible
    • -
  • Writing new types of traverals is easy
    • -
  • The default traversals cover most cases
    • -
-

- The ideas behind the Uniplate class have been used extensively, in both the Yhc compiler and the Catch tool. In Catch there are over 100 traversals using the Uniplate class, showing that the Uniplate class gets extensive use. -

- -

Using Uniplate

@@ -117,7 +98,7 @@ 

-import Data.Generics.Uniplate
+import Data.Generics.Uniplate.Data
 
 data Expr = Val Int
           | Add Expr Expr
@@ -125,10 +106,10 @@
           | Div Expr Expr
           | Mul Expr Expr
           | Neg Expr
-          deriving (Show, Eq)
+          deriving (Show, Eq, Data, Typeable)

- Assume that a Uniplate class has already been written; so now instance Uniplate Expr is available to us. Some examples are presented, in rough order of increasingly complexity. + To start using Uniplate I recommend you import Data.Generics.Uniplate.Data and add deriving (Data, Typeable) to all types you wish to operate upon.

Checking for division by zero

@@ -160,18 +141,18 @@ 

 optimise :: Expr -> Expr
-optimise = transform $ \x -> case x of
-    Neg (Val i) -> Val (negate i)
-    x -> x
+optimise = transform f
+    where f (Neg (Val i)) = Val (negate i)
+          f x = x

Here the Uniplate method being used is transform. This applies the given function to all the children of an expression, before applying it to the parent. This can be thought of as bottom-up traversal of the data structure. The optimise code merely pattern matches on the negation of a literal, and replaces it with the literal.

- Now lets add another optimisation into the same pass, just before the x -> x line insert: + Now lets add another optimisation into the same pass, just before the f x = x line insert: 

-    Add x y | x == y -> Mul x (Val 2)
+    f (Add x y) | x == y = Mul x (Val 2)

This takes an addition where two terms are equal and changes it into a multiplication, causing the nested expression to be executed only once. This shows that normal Haskell applies, the Uniplate lets you write code as before. @@ -246,30 +227,28 @@

-

Using the operations from Biplate

+

Using Biplate

- To see various operations being used from the Biplate class, see the Uniplate paper. Typically the operations are just the same as Uniplate, with Bi on the end. + All the operations defined in Uniplate have a corresponding Biplate instance. Typically the operations are just the same as Uniplate, with Bi on the end. 

 universeBi:: Biplate on with => on -> [with]
 transformBi :: Biplate on with => (with -> with) -> on -> on
 transformBiM :: (Monad m, Biplate on with) => (with -> m with) -> on -> m on
- - -

Uniplate and Biplate instances

-

- To define Uniplate and Biplate instances it is sufficient to: + The biggest difference is for the functions childrenBi and descendBi. In these cases, if the starting type and the target type are the same, then the input value will be returned. For example:

-
    -
  • Use GHC.
    • -
  • Import the module Data.Generics.PlateData.
    • -
  • Add deriving (Data,Typeable) to all data type definitions.
    • -
+
+childrenBi (Add (Val 1) (Val 2)) == [Add (Val 1) (Val 2)]
+children (Add (Val 1) (Val 2)) == [Val 1, Val 2]
+
+ +

Making Uniplate Faster

+

- Alternative ways of implementing Uniplate and Biplate instances are presented in the associated thesis chapter. + To make Uniplate faster import Data.Generics.Uniplate.Direct, and provide Uniplate instances by generating them with the Derive tool.