From 77d6d5b553720102f05b3977f89566f2c5c1960b Mon Sep 17 00:00:00 2001
From: Lennart Spitzner <hexagoxel@hexagoxel.de>
Date: Wed, 27 Nov 2019 22:21:16 +0100
Subject: [PATCH] Fix roundtripping of (~) constraint/type

---
 src-literatetests/15-regressions.blt          |  6 +++++
 .../Brittany/Internal/LayouterBasics.hs       | 23 ++++++++++++-------
 .../Brittany/Internal/Layouters/Type.hs       |  4 ++--
 3 files changed, 23 insertions(+), 10 deletions(-)

diff --git a/src-literatetests/15-regressions.blt b/src-literatetests/15-regressions.blt
index 761dfb5..8942d3f 100644
--- a/src-literatetests/15-regressions.blt
+++ b/src-literatetests/15-regressions.blt
@@ -684,3 +684,9 @@ d = \(~x) -> x
 #test type signature with forall and constraint
 {-# LANGUAGE RankNTypes #-}
 func :: forall b . Show b => b -> String
+
+#test issue 267
+
+{-# LANGUAGE TypeFamilies #-}
+f :: ((~) a b) => a -> b
+f = id
diff --git a/src/Language/Haskell/Brittany/Internal/LayouterBasics.hs b/src/Language/Haskell/Brittany/Internal/LayouterBasics.hs
index 701339c..cd5764d 100644
--- a/src/Language/Haskell/Brittany/Internal/LayouterBasics.hs
+++ b/src/Language/Haskell/Brittany/Internal/LayouterBasics.hs
@@ -206,13 +206,14 @@ rdrNameToText (Exact name) = Text.pack $ getOccString name
 lrdrNameToText :: GenLocated l RdrName -> Text
 lrdrNameToText (L _ n) = rdrNameToText n
 
-lrdrNameToTextAnn
+lrdrNameToTextAnnGen
   :: (MonadMultiReader Config m, MonadMultiReader (Map AnnKey Annotation) m)
-  => Located RdrName
+  => (Text -> Text)
+  -> Located RdrName
   -> m Text
-lrdrNameToTextAnn ast@(L _ n) = do
+lrdrNameToTextAnnGen f ast@(L _ n) = do
   anns <- mAsk
-  let t = rdrNameToText n
+  let t = f $ rdrNameToText n
   let hasUni x (ExactPrint.Types.G y, _) = x == y
       hasUni _ _                         = False
   -- TODO: in general: we should _always_ process all annotaiton stuff here.
@@ -228,15 +229,21 @@ lrdrNameToTextAnn ast@(L _ n) = do
       _ | any (hasUni AnnOpenP) aks      -> Text.pack "(" <> t <> Text.pack ")"
       _ | otherwise                      -> t
 
+lrdrNameToTextAnn
+  :: (MonadMultiReader Config m, MonadMultiReader (Map AnnKey Annotation) m)
+  => Located RdrName
+  -> m Text
+lrdrNameToTextAnn = lrdrNameToTextAnnGen id
+
 lrdrNameToTextAnnTypeEqualityIsSpecial
   :: (MonadMultiReader Config m, MonadMultiReader (Map AnnKey Annotation) m)
   => Located RdrName
   -> m Text
 lrdrNameToTextAnnTypeEqualityIsSpecial ast = do
-  x <- lrdrNameToTextAnn ast
-  return $ if x == Text.pack "Data.Type.Equality~"
-    then Text.pack "~" -- rraaaahhh special casing rraaahhhhhh
-    else x
+  let f x = if x == Text.pack "Data.Type.Equality~"
+        then Text.pack "~" -- rraaaahhh special casing rraaahhhhhh
+        else x
+  lrdrNameToTextAnnGen f ast
 
 -- | Same as lrdrNameToTextAnnTypeEqualityIsSpecial, but also inspects
 -- the annotations for a (parent) node for a tick to be added to the
diff --git a/src/Language/Haskell/Brittany/Internal/Layouters/Type.hs b/src/Language/Haskell/Brittany/Internal/Layouters/Type.hs
index cf9d10c..4902a08 100644
--- a/src/Language/Haskell/Brittany/Internal/Layouters/Type.hs
+++ b/src/Language/Haskell/Brittany/Internal/Layouters/Type.hs
@@ -40,7 +40,7 @@ layoutType ltype@(L _ typ) = docWrapNode ltype $ case typ of
 #else   /* ghc-8.2 ghc-8.4 */
   HsTyVar promoted name -> do
 #endif
-    t <- lrdrNameToTextAnn name
+    t <- lrdrNameToTextAnnTypeEqualityIsSpecial name
     case promoted of
 #if MIN_VERSION_ghc(8,8,0)
       IsPromoted -> docSeq
@@ -54,7 +54,7 @@ layoutType ltype@(L _ typ) = docWrapNode ltype $ case typ of
       NotPromoted -> docWrapNode name $ docLit t
 #else /* ghc-8.0 */
   HsTyVar name -> do
-    t <- lrdrNameToTextAnn name
+    t <- lrdrNameToTextAnnTypeEqualityIsSpecial name
     docWrapNode name $ docLit t
 #endif
 #if MIN_VERSION_ghc(8,6,0)