{- |
/DEPRECATED/: 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".

The only function missing from "Data.Generics.Uniplate" is 'fold', as it can be
constructed from 'children' and has little meaning in a multi-typed setting.

All operations, apart from 'childrenOn', 'descendOn' and 'holesOn' should perform
identically to their non @On@ counterparts.
-}

module Data.Generics.UniplateStrOn
    {- DEPRECATED "Use Data.Generics.Uniplate.Operations instead" -}
    (
    module Data.Generics.UniplateStr,
    module Data.Generics.UniplateStrOn
    ) where

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

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

-- * Types

-- | 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.
type BiplateType from to = from -> (Str to, Str to -> from)


-- * Operations

-- ** Queries

universeOn :: Uniplate to => BiplateType from to -> from -> [to]
universeOn :: BiplateType from to -> from -> [to]
universeOn BiplateType from to
biplate from
x = (forall b. (to -> b -> b) -> b -> b) -> [to]
forall a. (forall b. (a -> b -> b) -> b -> b) -> [a]
builder forall b. (to -> b -> b) -> b -> b
f
    where
        f :: (to -> t -> t) -> t -> t
f to -> t -> t
cons t
nil = (to -> t -> t) -> t -> Str to -> t -> t
forall on t t.
Uniplate on =>
(on -> t -> t) -> t -> Str on -> t -> t
g to -> t -> t
cons t
nil ((Str to, Str to -> from) -> Str to
forall a b. (a, b) -> a
fst ((Str to, Str to -> from) -> Str to)
-> (Str to, Str to -> from) -> Str to
forall a b. (a -> b) -> a -> b
$ BiplateType from to
biplate from
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)


-- | Return the children of a type. If @to == from@ then it returns the
-- original element (in contrast to 'children')
childrenOn :: Uniplate to => BiplateType from to -> from -> [to]
childrenOn :: BiplateType from to -> from -> [to]
childrenOn BiplateType from to
biplate from
x = (forall b. (to -> b -> b) -> b -> b) -> [to]
forall a. (forall b. (a -> b -> b) -> b -> b) -> [a]
builder forall b. (to -> b -> b) -> b -> b
f
    where
        f :: (to -> t -> t) -> t -> t
f to -> t -> t
cons t
nil = (to -> t -> t) -> t -> Str to -> t -> t
forall t t t. (t -> t -> t) -> t -> Str t -> t -> t
g to -> t -> t
cons t
nil ((Str to, Str to -> from) -> Str to
forall a b. (a, b) -> a
fst ((Str to, Str to -> from) -> Str to)
-> (Str to, Str to -> from) -> Str to
forall a b. (a -> b) -> a -> b
$ BiplateType from to
biplate from
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

transformOn :: Uniplate to => BiplateType from to -> (to -> to) -> from -> from
transformOn :: BiplateType from to -> (to -> to) -> from -> from
transformOn BiplateType from to
biplate to -> to
f from
x = Str to -> from
generate (Str to -> from) -> Str to -> from
forall a b. (a -> b) -> a -> b
$ (to -> to) -> Str to -> Str to
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((to -> to) -> to -> to
forall on. Uniplate on => (on -> on) -> on -> on
transform to -> to
f) Str to
current
    where (Str to
current, Str to -> from
generate) = BiplateType from to
biplate from
x


transformOnM :: (Monad m, Uniplate to) => BiplateType from to -> (to -> m to) -> from -> m from
transformOnM :: BiplateType from to -> (to -> m to) -> from -> m from
transformOnM BiplateType from to
biplate to -> m to
f from
x = (Str to -> from) -> m (Str to) -> m from
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM Str to -> from
generate (m (Str to) -> m from) -> m (Str to) -> m from
forall a b. (a -> b) -> a -> b
$ (to -> m to) -> Str to -> m (Str to)
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM ((to -> m to) -> to -> m to
forall (m :: * -> *) on.
(Monad m, Uniplate on) =>
(on -> m on) -> on -> m on
transformM to -> m to
f) Str to
current
    where (Str to
current, Str to -> from
generate) = BiplateType from to
biplate from
x


rewriteOn :: Uniplate to => BiplateType from to -> (to -> Maybe to) -> from -> from
rewriteOn :: BiplateType from to -> (to -> Maybe to) -> from -> from
rewriteOn BiplateType from to
biplate to -> Maybe to
f from
x = Str to -> from
generate (Str to -> from) -> Str to -> from
forall a b. (a -> b) -> a -> b
$ (to -> to) -> Str to -> Str to
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((to -> Maybe to) -> to -> to
forall on. Uniplate on => (on -> Maybe on) -> on -> on
rewrite to -> Maybe to
f) Str to
current
    where (Str to
current, Str to -> from
generate) = BiplateType from to
biplate from
x


rewriteOnM :: (Monad m, Uniplate to) => BiplateType from to -> (to -> m (Maybe to)) -> from -> m from
rewriteOnM :: BiplateType from to -> (to -> m (Maybe to)) -> from -> m from
rewriteOnM BiplateType from to
biplate to -> m (Maybe to)
f from
x = (Str to -> from) -> m (Str to) -> m from
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM Str to -> from
generate (m (Str to) -> m from) -> m (Str to) -> m from
forall a b. (a -> b) -> a -> b
$ (to -> m to) -> Str to -> m (Str to)
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM ((to -> m (Maybe to)) -> to -> m to
forall (m :: * -> *) on.
(Monad m, Uniplate on) =>
(on -> m (Maybe on)) -> on -> m on
rewriteM to -> m (Maybe to)
f) Str to
current
    where (Str to
current, Str to -> from
generate) = BiplateType from to
biplate from
x


descendOn :: Uniplate to => BiplateType from to -> (to -> to) -> from -> from
descendOn :: BiplateType from to -> (to -> to) -> from -> from
descendOn BiplateType from to
biplate to -> to
f from
x = Str to -> from
generate (Str to -> from) -> Str to -> from
forall a b. (a -> b) -> a -> b
$ (to -> to) -> Str to -> Str to
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap to -> to
f Str to
current
    where (Str to
current, Str to -> from
generate) = BiplateType from to
biplate from
x


descendOnM :: (Monad m, Uniplate to) => BiplateType from to -> (to -> m to) -> from -> m from
descendOnM :: BiplateType from to -> (to -> m to) -> from -> m from
descendOnM BiplateType from to
biplate to -> m to
f from
x = (Str to -> from) -> m (Str to) -> m from
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM Str to -> from
generate (m (Str to) -> m from) -> m (Str to) -> m from
forall a b. (a -> b) -> a -> b
$ (to -> m to) -> Str to -> m (Str to)
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM to -> m to
f Str to
current
    where (Str to
current, Str to -> from
generate) = BiplateType from to
biplate from
x


-- ** Other
holesOn :: Uniplate to => BiplateType from to -> from -> [(to, to -> from)]
holesOn :: BiplateType from to -> from -> [(to, to -> from)]
holesOn BiplateType from to
biplate from
x = (Str to -> (Str to -> from) -> [(to, to -> from)])
-> (Str to, Str to -> from) -> [(to, to -> from)]
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Str to -> (Str to -> from) -> [(to, to -> from)]
forall a c. Str a -> (Str a -> c) -> [(a, a -> c)]
f (BiplateType from to
biplate from
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))

contextsOn :: Uniplate to => BiplateType from to -> from -> [(to, to -> from)]
contextsOn :: BiplateType from to -> from -> [(to, to -> from)]
contextsOn BiplateType from to
biplate from
x = [(to, to -> from)] -> [(to, to -> from)]
forall b c. Uniplate b => [(b, b -> c)] -> [(b, b -> c)]
f (BiplateType from to -> from -> [(to, to -> from)]
forall to from.
Uniplate to =>
BiplateType from to -> from -> [(to, to -> from)]
holesOn BiplateType from to
biplate from
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]

-- * Helper for writing instances

-- | Used for defining instances @UniplateFoo a => UniplateFoo [a]@
uniplateOnList :: BiplateType a b -> BiplateType [a] b
uniplateOnList :: BiplateType a b -> BiplateType [a] b
uniplateOnList BiplateType a b
f [] = (Str b
forall a. Str a
Zero, \Str b
_ -> [])
uniplateOnList BiplateType a b
f (a
x:[a]
xs) =
        (Str b -> Str b -> Str b
forall a. Str a -> Str a -> Str a
Two Str b
a Str b
as,
        \(Two Str b
n Str b
ns) -> Str b -> a
b Str b
n a -> [a] -> [a]
forall a. a -> [a] -> [a]
: Str b -> [a]
bs Str b
ns)
    where
        (Str b
a , Str b -> a
b ) = BiplateType a b
f a
x
        (Str b
as, Str b -> [a]
bs) = BiplateType a b -> BiplateType [a] b
forall a b. BiplateType a b -> BiplateType [a] b
uniplateOnList BiplateType a b
f [a]
xs