<?xml version="1.0" encoding="UTF-8"?>
<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Strict//EN" "http://www.w3.org/TR/xhtml1/DTD/xhtml1-strict.dtd">
<html>
<head>
<!-- Generated by HsColour, http://www.cs.york.ac.uk/fp/darcs/hscolour/ -->
<title>Data/Generics/UniplateStr.hs</title>
<link type='text/css' rel='stylesheet' href='hscolour.css' />
</head>
<body>
<pre><a name="line-1"></a><span class='hs-comment'>{- |
<a name="line-2"></a>/RECOMMENDATION/: Use "Data.Generics.Uniplate.Operations" instead.
<a name="line-3"></a>
<a name="line-4"></a>This is the main Uniplate module, which defines all the essential operations
<a name="line-5"></a>in a Haskell 98 compatible manner.
<a name="line-6"></a>
<a name="line-7"></a>Most functions have an example of a possible use for the function.
<a name="line-8"></a>To illustate, I have used the @Expr@ type as below:
<a name="line-9"></a>
<a name="line-10"></a>> data Expr = Val Int
<a name="line-11"></a>> | Neg Expr
<a name="line-12"></a>> | Add Expr Expr
<a name="line-13"></a>-}</span>
<a name="line-14"></a>
<a name="line-15"></a>
<a name="line-16"></a><span class='hs-keyword'>module</span> <span class='hs-conid'>Data</span><span class='hs-varop'>.</span><span class='hs-conid'>Generics</span><span class='hs-varop'>.</span><span class='hs-conid'>UniplateStr</span><span class='hs-layout'>(</span>
<a name="line-17"></a> <span class='hs-keyword'>module</span> <span class='hs-conid'>Data</span><span class='hs-varop'>.</span><span class='hs-conid'>Generics</span><span class='hs-varop'>.</span><span class='hs-conid'>UniplateStr</span><span class='hs-layout'>,</span>
<a name="line-18"></a> <span class='hs-keyword'>module</span> <span class='hs-conid'>Data</span><span class='hs-varop'>.</span><span class='hs-conid'>Generics</span><span class='hs-varop'>.</span><span class='hs-conid'>Str</span>
<a name="line-19"></a> <span class='hs-layout'>)</span> <span class='hs-keyword'>where</span>
<a name="line-20"></a>
<a name="line-21"></a><span class='hs-keyword'>import</span> <span class='hs-conid'>Control</span><span class='hs-varop'>.</span><span class='hs-conid'>Monad</span> <span class='hs-varid'>hiding</span> <span class='hs-layout'>(</span><span class='hs-varid'>mapM</span><span class='hs-layout'>)</span>
<a name="line-22"></a><span class='hs-keyword'>import</span> <span class='hs-conid'>Data</span><span class='hs-varop'>.</span><span class='hs-conid'>Traversable</span>
<a name="line-23"></a><span class='hs-keyword'>import</span> <span class='hs-conid'>Prelude</span> <span class='hs-varid'>hiding</span> <span class='hs-layout'>(</span><span class='hs-varid'>mapM</span><span class='hs-layout'>)</span>
<a name="line-24"></a>
<a name="line-25"></a><span class='hs-keyword'>import</span> <span class='hs-conid'>Data</span><span class='hs-varop'>.</span><span class='hs-conid'>Generics</span><span class='hs-varop'>.</span><span class='hs-conid'>PlateInternal</span>
<a name="line-26"></a><span class='hs-keyword'>import</span> <span class='hs-conid'>Data</span><span class='hs-varop'>.</span><span class='hs-conid'>Generics</span><span class='hs-varop'>.</span><span class='hs-conid'>Str</span>
<a name="line-27"></a>
<a name="line-28"></a>
<a name="line-29"></a><span class='hs-comment'>-- * The Class</span>
<a name="line-30"></a>
<a name="line-31"></a><a name="UniplateType"></a><span class='hs-comment'>-- | The type of replacing all the children of a node</span>
<a name="line-32"></a><a name="UniplateType"></a><span class='hs-comment'>--</span>
<a name="line-33"></a><a name="UniplateType"></a><span class='hs-comment'>-- Taking a value, the function should return all the immediate children</span>
<a name="line-34"></a><a name="UniplateType"></a><span class='hs-comment'>-- of the same type, and a function to replace them.</span>
<a name="line-35"></a><a name="UniplateType"></a><span class='hs-keyword'>type</span> <span class='hs-conid'>UniplateType</span> <span class='hs-varid'>on</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>on</span> <span class='hs-keyglyph'>-></span> <span class='hs-layout'>(</span><span class='hs-conid'>Str</span> <span class='hs-varid'>on</span><span class='hs-layout'>,</span> <span class='hs-conid'>Str</span> <span class='hs-varid'>on</span> <span class='hs-keyglyph'>-></span> <span class='hs-varid'>on</span><span class='hs-layout'>)</span>
<a name="line-36"></a>
<a name="line-37"></a><span class='hs-comment'>-- | The standard Uniplate class, all operations require this.</span>
<a name="line-38"></a><span class='hs-keyword'>class</span> <span class='hs-conid'>Uniplate</span> <span class='hs-varid'>on</span> <span class='hs-keyword'>where</span>
<a name="line-39"></a> <span class='hs-comment'>-- | The underlying method in the class.</span>
<a name="line-40"></a> <span class='hs-comment'>--</span>
<a name="line-41"></a> <span class='hs-comment'>-- Given @uniplate x = (cs, gen)@</span>
<a name="line-42"></a> <span class='hs-comment'>--</span>
<a name="line-43"></a> <span class='hs-comment'>-- @cs@ should be a @Str on@, constructed of @Zero@, @One@ and @Two@,</span>
<a name="line-44"></a> <span class='hs-comment'>-- containing all @x@'s direct children of the same type as @x@. @gen@</span>
<a name="line-45"></a> <span class='hs-comment'>-- should take a @Str on@ with exactly the same structure as @cs@,</span>
<a name="line-46"></a> <span class='hs-comment'>-- and generate a new element with the children replaced.</span>
<a name="line-47"></a> <span class='hs-comment'>--</span>
<a name="line-48"></a> <span class='hs-comment'>-- Example instance:</span>
<a name="line-49"></a> <span class='hs-comment'>--</span>
<a name="line-50"></a> <span class='hs-comment'>-- > instance Uniplate Expr where</span>
<a name="line-51"></a> <span class='hs-comment'>-- > uniplate (Val i ) = (Zero , \Zero -> Val i )</span>
<a name="line-52"></a> <span class='hs-comment'>-- > uniplate (Neg a ) = (One a , \(One a) -> Neg a )</span>
<a name="line-53"></a> <span class='hs-comment'>-- > uniplate (Add a b) = (Two (One a) (One b), \(Two (One a) (One b)) -> Add a b)</span>
<a name="line-54"></a> <span class='hs-varid'>uniplate</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>UniplateType</span> <span class='hs-varid'>on</span>
<a name="line-55"></a>
<a name="line-56"></a>
<a name="line-57"></a><a name="uniplateList"></a><span class='hs-comment'>-- | Compatibility method, for direct users of the old list-based 'uniplate' function</span>
<a name="line-58"></a><span class='hs-definition'>uniplateList</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>Uniplate</span> <span class='hs-varid'>on</span> <span class='hs-keyglyph'>=></span> <span class='hs-varid'>on</span> <span class='hs-keyglyph'>-></span> <span class='hs-layout'>(</span><span class='hs-keyglyph'>[</span><span class='hs-varid'>on</span><span class='hs-keyglyph'>]</span><span class='hs-layout'>,</span> <span class='hs-keyglyph'>[</span><span class='hs-varid'>on</span><span class='hs-keyglyph'>]</span> <span class='hs-keyglyph'>-></span> <span class='hs-varid'>on</span><span class='hs-layout'>)</span>
<a name="line-59"></a><span class='hs-definition'>uniplateList</span> <span class='hs-varid'>x</span> <span class='hs-keyglyph'>=</span> <span class='hs-layout'>(</span><span class='hs-varid'>c</span><span class='hs-layout'>,</span> <span class='hs-varid'>b</span> <span class='hs-varop'>.</span> <span class='hs-varid'>d</span><span class='hs-layout'>)</span>
<a name="line-60"></a> <span class='hs-keyword'>where</span>
<a name="line-61"></a> <span class='hs-layout'>(</span><span class='hs-varid'>a</span><span class='hs-layout'>,</span><span class='hs-varid'>b</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>uniplate</span> <span class='hs-varid'>x</span>
<a name="line-62"></a> <span class='hs-layout'>(</span><span class='hs-varid'>c</span><span class='hs-layout'>,</span><span class='hs-varid'>d</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>strStructure</span> <span class='hs-varid'>a</span>
<a name="line-63"></a>
<a name="line-64"></a>
<a name="line-65"></a><span class='hs-comment'>-- * The Operations</span>
<a name="line-66"></a>
<a name="line-67"></a><span class='hs-comment'>-- ** Queries</span>
<a name="line-68"></a>
<a name="line-69"></a><a name="universe"></a><span class='hs-comment'>-- | Get all the children of a node, including itself and all children.</span>
<a name="line-70"></a><span class='hs-comment'>--</span>
<a name="line-71"></a><span class='hs-comment'>-- > universe (Add (Val 1) (Neg (Val 2))) =</span>
<a name="line-72"></a><span class='hs-comment'>-- > [Add (Val 1) (Neg (Val 2)), Val 1, Neg (Val 2), Val 2]</span>
<a name="line-73"></a><span class='hs-comment'>--</span>
<a name="line-74"></a><span class='hs-comment'>-- This method is often combined with a list comprehension, for example:</span>
<a name="line-75"></a><span class='hs-comment'>--</span>
<a name="line-76"></a><span class='hs-comment'>-- > vals x = [i | Val i <- universe x]</span>
<a name="line-77"></a><span class='hs-definition'>universe</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>Uniplate</span> <span class='hs-varid'>on</span> <span class='hs-keyglyph'>=></span> <span class='hs-varid'>on</span> <span class='hs-keyglyph'>-></span> <span class='hs-keyglyph'>[</span><span class='hs-varid'>on</span><span class='hs-keyglyph'>]</span>
<a name="line-78"></a><span class='hs-definition'>universe</span> <span class='hs-varid'>x</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>builder</span> <span class='hs-varid'>f</span>
<a name="line-79"></a> <span class='hs-keyword'>where</span>
<a name="line-80"></a> <span class='hs-varid'>f</span> <span class='hs-varid'>cons</span> <span class='hs-varid'>nil</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>g</span> <span class='hs-varid'>cons</span> <span class='hs-varid'>nil</span> <span class='hs-layout'>(</span><span class='hs-conid'>One</span> <span class='hs-varid'>x</span><span class='hs-layout'>)</span> <span class='hs-varid'>nil</span>
<a name="line-81"></a> <span class='hs-varid'>g</span> <span class='hs-varid'>cons</span> <span class='hs-varid'>nil</span> <span class='hs-conid'>Zero</span> <span class='hs-varid'>res</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>res</span>
<a name="line-82"></a> <span class='hs-varid'>g</span> <span class='hs-varid'>cons</span> <span class='hs-varid'>nil</span> <span class='hs-layout'>(</span><span class='hs-conid'>One</span> <span class='hs-varid'>x</span><span class='hs-layout'>)</span> <span class='hs-varid'>res</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>x</span> <span class='hs-varop'>`cons`</span> <span class='hs-varid'>g</span> <span class='hs-varid'>cons</span> <span class='hs-varid'>nil</span> <span class='hs-layout'>(</span><span class='hs-varid'>fst</span> <span class='hs-varop'>$</span> <span class='hs-varid'>uniplate</span> <span class='hs-varid'>x</span><span class='hs-layout'>)</span> <span class='hs-varid'>res</span>
<a name="line-83"></a> <span class='hs-varid'>g</span> <span class='hs-varid'>cons</span> <span class='hs-varid'>nil</span> <span class='hs-layout'>(</span><span class='hs-conid'>Two</span> <span class='hs-varid'>x</span> <span class='hs-varid'>y</span><span class='hs-layout'>)</span> <span class='hs-varid'>res</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>g</span> <span class='hs-varid'>cons</span> <span class='hs-varid'>nil</span> <span class='hs-varid'>x</span> <span class='hs-layout'>(</span><span class='hs-varid'>g</span> <span class='hs-varid'>cons</span> <span class='hs-varid'>nil</span> <span class='hs-varid'>y</span> <span class='hs-varid'>res</span><span class='hs-layout'>)</span>
<a name="line-84"></a>
<a name="line-85"></a>
<a name="line-86"></a>
<a name="line-87"></a><a name="children"></a><span class='hs-comment'>-- | Get the direct children of a node. Usually using 'universe' is more appropriate.</span>
<a name="line-88"></a><span class='hs-comment'>--</span>
<a name="line-89"></a><span class='hs-comment'>-- @children = fst . 'uniplate'@</span>
<a name="line-90"></a><span class='hs-definition'>children</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>Uniplate</span> <span class='hs-varid'>on</span> <span class='hs-keyglyph'>=></span> <span class='hs-varid'>on</span> <span class='hs-keyglyph'>-></span> <span class='hs-keyglyph'>[</span><span class='hs-varid'>on</span><span class='hs-keyglyph'>]</span>
<a name="line-91"></a><span class='hs-definition'>children</span> <span class='hs-varid'>x</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>builder</span> <span class='hs-varid'>f</span>
<a name="line-92"></a> <span class='hs-keyword'>where</span>
<a name="line-93"></a> <span class='hs-varid'>f</span> <span class='hs-varid'>cons</span> <span class='hs-varid'>nil</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>g</span> <span class='hs-varid'>cons</span> <span class='hs-varid'>nil</span> <span class='hs-layout'>(</span><span class='hs-varid'>fst</span> <span class='hs-varop'>$</span> <span class='hs-varid'>uniplate</span> <span class='hs-varid'>x</span><span class='hs-layout'>)</span> <span class='hs-varid'>nil</span>
<a name="line-94"></a> <span class='hs-varid'>g</span> <span class='hs-varid'>cons</span> <span class='hs-varid'>nil</span> <span class='hs-conid'>Zero</span> <span class='hs-varid'>res</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>res</span>
<a name="line-95"></a> <span class='hs-varid'>g</span> <span class='hs-varid'>cons</span> <span class='hs-varid'>nil</span> <span class='hs-layout'>(</span><span class='hs-conid'>One</span> <span class='hs-varid'>x</span><span class='hs-layout'>)</span> <span class='hs-varid'>res</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>x</span> <span class='hs-varop'>`cons`</span> <span class='hs-varid'>res</span>
<a name="line-96"></a> <span class='hs-varid'>g</span> <span class='hs-varid'>cons</span> <span class='hs-varid'>nil</span> <span class='hs-layout'>(</span><span class='hs-conid'>Two</span> <span class='hs-varid'>x</span> <span class='hs-varid'>y</span><span class='hs-layout'>)</span> <span class='hs-varid'>res</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>g</span> <span class='hs-varid'>cons</span> <span class='hs-varid'>nil</span> <span class='hs-varid'>x</span> <span class='hs-layout'>(</span><span class='hs-varid'>g</span> <span class='hs-varid'>cons</span> <span class='hs-varid'>nil</span> <span class='hs-varid'>y</span> <span class='hs-varid'>res</span><span class='hs-layout'>)</span>
<a name="line-97"></a>
<a name="line-98"></a>
<a name="line-99"></a><span class='hs-comment'>-- ** Transformations</span>
<a name="line-100"></a>
<a name="line-101"></a>
<a name="line-102"></a><a name="transform"></a><span class='hs-comment'>-- | Transform every element in the tree, in a bottom-up manner.</span>
<a name="line-103"></a><span class='hs-comment'>--</span>
<a name="line-104"></a><span class='hs-comment'>-- For example, replacing negative literals with literals:</span>
<a name="line-105"></a><span class='hs-comment'>--</span>
<a name="line-106"></a><span class='hs-comment'>-- > negLits = transform f</span>
<a name="line-107"></a><span class='hs-comment'>-- > where f (Neg (Lit i)) = Lit (negate i)</span>
<a name="line-108"></a><span class='hs-comment'>-- > f x = x</span>
<a name="line-109"></a><span class='hs-definition'>transform</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>Uniplate</span> <span class='hs-varid'>on</span> <span class='hs-keyglyph'>=></span> <span class='hs-layout'>(</span><span class='hs-varid'>on</span> <span class='hs-keyglyph'>-></span> <span class='hs-varid'>on</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>-></span> <span class='hs-varid'>on</span> <span class='hs-keyglyph'>-></span> <span class='hs-varid'>on</span>
<a name="line-110"></a><span class='hs-definition'>transform</span> <span class='hs-varid'>f</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>f</span> <span class='hs-varop'>.</span> <span class='hs-varid'>descend</span> <span class='hs-layout'>(</span><span class='hs-varid'>transform</span> <span class='hs-varid'>f</span><span class='hs-layout'>)</span>
<a name="line-111"></a>
<a name="line-112"></a>
<a name="line-113"></a><a name="transformM"></a><span class='hs-comment'>-- | Monadic variant of 'transform'</span>
<a name="line-114"></a><span class='hs-definition'>transformM</span> <span class='hs-keyglyph'>::</span> <span class='hs-layout'>(</span><span class='hs-conid'>Monad</span> <span class='hs-varid'>m</span><span class='hs-layout'>,</span> <span class='hs-conid'>Uniplate</span> <span class='hs-varid'>on</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>=></span> <span class='hs-layout'>(</span><span class='hs-varid'>on</span> <span class='hs-keyglyph'>-></span> <span class='hs-varid'>m</span> <span class='hs-varid'>on</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>-></span> <span class='hs-varid'>on</span> <span class='hs-keyglyph'>-></span> <span class='hs-varid'>m</span> <span class='hs-varid'>on</span>
<a name="line-115"></a><span class='hs-definition'>transformM</span> <span class='hs-varid'>f</span> <span class='hs-varid'>x</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>f</span> <span class='hs-varop'>=<<</span> <span class='hs-varid'>descendM</span> <span class='hs-layout'>(</span><span class='hs-varid'>transformM</span> <span class='hs-varid'>f</span><span class='hs-layout'>)</span> <span class='hs-varid'>x</span>
<a name="line-116"></a>
<a name="line-117"></a>
<a name="line-118"></a><a name="rewrite"></a><span class='hs-comment'>-- | Rewrite by applying a rule everywhere you can. Ensures that the rule cannot</span>
<a name="line-119"></a><span class='hs-comment'>-- be applied anywhere in the result:</span>
<a name="line-120"></a><span class='hs-comment'>--</span>
<a name="line-121"></a><span class='hs-comment'>-- > propRewrite r x = all (isNothing . r) (universe (rewrite r x))</span>
<a name="line-122"></a><span class='hs-comment'>--</span>
<a name="line-123"></a><span class='hs-comment'>-- Usually 'transform' is more appropriate, but 'rewrite' can give better</span>
<a name="line-124"></a><span class='hs-comment'>-- compositionality. Given two single transformations @f@ and @g@, you can</span>
<a name="line-125"></a><span class='hs-comment'>-- construct @f `mplus` g@ which performs both rewrites until a fixed point.</span>
<a name="line-126"></a><span class='hs-definition'>rewrite</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>Uniplate</span> <span class='hs-varid'>on</span> <span class='hs-keyglyph'>=></span> <span class='hs-layout'>(</span><span class='hs-varid'>on</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>Maybe</span> <span class='hs-varid'>on</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>-></span> <span class='hs-varid'>on</span> <span class='hs-keyglyph'>-></span> <span class='hs-varid'>on</span>
<a name="line-127"></a><span class='hs-definition'>rewrite</span> <span class='hs-varid'>f</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>transform</span> <span class='hs-varid'>g</span>
<a name="line-128"></a> <span class='hs-keyword'>where</span> <span class='hs-varid'>g</span> <span class='hs-varid'>x</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>maybe</span> <span class='hs-varid'>x</span> <span class='hs-layout'>(</span><span class='hs-varid'>rewrite</span> <span class='hs-varid'>f</span><span class='hs-layout'>)</span> <span class='hs-layout'>(</span><span class='hs-varid'>f</span> <span class='hs-varid'>x</span><span class='hs-layout'>)</span>
<a name="line-129"></a>
<a name="line-130"></a>
<a name="line-131"></a><a name="rewriteM"></a><span class='hs-comment'>-- | Monadic variant of 'rewrite'</span>
<a name="line-132"></a><span class='hs-definition'>rewriteM</span> <span class='hs-keyglyph'>::</span> <span class='hs-layout'>(</span><span class='hs-conid'>Monad</span> <span class='hs-varid'>m</span><span class='hs-layout'>,</span> <span class='hs-conid'>Uniplate</span> <span class='hs-varid'>on</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>=></span> <span class='hs-layout'>(</span><span class='hs-varid'>on</span> <span class='hs-keyglyph'>-></span> <span class='hs-varid'>m</span> <span class='hs-layout'>(</span><span class='hs-conid'>Maybe</span> <span class='hs-varid'>on</span><span class='hs-layout'>)</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>-></span> <span class='hs-varid'>on</span> <span class='hs-keyglyph'>-></span> <span class='hs-varid'>m</span> <span class='hs-varid'>on</span>
<a name="line-133"></a><span class='hs-definition'>rewriteM</span> <span class='hs-varid'>f</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>transformM</span> <span class='hs-varid'>g</span>
<a name="line-134"></a> <span class='hs-keyword'>where</span> <span class='hs-varid'>g</span> <span class='hs-varid'>x</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>f</span> <span class='hs-varid'>x</span> <span class='hs-varop'>>>=</span> <span class='hs-varid'>maybe</span> <span class='hs-layout'>(</span><span class='hs-varid'>return</span> <span class='hs-varid'>x</span><span class='hs-layout'>)</span> <span class='hs-layout'>(</span><span class='hs-varid'>rewriteM</span> <span class='hs-varid'>f</span><span class='hs-layout'>)</span>
<a name="line-135"></a>
<a name="line-136"></a>
<a name="line-137"></a><a name="descend"></a><span class='hs-comment'>-- | Perform a transformation on all the immediate children, then combine them back.</span>
<a name="line-138"></a><span class='hs-comment'>-- This operation allows additional information to be passed downwards, and can be</span>
<a name="line-139"></a><span class='hs-comment'>-- used to provide a top-down transformation.</span>
<a name="line-140"></a><span class='hs-definition'>descend</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>Uniplate</span> <span class='hs-varid'>on</span> <span class='hs-keyglyph'>=></span> <span class='hs-layout'>(</span><span class='hs-varid'>on</span> <span class='hs-keyglyph'>-></span> <span class='hs-varid'>on</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>-></span> <span class='hs-varid'>on</span> <span class='hs-keyglyph'>-></span> <span class='hs-varid'>on</span>
<a name="line-141"></a><span class='hs-definition'>descend</span> <span class='hs-varid'>f</span> <span class='hs-varid'>x</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>generate</span> <span class='hs-varop'>$</span> <span class='hs-varid'>fmap</span> <span class='hs-varid'>f</span> <span class='hs-varid'>current</span>
<a name="line-142"></a> <span class='hs-keyword'>where</span> <span class='hs-layout'>(</span><span class='hs-varid'>current</span><span class='hs-layout'>,</span> <span class='hs-varid'>generate</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>uniplate</span> <span class='hs-varid'>x</span>
<a name="line-143"></a>
<a name="line-144"></a>
<a name="line-145"></a><a name="descendM"></a><span class='hs-comment'>-- | Monadic variant of 'descend' </span>
<a name="line-146"></a><span class='hs-definition'>descendM</span> <span class='hs-keyglyph'>::</span> <span class='hs-layout'>(</span><span class='hs-conid'>Monad</span> <span class='hs-varid'>m</span><span class='hs-layout'>,</span> <span class='hs-conid'>Uniplate</span> <span class='hs-varid'>on</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>=></span> <span class='hs-layout'>(</span><span class='hs-varid'>on</span> <span class='hs-keyglyph'>-></span> <span class='hs-varid'>m</span> <span class='hs-varid'>on</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>-></span> <span class='hs-varid'>on</span> <span class='hs-keyglyph'>-></span> <span class='hs-varid'>m</span> <span class='hs-varid'>on</span>
<a name="line-147"></a><span class='hs-definition'>descendM</span> <span class='hs-varid'>f</span> <span class='hs-varid'>x</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>liftM</span> <span class='hs-varid'>generate</span> <span class='hs-varop'>$</span> <span class='hs-varid'>mapM</span> <span class='hs-varid'>f</span> <span class='hs-varid'>current</span>
<a name="line-148"></a> <span class='hs-keyword'>where</span> <span class='hs-layout'>(</span><span class='hs-varid'>current</span><span class='hs-layout'>,</span> <span class='hs-varid'>generate</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>uniplate</span> <span class='hs-varid'>x</span>
<a name="line-149"></a>
<a name="line-150"></a><span class='hs-comment'>-- ** Others</span>
<a name="line-151"></a>
<a name="line-152"></a><a name="contexts"></a><span class='hs-comment'>-- | Return all the contexts and holes.</span>
<a name="line-153"></a><span class='hs-comment'>--</span>
<a name="line-154"></a><span class='hs-comment'>-- > propUniverse x = universe x == map fst (contexts x)</span>
<a name="line-155"></a><span class='hs-comment'>-- > propId x = all (== x) [b a | (a,b) <- contexts x]</span>
<a name="line-156"></a><span class='hs-definition'>contexts</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>Uniplate</span> <span class='hs-varid'>on</span> <span class='hs-keyglyph'>=></span> <span class='hs-varid'>on</span> <span class='hs-keyglyph'>-></span> <span class='hs-keyglyph'>[</span><span class='hs-layout'>(</span><span class='hs-varid'>on</span><span class='hs-layout'>,</span> <span class='hs-varid'>on</span> <span class='hs-keyglyph'>-></span> <span class='hs-varid'>on</span><span class='hs-layout'>)</span><span class='hs-keyglyph'>]</span>
<a name="line-157"></a><span class='hs-definition'>contexts</span> <span class='hs-varid'>x</span> <span class='hs-keyglyph'>=</span> <span class='hs-layout'>(</span><span class='hs-varid'>x</span><span class='hs-layout'>,</span><span class='hs-varid'>id</span><span class='hs-layout'>)</span> <span class='hs-conop'>:</span> <span class='hs-varid'>f</span> <span class='hs-layout'>(</span><span class='hs-varid'>holes</span> <span class='hs-varid'>x</span><span class='hs-layout'>)</span>
<a name="line-158"></a> <span class='hs-keyword'>where</span>
<a name="line-159"></a> <span class='hs-varid'>f</span> <span class='hs-varid'>xs</span> <span class='hs-keyglyph'>=</span> <span class='hs-keyglyph'>[</span> <span class='hs-layout'>(</span><span class='hs-varid'>y</span><span class='hs-layout'>,</span> <span class='hs-varid'>ctx</span> <span class='hs-varop'>.</span> <span class='hs-varid'>context</span><span class='hs-layout'>)</span>
<a name="line-160"></a> <span class='hs-keyglyph'>|</span> <span class='hs-layout'>(</span><span class='hs-varid'>child</span><span class='hs-layout'>,</span> <span class='hs-varid'>ctx</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'><-</span> <span class='hs-varid'>xs</span>
<a name="line-161"></a> <span class='hs-layout'>,</span> <span class='hs-layout'>(</span><span class='hs-varid'>y</span><span class='hs-layout'>,</span> <span class='hs-varid'>context</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'><-</span> <span class='hs-varid'>contexts</span> <span class='hs-varid'>child</span><span class='hs-keyglyph'>]</span>
<a name="line-162"></a>
<a name="line-163"></a>
<a name="line-164"></a><a name="holes"></a><span class='hs-comment'>-- | The one depth version of 'contexts'</span>
<a name="line-165"></a><span class='hs-comment'>--</span>
<a name="line-166"></a><span class='hs-comment'>-- > propChildren x = children x == map fst (holes x)</span>
<a name="line-167"></a><span class='hs-comment'>-- > propId x = all (== x) [b a | (a,b) <- holes x]</span>
<a name="line-168"></a><span class='hs-definition'>holes</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>Uniplate</span> <span class='hs-varid'>on</span> <span class='hs-keyglyph'>=></span> <span class='hs-varid'>on</span> <span class='hs-keyglyph'>-></span> <span class='hs-keyglyph'>[</span><span class='hs-layout'>(</span><span class='hs-varid'>on</span><span class='hs-layout'>,</span> <span class='hs-varid'>on</span> <span class='hs-keyglyph'>-></span> <span class='hs-varid'>on</span><span class='hs-layout'>)</span><span class='hs-keyglyph'>]</span>
<a name="line-169"></a><span class='hs-definition'>holes</span> <span class='hs-varid'>x</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>uncurry</span> <span class='hs-varid'>f</span> <span class='hs-layout'>(</span><span class='hs-varid'>uniplate</span> <span class='hs-varid'>x</span><span class='hs-layout'>)</span>
<a name="line-170"></a> <span class='hs-keyword'>where</span> <span class='hs-varid'>f</span> <span class='hs-conid'>Zero</span> <span class='hs-keyword'>_</span> <span class='hs-keyglyph'>=</span> <span class='hs-conid'>[]</span>
<a name="line-171"></a> <span class='hs-varid'>f</span> <span class='hs-layout'>(</span><span class='hs-conid'>One</span> <span class='hs-varid'>i</span><span class='hs-layout'>)</span> <span class='hs-varid'>generate</span> <span class='hs-keyglyph'>=</span> <span class='hs-keyglyph'>[</span><span class='hs-layout'>(</span><span class='hs-varid'>i</span><span class='hs-layout'>,</span> <span class='hs-varid'>generate</span> <span class='hs-varop'>.</span> <span class='hs-conid'>One</span><span class='hs-layout'>)</span><span class='hs-keyglyph'>]</span>
<a name="line-172"></a> <span class='hs-varid'>f</span> <span class='hs-layout'>(</span><span class='hs-conid'>Two</span> <span class='hs-varid'>l</span> <span class='hs-varid'>r</span><span class='hs-layout'>)</span> <span class='hs-varid'>gen</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>f</span> <span class='hs-varid'>l</span> <span class='hs-layout'>(</span><span class='hs-varid'>gen</span> <span class='hs-varop'>.</span> <span class='hs-layout'>(</span><span class='hs-keyglyph'>\</span><span class='hs-varid'>i</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>Two</span> <span class='hs-varid'>i</span> <span class='hs-varid'>r</span><span class='hs-layout'>)</span><span class='hs-layout'>)</span>
<a name="line-173"></a> <span class='hs-varop'>++</span> <span class='hs-varid'>f</span> <span class='hs-varid'>r</span> <span class='hs-layout'>(</span><span class='hs-varid'>gen</span> <span class='hs-varop'>.</span> <span class='hs-layout'>(</span><span class='hs-keyglyph'>\</span><span class='hs-varid'>i</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>Two</span> <span class='hs-varid'>l</span> <span class='hs-varid'>i</span><span class='hs-layout'>)</span><span class='hs-layout'>)</span>
<a name="line-174"></a>
<a name="line-175"></a><a name="para"></a><span class='hs-comment'>-- | Perform a fold-like computation on each value,</span>
<a name="line-176"></a><span class='hs-comment'>-- technically a paramorphism</span>
<a name="line-177"></a><span class='hs-definition'>para</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>Uniplate</span> <span class='hs-varid'>on</span> <span class='hs-keyglyph'>=></span> <span class='hs-layout'>(</span><span class='hs-varid'>on</span> <span class='hs-keyglyph'>-></span> <span class='hs-keyglyph'>[</span><span class='hs-varid'>r</span><span class='hs-keyglyph'>]</span> <span class='hs-keyglyph'>-></span> <span class='hs-varid'>r</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>-></span> <span class='hs-varid'>on</span> <span class='hs-keyglyph'>-></span> <span class='hs-varid'>r</span>
<a name="line-178"></a><span class='hs-definition'>para</span> <span class='hs-varid'>op</span> <span class='hs-varid'>x</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>op</span> <span class='hs-varid'>x</span> <span class='hs-varop'>$</span> <span class='hs-varid'>map</span> <span class='hs-layout'>(</span><span class='hs-varid'>para</span> <span class='hs-varid'>op</span><span class='hs-layout'>)</span> <span class='hs-varop'>$</span> <span class='hs-varid'>children</span> <span class='hs-varid'>x</span>
</pre></body>
</html>
