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