transitive descendents

gistfile1.hs

import Control.Applicative
import Control.Lens
import Data.Data
import Data.Data.Lens

descendents :: (Data a, Data b) => (b -> Bool) -> Fold a b 
descendents p f = biplate go
 where
  go x
    | p x = f x
    | otherwise = uniplate go x

{-
> typ <- runQ [t| forall x y z. (x, y) -> z |]
> let (ForallT [PlainTV v, _, _] _ _) = typ
> typ ^.. descendents ((==VarT v))
[VarT x_0]
> typ ^.. biplate . filtered ((==VarT v))
[]
> typ ^.. uniplate . filtered ((==VarT v))
[]
-}

substitute :: (Data a, Data b, Ord b) => (b -> Bool) -> ([b] -> [(b, b)]) -> a -> a
substitute p lf x = over (descendents p) (\v -> fromMaybe v $ M.lookup v rewrites) x
where
rewrites = M.fromList . lf . map head . group $ sort (x ^.. descendents p)

substitute :: (Data a, Data b, Ord b) => (b -> Bool) -> ([b] -> [(b, b)]) -> a -> a
substitute p lf x = over (descendents p) (\v -> fromMaybe v $ M.lookup v rewrites) x
  where
    rewrites = M.fromList . lf . map head . group $ sort (x ^.. descendents p)