git.iko.soy/rowtype-yoga/purescript-native
on 495eeec help sign in
rowtype-yoga/purescript-native/src/Data/Generics/Extras.hs
63 lines 1.8 kB history raw
1-----------------------------------------------------------------------------
2--
3-- Module : Data.Generics.Extras
4-- Copyright : (c) Phil Freeman 2013
5-- License : MIT
6--
7-- Maintainer : Phil Freeman <paf31@cantab.net>
8-- Stability : experimental
9-- Portability :
10--
11-- |
12-- Additional SYB combinators
13--
14-----------------------------------------------------------------------------
16{-# LANGUAGE Rank2Types #-}
18module Data.Generics.Extras where
20import Data.Data
21import Data.Maybe (fromMaybe)
23-- |
24-- Apply a top-down monadic transformation everywhere
25--
26everywhereM' :: (Monad m, Data d) => (forall d1. (Data d1) => d1 -> m d1) -> d -> m d
27everywhereM' f x = do
28 y <- f x
29 gmapM (everywhereM' f) y
31-- |
32-- Apply a top-down transformation, mutating a state when descending from parents to children
33--
34-- For example, if we want to relabel bound variables with a different data constructor, we can do so:
35--
36-- > data Expr = Var String
37-- > | Lam String Test
38-- > | App Test Test
39-- > | LocalVar String deriving (Show, Data, Typeable)
40-- >
41-- > test = App (Lam "a" (App (Var "a") (Var "b"))) (Var "a")
42-- >
43-- > varsToLocals :: Expr -> Expr
44-- > varsToLocals = everywhereWithContext' [] (mkS go)
45-- > where
46-- > go locals (Var v) | v `elem` locals = (locals, LocalVar v)
47-- > go locals lam@(Lam local _) = (local : locals, lam)
48-- > go locals other = (locals, other)
49--
50everywhereWithContext' :: (Data d) => s -> (forall d1. (Data d1) => s -> d1 -> (s, d1)) -> d -> d
51everywhereWithContext' s0 f x =
52 let (s, y) = f s0 x in
53 gmapT (everywhereWithContext' s f) y
55-- |
56-- Make a stateful transformation function
57--
58mkS :: (Data a, Data b) => (s -> a -> (s, a)) -> s -> b -> (s, b)
59mkS f s b = fromMaybe (s, b) $ do
60 a <- cast b
61 let (s', a') = f s a
62 b' <- cast a'
63 return (s', b')