Deal with parens inside comments on 8.4.3

src/Language/Haskell/Brittany/Internal/Backend.hs

@@ -19,6 +19,8 @@ import qualified Language.Haskell.GHC.ExactPrint.Annotate as ExactPrint.Annotate
 import qualified Language.Haskell.GHC.ExactPrint.Types as ExactPrint.Types
 import           Language.Haskell.GHC.ExactPrint.Types ( AnnKey, Annotation )
 
+import GHC ( AnnKeywordId (..) )
+
 import           Language.Haskell.Brittany.Internal.LayouterBasics
 import           Language.Haskell.Brittany.Internal.BackendUtils
 import           Language.Haskell.Brittany.Internal.Utils
@@ -173,6 +175,8 @@ layoutBriDocM = \case
                       -- evil hack for CPP:
                       case comment of
                         ('#':_) -> layoutMoveToCommentPos y (-999)
+                        "("     -> pure ()
+                        ")"     -> layoutMoveToCommentPosX (x - 1)
                         _       -> layoutMoveToCommentPos y x
                       -- fixedX <- fixMoveToLineByIsNewline x
                       -- replicateM_ fixedX layoutWriteNewline
@@ -244,6 +248,7 @@ layoutBriDocM = \case
       -- evil hack for CPP:
             case comment of
               ('#':_) -> layoutMoveToCommentPos y (-999)
+              ")"     -> layoutMoveToCommentPosX (x - 1)
               _       -> layoutMoveToCommentPos y x
             -- fixedX <- fixMoveToLineByIsNewline x
             -- replicateM_ fixedX layoutWriteNewline

src/Language/Haskell/Brittany/Internal/BackendUtils.hs

@@ -26,6 +26,7 @@ module Language.Haskell.Brittany.Internal.BackendUtils
   , layoutAddSepSpace
   , layoutSetCommentCol
   , layoutMoveToCommentPos
+  , layoutMoveToCommentPosX
   , layoutIndentRestorePostComment
   , moveToExactAnn
   , ppmMoveToExactLoc
@@ -200,6 +201,17 @@ layoutMoveToCommentPos y x = do
         Right{} -> lstate_baseY state
     }
 
+layoutMoveToCommentPosX
+  :: ( MonadMultiWriter Text.Builder.Builder m
+     , MonadMultiState LayoutState m
+     , MonadMultiWriter (Seq String) m
+     )
+  => Int
+  -> m ()
+layoutMoveToCommentPosX x = do
+  traceLocal ("layoutMoveToCommentPosX", x)
+  state <- mGet
+  mSet state { _lstate_addSepSpace = Just $ _lstate_indLevelLinger state + x }
 
 -- | does _not_ add spaces to again reach the current base column.
 layoutWriteNewline

src/Language/Haskell/Brittany/Internal/LayouterBasics.hs

@@ -63,6 +63,7 @@ module Language.Haskell.Brittany.Internal.LayouterBasics
   , docSharedWrapper
   , hasAnyCommentsBelow
   , hasAnyCommentsConnected
+  , hasAnnKeywordComment
   , hasAnnKeyword
   )
 where
@@ -296,6 +297,15 @@ hasAnyCommentsConnected ast = do
     $ Map.elems
     $ anns
 
+hasAnnKeywordComment
+  :: Data ast => GHC.Located ast -> AnnKeywordId -> ToBriDocM Bool
+hasAnnKeywordComment ast annKeyword = do
+  anns <- mAsk
+  pure $ case Map.lookup (ExactPrint.Types.mkAnnKey ast) anns of
+    Nothing  -> False
+    Just ann -> any hasK (extractAllComments ann)
+  where hasK = (== Just annKeyword) . ExactPrint.Types.commentOrigin . fst
+
 hasAnnKeyword
   :: (Data a, MonadMultiReader (Map AnnKey Annotation) m)
   => Located a

src/Language/Haskell/Brittany/Internal/Layouters/Decl.hs

@@ -633,34 +633,41 @@ layoutTyCl ltycl@(L _loc tycl) = case tycl of
           Just (c, _) -> not (c == '(' || isUpper c)
     isInfix <- (isInfixTypeOp ||) <$> hasAnnKeyword name AnnBackquote
 #endif
-    docWrapNode ltycl $ layoutSynDecl isInfix name (hsq_explicit vars) typ
+    hasTrailingParen <- hasAnnKeywordComment ltycl AnnCloseP
+    let parenWrapper = if hasTrailingParen
+          then appSep . docWrapNodeRest ltycl
+          else id
+    docWrapNodePrior ltycl
+      $ layoutSynDecl isInfix parenWrapper name (hsq_explicit vars) typ
   _ -> briDocByExactNoComment ltycl
 
 layoutSynDecl
   :: Bool
+  -> (ToBriDocM BriDocNumbered -> ToBriDocM BriDocNumbered)
   -> Located (IdP GhcPs)
   -> [LHsTyVarBndr GhcPs]
   -> LHsType GhcPs
   -> ToBriDocM BriDocNumbered
-layoutSynDecl isInfix name vars typ = do
+layoutSynDecl isInfix parenWrapper name vars typ = do
   nameStr <- lrdrNameToTextAnn name
   let
     lhs = if isInfix
       then do
         let
           (a : b : rest) = vars
+        hasOwnParens <- hasAnnKeywordComment a AnnOpenP
           -- This isn't quite right, but does give syntactically valid results
-          hasParens = not $ null rest
+        let needsParens = not $ null rest || hasOwnParens
-        docSeq
+        parenWrapper . docSeq
           $  [ appSep $ docLit $ Text.pack "type"
              , appSep
              .  docSeq
-             $  [ docParenL | hasParens ]
+             $  [ docParenL | needsParens ]
              ++ [ appSep $ layoutTyVarBndr a
                 , appSep $ docLit nameStr
                 , layoutTyVarBndr b
                 ]
-             ++ [ docParenR | hasParens ]
+             ++ [ docParenR | needsParens ]
              ]
           ++ fmap (appSep . layoutTyVarBndr) rest
       else
@@ -679,19 +686,22 @@ layoutSynDecl isInfix name vars typ = do
     ]
 
 layoutTyVarBndr :: ToBriDoc HsTyVarBndr
-layoutTyVarBndr (L _ bndr) = case bndr of
+layoutTyVarBndr lbndr@(L _ bndr) = do
-  UserTyVar name -> do
+  needsPriorSpace <- hasAnnKeywordComment lbndr AnnCloseP
-    nameStr <- lrdrNameToTextAnn name
+  docWrapNodePrior lbndr $ case bndr of
-    docLit nameStr
+    UserTyVar name -> do
-  KindedTyVar name kind -> do
+      nameStr <- lrdrNameToTextAnn name
-    nameStr <- lrdrNameToTextAnn name
+      docSeq $ [ docSeparator | needsPriorSpace ] ++ [docLit nameStr]
-    docSeq
+    KindedTyVar name kind -> do
-      [ docLit $ Text.pack "("
+      nameStr <- lrdrNameToTextAnn name
-      , appSep $ docLit nameStr
+      docSeq
-      , appSep . docLit $ Text.pack "::"
+        $  [ docSeparator | needsPriorSpace ]
-      , docForceSingleline $ layoutType kind
+        ++ [ docLit $ Text.pack "("
-      , docLit $ Text.pack ")"
+           , appSep $ docLit nameStr
-      ]
+           , appSep . docLit $ Text.pack "::"
+           , docForceSingleline $ layoutType kind
+           , docLit $ Text.pack ")"
+           ]
 
 
 --------------------------------------------------------------------------------