From d21ecf89e6c31f34f58f7da514e56d6b8167ef8d Mon Sep 17 00:00:00 2001
From: Lennart Spitzner <hexagoxel@hexagoxel.de>
Date: Wed, 23 Oct 2019 01:32:01 +0200
Subject: [PATCH] Fix a comment bug in tuple-type layouting

---
 src-literatetests/10-tests.blt                |  8 +++++
 .../Brittany/Internal/LayouterBasics.hs       | 35 +++++++++++++------
 .../Brittany/Internal/Layouters/Type.hs       | 15 ++++----
 3 files changed, 42 insertions(+), 16 deletions(-)

diff --git a/src-literatetests/10-tests.blt b/src-literatetests/10-tests.blt
index 59ffedb..78de0ce 100644
--- a/src-literatetests/10-tests.blt
+++ b/src-literatetests/10-tests.blt
@@ -1163,6 +1163,14 @@ type (a :+: b) = (a, b)
 
 type ((a :+: b) c) = (a, c)
 
+#test synonym-tuple-type-many-comments
+
+type Foo
+  = ( -- t1
+     A -- t2
+      , -- t3
+        B -- t4
+         ) -- t5
 
 ###############################################################################
 ###############################################################################
diff --git a/src/Language/Haskell/Brittany/Internal/LayouterBasics.hs b/src/Language/Haskell/Brittany/Internal/LayouterBasics.hs
index cd5764d..d7acf16 100644
--- a/src/Language/Haskell/Brittany/Internal/LayouterBasics.hs
+++ b/src/Language/Haskell/Brittany/Internal/LayouterBasics.hs
@@ -642,18 +642,18 @@ docNodeMoveToKWDP ast kw shouldRestoreIndent bdm =
 class DocWrapable a where
   docWrapNode :: ( Data.Data.Data ast)
               => Located ast
-              -> ToBriDocM a
-              -> ToBriDocM a
+              -> a
+              -> a
   docWrapNodePrior :: ( Data.Data.Data ast)
                    => Located ast
-                   -> ToBriDocM a
-                   -> ToBriDocM a
+                   -> a
+                   -> a
   docWrapNodeRest  :: ( Data.Data.Data ast)
                    => Located ast
-                   -> ToBriDocM a
-                   -> ToBriDocM a
+                   -> a
+                   -> a
 
-instance DocWrapable BriDocNumbered where
+instance DocWrapable (ToBriDocM BriDocNumbered) where
   docWrapNode ast bdm = do
     bd <- bdm
     i1 <- allocNodeIndex
@@ -679,7 +679,22 @@ instance DocWrapable BriDocNumbered where
       $ BDFAnnotationRest (ExactPrint.Types.mkAnnKey ast)
       $ bd
 
-instance DocWrapable a => DocWrapable [a] where
+instance DocWrapable (ToBriDocM a) => DocWrapable [ToBriDocM a] where
+  docWrapNode ast bdms = case bdms of
+    [] -> []
+    [bd] -> [docWrapNode ast bd]
+    (bd1:bdR) | (bdN:bdM) <- reverse bdR ->
+      [docWrapNodePrior ast bd1] ++ reverse bdM ++ [docWrapNodeRest ast bdN]
+    _ -> error "cannot happen (TM)"
+  docWrapNodePrior ast bdms = case bdms of
+    [] -> []
+    [bd] -> [docWrapNodePrior ast bd]
+    (bd1:bdR) -> docWrapNodePrior ast bd1 : bdR
+  docWrapNodeRest ast bdms = case reverse bdms of
+      [] -> []
+      (bdN:bdR) -> reverse $ docWrapNodeRest ast bdN : bdR
+
+instance DocWrapable (ToBriDocM a) => DocWrapable (ToBriDocM [a]) where
   docWrapNode ast bdsm = do
     bds <- bdsm
     case bds of
@@ -707,7 +722,7 @@ instance DocWrapable a => DocWrapable [a] where
         bdN' <- docWrapNodeRest ast (return bdN)
         return $ reverse (bdN':bdR)
 
-instance DocWrapable a => DocWrapable (Seq a) where
+instance DocWrapable (ToBriDocM a) => DocWrapable (ToBriDocM (Seq a)) where
   docWrapNode ast bdsm = do
     bds <- bdsm
     case Seq.viewl bds of
@@ -735,7 +750,7 @@ instance DocWrapable a => DocWrapable (Seq a) where
         bdN' <- docWrapNodeRest ast (return bdN)
         return $ bdR Seq.|> bdN'
 
-instance DocWrapable ([BriDocNumbered], BriDocNumbered, a) where
+instance DocWrapable (ToBriDocM ([BriDocNumbered], BriDocNumbered, a)) where
   docWrapNode ast stuffM = do
     (bds, bd, x) <- stuffM
     if null bds
diff --git a/src/Language/Haskell/Brittany/Internal/Layouters/Type.hs b/src/Language/Haskell/Brittany/Internal/Layouters/Type.hs
index 4902a08..bf5a956 100644
--- a/src/Language/Haskell/Brittany/Internal/Layouters/Type.hs
+++ b/src/Language/Haskell/Brittany/Internal/Layouters/Type.hs
@@ -444,15 +444,17 @@ layoutType ltype@(L _ typ) = docWrapNode ltype $ case typ of
       docs <- docSharedWrapper layoutType `mapM` typs
       let end = docLit $ Text.pack ")"
           lines = List.tail docs <&> \d ->
-                  docCols ColTyOpPrefix [docCommaSep, d]
+            docAddBaseY (BrIndentSpecial 2)
+              $ docCols ColTyOpPrefix [docCommaSep, d]
+          commaDocs = List.intersperse docCommaSep (docForceSingleline <$> docs)
       docAlt
         [ docSeq $ [docLit $ Text.pack "("]
-               ++ List.intersperse docCommaSep (docForceSingleline <$> docs)
+               ++ docWrapNodeRest ltype commaDocs
                ++ [end]
         , let line1 = docCols ColTyOpPrefix [docParenLSep, head docs]
           in docPar
             (docAddBaseY (BrIndentSpecial 2) $ line1)
-            (docLines $ (docAddBaseY (BrIndentSpecial 2) <$> lines) ++ [end])
+            (docLines $ docWrapNodeRest ltype lines ++ [end])
         ]
     unboxedL = do
       docs <- docSharedWrapper layoutType `mapM` typs
@@ -460,15 +462,16 @@ layoutType ltype@(L _ typ) = docWrapNode ltype $ case typ of
           end   = docParenHashRSep
       docAlt
         [ docSeq $ [start]
-                ++ List.intersperse docCommaSep docs
+                ++ docWrapNodeRest ltype (List.intersperse docCommaSep docs)
                 ++ [end]
         , let
             line1 = docCols ColTyOpPrefix [start, head docs]
             lines  = List.tail docs <&> \d ->
-                     docCols ColTyOpPrefix [docCommaSep, d]
+              docAddBaseY (BrIndentSpecial 2)
+                $ docCols ColTyOpPrefix [docCommaSep, d]
           in docPar
             (docAddBaseY (BrIndentSpecial 2) line1)
-            (docLines $ (docAddBaseY (BrIndentSpecial 2) <$> lines) ++ [end])
+            (docLines $ lines ++ [end])
         ]
   HsOpTy{} -> -- TODO
     briDocByExactInlineOnly "HsOpTy{}" ltype