gistfile1.txt

class Uniplate on where
    -- | The underlying method in the class.
    --   Taking a value, the function should return all the immediate children
    --   of the same type, and a function to replace them.
    --
    --   Given @uniplate x = (cs, gen)@
    --
    --   @cs@ should be a @Str on@, constructed of @Zero@, @One@ and @Two@,
    --   containing all @x@'s direct children of the same type as @x@. @gen@
    --   should take a @Str on@ with exactly the same structure as @cs@,
    --   and generate a new element with the children replaced.
    --
    --   Example instance:
    --
    -- > instance Uniplate Expr where
    -- >     uniplate (Val i  ) = (Zero               , \Zero                  -> Val i  )
    -- >     uniplate (Neg a  ) = (One a              , \(One a)               -> Neg a  )
    -- >     uniplate (Add a b) = (Two (One a) (One b), \(Two (One a) (One b)) -> Add a b)
    uniplate :: on -> (Str on, Str on -> on)

    -- | Perform a transformation on all the immediate children, then combine them back.
    --   This operation allows additional information to be passed downwards, and can be
    --   used to provide a top-down transformation. This function can be defined explicitly,
    --   or can be provided by automatically in terms of 'uniplate'.
    --
    --   For example, on the sample type, we could write:
    --
    -- > descend f (Val i  ) = Val i
    -- > descend f (Neg a  ) = Neg (f a)
    -- > descend f (Add a b) = Add (f a) (f b)
    {-# INLINE descend #-}
    descend :: (on -> on) -> on -> on
    descend f x = case uniplate x of
        (current, generate) -> generate $ strMap f current

    -- | Monadic variant of 'descend'
    {-# INLINE descendM #-}
    descendM :: Monad m => (on -> m on) -> on -> m on
    descendM f x = case uniplate x of
        (current, generate) -> liftM generate $ strMapM f current
        
        
        
transform :: Uniplate on => (on -> on) -> on -> on
transform f = g
    where g = f . descend g
    

-- | Rewrite by applying a rule everywhere you can. Ensures that the rule cannot
-- be applied anywhere in the result:
--
-- > propRewrite r x = all (isNothing . r) (universe (rewrite r x))
--
-- Usually 'transform' is more appropriate, but 'rewrite' can give better
-- compositionality. Given two single transformations @f@ and @g@, you can
-- construct @f `mplus` g@ which performs both rewrites until a fixed point.
rewrite :: Uniplate on => (on -> Maybe on) -> on -> on
rewrite f = transform g
    where g x = maybe x (rewrite f) (f x)