{-# OPTIONS_GHC -fno-warn-deprecations #-}
{- |
/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' should perform identically to their non @On@
counterparts.
-}

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

import Data.Generics.Uniplate
import Control.Monad(liftM)

-- * 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 -> ([to], [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 = (to -> [to]) -> [to] -> [to]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap to -> [to]
forall on. Uniplate on => on -> [on]
universe ([to] -> [to]) -> [to] -> [to]
forall a b. (a -> b) -> a -> b
$ ([to], [to] -> from) -> [to]
forall a b. (a, b) -> a
fst (([to], [to] -> from) -> [to]) -> ([to], [to] -> from) -> [to]
forall a b. (a -> b) -> a -> b
$ BiplateType from to
biplate from
x


-- | 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 = ([to], [to] -> from) -> [to]
forall a b. (a, b) -> a
fst (([to], [to] -> from) -> [to]) -> ([to], [to] -> from) -> [to]
forall a b. (a -> b) -> a -> b
$ BiplateType from to
biplate from
x


-- ** 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 = [to] -> from
generate ([to] -> from) -> [to] -> from
forall a b. (a -> b) -> a -> b
$ (to -> to) -> [to] -> [to]
forall a b. (a -> b) -> [a] -> [b]
map ((to -> to) -> to -> to
forall on. Uniplate on => (on -> on) -> on -> on
transform to -> to
f) [to]
current
    where ([to]
current, [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 = ([to] -> from) -> m [to] -> m from
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM [to] -> from
generate (m [to] -> m from) -> m [to] -> m from
forall a b. (a -> b) -> a -> b
$ (to -> m to) -> [to] -> m [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) [to]
current
    where ([to]
current, [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 = [to] -> from
generate ([to] -> from) -> [to] -> from
forall a b. (a -> b) -> a -> b
$ (to -> to) -> [to] -> [to]
forall a b. (a -> b) -> [a] -> [b]
map ((to -> Maybe to) -> to -> to
forall on. Uniplate on => (on -> Maybe on) -> on -> on
rewrite to -> Maybe to
f) [to]
current
    where ([to]
current, [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 = ([to] -> from) -> m [to] -> m from
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM [to] -> from
generate (m [to] -> m from) -> m [to] -> m from
forall a b. (a -> b) -> a -> b
$ (to -> m to) -> [to] -> m [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) [to]
current
    where ([to]
current, [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 = [to] -> from
generate ([to] -> from) -> [to] -> from
forall a b. (a -> b) -> a -> b
$ (to -> to) -> [to] -> [to]
forall a b. (a -> b) -> [a] -> [b]
map to -> to
f [to]
current
    where ([to]
current, [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 = ([to] -> from) -> m [to] -> m from
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM [to] -> from
generate (m [to] -> m from) -> m [to] -> m from
forall a b. (a -> b) -> a -> b
$ (to -> m to) -> [to] -> m [to]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM to -> m to
f [to]
current
    where ([to]
current, [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 = ([to] -> ([to] -> from) -> [(to, to -> from)])
-> ([to], [to] -> from) -> [(to, to -> from)]
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry [to] -> ([to] -> from) -> [(to, to -> from)]
forall a c. [a] -> ([a] -> c) -> [(a, a -> c)]
f (BiplateType from to
biplate from
x)
  where f :: [a] -> ([a] -> c) -> [(a, a -> c)]
f [] [a] -> c
_ = []
        f (a
x:[a]
xs) [a] -> c
gen = (a
x, [a] -> c
gen ([a] -> c) -> (a -> [a]) -> a -> c
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> [a] -> [a]
forall a. a -> [a] -> [a]
:[a]
xs)) (a, a -> c) -> [(a, a -> c)] -> [(a, a -> c)]
forall a. a -> [a] -> [a]
:
                       [a] -> ([a] -> c) -> [(a, a -> c)]
f [a]
xs ([a] -> c
gen ([a] -> c) -> ([a] -> [a]) -> [a] -> c
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a
xa -> [a] -> [a]
forall a. a -> [a] -> [a]
:))


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 [] = ([], \[] -> [])
uniplateOnList BiplateType a b
f (a
x:[a]
xs) =
        ([b]
a [b] -> [b] -> [b]
forall a. [a] -> [a] -> [a]
++ [b]
as,
        \[b]
ns -> let ([b]
n1,[b]
n2) = Int -> [b] -> ([b], [b])
forall a. Int -> [a] -> ([a], [a])
splitAt ([b] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [b]
a) [b]
ns in [b] -> a
b [b]
n1 a -> [a] -> [a]
forall a. a -> [a] -> [a]
: [b] -> [a]
bs [b]
n2)
    where
        ([b]
a , [b] -> a
b ) = BiplateType a b
f a
x
        ([b]
as, [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