title: Simplifying a GADT with Uniplate
body: <p>I'm trying to answer <a href="https://stackoverflow.com/questions/25311781/reusing-patterns-in-pattern-guards-or-case-expressions#comment39456277_25311781">this stackoverflow question, using <code>uniplate</code> as I suggested</a>, but <a href="https://gist.github.com/rampion/44deb2f2ca9e2b53f2b8" rel="nofollow noreferrer">the only solution I've come up with so far</a> is pretty ugly.</p>
  
  <p>This seems like a fairly common issue, so I wanted to know if there was a more elegant solution.</p>
  
  <p>Basically, we've got a GADT which resolves to either <code>Expression Int</code> or <code>Expression Bool</code> (ignoring <code>codataIf = If (B True) codataIf codataIf</code>):</p>
  
  <pre><code>data Expression a where
      I :: Int -&gt; Expression Int
      B :: Bool -&gt; Expression Bool
      Add :: Expression Int  -&gt; Expression Int  -&gt; Expression Int
      Mul :: Expression Int  -&gt; Expression Int  -&gt; Expression Int
      Eq  :: Expression Int  -&gt; Expression Int  -&gt; Expression Bool
      And :: Expression Bool -&gt; Expression Bool -&gt; Expression Bool
      Or  :: Expression Bool -&gt; Expression Bool -&gt; Expression Bool
      If  :: Expression Bool -&gt; Expression a    -&gt; Expression a -&gt; Expression a
  </code></pre>
  
  <p>And (in my version of the problem) we want to be able to evaluate the expression tree from the bottom-up using a simple operation to combine leaves into a new leaf:</p>
  
  <pre><code>step :: Expression a -&gt; Expression a
  step = \case
    Add (I x) (I y)   -&gt; I $ x + y
    Mul (I x) (I y)   -&gt; I $ x * y
    Eq (I x) (I y)    -&gt; B $ x == y
    And (B x) (B y)   -&gt; B $ x &amp;&amp; y
    Or (B x) (B y)    -&gt; B $ x || y
    If (B b) x y      -&gt; if b then x else y
    z                 -&gt; z
  </code></pre>
  
  <p>I had some difficulty using <code>DataDeriving</code> to derive <code>Uniplate</code> and <code>Biplate</code> instances (which maybe should have been a red flag), so 
  I rolled my own <code>Uniplate</code> instances for <code>Expression Int</code>, <code>Expression Bool</code>, and <code>Biplate</code> instances for <code>(Expression a) (Expression a)</code>, <code>(Expression Int) (Expression Bool)</code>, and <code>(Expression Bool) (Expression Int)</code>.</p>
  
  <p>This let me come up with these bottom-up traversals:</p>
  
  <pre><code>evalInt :: Expression Int -&gt; Expression Int
  evalInt = transform step
  
  evalIntBi :: Expression Bool -&gt; Expression Bool
  evalIntBi = transformBi (step :: Expression Int -&gt; Expression Int)
  
  evalBool :: Expression Bool -&gt; Expression Bool
  evalBool = transform step
  
  evalBoolBi :: Expression Int -&gt; Expression Int
  evalBoolBi = transformBi (step :: Expression Bool -&gt; Expression Bool)
  </code></pre>
  
  <p>But since each of these can only do one transformation (combine <code>Int</code> leaves or <code>Bool</code> leaves, but not either), they can't do the complete simplification, but must be chained together manually:</p>
  
  <pre><code>λ example1
  If (Eq (I 0) (Add (I 0) (I 0))) (I 1) (I 2)
  λ evalInt it
  If (Eq (I 0) (I 0)) (I 1) (I 2)
  λ evalBoolBi it
  If (B True) (I 1) (I 2)
  λ evalInt it
  I 1
  λ example2
  If (Eq (I 0) (Add (I 0) (I 0))) (B True) (B False)
  λ evalIntBi it
  If (Eq (I 0) (I 0)) (B True) (B False)
  λ evalBool it
  B True
  </code></pre>
  
  <p>My hackish workaround was to define a <code>Uniplate</code> instance for <code>Either (Expression Int) (Expression Bool)</code>:</p>
  
  <pre><code>type  WExp = Either (Expression Int) (Expression Bool)
  
  instance Uniplate WExp where
    uniplate = \case
        Left (Add x y)    -&gt; plate (i2 Left Add)  |* Left x  |* Left y
        Left (Mul x y)    -&gt; plate (i2 Left Mul)  |* Left x  |* Left y
        Left (If b x y)   -&gt; plate (bi2 Left If)  |* Right b |* Left x  |* Left y
        Right (Eq x y)    -&gt; plate (i2 Right Eq)  |* Left x  |* Left y
        Right (And x y)   -&gt; plate (b2 Right And) |* Right x |* Right y
        Right (Or x y)    -&gt; plate (b2 Right Or)  |* Right x |* Right y
        Right (If b x y)  -&gt; plate (b3 Right If)  |* Right b |* Right x |* Right y
        e                 -&gt; plate e
      where i2 side op (Left x) (Left y) = side (op x y)
            i2 _ _ _ _ = error "type mismatch"
            b2 side op (Right x) (Right y) = side (op x y)
            b2 _ _ _ _ = error "type mismatch"
            bi2 side op (Right x) (Left y) (Left z) = side (op x y z)
            bi2 _ _ _ _ _ = error "type mismatch"
            b3 side op (Right x) (Right y) (Right z) = side (op x y z)
            b3 _ _ _ _ _ = error "type mismatch"
  
  evalWExp :: WExp -&gt; WExp
  evalWExp = transform (either (Left . step) (Right . step))
  </code></pre>
  
  <p>Now I can do the complete simplification:</p>
  
  <pre><code>λ evalWExp . Left $ example1
  Left (I 1)
  λ evalWExp . Right $ example2
  Right (B True)
  </code></pre>
  
  <p>But the amount of <code>error</code> and wrapping/unwrapping I had to do to make this work just makes this feel inelegant and wrong to me.</p>
  
  <p>Is there a <em>right</em> way to solve this problem <strong>with <code>uniplate</code></strong>?</p>