Use Semigroup's (<>) for Doc/SDocwip/semigroup-sdoc

Before this patch, Outputable.hs defined its own (<>) which caused
conflicts with (Data.Semigroup.<>) and thus led to inconvenience.

However, replacing it is not trivial due to a different fixity:

  http://www.haskell.org/pipermail/libraries/2011-November/017066.html

Nevertheless, it is possible to update the pretty-printing code to work
with (<>) of a different fixitiy, and that's what this patch implements.

Now Doc and SDoc are instances of Semigroup.

3 files changed, 18 insertions, 22 deletions

diff --git a/compiler/utils/GhcPrelude.hs b/compiler/utils/GhcPrelude.hs
index dd78f15573..fa028b2d56 100644
--- a/compiler/utils/GhcPrelude.hs
+++ b/compiler/utils/GhcPrelude.hs
@@ -12,11 +12,7 @@
 
 module GhcPrelude (module X) where
 
--- We export the 'Semigroup' class but w/o the (<>) operator to avoid
--- clashing with the (Outputable.<>) operator which is heavily used
--- through GHC's code-base.
-
-import Prelude as X hiding ((<>))
+import Prelude as X
 import Data.Foldable as X (foldl')
 
 {-
diff --git a/compiler/utils/Outputable.hs b/compiler/utils/Outputable.hs
index d36faa4724..a65dda8f75 100644
--- a/compiler/utils/Outputable.hs
+++ b/compiler/utils/Outputable.hs
@@ -700,12 +700,14 @@ unicode unicode plain = sdocOption sdocCanUseUnicode $ \case
    True  -> unicode
    False -> plain
 
+infixr 6 <+>  -- matches that of (Semigroup.<>)
+infixl 5 $$, $+$
+
 nest :: Int -> SDoc -> SDoc
 -- ^ Indent 'SDoc' some specified amount
-(<>) :: SDoc -> SDoc -> SDoc
--- ^ Join two 'SDoc' together horizontally without a gap
 (<+>) :: SDoc -> SDoc -> SDoc
--- ^ Join two 'SDoc' together horizontally with a gap between them
+-- ^ Join two 'SDoc' together horizontally with a gap between them.
+-- Use '(<>)' to join without a gap.
 ($$) :: SDoc -> SDoc -> SDoc
 -- ^ Join two 'SDoc' together vertically; if there is
 -- no vertical overlap it "dovetails" the two onto one line
@@ -713,11 +715,14 @@ nest :: Int -> SDoc -> SDoc
 -- ^ Join two 'SDoc' together vertically
 
 nest n d    = SDoc $ Pretty.nest n . runSDoc d
-(<>) d1 d2  = SDoc $ \sty -> (Pretty.<>)  (runSDoc d1 sty) (runSDoc d2 sty)
 (<+>) d1 d2 = SDoc $ \sty -> (Pretty.<+>) (runSDoc d1 sty) (runSDoc d2 sty)
 ($$) d1 d2  = SDoc $ \sty -> (Pretty.$$)  (runSDoc d1 sty) (runSDoc d2 sty)
 ($+$) d1 d2 = SDoc $ \sty -> (Pretty.$+$) (runSDoc d1 sty) (runSDoc d2 sty)
 
+-- | Join two 'SDoc' together horizontally without a gap
+instance Semigroup SDoc where
+  d1 <> d2 = SDoc $ \sty -> runSDoc d1 sty <> runSDoc d2 sty
+
 hcat :: [SDoc] -> SDoc
 -- ^ Concatenate 'SDoc' horizontally
 hsep :: [SDoc] -> SDoc
@@ -790,8 +795,8 @@ coloured col sdoc = sdocOption sdocShouldUseColor $ \case
       ctx@SDC{ sdocLastColour = lastCol, sdocStyle = PprUser _ _ Coloured } ->
          let ctx' = ctx{ sdocLastColour = lastCol `mappend` col } in
          Pretty.zeroWidthText (Col.renderColour col)
-           Pretty.<> runSDoc sdoc ctx'
-           Pretty.<> Pretty.zeroWidthText (Col.renderColourAfresh lastCol)
+           <> runSDoc sdoc ctx'
+           <> Pretty.zeroWidthText (Col.renderColourAfresh lastCol)
       ctx -> runSDoc sdoc ctx
    False -> sdoc
 
@@ -1179,9 +1184,9 @@ speakNOf n d = speakN n <+> d <> char 's'               -- E.g. "three arguments
 -- > plural [] = char 's'
 -- > plural ["Hello"] = empty
 -- > plural ["Hello", "World"] = char 's'
-plural :: [a] -> SDoc
-plural [_] = empty  -- a bit frightening, but there you are
-plural _   = char 's'
+plural :: String -> [a] -> SDoc
+plural s [_] = text s  -- a bit frightening, but there you are
+plural s _   = text (s ++ "s")
 
 -- | Determines the form of to be appropriate for the length of a list:
 --
diff --git a/compiler/utils/Pretty.hs b/compiler/utils/Pretty.hs
index 5adfdd7699..6e8686a62d 100644
--- a/compiler/utils/Pretty.hs
+++ b/compiler/utils/Pretty.hs
@@ -201,8 +201,7 @@ But it doesn't work, for if x=empty, we would have
 -- ---------------------------------------------------------------------------
 -- Operator fixity
 
-infixl 6 <>
-infixl 6 <+>
+infixr 6 <+>  -- matches that of (Semigroup.<>)
 infixl 5 $$, $+$
 
 
@@ -659,14 +658,10 @@ nilAboveNest g k q           | not g && k > 0      -- No newline if no overlap
 -- ---------------------------------------------------------------------------
 -- Horizontal composition @<>@
 
--- We intentionally avoid Data.Monoid.(<>) here due to interactions of
--- Data.Monoid.(<>) and (<+>).  See
--- http://www.haskell.org/pipermail/libraries/2011-November/017066.html
-
 -- | Beside.
 -- '<>' is associative, with identity 'empty'.
-(<>) :: Doc -> Doc -> Doc
-p <>  q = beside_ p False q
+instance Semigroup Doc where
+  p <> q = beside_ p False q
 
 -- | Beside, separated by space, unless one of the arguments is 'empty'.
 -- '<+>' is associative, with identity 'empty'.