Merge pull request #914 from harpocrates/feature/unboxed-stuff

Better rendering of unboxed sums, unboxed tuples, promoted tuples.
author: Alec Theriault <alec.theriault@gmail.com> 2018-08-21 22:24:03 -0700
committer: GitHub <noreply@github.com> 2018-08-21 22:24:03 -0700
commit: 6a9ada2426579b72696514b3fd081aacac9c5740 (patch)
tree: c3cbf5c8d7ec9c36fa9e91ccb7b3c5c2bbb7fe87
parent: 9ef12f3c2f0ef2948e6f4bd38fdfa002c416ab09 (diff)
parent: d23dbf3d54bf1c29a9720872f312a370f830b5ae (diff)
10 files changed, 345 insertions, 4 deletions
diff --git a/haddock-api/src/Haddock/Backends/LaTeX.hs b/haddock-api/src/Haddock/Backends/LaTeX.hs
index 4e0e6eba..0c7747bd 100644
--- a/haddock-api/src/Haddock/Backends/LaTeX.hs
+++ b/haddock-api/src/Haddock/Backends/LaTeX.hs
@@ -974,7 +974,7 @@ tupleParens _              = parenList
 
 
 sumParens :: [LaTeX] -> LaTeX
-sumParens = ubxparens . hsep . punctuate (text " | ")
+sumParens = ubxparens . hsep . punctuate (text " |")
 
 
 -------------------------------------------------------------------------------
@@ -1335,7 +1335,7 @@ ubxParenList = ubxparens . hsep . punctuate comma
 
 
 ubxparens :: LaTeX -> LaTeX
-ubxparens h = text "(#" <> h <> text "#)"
+ubxparens h = text "(#" <+> h <+> text "#)"
 
 
 nl :: LaTeX
diff --git a/haddock-api/src/Haddock/Backends/Xhtml/Utils.hs b/haddock-api/src/Haddock/Backends/Xhtml/Utils.hs
index 7fbaec6d..62781fd0 100644
--- a/haddock-api/src/Haddock/Backends/Xhtml/Utils.hs
+++ b/haddock-api/src/Haddock/Backends/Xhtml/Utils.hs
@@ -183,7 +183,7 @@ ubxSumList = ubxparens . hsep . punctuate (toHtml " | ")
 
 
 ubxparens :: Html -> Html
-ubxparens h = toHtml "(#" +++ h +++ toHtml "#)"
+ubxparens h = toHtml "(#" <+> h <+> toHtml "#)"
 
 
 dcolon, arrow, darrow, forallSymbol :: Bool -> Html
diff --git a/haddock-api/src/Haddock/Convert.hs b/haddock-api/src/Haddock/Convert.hs
index 044e1e11..622837fa 100644
--- a/haddock-api/src/Haddock/Convert.hs
+++ b/haddock-api/src/Haddock/Convert.hs
@@ -457,6 +457,11 @@ synifyType _ (TyConApp tc tys)
                               ConstraintTuple -> HsConstraintTuple
                               UnboxedTuple    -> HsUnboxedTuple)
                            (map (synifyType WithinType) vis_tys)
+      | isUnboxedSumTyCon tc = noLoc $ HsSumTy noExt (map (synifyType WithinType) vis_tys)
+      | Just dc <- isPromotedDataCon_maybe tc
+      , isTupleDataCon dc
+      , dataConSourceArity dc == length vis_tys
+      = noLoc $ HsExplicitTupleTy noExt (map (synifyType WithinType) vis_tys)
       -- ditto for lists
       | getName tc == listTyConName, [ty] <- tys =
          noLoc $ HsListTy noExt (synifyType WithinType ty)
diff --git a/hoogle-test/ref/Bug722/test.txt b/hoogle-test/ref/Bug722/test.txt
index 96f3747b..2f44ed8f 100644
--- a/hoogle-test/ref/Bug722/test.txt
+++ b/hoogle-test/ref/Bug722/test.txt
@@ -8,7 +8,7 @@ module Bug722
 class Foo a
 (!@#) :: Foo a => a -> a -> a
 infixl 4 !@#
-type family &* :: * -> * -> *
+type family (&*) :: * -> * -> *
 infixr 3 &*
 data a :-& b
 (:^&) :: a -> b -> (:-&) a b
diff --git a/html-test/ref/UnboxedStuff.html b/html-test/ref/UnboxedStuff.html
new file mode 100644
index 00000000..4c1196b9
--- /dev/null
+++ b/html-test/ref/UnboxedStuff.html
@@ -0,0 +1,196 @@
+<html xmlns="http://www.w3.org/1999/xhtml"
+><head
+  ><meta http-equiv="Content-Type" content="text/html; charset=UTF-8"
+     /><title
+    >UnboxedStuff</title
+    ><link href="#" rel="stylesheet" type="text/css" title="Ocean"
+     /><link rel="stylesheet" type="text/css" href="#"
+     /><script src="haddock-bundle.min.js" async="async" type="text/javascript"
+    ></script
+    ><script src="https://cdnjs.cloudflare.com/ajax/libs/mathjax/2.7.0/MathJax.js?config=TeX-AMS-MML_HTMLorMML" type="text/javascript"
+    ></script
+    ></head
+  ><body
+  ><div id="package-header"
+    ><ul class="links" id="page-menu"
+      ><li
+	><a href="#"
+	  >Contents</a
+	  ></li
+	><li
+	><a href="#"
+	  >Index</a
+	  ></li
+	></ul
+      ><p class="caption empty"
+      ></p
+      ></div
+    ><div id="content"
+    ><div id="module-header"
+      ><table class="info"
+	><tr
+	  ><th
+	    >Safe Haskell</th
+	    ><td
+	    >Safe</td
+	    ></tr
+	  ></table
+	><p class="caption"
+	>UnboxedStuff</p
+	></div
+      ><div id="table-of-contents"
+      ><p class="caption"
+	>Contents</p
+	><ul
+	><li
+	  ><a href="#"
+	    >Unboxed type constructors</a
+	    ></li
+	  ></ul
+	></div
+      ><div id="synopsis"
+      ><details id="syn"
+	><summary
+	  >Synopsis</summary
+	  ><ul class="details-toggle" data-details-id="syn"
+	  ><li class="src short"
+	    ><span class="keyword"
+	      >data</span
+	      > <a href="#"
+	      >X</a
+	      ></li
+	    ><li class="src short"
+	    ><span class="keyword"
+	      >data</span
+	      > <a href="#"
+	      >Y</a
+	      ></li
+	    ><li class="src short"
+	    ><span class="keyword"
+	      >data</span
+	      > <a href="#"
+	      >Z</a
+	      ></li
+	    ><li class="src short"
+	    ><a href="#"
+	      >unboxedUnit</a
+	      > :: (# #) -&gt; (# #)</li
+	    ><li class="src short"
+	    ><a href="#"
+	      >unboxedTuple</a
+	      > :: (# <a href="#" title="UnboxedStuff"
+	      >X</a
+	      >, <a href="#" title="UnboxedStuff"
+	      >Y</a
+	      > #) -&gt; (# <a href="#" title="UnboxedStuff"
+	      >X</a
+	      >, <a href="#" title="UnboxedStuff"
+	      >Y</a
+	      >, <a href="#" title="UnboxedStuff"
+	      >Z</a
+	      > #)</li
+	    ><li class="src short"
+	    ><a href="#"
+	      >unboxedSum</a
+	      > :: (# <a href="#" title="UnboxedStuff"
+	      >X</a
+	      > |  <a href="#" title="UnboxedStuff"
+	      >Y</a
+	      > #) -&gt; (# <a href="#" title="UnboxedStuff"
+	      >X</a
+	      > |  <a href="#" title="UnboxedStuff"
+	      >Y</a
+	      > |  <a href="#" title="UnboxedStuff"
+	      >Z</a
+	      > #)</li
+	    ></ul
+	  ></details
+	></div
+      ><div id="interface"
+      ><h1
+	>Documentation</h1
+	><div class="top"
+	><p class="src"
+	  ><span class="keyword"
+	    >data</span
+	    > <a id="t:X" class="def"
+	    >X</a
+	    > <a href="#" class="selflink"
+	    >#</a
+	    ></p
+	  ></div
+	><div class="top"
+	><p class="src"
+	  ><span class="keyword"
+	    >data</span
+	    > <a id="t:Y" class="def"
+	    >Y</a
+	    > <a href="#" class="selflink"
+	    >#</a
+	    ></p
+	  ></div
+	><div class="top"
+	><p class="src"
+	  ><span class="keyword"
+	    >data</span
+	    > <a id="t:Z" class="def"
+	    >Z</a
+	    > <a href="#" class="selflink"
+	    >#</a
+	    ></p
+	  ></div
+	><a href="#" id="g:1"
+	><h1
+	  >Unboxed type constructors</h1
+	  ></a
+	><div class="top"
+	><p class="src"
+	  ><a id="v:unboxedUnit" class="def"
+	    >unboxedUnit</a
+	    > :: (# #) -&gt; (# #) <a href="#" class="selflink"
+	    >#</a
+	    ></p
+	  ></div
+	><div class="top"
+	><p class="src"
+	  ><a id="v:unboxedTuple" class="def"
+	    >unboxedTuple</a
+	    > :: (# <a href="#" title="UnboxedStuff"
+	    >X</a
+	    >, <a href="#" title="UnboxedStuff"
+	    >Y</a
+	    > #) -&gt; (# <a href="#" title="UnboxedStuff"
+	    >X</a
+	    >, <a href="#" title="UnboxedStuff"
+	    >Y</a
+	    >, <a href="#" title="UnboxedStuff"
+	    >Z</a
+	    > #) <a href="#" class="selflink"
+	    >#</a
+	    ></p
+	  ></div
+	><div class="top"
+	><p class="src"
+	  ><a id="v:unboxedSum" class="def"
+	    >unboxedSum</a
+	    > :: (# <a href="#" title="UnboxedStuff"
+	    >X</a
+	    > |  <a href="#" title="UnboxedStuff"
+	    >Y</a
+	    > #) -&gt; (# <a href="#" title="UnboxedStuff"
+	    >X</a
+	    > |  <a href="#" title="UnboxedStuff"
+	    >Y</a
+	    > |  <a href="#" title="UnboxedStuff"
+	    >Z</a
+	    > #) <a href="#" class="selflink"
+	    >#</a
+	    ></p
+	  ></div
+	></div
+      ></div
+    ><div id="footer"
+    ></div
+    ></body
+  ></html
+>
+\ No newline at end of file
diff --git a/html-test/src/UnboxedStuff.hs b/html-test/src/UnboxedStuff.hs
new file mode 100644
index 00000000..bd1b1302
--- /dev/null
+++ b/html-test/src/UnboxedStuff.hs
@@ -0,0 +1,18 @@
+{-# LANGUAGE UnboxedSums, UnboxedTuples #-}
+module UnboxedStuff where
+
+data X
+data Y
+data Z
+
+-- * Unboxed type constructors
+
+unboxedUnit :: (# #) -> (# #)
+unboxedUnit  = undefined
+
+unboxedTuple :: (# X, Y #) -> (# X, Y, Z #)
+unboxedTuple = undefined 
+
+unboxedSum :: (# X | Y #) -> (# X | Y | Z #)
+unboxedSum = undefined 
+
diff --git a/latex-test/ref/UnboxedStuff/UnboxedStuff.tex b/latex-test/ref/UnboxedStuff/UnboxedStuff.tex
new file mode 100644
index 00000000..36d5c12b
--- /dev/null
+++ b/latex-test/ref/UnboxedStuff/UnboxedStuff.tex
@@ -0,0 +1,36 @@
+\haddockmoduleheading{UnboxedStuff}
+\label{module:UnboxedStuff}
+\haddockbeginheader
+{\haddockverb\begin{verbatim}
+module UnboxedStuff (
+    X,  Y,  Z,  unboxedUnit,  unboxedTuple,  unboxedSum
+  ) where\end{verbatim}}
+\haddockendheader
+
+\begin{haddockdesc}
+\item[\begin{tabular}{@{}l}
+data\ X
+\end{tabular}]
+\end{haddockdesc}
+\begin{haddockdesc}
+\item[\begin{tabular}{@{}l}
+data\ Y
+\end{tabular}]
+\end{haddockdesc}
+\begin{haddockdesc}
+\item[\begin{tabular}{@{}l}
+data\ Z
+\end{tabular}]
+\end{haddockdesc}
+\section{Unboxed type constructors}
+\begin{haddockdesc}
+\item[
+unboxedUnit\ ::\ ({\char '43}\ {\char '43})\ ->\ ({\char '43}\ {\char '43})
+]
+\item[
+unboxedTuple\ ::\ ({\char '43}\ X,\ Y\ {\char '43})\ ->\ ({\char '43}\ X,\ Y,\ Z\ {\char '43})
+]
+\item[
+unboxedSum\ ::\ ({\char '43}\ X\ |\ Y\ {\char '43})\ ->\ ({\char '43}\ X\ |\ Y\ |\ Z\ {\char '43})
+]
+\end{haddockdesc}
+\ No newline at end of file
diff --git a/latex-test/ref/UnboxedStuff/haddock.sty b/latex-test/ref/UnboxedStuff/haddock.sty
new file mode 100644
index 00000000..6e031a98
--- /dev/null
+++ b/latex-test/ref/UnboxedStuff/haddock.sty
@@ -0,0 +1,57 @@
+% Default Haddock style definitions.  To use your own style, invoke
+% Haddock with the option --latex-style=mystyle.
+
+\usepackage{tabulary} % see below
+
+% make hyperlinks in the PDF, and add an expandabale index
+\usepackage[pdftex,bookmarks=true]{hyperref}
+
+\newenvironment{haddocktitle}
+  {\begin{center}\bgroup\large\bfseries}
+  {\egroup\end{center}}
+\newenvironment{haddockprologue}{\vspace{1in}}{}
+
+\newcommand{\haddockmoduleheading}[1]{\chapter{\texttt{#1}}}
+
+\newcommand{\haddockbeginheader}{\hrulefill}
+\newcommand{\haddockendheader}{\noindent\hrulefill}
+
+% a little gap before the ``Methods'' header
+\newcommand{\haddockpremethods}{\vspace{2ex}}
+
+% inserted before \\begin{verbatim}
+\newcommand{\haddockverb}{\small}
+
+% an identifier: add an index entry
+\newcommand{\haddockid}[1]{\haddocktt{#1}\index{#1@\texttt{#1}}}
+
+% The tabulary environment lets us have a column that takes up ``the
+% rest of the space''.  Unfortunately it doesn't allow
+% the \end{tabulary} to be in the expansion of a macro, it must appear
+% literally in the document text, so Haddock inserts
+% the \end{tabulary} itself.
+\newcommand{\haddockbeginconstrs}{\begin{tabulary}{\linewidth}{@{}llJ@{}}}
+\newcommand{\haddockbeginargs}{\begin{tabulary}{\linewidth}{@{}llJ@{}}}
+
+\newcommand{\haddocktt}[1]{{\small \texttt{#1}}}
+\newcommand{\haddockdecltt}[1]{{\small\bfseries \texttt{#1}}}
+
+\makeatletter
+\newenvironment{haddockdesc}
+               {\list{}{\labelwidth\z@ \itemindent-\leftmargin
+                        \let\makelabel\haddocklabel}}
+               {\endlist}
+\newcommand*\haddocklabel[1]{\hspace\labelsep\haddockdecltt{#1}}
+\makeatother
+
+% after a declaration, start a new line for the documentation.
+% Otherwise, the documentation starts right after the declaration,
+% because we're using the list environment and the declaration is the
+% ``label''.  I tried making this newline part of the label, but
+% couldn't get that to work reliably (the space seemed to stretch
+% sometimes).
+\newcommand{\haddockbegindoc}{\hfill\\[1ex]}
+
+% spacing between paragraphs and no \parindent looks better
+\parskip=10pt plus2pt minus2pt
+\setlength{\parindent}{0cm}
diff --git a/latex-test/ref/UnboxedStuff/main.tex b/latex-test/ref/UnboxedStuff/main.tex
new file mode 100644
index 00000000..e34c5f14
--- /dev/null
+++ b/latex-test/ref/UnboxedStuff/main.tex
@@ -0,0 +1,11 @@
+\documentclass{book}
+\usepackage{haddock}
+\begin{document}
+\begin{titlepage}
+\begin{haddocktitle}
+
+\end{haddocktitle}
+\end{titlepage}
+\tableofcontents
+\input{UnboxedStuff}
+\end{document}
+\ No newline at end of file
diff --git a/latex-test/src/UnboxedStuff/UnboxedStuff.hs b/latex-test/src/UnboxedStuff/UnboxedStuff.hs
new file mode 100644
index 00000000..bd1b1302
--- /dev/null
+++ b/latex-test/src/UnboxedStuff/UnboxedStuff.hs
@@ -0,0 +1,18 @@
+{-# LANGUAGE UnboxedSums, UnboxedTuples #-}
+module UnboxedStuff where
+
+data X
+data Y
+data Z
+
+-- * Unboxed type constructors
+
+unboxedUnit :: (# #) -> (# #)
+unboxedUnit  = undefined
+
+unboxedTuple :: (# X, Y #) -> (# X, Y, Z #)
+unboxedTuple = undefined 
+
+unboxedSum :: (# X | Y #) -> (# X | Y | Z #)
+unboxedSum = undefined 
+
author	Alec Theriault <alec.theriault@gmail.com>	2018-08-21 22:24:03 -0700
committer	GitHub <noreply@github.com>	2018-08-21 22:24:03 -0700
commit	6a9ada2426579b72696514b3fd081aacac9c5740 (patch)
tree	c3cbf5c8d7ec9c36fa9e91ccb7b3c5c2bbb7fe87
parent	9ef12f3c2f0ef2948e6f4bd38fdfa002c416ab09 (diff)
parent	d23dbf3d54bf1c29a9720872f312a370f830b5ae (diff)