author Thomas Miedema Wed, 5 Aug 2015 09:31:21 +0000 (11:31 +0200) committer Thomas Miedema Wed, 12 Aug 2015 09:19:14 +0000 (11:19 +0200)
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)"

index 99566d3..d07bd3d 100644 (file)
@@ -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