aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorNiklas Haas <git@nand.wakku.to>2014-02-23 15:37:13 +0100
committerNiklas Haas <git@nand.wakku.to>2014-02-23 15:37:13 +0100
commit64850ca4f7dc2ca0fdb21d078d93cd636de5c87a (patch)
tree294c6f3115b29620ed7b4cd9bf3b5a5f93a5c289
parent14531f7838c5abd0ba2aaf5217a477194d7b1897 (diff)
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
-rw-r--r--html-test/ref/TypeOperators.html110
-rw-r--r--html-test/src/TypeOperators.hs25
-rw-r--r--src/Haddock/Backends/Xhtml/Decl.hs2
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"
@@ -164,17 +110,61 @@ window.onload = function () {pageLoad();setSynopsis("mini_TypeOperators.html");}
></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