Fix not pretty-printing typeclass constraints with records

CHANGELOG.md

@@ -18,6 +18,7 @@
 - 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])
 - Fix the bug of not pretty-printing multiple functional dependencies in a typeclass ([#843])
+- Fix the bug of not pretty-printing data declarations with records and typeclass constraints ([#849])
 
 ### Removed
 
@@ -373,6 +374,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
 
+[#849]: https://github.com/mihaimaruseac/hindent/pull/849
 [#843]: https://github.com/mihaimaruseac/hindent/pull/843
 [#839]: https://github.com/mihaimaruseac/hindent/pull/839
 [#829]: https://github.com/mihaimaruseac/hindent/pull/829

TESTS.md

@@ -824,10 +824,8 @@ data Foo = Foo
 Single
 
 ```haskell
--- https://github.com/mihaimaruseac/hindent/issues/278
-data Link c1 c2 a c =
-  forall b. (c1 a b, c2 b c) =>
-            Link (Proxy b)
+data D =
+  forall a. D a
 ```
 
 Multiple
@@ -840,6 +838,46 @@ data D =
   forall a b c. D a b c
 ```
 
+With an infix constructor
+
+```haskell
+data D =
+  forall a. a :== a
+```
+
+#### Fields with contexts
+
+Without a `forall`
+
+```haskell
+data Foo =
+  Eq a => Foo a
+```
+
+With a `forall`
+
+```haskell
+-- https://github.com/mihaimaruseac/hindent/issues/278
+data Link c1 c2 a c =
+  forall b. (c1 a b, c2 b c) =>
+            Link (Proxy b)
+```
+
+With an infix constructor without a `forall`
+
+```haskell
+data Foo =
+  Eq a => a :== a
+```
+
+With an infix constructor with a `forall`
+
+```haskell
+data Foo =
+  forall a. Eq a =>
+            a :== a
+```
+
 #### Derivings
 
 With a single constructor

src/HIndent/Pretty.hs

@@ -880,39 +880,65 @@
 #endif
 #if MIN_VERSION_ghc_lib_parser(9,4,1)
 prettyConDecl GHC.ConDeclH98 {con_forall = True, ..} =
-  (do
-     string "forall "
-     spaced $ fmap pretty con_ex_tvs
-     string ". ")
-    |=> (do
-           whenJust con_mb_cxt $ \c -> do
-             pretty $ Context c
-             string " =>"
-             newline
-           pretty con_name
-           pretty con_args)
+  (string "forall " >> spaced (fmap pretty con_ex_tvs) >> string ". ")
+    |=> (case con_args of
+           (GHC.InfixCon l r) -> do
+             whenJust con_mb_cxt $ \c -> do
+               pretty $ Context c
+               string " =>"
+               newline
+             spaced [pretty l, pretty $ fmap InfixOp con_name, pretty r]
+           _ -> do
+             whenJust con_mb_cxt $ \c -> do
+               pretty $ Context c
+               string " =>"
+               newline
+             pretty con_name
+             pretty con_args)
+prettyConDecl GHC.ConDeclH98 {con_forall = False, ..} =
+  case con_args of
+    (GHC.InfixCon l r) -> do
+      whenJust con_mb_cxt $ \c -> do
+        pretty $ Context c
+        string " => "
+      spaced [pretty l, pretty $ fmap InfixOp con_name, pretty r]
+    _ -> do
+      whenJust con_mb_cxt $ \c -> do
+        pretty $ Context c
+        string " => "
+      pretty con_name
+      pretty con_args
 #else
 prettyConDecl GHC.ConDeclH98 {con_forall = True, ..} =
-  (do
-     string "forall "
-     spaced $ fmap pretty con_ex_tvs
-     string ". ")
-    |=> (do
-           whenJust con_mb_cxt $ \_ -> do
-             pretty $ Context con_mb_cxt
-             string " =>"
-             newline
-           pretty con_name
-           pretty con_args)
-#endif
+  (string "forall " >> spaced (fmap pretty con_ex_tvs) >> string ". ")
+    |=> (case con_args of
+           (GHC.InfixCon l r) -> do
+             whenJust con_mb_cxt $ \_ -> do
+               pretty $ Context con_mb_cxt
+               string " =>"
+               newline
+             spaced [pretty l, pretty $ fmap InfixOp con_name, pretty r]
+           _ -> do
+             whenJust con_mb_cxt $ \_ -> do
+               pretty $ Context con_mb_cxt
+               string " =>"
+               newline
+             pretty con_name
+             pretty con_args)
 prettyConDecl GHC.ConDeclH98 {con_forall = False, ..} =
   case con_args of
-    (GHC.InfixCon l r) ->
+    (GHC.InfixCon l r) -> do
+      whenJust con_mb_cxt $ \_ -> do
+        pretty $ Context con_mb_cxt
+        string " => "
       spaced [pretty l, pretty $ fmap InfixOp con_name, pretty r]
     _ -> do
+      whenJust con_mb_cxt $ \_ -> do
+        pretty $ Context con_mb_cxt
+        string " => "
       pretty con_name
       pretty con_args
-
+#endif
 instance Pretty
            (GHC.Match
               GHC.GhcPs
@@ -923,7 +949,7 @@
 prettyMatchExpr GHC.Match {m_ctxt = GHC.LambdaExpr, ..} = do
   string "\\"
   unless (null m_pats)
     $ case GHC.unLoc $ head m_pats of
         GHC.LazyPat {} -> space
         GHC.BangPat {} -> space
         _ -> return ()
@@ -962,7 +988,7 @@
 prettyMatchProc GHC.Match {m_ctxt = GHC.LambdaExpr, ..} = do
   string "\\"
   unless (null m_pats)
     $ case GHC.unLoc $ head m_pats of
         GHC.LazyPat {} -> space
         GHC.BangPat {} -> space
         _ -> return ()
@@ -1644,7 +1670,7 @@
   pretty' (GHC.DctMulti _ ts) = hvTuple $ fmap pretty ts
 
 instance Pretty GHC.OverlapMode where
   pretty' GHC.NoOverlap {} = notUsedInParsedStage
   pretty' GHC.Overlappable {} = string "{-# OVERLAPPABLE #-}"
   pretty' GHC.Overlapping {} = string "{-# OVERLAPPING #-}"
   pretty' GHC.Overlaps {} = string "{-# OVERLAPS #-}"
@@ -1805,8 +1831,8 @@
       [] -> pure ()
       [x'] -> string x'
       xs -> do
         string $ head xs
         indentedWithFixedLevel 0 $ newlinePrefixed $ string <$> tail xs
   pretty' (GHC.IEModuleContents _ name) =
     pretty $ fmap ModuleNameWithPrefix name
   pretty' GHC.IEGroup {} = docNode
@@ -2231,7 +2257,7 @@
   pretty' (GHC.HsFloatPrim _ x) = pretty x >> string "#"
   pretty' GHC.HsDoublePrim {} = notUsedInParsedStage
   pretty' x =
     case x of
       GHC.HsString {} -> prettyString
       GHC.HsStringPrim {} -> prettyString
     where
@@ -2372,7 +2398,7 @@
           string p |=> pretty (fmap StmtLRInsideVerticalList x)
           newline
         string "]"
       stmtsAndPrefixes l = ("| ", head l) : fmap (", ", ) (tail l)
 
 instance Pretty DoExpression where
   pretty' DoExpression {..} = do