Fix type synonym comments

src-literatetests/10-tests.blt

@@ -983,7 +983,6 @@ type a :+: b = (a, b)
 type (a `Foo` b) c = (a, b, c)
 
 #test synonym-comments
-#pending
 
 type Foo a -- fancy type comment
   = -- strange comment

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

@@ -63,6 +63,7 @@ module Language.Haskell.Brittany.Internal.LayouterBasics
   , docSharedWrapper
   , hasAnyCommentsBelow
   , hasAnyCommentsConnected
+  , hasAnyCommentsPrior
   , hasAnnKeywordComment
   , hasAnnKeyword
   )
@@ -297,13 +298,16 @@ hasAnyCommentsConnected ast = do
     $ Map.elems
     $ anns
 
+hasAnyCommentsPrior :: Data ast => GHC.Located ast -> ToBriDocM Bool
+hasAnyCommentsPrior ast = astAnn ast <&> \case
+  Nothing -> False
+  Just (ExactPrint.Types.Ann _ priors _ _ _ _) -> not $ null priors
+
 hasAnnKeywordComment
   :: Data ast => GHC.Located ast -> AnnKeywordId -> ToBriDocM Bool
-hasAnnKeywordComment ast annKeyword = do
+hasAnnKeywordComment ast annKeyword = astAnn ast <&> \case
-  anns <- mAsk
+  Nothing  -> False
-  pure $ case Map.lookup (ExactPrint.Types.mkAnnKey ast) anns of
+  Just ann -> any hasK (extractAllComments ann)
-    Nothing  -> False
-    Just ann -> any hasK (extractAllComments ann)
   where hasK = (== Just annKeyword) . ExactPrint.Types.commentOrigin . fst
 
 hasAnnKeyword
@@ -311,13 +315,18 @@ hasAnnKeyword
   => Located a
   -> AnnKeywordId
   -> m Bool
-hasAnnKeyword ast annKeyword = do
+hasAnnKeyword ast annKeyword = astAnn ast <&> \case
-  anns <- mAsk
+  Nothing -> False
-  let hasK (ExactPrint.Types.G x, _) = x == annKeyword
+  Just (ExactPrint.Types.Ann _ _ _ aks _ _) -> any hasK aks
-      hasK _                         = False
+ where
-  pure $ case Map.lookup (ExactPrint.Types.mkAnnKey ast) anns of
+  hasK (ExactPrint.Types.G x, _) = x == annKeyword
-    Nothing -> False
+  hasK _                         = False
-    Just (ExactPrint.Types.Ann _ _ _ aks _ _) -> any hasK aks
+
+astAnn
+  :: (Data ast, MonadMultiReader (Map AnnKey Annotation) m)
+  => GHC.Located ast
+  -> m (Maybe Annotation)
+astAnn ast = Map.lookup (ExactPrint.Types.mkAnnKey ast) <$> mAsk
 
 -- new BriDoc stuff
 

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

@@ -633,12 +633,13 @@ layoutTyCl ltycl@(L _loc tycl) = case tycl of
           Just (c, _) -> not (c == '(' || isUpper c)
     isInfix <- (isInfixTypeOp ||) <$> hasAnnKeyword name AnnBackquote
 #endif
-    hasTrailingParen <- hasAnnKeywordComment ltycl AnnCloseP
+    -- hasTrailingParen <- hasAnnKeywordComment ltycl AnnCloseP
-    let parenWrapper = if hasTrailingParen
+    -- let parenWrapper = if hasTrailingParen
-          then appSep . docWrapNodeRest ltycl
+    --       then appSep . docWrapNodeRest ltycl
-          else id
+    --       else id
+    let wrapNodeRest = docWrapNodeRest ltycl
     docWrapNodePrior ltycl
-      $ layoutSynDecl isInfix parenWrapper name (hsq_explicit vars) typ
+      $ layoutSynDecl isInfix wrapNodeRest name (hsq_explicit vars) typ
   _ -> briDocByExactNoComment ltycl
 
 layoutSynDecl
@@ -648,17 +649,16 @@ layoutSynDecl
   -> [LHsTyVarBndr GhcPs]
   -> LHsType GhcPs
   -> ToBriDocM BriDocNumbered
-layoutSynDecl isInfix parenWrapper name vars typ = do
+layoutSynDecl isInfix wrapNodeRest name vars typ = do
   nameStr <- lrdrNameToTextAnn name
   let
-    lhs = if isInfix
+    lhs = appSep . wrapNodeRest $ if isInfix
       then do
-        let
+        let (a : b : rest) = vars
-          (a : b : rest) = vars
         hasOwnParens <- hasAnnKeywordComment a AnnOpenP
-          -- This isn't quite right, but does give syntactically valid results
+        -- This isn't quite right, but does give syntactically valid results
         let needsParens = not $ null rest || hasOwnParens
-        parenWrapper . docSeq
+        docSeq
           $  [ appSep $ docLit $ Text.pack "type"
              , appSep
              .  docSeq
@@ -672,18 +672,21 @@ layoutSynDecl isInfix parenWrapper name vars typ = do
           ++ fmap (appSep . layoutTyVarBndr) rest
       else
         docSeq
-        $  [appSep $ docLit $ Text.pack "type", appSep $ docLit nameStr]
+        $  [ appSep $ docLit $ Text.pack "type"
+           , appSep $ docWrapNode name $ docLit nameStr
+           ]
         ++ fmap (appSep . layoutTyVarBndr) vars
-  typeDoc <- docSharedWrapper layoutType typ
+  typeDoc     <- docSharedWrapper layoutType typ
+  hasComments <- hasAnyCommentsConnected typ
   docAlt
-    [ docSeq [lhs, appSep $ docLit $ Text.pack "=", docForceSingleline typeDoc]
+    $  [ docSeq
-    , docAddBaseY BrIndentRegular $ docPar
+           [lhs, appSep $ docLit $ Text.pack "=", docForceSingleline typeDoc]
-      lhs
+       | not hasComments
-      (docCols
+       ]
-        ColTyOpPrefix
+    ++ [ docAddBaseY BrIndentRegular $ docPar
-        [docLit $ Text.pack "= ", docAddBaseY (BrIndentSpecial 2) typeDoc]
+          lhs
-      )
+          (docCols ColTyOpPrefix [appSep $ docLit $ Text.pack "=", typeDoc])
-    ]
+       ]
 
 layoutTyVarBndr :: ToBriDoc HsTyVarBndr
 layoutTyVarBndr lbndr@(L _ bndr) = do