From a3b501051a2662658ef1ae690ff7a354129f8174 Mon Sep 17 00:00:00 2001
From: Lennart Spitzner <hexagoxel@hexagoxel.de>
Date: Sun, 23 Feb 2020 23:33:03 +0100
Subject: [PATCH] Add proper multiline layout for type-level-lists

---
 src-literatetests/15-regressions.blt          | 26 +++++++++++
 .../Brittany/Internal/Layouters/Type.hs       | 44 ++++++++++++++++++-
 2 files changed, 68 insertions(+), 2 deletions(-)

diff --git a/src-literatetests/15-regressions.blt b/src-literatetests/15-regressions.blt
index 3ae2892..dbab5b7 100644
--- a/src-literatetests/15-regressions.blt
+++ b/src-literatetests/15-regressions.blt
@@ -834,3 +834,29 @@ module Main
   , name
   )
 where
+
+#test type level list
+
+xeoeqibIaib
+  :: ( KqujhIsaus m
+     , XivuvIpoboi Droqifim m
+     , IgorvOtowtf m
+     , RyagaYaqac m
+     , QouruDU m
+     )
+  => MaptAdfuxgu
+  -> Zcnxg NsxayqmvIjsezea -- ^ if Lvqucoo, opsip jl reyoyhk lfil qaculxgd
+  -> QNOZqwuzg
+  -> Eoattuq
+       '[ XkatytdWdquraosu -- test comment
+        , KyezKijim        -- another test comment
+        , DjmioeePuoeg
+        , NinrxoiOwezc
+        , QATAlrijacpk
+        , TrutvotwIwifiqOjdtu
+        , CoMmuatjwr
+        , BoZckzqyodseZole
+        , VagfwoXaeChfqe
+        ]
+       m
+       ()
diff --git a/src/Language/Haskell/Brittany/Internal/Layouters/Type.hs b/src/Language/Haskell/Brittany/Internal/Layouters/Type.hs
index bf5a956..940eac7 100644
--- a/src/Language/Haskell/Brittany/Internal/Layouters/Type.hs
+++ b/src/Language/Haskell/Brittany/Internal/Layouters/Type.hs
@@ -14,6 +14,10 @@ where
 import           Language.Haskell.Brittany.Internal.Config.Types
 import           Language.Haskell.Brittany.Internal.Types
 import           Language.Haskell.Brittany.Internal.LayouterBasics
+import           Language.Haskell.Brittany.Internal.Utils
+                                                ( splitFirstLast
+                                                , FirstLastView(..)
+                                                )
 
 import           GHC ( runGhc
                      , GenLocated(L)
@@ -693,12 +697,48 @@ layoutType ltype@(L _ typ) = docWrapNode ltype $ case typ of
   HsExplicitListTy _ typs -> do
 #endif
     typDocs <- docSharedWrapper layoutType `mapM` typs
+    hasComments <- hasAnyCommentsBelow ltype
+    let specialCommaSep = appSep $ docLit $ Text.pack " ,"
     docAlt
       [ docSeq
       $  [docLit $ Text.pack "'["]
-      ++ List.intersperse docCommaSep typDocs
+      ++ List.intersperse specialCommaSep (docForceSingleline <$> typDocs)
       ++ [docLit $ Text.pack "]"]
-      -- TODO
+      , case splitFirstLast typDocs of
+        FirstLastEmpty -> docSeq
+          [ docLit $ Text.pack "'["
+          , docNodeAnnKW ltype (Just AnnOpenS) $ docLit $ Text.pack "]"
+          ]
+        FirstLastSingleton e -> docAlt
+          [ docSeq
+            [ docLit $ Text.pack "'["
+            , docNodeAnnKW ltype (Just AnnOpenS) $ docForceSingleline e
+            , docLit $ Text.pack "]"
+            ]
+          , docSetBaseY $ docLines
+            [ docSeq
+              [ docLit $ Text.pack "'["
+              , docSeparator
+              , docSetBaseY $ docNodeAnnKW ltype (Just AnnOpenS) e
+              ]
+            , docLit $ Text.pack " ]"
+            ]
+          ]
+        FirstLast e1 ems eN -> runFilteredAlternative $ do
+          addAlternativeCond (not hasComments)
+            $  docSeq
+            $  [docLit $ Text.pack "'["]
+            ++ List.intersperse specialCommaSep (docForceSingleline <$> (e1:ems ++ [docNodeAnnKW ltype (Just AnnOpenS) eN]))
+            ++ [docLit $ Text.pack " ]"]
+          addAlternative $
+            let
+              start = docCols ColList
+                        [appSep $ docLit $ Text.pack "'[", e1]
+              linesM = ems <&> \d ->
+                      docCols ColList [specialCommaSep, d]
+              lineN = docCols ColList [specialCommaSep, docNodeAnnKW ltype (Just AnnOpenS) eN]
+              end   = docLit $ Text.pack " ]"
+            in docSetBaseY $ docLines $ [start] ++ linesM ++ [lineN] ++ [end]
       ]
   HsExplicitTupleTy{} -> -- TODO
     briDocByExactInlineOnly "HsExplicitTupleTy{}" ltype