Fix a newtype instance is wrongly converted to a data one (#839)

* Add a test Co-authored-by: Jake McArthur <[email protected]> * Pass the test * Add a changelog * Format * Fix * Fix --------- Co-authored-by: Jake McArthur <[email protected]>
mihaimaruseac · Mar 12, 2024 · 02e0fb8 · 02e0fb8
1 parent 4bf514d
commit 02e0fb8
Show file tree

Hide file tree

Showing 3 changed files with 30 additions and 4 deletions.
diff --git a/CHANGELOG.md b/CHANGELOG.md
@@ -16,6 +16,7 @@
 - Fix the bug of panicking when the given source code has CPP lines and space-prefixed lines ([#780]).
 - Fix not pretty-printing multiple signatures in a `SPECIALISE` ([#784]).
 - Fix the bug of not pretty-printing multiple module-level warning messages ([#822])
+- Fix the bug of wrongly converting a `newtype` instance to a `data` one ([#839])
 
 ### Removed
 
@@ -371,6 +372,7 @@ This version is accidentally pushlished, and is the same as 5.3.3.
 [@uhbif19]: https://github.com/uhbif19
 [@toku-sa-n]: https://github.com/toku-sa-n
 
+[#839]: https://github.com/mihaimaruseac/hindent/pull/839
 [#829]: https://github.com/mihaimaruseac/hindent/pull/829
 [#822]: https://github.com/mihaimaruseac/hindent/pull/822
 [#784]: https://github.com/mihaimaruseac/hindent/pull/784

diff --git a/TESTS.md b/TESTS.md
@@ -583,6 +583,15 @@ instance GM 'Practice where
     }
 ```
 
+With associated newtypes
+
+```haskell
+-- https://github.com/mihaimaruseac/hindent/issues/837
+instance Foo a where
+  newtype Bar a =
+    FooBar a
+```
+
 #### With overlapping pragmas
 
 `OVERLAPPING`

diff --git a/src/HIndent/Pretty.hs b/src/HIndent/Pretty.hs
@@ -1896,16 +1896,31 @@ instance Pretty (FamEqn GhcPs (GenLocated SrcSpanAnnA (HsType GhcPs))) where
 -- | Pretty-print a data instance.
 instance Pretty (FamEqn GhcPs (HsDataDefn GhcPs)) where
   pretty' = pretty' . FamEqnTopLevel
-
+#if MIN_VERSION_ghc_lib_parser(9, 6, 1)
 instance Pretty FamEqn' where
   pretty' FamEqn' {famEqn = FamEqn {..}, ..} = do
     spaced $ string prefix : pretty feqn_tycon : fmap pretty feqn_pats
     pretty feqn_rhs
     where
       prefix =
-        case famEqnFor of
-          DataFamInstDeclForTopLevel -> "data instance"
-          DataFamInstDeclForInsideClassInst -> "data"
+        case (famEqnFor, dd_cons feqn_rhs) of
+          (DataFamInstDeclForTopLevel, NewTypeCon {}) -> "newtype instance"
+          (DataFamInstDeclForTopLevel, DataTypeCons {}) -> "data instance"
+          (DataFamInstDeclForInsideClassInst, NewTypeCon {}) -> "newtype"
+          (DataFamInstDeclForInsideClassInst, DataTypeCons {}) -> "data"
+#else
+instance Pretty FamEqn' where
+  pretty' FamEqn' {famEqn = FamEqn {..}, ..} = do
+    spaced $ string prefix : pretty feqn_tycon : fmap pretty feqn_pats
+    pretty feqn_rhs
+    where
+      prefix =
+        case (famEqnFor, dd_ND feqn_rhs) of
+          (DataFamInstDeclForTopLevel, NewType) -> "newtype instance"
+          (DataFamInstDeclForTopLevel, DataType) -> "data instance"
+          (DataFamInstDeclForInsideClassInst, NewType) -> "newtype"
+          (DataFamInstDeclForInsideClassInst, DataType) -> "data"
+#endif
 -- | HsArg (LHsType GhcPs) (LHsType GhcPs)
 #if MIN_VERSION_ghc_lib_parser(9,8,1)
 instance Pretty