diff --git a/CHANGELOG.md b/CHANGELOG.md index 0a8bf6e98..d9290eabd 100644 --- a/CHANGELOG.md +++ b/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 diff --git a/TESTS.md b/TESTS.md index e02657842..49769d405 100644 --- a/TESTS.md +++ b/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 diff --git a/src/HIndent/Pretty.hs b/src/HIndent/Pretty.hs index ea4501d77..b9c245ee6 100644 --- a/src/HIndent/Pretty.hs +++ b/src/HIndent/Pretty.hs @@ -880,39 +880,65 @@ prettyConDecl GHC.ConDeclGADT {..} = do #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