From b517eef71e992eccfbe061746e8197ccc1fb4b83 Mon Sep 17 00:00:00 2001
From: Taylor Fausak <taylor@fausak.me>
Date: Sat, 6 Nov 2021 16:46:24 +0000
Subject: [PATCH] Fix handling of type families

---
 src-literatetests/10-tests.blt            | 91 +++++++++++++++++++++++
 src/Language/Haskell/Brittany/Internal.hs | 11 ++-
 2 files changed, 100 insertions(+), 2 deletions(-)

diff --git a/src-literatetests/10-tests.blt b/src-literatetests/10-tests.blt
index 806dd47..aa3c7cb 100644
--- a/src-literatetests/10-tests.blt
+++ b/src-literatetests/10-tests.blt
@@ -1551,6 +1551,97 @@ instance Foo Int where
     { unBarInt :: Int
     }
 
+###############################################################################
+###############################################################################
+###############################################################################
+#group gh-357
+###############################################################################
+###############################################################################
+###############################################################################
+
+#test type-instance-without-comment
+
+{-# language TypeFamilies #-}
+type family F a
+type instance F Int = IO Int
+
+#test type-instance-with-comment
+
+{-# language TypeFamilies #-}
+type family F a
+type instance F Int = IO Int -- x
+
+#test newtype-instance-without-comment
+
+{-# language TypeFamilies #-}
+data family F a
+newtype instance F Int = N Int
+
+#test newtype-instance-with-comment
+
+{-# language TypeFamilies #-}
+data family F a
+newtype instance F Int = N Int -- x
+
+#test data-instance-without-comment
+
+{-# language TypeFamilies #-}
+data family F a
+data instance F Int = D Int
+
+#test data-instance-with-comment
+
+{-# language TypeFamilies #-}
+data family F a
+data instance F Int = D Int -- x
+
+#test instance-type-without-comment
+
+{-# language TypeFamilies #-}
+class C a where
+  type family F a
+instance C Int where
+  type F Int = IO Int
+
+#test instance-type-with-comment
+
+{-# language TypeFamilies #-}
+class C a where
+  type family F a
+instance C Int where
+  type F Int = IO Int -- x
+
+#test instance-newtype-without-comment
+
+{-# language TypeFamilies #-}
+class C a where
+  data family F a
+instance C Int where
+  newtype F Int = N Int
+
+#test instance-newtype-with-comment
+
+{-# language TypeFamilies #-}
+class C a where
+  data family F a
+instance C Int where
+  newtype F Int = N Int -- x
+
+#test instance-data-without-comment
+
+{-# language TypeFamilies #-}
+class C a where
+  data family F a
+instance C Int where
+  data F Int = D Int
+
+#test instance-data-with-comment
+
+{-# language TypeFamilies #-}
+class C a where
+  data family F a
+instance C Int where
+  data F Int = D Int -- x
 
 ###############################################################################
 ###############################################################################
diff --git a/src/Language/Haskell/Brittany/Internal.hs b/src/Language/Haskell/Brittany/Internal.hs
index 7aa6127..c084c83 100644
--- a/src/Language/Haskell/Brittany/Internal.hs
+++ b/src/Language/Haskell/Brittany/Internal.hs
@@ -397,7 +397,7 @@ parsePrintModuleTests conf filename input = do
         then return $ pPrintModule moduleConf perItemConf anns parsedModule
         else lift
           $ pPrintModuleAndCheck moduleConf perItemConf anns parsedModule
-      if null errs
+      if null $ filter (not . isErrorUnusedComment) errs
         then pure $ TextL.toStrict $ ltext
         else
           let
@@ -410,6 +410,10 @@ parsePrintModuleTests conf filename input = do
               ErrorOutputCheck       -> "Output is not syntactically valid."
           in  throwE $ "pretty printing error(s):\n" ++ List.unlines errStrs
 
+isErrorUnusedComment :: BrittanyError -> Bool
+isErrorUnusedComment x = case x of
+  ErrorUnusedComment _ -> True
+  _ -> False
 
 -- this approach would for if there was a pure GHC.parseDynamicFilePragma.
 -- Unfortunately that does not exist yet, so we cannot provide a nominally
@@ -454,6 +458,7 @@ toLocal conf anns m = do
 
 ppModule :: GenLocated SrcSpan HsModule -> PPM ()
 ppModule lmod@(L _loc _m@(HsModule _ _name _exports _ decls _ _)) = do
+  let annKey = ExactPrint.mkAnnKey lmod
   post <- ppPreamble lmod
   decls `forM_` \decl -> do
     let declAnnKey       = ExactPrint.mkAnnKey decl
@@ -463,7 +468,9 @@ ppModule lmod@(L _loc _m@(HsModule _ _name _exports _ decls _ _)) = do
     let mBindingConfs =
           declBindingNames <&> \n -> Map.lookup n $ _icd_perBinding inlineConf
     filteredAnns <- mAsk
-      <&> \annMap -> Map.findWithDefault Map.empty declAnnKey annMap
+      <&> \annMap ->
+        Map.union (Map.findWithDefault Map.empty annKey annMap) $
+        Map.findWithDefault Map.empty declAnnKey annMap
 
     traceIfDumpConf "bridoc annotations filtered/transformed"
                     _dconf_dump_annotations