1{- | 2/DEPRECATED/: Use "Data.Generics.Uniplate.Operations" instead. 3 4This is the main Uniplate module, which defines all the essential operations 5in a Haskell 98 compatible manner. 6 7Most functions have an example of a possible use for the function. 8To illustate, I have used the @Expr@ type as below: 9 10> data Expr = Val Int 11> | Neg Expr 12> | Add Expr Expr 13-} 14 15 16module Data.Generics.UniplateStr 17 {- DEPRECATED "Use Data.Generics.Uniplate.Operations instead" -} 18 ( 19 module Data.Generics.UniplateStr, 20 module Data.Generics.Str 21 ) where 22 23import Control.Monad hiding (mapM) 24import Data.Traversable 25import Prelude hiding (mapM) 26 27import Data.Generics.Uniplate.Internal.Utils 28import Data.Generics.Str 29 30 31-- * The Class 32 33-- | The type of replacing all the children of a node 34-- 35-- Taking a value, the function should return all the immediate children 36-- of the same type, and a function to replace them. 37type UniplateType on = on -> (Str on, Str on -> on) 38 39-- | The standard Uniplate class, all operations require this. 40class Uniplate on where 41 -- | The underlying method in the class. 42 -- 43 -- Given @uniplate x = (cs, gen)@ 44 -- 45 -- @cs@ should be a @Str on@, constructed of @Zero@, @One@ and @Two@, 46 -- containing all @x@'s direct children of the same type as @x@. @gen@ 47 -- should take a @Str on@ with exactly the same structure as @cs@, 48 -- and generate a new element with the children replaced. 49 -- 50 -- Example instance: 51 -- 52 -- > instance Uniplate Expr where 53 -- > uniplate (Val i ) = (Zero , \Zero -> Val i ) 54 -- > uniplate (Neg a ) = (One a , \(One a) -> Neg a ) 55 -- > uniplate (Add a b) = (Two (One a) (One b), \(Two (One a) (One b)) -> Add a b) 56 uniplate :: UniplateType on 57 58 59-- | Compatibility method, for direct users of the old list-based 'uniplate' function 60uniplateList :: Uniplate on => on -> ([on], [on] -> on) 61uniplateList x = (c, b . d) 62 where 63 (a,b) = uniplate x 64 (c,d) = strStructure a 65 66 67-- * The Operations 68 69-- ** Queries 70 71-- | Get all the children of a node, including itself and all children. 72-- 73-- > universe (Add (Val 1) (Neg (Val 2))) = 74-- > [Add (Val 1) (Neg (Val 2)), Val 1, Neg (Val 2), Val 2] 75-- 76-- This method is often combined with a list comprehension, for example: 77-- 78-- > vals x = [i | Val i <- universe x] 79universe :: Uniplate on => on -> [on] 80universe x = builder f 81 where 82 f cons nil = g cons nil (One x) nil 83 g cons nil Zero res = res 84 g cons nil (One x) res = x `cons` g cons nil (fst $ uniplate x) res 85 g cons nil (Two x y) res = g cons nil x (g cons nil y res) 86 87 88 89-- | Get the direct children of a node. Usually using 'universe' is more appropriate. 90-- 91-- @children = fst . 'uniplate'@ 92children :: Uniplate on => on -> [on] 93children x = builder f 94 where 95 f cons nil = g cons nil (fst $ uniplate x) nil 96 g cons nil Zero res = res 97 g cons nil (One x) res = x `cons` res 98 g cons nil (Two x y) res = g cons nil x (g cons nil y res) 99 100 101-- ** Transformations 102 103 104-- | Transform every element in the tree, in a bottom-up manner. 105-- 106-- For example, replacing negative literals with literals: 107-- 108-- > negLits = transform f 109-- > where f (Neg (Lit i)) = Lit (negate i) 110-- > f x = x 111transform :: Uniplate on => (on -> on) -> on -> on 112transform f = f . descend (transform f) 113 114 115-- | Monadic variant of 'transform' 116transformM :: (Monad m, Uniplate on) => (on -> m on) -> on -> m on 117transformM f x = f =<< descendM (transformM f) x 118 119 120-- | Rewrite by applying a rule everywhere you can. Ensures that the rule cannot 121-- be applied anywhere in the result: 122-- 123-- > propRewrite r x = all (isNothing . r) (universe (rewrite r x)) 124-- 125-- Usually 'transform' is more appropriate, but 'rewrite' can give better 126-- compositionality. Given two single transformations @f@ and @g@, you can 127-- construct @f `mplus` g@ which performs both rewrites until a fixed point. 128rewrite :: Uniplate on => (on -> Maybe on) -> on -> on 129rewrite f = transform g 130 where g x = maybe x (rewrite f) (f x) 131 132 133-- | Monadic variant of 'rewrite' 134rewriteM :: (Monad m, Uniplate on) => (on -> m (Maybe on)) -> on -> m on 135rewriteM f = transformM g 136 where g x = f x >>= maybe (return x) (rewriteM f) 137 138 139-- | Perform a transformation on all the immediate children, then combine them back. 140-- This operation allows additional information to be passed downwards, and can be 141-- used to provide a top-down transformation. 142descend :: Uniplate on => (on -> on) -> on -> on 143descend f x = generate $ fmap f current 144 where (current, generate) = uniplate x 145 146 147-- | Monadic variant of 'descend' 148descendM :: (Monad m, Uniplate on) => (on -> m on) -> on -> m on 149descendM f x = liftM generate $ mapM f current 150 where (current, generate) = uniplate x 151 152-- ** Others 153 154-- | Return all the contexts and holes. 155-- 156-- > propUniverse x = universe x == map fst (contexts x) 157-- > propId x = all (== x) [b a | (a,b) <- contexts x] 158contexts :: Uniplate on => on -> [(on, on -> on)] 159contexts x = (x,id) : f (holes x) 160 where 161 f xs = [ (y, ctx . context) 162 | (child, ctx) <- xs 163 , (y, context) <- contexts child] 164 165 166-- | The one depth version of 'contexts' 167-- 168-- > propChildren x = children x == map fst (holes x) 169-- > propId x = all (== x) [b a | (a,b) <- holes x] 170holes :: Uniplate on => on -> [(on, on -> on)] 171holes x = uncurry f (uniplate x) 172 where f Zero _ = [] 173 f (One i) generate = [(i, generate . One)] 174 f (Two l r) gen = f l (gen . (\i -> Two i r)) 175 ++ f r (gen . (\i -> Two l i)) 176 177-- | Perform a fold-like computation on each value, 178-- technically a paramorphism 179para :: Uniplate on => (on -> [r] -> r) -> on -> r 180para op x = op x $ map (para op) $ children x 181