-- |
-- Lightweight generic traversals for Haskell.
-- See
--
module Traversal where
import Monad
-- |
-- A datatype is @Traversable@ if it defines the function @scrap@
-- that can decompose a value into a list of children of the same type
-- and recombine new children to a new value of the original type.
--
class Traversable a b
where scrap :: a -> ([b],[b] -> a)
-- |
-- Yields the children of a value.
--
children :: Traversable a b => a -> [b]
children = fst . scrap
-- |
-- Replaces the children of a value.
--
replaceChildren :: Traversable a b => a -> [b] -> a
replaceChildren = snd . scrap
-- |
-- Applies the given function to each child of a value.
--
mapChildren :: Traversable a b => (b -> b) -> a -> a
mapChildren f a = rep (map f cs)
where (cs,rep) = scrap a
-- |
-- Computes a list of the given value, its children, those children, etc.
--
family :: Traversable a a => a -> [a]
family a = a : childFamilies a
-- |
-- Computes a list of family members of the children of a value.
-- The value and its children can have different types.
--
childFamilies :: (Traversable a b, Traversable b b) => a -> [b]
childFamilies = concatMap family . children
-- |
-- Applies the given function to each member of the family of a value.
-- Proceeds bottom-up.
--
mapFamily :: Traversable a a => (a -> a) -> a -> a
mapFamily f = f . mapChildFamilies f
-- |
-- Applies the given function to each member of the families of the children
-- of a value. The value and its children can have different types.
-- Proceeds bottom-up.
--
mapChildFamilies :: (Traversable a b, Traversable b b) => (b -> b) -> a -> a
mapChildFamilies = mapChildren . mapFamily
-- |
-- Applies the given function to each member of the family of a value
-- as long as possible. On each member of the family of the result the given
-- function will yield @Nothing@.
-- Proceeds bottom-up.
--
evalFamily :: Traversable a a => (a -> Maybe a) -> a -> a
evalFamily f = mapFamily g
where g x = maybe x (mapFamily g) (f x)
-- |
-- Applies the given function to each member of the families of the children
-- of a value as long as possible.
-- Similar to 'evalFamily'.
--
evalChildFamilies :: (Traversable a b, Traversable b b)
=> (b -> Maybe b) -> a -> a
evalChildFamilies = mapChildren . evalFamily
-- |
-- Implements a traversal similar to a fold with possible default cases.
--
fold :: Traversable a a => (a -> [r] -> r) -> a -> r
fold f = foldChildren f f
-- |
-- Fold the children and combine the results.
--
foldChildren :: (Traversable a b, Traversable b b)
=> (a -> [rb] -> ra) -> (b -> [rb] -> rb) -> a -> ra
foldChildren f g a = f a (map (fold g) (children a))
-- |
-- Monadic variant of 'replaceChildren'.
--
replaceChildrenM :: (Monad m, Traversable a b) => a -> m [b] -> m a
replaceChildrenM = liftM . replaceChildren
-- |
-- Monadic variant of 'mapChildren'.
--
mapChildrenM :: (Monad m, Traversable a b) => (b -> m b) -> a -> m a
mapChildrenM f a = replaceChildrenM a (mapM f (children a))
-- |
-- Monadic variant of 'mapFamily'.
--
mapFamilyM :: (Monad m, Traversable a a) => (a -> m a) -> a -> m a
mapFamilyM f a = f =<< mapChildFamiliesM f a
-- |
-- Monadic variant of 'mapChildFamilies'.
--
mapChildFamiliesM :: (Monad m, Traversable a b, Traversable b b)
=> (b -> m b) -> a -> m a
mapChildFamiliesM = mapChildrenM . mapFamilyM
-- |
-- Monadic variant of 'evalFamily'.
--
evalFamilyM :: (Monad m, Traversable a a) => (a -> m (Maybe a)) -> a -> m a
evalFamilyM f = mapFamilyM g
where g x = maybe (return x) (mapFamilyM g) =<< f x
-- |
-- Monadic variant of 'evalChildFamilies'.
--
evalChildFamiliesM :: (Monad m, Traversable a b, Traversable b b)
=> (b -> m (Maybe b)) -> a -> m a
evalChildFamiliesM = mapChildrenM . evalFamilyM