From 5d57087e314bd484dbe14958f9b422be3ac6641a Mon Sep 17 00:00:00 2001
From: Thomas Miedema <thomasmiedema@gmail.com>
Date: Wed, 5 Aug 2015 11:31:21 +0200
Subject: Pretty: fix a broken invariant (#10735)

This is a backport of a bug fix from
6cfbd0444981c074bae10a3cf72733bcb8597bef in libraries/pretty:

    Fix a broken invariant
    Patch from #694,  for the problem "empty is an identity for <> and $$" is
    currently broken by eg. isEmpty (empty<>empty)"
---
 compiler/utils/Pretty.hs | 18 ++++++++++++++----
 1 file changed, 14 insertions(+), 4 deletions(-)

diff --git a/compiler/utils/Pretty.hs b/compiler/utils/Pretty.hs
index 99566d36ea..d07bd3d433 100644
--- a/compiler/utils/Pretty.hs
+++ b/compiler/utils/Pretty.hs
@@ -623,12 +623,17 @@ union_ = Union
 -- * @(x '$$' y) '<>' z = x '$$' (y '<>' z)@, if @y@ non-empty.
 --
 ($$) :: Doc -> Doc -> Doc
-p $$  q = Above p False q
+p $$  q = above_ p False q
 
 -- | Above, with no overlapping.
 -- '$+$' is associative, with identity 'empty'.
 ($+$) :: Doc -> Doc -> Doc
-p $+$ q = Above p True q
+p $+$ q = above_ p True q
+
+above_ :: Doc -> Bool -> Doc -> Doc
+above_ p _ Empty = p
+above_ Empty _ q = q
+above_ p g q     = Above p g q
 
 above :: Doc -> Bool -> RDoc -> RDoc
 above (Above p g1 q1)  g2 q2 = above p g1 (above q1 g2 q2)
@@ -679,12 +684,17 @@ nilAboveNest g k q           | not g && k > 0      -- No newline if no overlap
 -- | Beside.
 -- '<>' is associative, with identity 'empty'.
 (<>) :: Doc -> Doc -> Doc
-p <>  q = Beside p False q
+p <>  q = beside_ p False q
 
 -- | Beside, separated by space, unless one of the arguments is 'empty'.
 -- '<+>' is associative, with identity 'empty'.
 (<+>) :: Doc -> Doc -> Doc
-p <+> q = Beside p True  q
+p <+> q = beside_ p True  q
+
+beside_ :: Doc -> Bool -> Doc -> Doc
+beside_ p _ Empty = p
+beside_ Empty _ q = q
+beside_ p g q     = Beside p g q
 
 -- Specification: beside g p q = p <g> q
 beside :: Doc -> Bool -> RDoc -> RDoc
-- 
cgit v1.2.1