{-# OPTIONS_GHC -fno-warn-deprecations #-}
module Data.Generics.UniplateOn
(
module Data.Generics.Uniplate,
module Data.Generics.UniplateOn
) where
import Data.Generics.Uniplate
import Control.Monad(liftM)
type BiplateType from to = from -> ([to], [to] -> from)
universeOn :: Uniplate to => BiplateType from to -> from -> [to]
universeOn biplate x = concatMap universe $ fst $ biplate x
childrenOn :: Uniplate to => BiplateType from to -> from -> [to]
childrenOn biplate x = fst $ biplate x
transformOn :: Uniplate to => BiplateType from to -> (to -> to) -> from -> from
transformOn biplate f x = generate $ map (transform f) current
where (current, generate) = biplate x
transformOnM :: (Monad m, Uniplate to) => BiplateType from to -> (to -> m to) -> from -> m from
transformOnM biplate f x = liftM generate $ mapM (transformM f) current
where (current, generate) = biplate x
rewriteOn :: Uniplate to => BiplateType from to -> (to -> Maybe to) -> from -> from
rewriteOn biplate f x = generate $ map (rewrite f) current
where (current, generate) = biplate x
rewriteOnM :: (Monad m, Uniplate to) => BiplateType from to -> (to -> m (Maybe to)) -> from -> m from
rewriteOnM biplate f x = liftM generate $ mapM (rewriteM f) current
where (current, generate) = biplate x
descendOn :: Uniplate to => BiplateType from to -> (to -> to) -> from -> from
descendOn biplate f x = generate $ map f current
where (current, generate) = biplate x
descendOnM :: (Monad m, Uniplate to) => BiplateType from to -> (to -> m to) -> from -> m from
descendOnM biplate f x = liftM generate $ mapM f current
where (current, generate) = biplate x
holesOn :: Uniplate to => BiplateType from to -> from -> [(to, to -> from)]
holesOn biplate x = uncurry f (biplate x)
where f [] _ = []
f (x:xs) gen = (x, gen . (:xs)) :
f xs (gen . (x:))
contextsOn :: Uniplate to => BiplateType from to -> from -> [(to, to -> from)]
contextsOn biplate x = f (holesOn biplate x)
where
f xs = [ (y, ctx . context)
| (child, ctx) <- xs
, (y, context) <- contexts child]
uniplateOnList :: BiplateType a b -> BiplateType [a] b
uniplateOnList f [] = ([], \[] -> [])
uniplateOnList f (x:xs) =
(a ++ as,
\ns -> let (n1,n2) = splitAt (length a) ns in b n1 : bs n2)
where
(a , b ) = f x
(as, bs) = uniplateOnList f xs