From 64850ca4f7dc2ca0fdb21d078d93cd636de5c87a Mon Sep 17 00:00:00 2001
From: Niklas Haas <git@nand.wakku.to>
Date: Sun, 23 Feb 2014 15:37:13 +0100
Subject: Lower precedence of equality constraints

This drops them to the new precedence pREC_CTX, which makes single
eqaulity constraints show up as (a ~ b) => ty, in line with GHC's
rendering. Additional tests added to make sure other type operators
render as intended. Current behavior matches GHC
---
 html-test/ref/TypeOperators.html   | 110 +++++++++++++++++--------------------
 html-test/src/TypeOperators.hs     |  25 ++++++---
 src/Haddock/Backends/Xhtml/Decl.hs |   2 +-
 3 files changed, 67 insertions(+), 70 deletions(-)

diff --git a/html-test/ref/TypeOperators.html b/html-test/ref/TypeOperators.html
index fa02b57e..eb9c3e9f 100644
--- a/html-test/ref/TypeOperators.html
+++ b/html-test/ref/TypeOperators.html
@@ -41,63 +41,9 @@ window.onload = function () {pageLoad();setSynopsis("mini_TypeOperators.html");}
 	><p class="caption"
 	>TypeOperators</p
 	></div
-      ><div id="table-of-contents"
-      ><p class="caption"
-	>Contents</p
-	><ul
-	><li
-	  ><a href=""
-	    >stuff</a
-	    ></li
-	  ></ul
-	></div
-      ><div id="synopsis"
-      ><p id="control.syn" class="caption expander" onclick="toggleSection('syn')"
-	>Synopsis</p
-	><ul id="section.syn" class="hide" onclick="toggleSection('syn')"
-	><li class="src short"
-	  ><span class="keyword"
-	    >data</span
-	    > a <a href=""
-	    >:-:</a
-	    > b</li
-	  ><li class="src short"
-	  ><span class="keyword"
-	    >data</span
-	    > (a <a href=""
-	    >:+:</a
-	    > b) c</li
-	  ><li class="src short"
-	  ><span class="keyword"
-	    >data</span
-	    > <a href=""
-	    >Op</a
-	    > a b</li
-	  ><li class="src short"
-	  ><span class="keyword"
-	    >newtype</span
-	    > <a href=""
-	    >O</a
-	    > g f a = <a href=""
-	    >O</a
-	    > {<ul class="subs"
-	    ><li
-	      ><a href=""
-		>unO</a
-		> :: g (f a)</li
-	      ></ul
-	    >}</li
-	  ><li class="src short"
-	  ><a href=""
-	    >biO</a
-	    > ::  (g `<a href=""
-	    >O</a
-	    >` f) a</li
-	  ></ul
-	></div
       ><div id="interface"
-      ><h1 id="g:1"
-	>stuff</h1
+      ><h1
+	>Documentation</h1
 	><div class="top"
 	><p class="src"
 	  ><span class="keyword"
@@ -163,18 +109,62 @@ window.onload = function () {pageLoad();setSynopsis("mini_TypeOperators.html");}
 	    ></div
 	  ></div
 	><div class="top"
+	><p class="src"
+	  ><span class="keyword"
+	    >class</span
+	    > a <a name="t:-60--61--62-" class="def"
+	    >&lt;=&gt;</a
+	    > b</p
+	  ></div
+	><div class="top"
 	><p class="src"
 	  ><a name="v:biO" class="def"
 	    >biO</a
-	    > ::  (g `<a href=""
-	    >O</a
-	    >` f) a</p
+	    > ::  (g <a href="TypeOperators.html#t:O"
+	    >`O`</a
+	    > f) a</p
+	  ></div
+	><div class="top"
+	><p class="src"
+	  ><a name="v:f" class="def"
+	    >f</a
+	    > :: (a ~ b) =&gt; a -&gt; b</p
+	  ></div
+	><div class="top"
+	><p class="src"
+	  ><a name="v:g" class="def"
+	    >g</a
+	    > :: (a ~ b, b ~ c) =&gt; a -&gt; c</p
+	  ></div
+	><div class="top"
+	><p class="src"
+	  ><a name="v:x" class="def"
+	    >x</a
+	    > :: (a <a href="TypeOperators.html#t::-45-:"
+	    >:-:</a
+	    > a) <a href="TypeOperators.html#t:-60--61--62-"
+	    >&lt;=&gt;</a
+	    > (a <a href="TypeOperators.html#t:Op"
+	    >`Op`</a
+	    > a) =&gt; a</p
+	  ></div
+	><div class="top"
+	><p class="src"
+	  ><a name="v:y" class="def"
+	    >y</a
+	    > :: (a <a href="TypeOperators.html#t:-60--61--62-"
+	    >&lt;=&gt;</a
+	    > a, (a <a href="TypeOperators.html#t:Op"
+	    >`Op`</a
+	    > a) <a href="TypeOperators.html#t:-60--61--62-"
+	    >&lt;=&gt;</a
+	    > a) =&gt; a</p
 	  ></div
 	></div
       ></div
     ><div id="footer"
     ><p
-      >Produced by <a href=""
+      >Produced by <a href="http://www.haskell.org/haddock/"
 	>Haddock</a
 	> version 2.14.0</p
       ></div
diff --git a/html-test/src/TypeOperators.hs b/html-test/src/TypeOperators.hs
index edbb9344..e69e89cb 100644
--- a/html-test/src/TypeOperators.hs
+++ b/html-test/src/TypeOperators.hs
@@ -1,12 +1,5 @@
-{-# LANGUAGE TypeOperators #-}
-module TypeOperators (
-  -- * stuff
-  (:-:),
-  (:+:),
-  Op,
-  O(..),
-  biO,
-) where
+{-# LANGUAGE TypeOperators, GADTs, MultiParamTypeClasses, FlexibleContexts #-}
+module TypeOperators where
 
 data a :-: b
 
@@ -16,5 +9,19 @@ data a `Op` b
 
 newtype (g `O` f) a = O { unO :: g (f a) }
 
+class a <=> b
+
 biO :: (g `O` f) a
 biO = undefined
+
+f :: (a ~ b) => a -> b
+f = id
+
+g :: (a ~ b, b ~ c) => a -> c
+g = id
+
+x :: ((a :-: a) <=> (a `Op` a)) => a
+x = undefined
+
+y :: (a <=> a, (a `Op` a) <=> a) => a
+y = undefined
diff --git a/src/Haddock/Backends/Xhtml/Decl.hs b/src/Haddock/Backends/Xhtml/Decl.hs
index 427d5670..2ecde081 100644
--- a/src/Haddock/Backends/Xhtml/Decl.hs
+++ b/src/Haddock/Backends/Xhtml/Decl.hs
@@ -750,7 +750,7 @@ ppr_mono_ty _         (HsExplicitTupleTy _ tys) u q = quote $ parenList $ map (p
 ppr_mono_ty _         (HsWrapTy {})       _ _ = error "ppr_mono_ty HsWrapTy"
 
 ppr_mono_ty ctxt_prec (HsEqTy ty1 ty2) unicode qual
-  = maybeParen ctxt_prec pREC_OP $
+  = maybeParen ctxt_prec pREC_CTX $
     ppr_mono_lty pREC_OP ty1 unicode qual <+> char '~' <+> ppr_mono_lty pREC_OP ty2 unicode qual
 
 ppr_mono_ty ctxt_prec (HsAppTy fun_ty arg_ty) unicode qual
-- 
cgit v1.2.3