From 8d52d87d7244faad8ad8b4da16ff74209e6d647c Mon Sep 17 00:00:00 2001
From: "gabriele.lana" <gabriele.lana@gmail.com>
Date: Sat, 20 Jul 2019 13:32:01 +0200
Subject: [PATCH] Preserve operators promotion (single quote)

Fixes #222
---
 .../type/infix-promoted-type-constructor-out.hs      |  4 ++--
 src/Ormolu/Printer/Meat/Common.hs                    | 12 +++++++++---
 2 files changed, 11 insertions(+), 5 deletions(-)

diff --git a/data/examples/declaration/signature/type/infix-promoted-type-constructor-out.hs b/data/examples/declaration/signature/type/infix-promoted-type-constructor-out.hs
index f490ae0..a8f4216 100644
--- a/data/examples/declaration/signature/type/infix-promoted-type-constructor-out.hs
+++ b/data/examples/declaration/signature/type/infix-promoted-type-constructor-out.hs
@@ -1,3 +1,3 @@
-fun1 :: Def ('[Ref s (Stored Uint32), IBool] T.:-> IBool)
+fun1 :: Def ('[Ref s (Stored Uint32), IBool] 'T.:-> IBool)
 
-fun2 :: Def ('[Ref s (Stored Uint32), IBool] :-> IBool)
+fun2 :: Def ('[Ref s (Stored Uint32), IBool] ':-> IBool)
diff --git a/src/Ormolu/Printer/Meat/Common.hs b/src/Ormolu/Printer/Meat/Common.hs
index 63fb871..067a612 100644
--- a/src/Ormolu/Printer/Meat/Common.hs
+++ b/src/Ormolu/Printer/Meat/Common.hs
@@ -49,7 +49,6 @@ p_ieWrappedName = \case
 p_rdrName :: Located RdrName -> R ()
 p_rdrName l@(L spn _) = located l $ \x -> do
   ids <- getAnns spn
-  -- NOTE Right now we're mainly interested in backticks and parentheses.
   let backticksWrapper =
         if AnnBackquote `elem` ids
           then backticks
@@ -58,6 +57,12 @@ p_rdrName l@(L spn _) = located l $ \x -> do
         if AnnOpenP `elem` ids
           then parens
           else id
+      singleQuoteWrapper =
+        if AnnSimpleQuote `elem` ids
+          then \y -> do
+             txt "'"
+             y
+        else id
       (m, avoidParens) =
         case x of
           Unqual occName ->
@@ -80,9 +85,10 @@ p_rdrName l@(L spn _) = located l $ \x -> do
             ( atom name
             , "$ghc-prim$GHC.Tuple$" `isPrefixOf` nameStableString name
             )
+      m' = backticksWrapper (singleQuoteWrapper m)
   if avoidParens
-    then m
-    else parensWrapper (backticksWrapper m)
+    then m'
+    else parensWrapper m'
 
 p_qualName :: ModuleName -> OccName -> R ()
 p_qualName mname occName = do