{- |
/DEPRECATED/: Use "Data.Generics.Uniplate.Operations" instead.

This is the main Uniplate module, which defines all the essential operations
in a Haskell 98 compatible manner.

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.UniplateStr
    {- DEPRECATED "Use Data.Generics.Uniplate.Operations instead" -}
    (
    module Data.Generics.UniplateStr,
    module Data.Generics.Str
    ) where

import Control.Monad hiding (mapM)
import Data.Traversable
import Prelude hiding (mapM)

import Data.Generics.Uniplate.Internal.Utils
import Data.Generics.Str


-- * The Class

-- | The type of replacing all the children of a node
--
--   Taking a value, the function should return all the immediate children
--   of the same type, and a function to replace them.
type UniplateType on = on -> (Str on, Str on -> on)

-- | The standard Uniplate class, all operations require this.
class Uniplate on where
    -- | The underlying method in the class.
    --
    --   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 :: UniplateType on


-- | Compatibility method, for direct users of the old list-based 'uniplate' function
uniplateList :: Uniplate on => on -> ([on], [on] -> on)
uniplateList :: on -> ([on], [on] -> on)
uniplateList on
x = ([on]
c, Str on -> on
b (Str on -> on) -> ([on] -> Str on) -> [on] -> on
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [on] -> Str on
d)
    where
        (Str on
a,Str on -> on
b) = UniplateType on
forall on. Uniplate on => UniplateType on
uniplate on
x
        ([on]
c,[on] -> Str on
d) = Str on -> ([on], [on] -> Str on)
forall a. Str a -> ([a], [a] -> Str a)
strStructure Str on
a


-- * The 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]
universe :: Uniplate on => on -> [on]
universe :: on -> [on]
universe on
x = (forall b. (on -> b -> b) -> b -> b) -> [on]
forall a. (forall b. (a -> b -> b) -> b -> b) -> [a]
builder forall b. (on -> b -> b) -> b -> b
f
    where
        f :: (on -> t -> t) -> t -> t
f on -> t -> t
cons t
nil = (on -> t -> t) -> t -> Str on -> t -> t
forall on t t.
Uniplate on =>
(on -> t -> t) -> t -> Str on -> t -> t
g on -> t -> t
cons t
nil (on -> Str on
forall a. a -> Str a
One on
x) t
nil
        g :: (on -> t -> t) -> t -> Str on -> t -> t
g on -> t -> t
cons t
nil Str on
Zero t
res = t
res
        g on -> t -> t
cons t
nil (One on
x) t
res = on
x on -> t -> t
`cons` (on -> t -> t) -> t -> Str on -> t -> t
g on -> t -> t
cons t
nil ((Str on, Str on -> on) -> Str on
forall a b. (a, b) -> a
fst ((Str on, Str on -> on) -> Str on)
-> (Str on, Str on -> on) -> Str on
forall a b. (a -> b) -> a -> b
$ UniplateType on
forall on. Uniplate on => UniplateType on
uniplate on
x) t
res
        g on -> t -> t
cons t
nil (Two Str on
x Str on
y) t
res = (on -> t -> t) -> t -> Str on -> t -> t
g on -> t -> t
cons t
nil Str on
x ((on -> t -> t) -> t -> Str on -> t -> t
g on -> t -> t
cons t
nil Str on
y t
res)



-- | Get the direct children of a node. Usually using 'universe' is more appropriate.
--
-- @children = fst . 'uniplate'@
children :: Uniplate on => on -> [on]
children :: on -> [on]
children on
x = (forall b. (on -> b -> b) -> b -> b) -> [on]
forall a. (forall b. (a -> b -> b) -> b -> b) -> [a]
builder forall b. (on -> b -> b) -> b -> b
f
    where
        f :: (on -> t -> t) -> t -> t
f on -> t -> t
cons t
nil = (on -> t -> t) -> t -> Str on -> t -> t
forall t t t. (t -> t -> t) -> t -> Str t -> t -> t
g on -> t -> t
cons t
nil ((Str on, Str on -> on) -> Str on
forall a b. (a, b) -> a
fst ((Str on, Str on -> on) -> Str on)
-> (Str on, Str on -> on) -> Str on
forall a b. (a -> b) -> a -> b
$ UniplateType on
forall on. Uniplate on => UniplateType on
uniplate on
x) t
nil
        g :: (t -> t -> t) -> t -> Str t -> t -> t
g t -> t -> t
cons t
nil Str t
Zero t
res = t
res
        g t -> t -> t
cons t
nil (One t
x) t
res = t
x t -> t -> t
`cons` t
res
        g t -> t -> t
cons t
nil (Two Str t
x Str t
y) t
res = (t -> t -> t) -> t -> Str t -> t -> t
g t -> t -> t
cons t
nil Str t
x ((t -> t -> t) -> t -> Str t -> t -> t
g t -> t -> t
cons t
nil Str t
y t
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 :: (on -> on) -> on -> on
transform on -> on
f = on -> on
f (on -> on) -> (on -> on) -> on -> on
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (on -> on) -> on -> on
forall on. Uniplate on => (on -> on) -> on -> on
descend ((on -> on) -> on -> on
forall on. Uniplate on => (on -> on) -> on -> on
transform on -> on
f)


-- | Monadic variant of 'transform'
transformM :: (Monad m, Uniplate on) => (on -> m on) -> on -> m on
transformM :: (on -> m on) -> on -> m on
transformM on -> m on
f on
x = on -> m on
f (on -> m on) -> m on -> m on
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< (on -> m on) -> on -> m on
forall (m :: * -> *) on.
(Monad m, Uniplate on) =>
(on -> m on) -> on -> m on
descendM ((on -> m on) -> on -> m on
forall (m :: * -> *) on.
(Monad m, Uniplate on) =>
(on -> m on) -> on -> m on
transformM on -> m on
f) on
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 :: (on -> Maybe on) -> on -> on
rewrite on -> Maybe on
f = (on -> on) -> on -> on
forall on. Uniplate on => (on -> on) -> on -> on
transform on -> on
g
    where g :: on -> on
g on
x = on -> (on -> on) -> Maybe on -> on
forall b a. b -> (a -> b) -> Maybe a -> b
maybe on
x ((on -> Maybe on) -> on -> on
forall on. Uniplate on => (on -> Maybe on) -> on -> on
rewrite on -> Maybe on
f) (on -> Maybe on
f on
x)


-- | Monadic variant of 'rewrite'
rewriteM :: (Monad m, Uniplate on) => (on -> m (Maybe on)) -> on -> m on
rewriteM :: (on -> m (Maybe on)) -> on -> m on
rewriteM on -> m (Maybe on)
f = (on -> m on) -> on -> m on
forall (m :: * -> *) on.
(Monad m, Uniplate on) =>
(on -> m on) -> on -> m on
transformM on -> m on
g
    where g :: on -> m on
g on
x = on -> m (Maybe on)
f on
x m (Maybe on) -> (Maybe on -> m on) -> m on
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= m on -> (on -> m on) -> Maybe on -> m on
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (on -> m on
forall (m :: * -> *) a. Monad m => a -> m a
return on
x) ((on -> m (Maybe on)) -> on -> m on
forall (m :: * -> *) on.
(Monad m, Uniplate on) =>
(on -> m (Maybe on)) -> on -> m on
rewriteM on -> m (Maybe on)
f)


-- | 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 :: Uniplate on => (on -> on) -> on -> on
descend :: (on -> on) -> on -> on
descend on -> on
f on
x = Str on -> on
generate (Str on -> on) -> Str on -> on
forall a b. (a -> b) -> a -> b
$ (on -> on) -> Str on -> Str on
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap on -> on
f Str on
current
    where (Str on
current, Str on -> on
generate) = UniplateType on
forall on. Uniplate on => UniplateType on
uniplate on
x


-- | Monadic variant of 'descend'
descendM :: (Monad m, Uniplate on) => (on -> m on) -> on -> m on
descendM :: (on -> m on) -> on -> m on
descendM on -> m on
f on
x = (Str on -> on) -> m (Str on) -> m on
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM Str on -> on
generate (m (Str on) -> m on) -> m (Str on) -> m on
forall a b. (a -> b) -> a -> b
$ (on -> m on) -> Str on -> m (Str on)
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM on -> m on
f Str on
current
    where (Str on
current, Str on -> on
generate) = UniplateType on
forall on. Uniplate on => UniplateType on
uniplate on
x

-- ** 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 :: on -> [(on, on -> on)]
contexts on
x = (on
x,on -> on
forall a. a -> a
id) (on, on -> on) -> [(on, on -> on)] -> [(on, on -> on)]
forall a. a -> [a] -> [a]
: [(on, on -> on)] -> [(on, on -> on)]
forall b c. Uniplate b => [(b, b -> c)] -> [(b, b -> c)]
f (on -> [(on, on -> on)]
forall on. Uniplate on => on -> [(on, on -> on)]
holes on
x)
  where
    f :: [(b, b -> c)] -> [(b, b -> c)]
f [(b, b -> c)]
xs = [ (b
y, b -> c
ctx (b -> c) -> (b -> b) -> b -> c
forall b c a. (b -> c) -> (a -> b) -> a -> c
. b -> b
context)
           | (b
child, b -> c
ctx) <- [(b, b -> c)]
xs
           , (b
y, b -> b
context) <- b -> [(b, b -> b)]
forall on. Uniplate on => on -> [(on, on -> on)]
contexts b
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 :: on -> [(on, on -> on)]
holes on
x = (Str on -> (Str on -> on) -> [(on, on -> on)])
-> (Str on, Str on -> on) -> [(on, on -> on)]
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Str on -> (Str on -> on) -> [(on, on -> on)]
forall a c. Str a -> (Str a -> c) -> [(a, a -> c)]
f (UniplateType on
forall on. Uniplate on => UniplateType on
uniplate on
x)
  where f :: Str a -> (Str a -> c) -> [(a, a -> c)]
f Str a
Zero Str a -> c
_ = []
        f (One a
i) Str a -> c
generate = [(a
i, Str a -> c
generate (Str a -> c) -> (a -> Str a) -> a -> c
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Str a
forall a. a -> Str a
One)]
        f (Two Str a
l Str a
r) Str a -> c
gen = Str a -> (Str a -> c) -> [(a, a -> c)]
f Str a
l (Str a -> c
gen (Str a -> c) -> (Str a -> Str a) -> Str a -> c
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (\Str a
i -> Str a -> Str a -> Str a
forall a. Str a -> Str a -> Str a
Two Str a
i Str a
r))
                       [(a, a -> c)] -> [(a, a -> c)] -> [(a, a -> c)]
forall a. [a] -> [a] -> [a]
++ Str a -> (Str a -> c) -> [(a, a -> c)]
f Str a
r (Str a -> c
gen (Str a -> c) -> (Str a -> Str a) -> Str a -> c
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (\Str a
i -> Str a -> Str a -> Str a
forall a. Str a -> Str a -> Str a
Two Str a
l Str a
i))

-- | Perform a fold-like computation on each value,
--   technically a paramorphism
para :: Uniplate on => (on -> [r] -> r) -> on -> r
para :: (on -> [r] -> r) -> on -> r
para on -> [r] -> r
op on
x = on -> [r] -> r
op on
x ([r] -> r) -> [r] -> r
forall a b. (a -> b) -> a -> b
$ (on -> r) -> [on] -> [r]
forall a b. (a -> b) -> [a] -> [b]
map ((on -> [r] -> r) -> on -> r
forall on r. Uniplate on => (on -> [r] -> r) -> on -> r
para on -> [r] -> r
op) ([on] -> [r]) -> [on] -> [r]
forall a b. (a -> b) -> a -> b
$ on -> [on]
forall on. Uniplate on => on -> [on]
children on
x