Fix list comprehension comment placement issue

src-unittests/IdentityTests.hs

@@ -639,3 +639,12 @@ regressionTests = do
             utargets''              = "foo"
         return ()
       |]
+  it "list comprehension comment placement" $ do
+    roundTripEqual $
+      [text|
+      func =
+        [ (thing, take 10 alts) --TODO: select best ones
+        | (thing, _got, alts@(_:_)) <- nosuchFooThing
+        , gast                      <- award
+        ]
+      |]

src/Language/Haskell/Brittany/LayoutBasics.hs

@@ -43,6 +43,7 @@ module Language.Haskell.Brittany.LayoutBasics
   , docEmpty
   , docLit
   , docAlt
+  , docAltFilter
   , docLines
   , docCols
   , docSeq
@@ -910,6 +911,9 @@ docExt x anns shouldAddComment = allocateNode $ BDFExternal
 docAlt :: [ToBriDocM BriDocNumbered] -> ToBriDocM BriDocNumbered
 docAlt l = allocateNode . BDFAlt =<< sequence l
 
+docAltFilter :: [(Bool, ToBriDocM BriDocNumbered)] -> ToBriDocM BriDocNumbered
+docAltFilter = docAlt . map snd . filter fst
+
 
 docSeq :: [ToBriDocM BriDocNumbered] -> ToBriDocM BriDocNumbered
 docSeq l = allocateNode . BDFSeq =<< sequence l

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

@@ -424,18 +424,31 @@ layoutExpr lexpr@(L _ expr) = docWrapNode lexpr $ case expr of
                                     ; MonadComp -> True
                                     ; _ -> False } -> do
     stmtDocs <- docSharedWrapper layoutStmt `mapM` stmts
-    docAlt
+    hasComments <- hasAnyCommentsBelow lexpr
-      [ docSeq
+    docAltFilter
-        [ appSep $ docLit $ Text.pack "["
+      [ (,) (not hasComments)
-        , appSep $ docForceSingleline $ List.last stmtDocs
+      $ docSeq
+        [ docNodeAnnKW lexpr Nothing
+        $ appSep
+        $ docLit
+        $ Text.pack "["
+        , docNodeAnnKW lexpr (Just AnnOpenS)
+        $ appSep
+        $ docForceSingleline
+        $ List.last stmtDocs
         , appSep $ docLit $ Text.pack "|"
         , docSeq $ List.intersperse docCommaSep
                 $ fmap docForceSingleline $ List.init stmtDocs
         , docLit $ Text.pack " ]"
         ]
-      , let
+      , (,) True
+      $ let
           start = docCols ColListComp
-                    [appSep $ docLit $ Text.pack "[", List.last stmtDocs]
+                    [ docNodeAnnKW lexpr Nothing
+                    $ appSep $ docLit $ Text.pack "["
+                    , docNodeAnnKW lexpr (Just AnnOpenS)
+                    $ List.last stmtDocs
+                    ]
           (s1:sM) = List.init stmtDocs
           line1 = docCols ColListComp
                     [appSep $ docLit $ Text.pack "|", s1]