Fix ExplicitList comment insertion (fixes #18)

src-literatetests/tests.blt

@@ -745,6 +745,12 @@ foo = Reflex.runSpiderHost $ ReflexHost.hostApp $ do
 foldrDesc f z = unSwitchQueue $ \q ->
   switch (Min.foldrDesc (f unTaggedF) z q) (Min.foldrAsc (f unTaggedF) z q)
 
+#test issue 18
+autocheckCases =
+  [ ("Never Deadlocks", representative deadlocksNever)
+  , ("No Exceptions", representative exceptionsNever)
+  , ("Consistent Result", alwaysSame) -- already representative
+  ]
 
 ###############################################################################
 ###############################################################################

src/Language/Haskell/Brittany/Layouters/Expr.hs

@@ -21,6 +21,7 @@ import           Name
 import qualified FastString
 import           BasicTypes
 
+import           Language.Haskell.Brittany.Utils
 import           Language.Haskell.Brittany.Layouters.Pattern
 import           Language.Haskell.Brittany.Layouters.Decl
 import           Language.Haskell.Brittany.Layouters.Stmt
@@ -547,19 +548,40 @@ layoutExpr lexpr@(L _ expr) = docWrapNode lexpr $ case expr of
     unknownNodeError "HsDo{} no comp" lexpr
   ExplicitList _ _ elems@(_:_) -> do
     elemDocs <- elems `forM` docSharedWrapper layoutExpr
-    docAlt
+    case splitFirstLast elemDocs of
-      [ docSeq
+      FirstLastEmpty -> docSeq
-      $  [docLit $ Text.pack "["]
+        [ docLit $ Text.pack "["
-      ++ List.intersperse docCommaSep (docForceSingleline <$> elemDocs)
+        , docNodeAnnKW lexpr (Just AnnOpenS) $ docLit $ Text.pack "]"
-      ++ [docLit $ Text.pack "]"]
+        ]
-      , let
+      FirstLastSingleton e -> docAlt
-          start = docCols ColList
+        [ docSeq
-                    [appSep $ docLit $ Text.pack "[", List.head elemDocs]
+          [ docLit $ Text.pack "["
-          lines = List.tail elemDocs <&> \d ->
+          , docNodeAnnKW lexpr (Just AnnOpenS) $ docForceSingleline e
-                  docCols ColList [docCommaSep, d]
+          , docLit $ Text.pack "]"
-          end   = docLit $ Text.pack "]"
+          ]
-        in docSetBaseY $ docLines $ [start] ++ lines ++ [end]
+        , docSetBaseY $ docLines
-      ]
+          [ docSeq
+            [ docLit $ Text.pack "["
+            , docNodeAnnKW lexpr (Just AnnOpenS) $ docForceSingleline e
+            ]
+          , docLit $ Text.pack "]"
+          ]
+        ]
+      FirstLast e1 ems eN ->
+        docAlt
+          [ docSeq
+          $  [docLit $ Text.pack "["]
+          ++ List.intersperse docCommaSep (docForceSingleline <$> (e1:ems ++ [docNodeAnnKW lexpr (Just AnnOpenS) eN]))
+          ++ [docLit $ Text.pack "]"]
+          , let
+              start = docCols ColList
+                        [appSep $ docLit $ Text.pack "[", e1]
+              linesM = ems <&> \d ->
+                      docCols ColList [docCommaSep, d]
+              lineN = docCols ColList [docCommaSep, docNodeAnnKW lexpr (Just AnnOpenS) eN]
+              end   = docLit $ Text.pack "]"
+            in docSetBaseY $ docLines $ [start] ++ linesM ++ [lineN] ++ [end]
+          ]
   ExplicitList _ _ [] ->
     docLit $ Text.pack "[]"
   ExplicitPArr{} -> do

src/Language/Haskell/Brittany/Utils.hs

@@ -22,6 +22,8 @@ module Language.Haskell.Brittany.Utils
   , spanMaybe
   , transformUp
   , transformDownMay
+  , FirstLastView(..)
+  , splitFirstLast
   )
 where
 
@@ -266,6 +268,16 @@ spanMaybe f (x1:xR) | Just y <- f x1 = (y : ys, xs)
   (ys, xs) = spanMaybe f xR
 spanMaybe _ xs                       = ([], xs)
 
+data FirstLastView a
+  = FirstLastEmpty
+  | FirstLastSingleton a
+  | FirstLast a [a] a
+
+splitFirstLast :: [a] -> FirstLastView a
+splitFirstLast [] = FirstLastEmpty
+splitFirstLast [x] = FirstLastSingleton x
+splitFirstLast (x1:xr) = FirstLast x1 (List.init xr) (List.last xr)
+
 -- TODO: move to uniplate upstream?
 -- aka `transform`
 transformUp :: Uniplate.Uniplate on => (on -> on) -> (on -> on)