git.iko.soy/rowtype-yoga/purescript-native
on 159cf3a help sign in
rowtype-yoga/purescript-native/src/Data/Generics/Extras.hs
74 lines 2.2 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--
50everywhereWithContextM' :: (Monad m, Data d) => s -> (forall d1. (Data d1) => s -> d1 -> m (s, d1)) -> d -> m d
51everywhereWithContextM' s0 f x = do
52 (s, y) <- f s0 x
53 gmapM (everywhereWithContextM' s f) y
55-- |
56-- Make a stateful transformation function
57--
58mkS :: (Monad m, Data a, Data b) => (s -> a -> m (s, a)) -> s -> b -> m (s, b)
59mkS = extS (curry return)
61-- |
62-- Extend a stateful transformation function
63--
64extS :: (Monad m, Data a, Data b) => (s -> a -> m (s, a)) -> (s -> b -> m (s, b)) -> (s -> a -> m (s, a))
65extS f g s a = do
66 (s', a') <- f s a
67 case cast a' of
68 Just b -> do
69 (s'', b') <- g s' b
70 case cast b' of
71 Just a'' -> return (s'', a'')
72 Nothing -> return (s', a')
73 Nothing -> return (s', a')