From d7f33eadff6e43650fb6e7b4c43fb2e058a33fd5 Mon Sep 17 00:00:00 2001
From: Hiroki Tokunaga <tokusan441@gmail.com>
Date: Tue, 27 Dec 2022 21:48:20 +0900
Subject: [PATCH 1/5] Change a test for `UnboxedSums`

The test is from #564.
---
 TESTS.md                                 | 2 +-
 src/HIndent/Pretty.hs                    | 7 +++++--
 src/HIndent/Pretty/Combinators/Lineup.hs | 5 +++++
 3 files changed, 11 insertions(+), 3 deletions(-)

diff --git a/TESTS.md b/TESTS.md
index 836e87425..dc275051b 100644
--- a/TESTS.md
+++ b/TESTS.md
@@ -1643,7 +1643,7 @@ foo = undefined
 ```haskell
 {-# LANGUAGE UnboxedSums #-}
 
-f :: (# Int | Bool | String #)
+f :: (# (# Int, String #) | String #) -> (# Int | String #)
 ```
 
 #### Promoted types
diff --git a/src/HIndent/Pretty.hs b/src/HIndent/Pretty.hs
index 0fb4b5609..f86dd05f6 100644
--- a/src/HIndent/Pretty.hs
+++ b/src/HIndent/Pretty.hs
@@ -1019,8 +1019,11 @@ prettyHsType (HsAppTy _ l r) = spaced $ fmap pretty [l, r]
 prettyHsType (HsAppKindTy _ l r) = pretty l >> string " @" >> pretty r
 prettyHsType (HsFunTy _ _ a b) = (pretty a >> string " -> ") |=> pretty b
 prettyHsType (HsListTy _ xs) = brackets $ pretty xs
-prettyHsType (HsTupleTy _ _ []) = string "()"
-prettyHsType (HsTupleTy _ _ xs) = hvTuple' $ fmap pretty xs
+prettyHsType (HsTupleTy _ HsUnboxedTuple []) = string "(# #)"
+prettyHsType (HsTupleTy _ HsBoxedOrConstraintTuple []) = string "()"
+prettyHsType (HsTupleTy _ HsUnboxedTuple xs) = hUnboxedTuple $ fmap pretty xs
+prettyHsType (HsTupleTy _ HsBoxedOrConstraintTuple xs) =
+  hvTuple' $ fmap pretty xs
 prettyHsType (HsSumTy _ xs) = unboxedSums $ hBarSep $ fmap pretty xs
   -- For `HsOpTy`, we do not need a single quote for the infix operator. An
   -- explicit promotion is necessary if there is a data constructor and
diff --git a/src/HIndent/Pretty/Combinators/Lineup.hs b/src/HIndent/Pretty/Combinators/Lineup.hs
index 6f3482e7b..ba1e8b810 100644
--- a/src/HIndent/Pretty/Combinators/Lineup.hs
+++ b/src/HIndent/Pretty/Combinators/Lineup.hs
@@ -7,6 +7,7 @@ module HIndent.Pretty.Combinators.Lineup
   , vTuple
   , vTuple'
   , hPromotedTuple
+  , hUnboxedTuple
   , -- * Records
     hvFields
   , hFields
@@ -69,6 +70,10 @@ vTuple' = vLineup' ("(", ")")
 hPromotedTuple :: [Printer ()] -> Printer ()
 hPromotedTuple = promotedTupleParens . hCommaSep
 
+-- | RUns printers to construct an unboxed tuple in a line.
+hUnboxedTuple :: [Printer ()] -> Printer ()
+hUnboxedTuple = unboxedSums . hCommaSep
+
 -- | Applies 'hFields' if the result fits in a line or 'vFields' otherwise.
 hvFields :: [Printer ()] -> Printer ()
 hvFields = (<-|>) <$> hFields <*> vFields

From 46e52d5675726005aeeda023b346fa29438e85e7 Mon Sep 17 00:00:00 2001
From: Hiroki Tokunaga <tokusan441@gmail.com>
Date: Tue, 27 Dec 2022 23:11:43 +0900
Subject: [PATCH 2/5] s/unboxedSums/unboxedParens

---
 src/HIndent/Pretty.hs                    | 4 ++--
 src/HIndent/Pretty/Combinators/Lineup.hs | 2 +-
 src/HIndent/Pretty/Combinators/Wrap.hs   | 6 +++---
 3 files changed, 6 insertions(+), 6 deletions(-)

diff --git a/src/HIndent/Pretty.hs b/src/HIndent/Pretty.hs
index f86dd05f6..a38716899 100644
--- a/src/HIndent/Pretty.hs
+++ b/src/HIndent/Pretty.hs
@@ -520,7 +520,7 @@ prettyHsExpr (ExplicitTuple _ full _) = horizontal <-|> vertical
     isMissing Missing {} = True
     isMissing _ = False
 prettyHsExpr (ExplicitSum _ _ _ expr) =
-  unboxedSums $ spaced [string "|", pretty expr]
+  unboxedParens $ spaced [string "|", pretty expr]
 prettyHsExpr (HsCase _ cond arms) = do
   string "case " |=> do
     pretty cond
@@ -1024,7 +1024,7 @@ prettyHsType (HsTupleTy _ HsBoxedOrConstraintTuple []) = string "()"
 prettyHsType (HsTupleTy _ HsUnboxedTuple xs) = hUnboxedTuple $ fmap pretty xs
 prettyHsType (HsTupleTy _ HsBoxedOrConstraintTuple xs) =
   hvTuple' $ fmap pretty xs
-prettyHsType (HsSumTy _ xs) = unboxedSums $ hBarSep $ fmap pretty xs
+prettyHsType (HsSumTy _ xs) = unboxedParens $ hBarSep $ fmap pretty xs
   -- For `HsOpTy`, we do not need a single quote for the infix operator. An
   -- explicit promotion is necessary if there is a data constructor and
   -- a type with the same name. However, infix data constructors never
diff --git a/src/HIndent/Pretty/Combinators/Lineup.hs b/src/HIndent/Pretty/Combinators/Lineup.hs
index ba1e8b810..c765293cc 100644
--- a/src/HIndent/Pretty/Combinators/Lineup.hs
+++ b/src/HIndent/Pretty/Combinators/Lineup.hs
@@ -72,7 +72,7 @@ hPromotedTuple = promotedTupleParens . hCommaSep
 
 -- | RUns printers to construct an unboxed tuple in a line.
 hUnboxedTuple :: [Printer ()] -> Printer ()
-hUnboxedTuple = unboxedSums . hCommaSep
+hUnboxedTuple = unboxedParens . hCommaSep
 
 -- | Applies 'hFields' if the result fits in a line or 'vFields' otherwise.
 hvFields :: [Printer ()] -> Printer ()
diff --git a/src/HIndent/Pretty/Combinators/Wrap.hs b/src/HIndent/Pretty/Combinators/Wrap.hs
index 908dac47e..c01948f46 100644
--- a/src/HIndent/Pretty/Combinators/Wrap.hs
+++ b/src/HIndent/Pretty/Combinators/Wrap.hs
@@ -12,7 +12,7 @@ module HIndent.Pretty.Combinators.Wrap
   , wrapWithBars
   , promotedListBrackets
   , promotedTupleParens
-  , unboxedSums
+  , unboxedParens
   ) where
 
 import GHC.Types.Name
@@ -77,8 +77,8 @@ promotedTupleParens :: Printer a -> Printer a
 promotedTupleParens = wrap "'( " ")"
 
 -- | Wraps with @(# @ and @ #)@.
-unboxedSums :: Printer a -> Printer a
-unboxedSums = wrap "(# " " #)"
+unboxedParens :: Printer a -> Printer a
+unboxedParens = wrap "(# " " #)"
 
 -- | This function wraps the printer with the prefix and the suffix.
 wrap :: String -> String -> Printer a -> Printer a

From abd609448d94c3addd1a67ea4d72ebd2805cc9ae Mon Sep 17 00:00:00 2001
From: Hiroki Tokunaga <tokusan441@gmail.com>
Date: Wed, 28 Dec 2022 00:05:41 +0900
Subject: [PATCH 3/5] Define helper functions

---
 src/HIndent/Pretty/Combinators/Lineup.hs | 57 ++++++++++++++----------
 1 file changed, 34 insertions(+), 23 deletions(-)

diff --git a/src/HIndent/Pretty/Combinators/Lineup.hs b/src/HIndent/Pretty/Combinators/Lineup.hs
index c765293cc..6912a69f9 100644
--- a/src/HIndent/Pretty/Combinators/Lineup.hs
+++ b/src/HIndent/Pretty/Combinators/Lineup.hs
@@ -59,12 +59,12 @@ hTuple = parens . hCommaSep
 -- | Runs printers to construct a tuple where elements are aligned
 -- vertically.
 vTuple :: [Printer ()] -> Printer ()
-vTuple = vLineup ("(", ")")
+vTuple = vCommaSepWrapped ("(", ")")
 
 -- | Similar to 'vTuple', but the closing parenthesis is in the last
 -- element.
 vTuple' :: [Printer ()] -> Printer ()
-vTuple' = vLineup' ("(", ")")
+vTuple' = vCommaSepWrapped' ("(", ")")
 
 -- | Runs printers to construct a promoted tuple in a line.
 hPromotedTuple :: [Printer ()] -> Printer ()
@@ -85,12 +85,12 @@ hFields = braces . hCommaSep
 -- | Runs printers to construct a record where elements are aligned
 -- vertically.
 vFields :: [Printer ()] -> Printer ()
-vFields = vLineup ("{", "}")
+vFields = vCommaSepWrapped ("{", "}")
 
 -- | Similar to 'vFields', but the closing brace is in the same line as the
 -- last element.
 vFields' :: [Printer ()] -> Printer ()
-vFields' = vLineup' ("{", "}")
+vFields' = vCommaSepWrapped' ("{", "}")
 
 -- | Runs printers to construct a list in a line.
 hList :: [Printer ()] -> Printer ()
@@ -99,30 +99,12 @@ hList = brackets . hCommaSep
 -- | Runs printers to construct a list where elements are aligned
 -- vertically.
 vList :: [Printer ()] -> Printer ()
-vList = vLineup ("[", "]")
+vList = vCommaSepWrapped ("[", "]")
 
 -- | Runs printers to construct a promoted list in a line.
 hPromotedList :: [Printer ()] -> Printer ()
 hPromotedList = promotedListBrackets . hCommaSep
 
--- | Prints elements in vertical with the given prefix and suffix.
-vLineup :: (String, String) -> [Printer ()] -> Printer ()
-vLineup (prefix, suffix) ps =
-  string prefix >>
-  space |=> do
-    vCommaSep ps
-    newline
-    indentedWithSpace (-(fromIntegral (length prefix) + 1)) $ string suffix
-
--- | Similar to 'vLineup' but the suffix is in the same line as the last
--- element.
-vLineup' :: (String, String) -> [Printer ()] -> Printer ()
-vLineup' (prefix, suffix) ps =
-  string prefix >>
-  space |=> do
-    vCommaSep ps
-    string suffix
-
 -- | Runs printers in a line with a space as the separator.
 spaced :: [Printer ()] -> Printer ()
 spaced = inter space
@@ -162,6 +144,16 @@ hCommaSep = inter (string ", ")
 vCommaSep :: [Printer ()] -> Printer ()
 vCommaSep = prefixedLined ", "
 
+-- | Prints elements separated by comma  in vertical with the given prefix
+-- and suffix.
+vCommaSepWrapped :: (String, String) -> [Printer ()] -> Printer ()
+vCommaSepWrapped = vWrappedLineup ','
+
+-- | Similar to 'vCommaSepWrapped' but the suffix is in the same line as the last
+-- element.
+vCommaSepWrapped' :: (String, String) -> [Printer ()] -> Printer ()
+vCommaSepWrapped' = vWrappedLineup' ','
+
 -- | Runs printers with a dot as the separator.
 hDotSep :: [Printer ()] -> Printer ()
 hDotSep = inter (string ".")
@@ -183,6 +175,25 @@ prefixedLined pref (x:xs) = do
     newline
     prefixed pref p
 
+-- | Prints elements in vertical with the given prefix, suffix, and
+-- separator.
+vWrappedLineup :: Char -> (String, String) -> [Printer ()] -> Printer ()
+vWrappedLineup sep (prefix, suffix) ps =
+  string prefix >>
+  space |=> do
+    prefixedLined [sep, ' '] ps
+    newline
+    indentedWithSpace (-(fromIntegral (length prefix) + 1)) $ string suffix
+
+-- | Similar to 'vWrappedLineup' but the suffix is in the same line as the
+-- last element.
+vWrappedLineup' :: Char -> (String, String) -> [Printer ()] -> Printer ()
+vWrappedLineup' sep (prefix, suffix) ps =
+  string prefix >>
+  space |=> do
+    prefixedLined [sep, ' '] ps
+    string suffix
+
 -- Inserts the first printer between each element of the list passed as the
 -- second argument and runs them.
 inter :: Printer () -> [Printer ()] -> Printer ()

From af2ee96ed3aa45f7445e1b96f5a3d5e989099d0c Mon Sep 17 00:00:00 2001
From: Hiroki Tokunaga <tokusan441@gmail.com>
Date: Wed, 28 Dec 2022 09:15:57 +0900
Subject: [PATCH 4/5] Print unboxed sum type signatures correctly

---
 TESTS.md                                 | 34 ++++++++++++++++++------
 src/HIndent/Pretty.hs                    |  2 +-
 src/HIndent/Pretty/Combinators/Lineup.hs | 24 ++++++++++++++++-
 3 files changed, 50 insertions(+), 10 deletions(-)

diff --git a/TESTS.md b/TESTS.md
index dc275051b..b36d2436c 100644
--- a/TESTS.md
+++ b/TESTS.md
@@ -1638,14 +1638,6 @@ foo = undefined
     go = undefined
 ```
 
-`UnboxedSums`
-
-```haskell
-{-# LANGUAGE UnboxedSums #-}
-
-f :: (# (# Int, String #) | String #) -> (# Int | String #)
-```
-
 #### Promoted types
 
 Promoted lists
@@ -1761,6 +1753,32 @@ f :: (a :?: b) => (a, b)
 f' :: ((:?:) a b) => (a, b)
 ```
 
+#### `UnboxedSums`
+
+Short
+
+```haskell
+{-# LANGUAGE UnboxedSums #-}
+
+f :: (# (# Int, String #) | String #) -> (# Int | String #)
+```
+
+Long
+
+```haskell
+{-# LANGUAGE UnboxedSums #-}
+
+f' ::
+     (# (# Int, String #)
+      | Either Bool Int
+      | Either Bool Int
+      | Either Bool Int
+      | Either Bool Int
+      | Either Bool Int
+      | String #)
+  -> (# Int | String #)
+```
+
 ### Type synonym declarations
 
 Short
diff --git a/src/HIndent/Pretty.hs b/src/HIndent/Pretty.hs
index a38716899..14fd15a43 100644
--- a/src/HIndent/Pretty.hs
+++ b/src/HIndent/Pretty.hs
@@ -1024,7 +1024,7 @@ prettyHsType (HsTupleTy _ HsBoxedOrConstraintTuple []) = string "()"
 prettyHsType (HsTupleTy _ HsUnboxedTuple xs) = hUnboxedTuple $ fmap pretty xs
 prettyHsType (HsTupleTy _ HsBoxedOrConstraintTuple xs) =
   hvTuple' $ fmap pretty xs
-prettyHsType (HsSumTy _ xs) = unboxedParens $ hBarSep $ fmap pretty xs
+prettyHsType (HsSumTy _ xs) = hvUnboxedSum' $ fmap pretty xs
   -- For `HsOpTy`, we do not need a single quote for the infix operator. An
   -- explicit promotion is necessary if there is a data constructor and
   -- a type with the same name. However, infix data constructors never
diff --git a/src/HIndent/Pretty/Combinators/Lineup.hs b/src/HIndent/Pretty/Combinators/Lineup.hs
index 6912a69f9..280fc39f2 100644
--- a/src/HIndent/Pretty/Combinators/Lineup.hs
+++ b/src/HIndent/Pretty/Combinators/Lineup.hs
@@ -8,6 +8,8 @@ module HIndent.Pretty.Combinators.Lineup
   , vTuple'
   , hPromotedTuple
   , hUnboxedTuple
+  , -- * Unboxed sums
+    hvUnboxedSum'
   , -- * Records
     hvFields
   , hFields
@@ -70,10 +72,30 @@ vTuple' = vCommaSepWrapped' ("(", ")")
 hPromotedTuple :: [Printer ()] -> Printer ()
 hPromotedTuple = promotedTupleParens . hCommaSep
 
--- | RUns printers to construct an unboxed tuple in a line.
+-- | Runs printers to construct an unboxed tuple in a line.
 hUnboxedTuple :: [Printer ()] -> Printer ()
 hUnboxedTuple = unboxedParens . hCommaSep
 
+-- | Runs printers to construct an unboxed sum. The elements are aligned
+-- either in a line or vertically.
+--
+-- The enclosing parenthesis will be printed on the same line as the last
+-- element.
+hvUnboxedSum' :: [Printer ()] -> Printer ()
+hvUnboxedSum' = (<-|>) <$> hUnboxedSum <*> vUnboxedSum'
+
+-- | Runs printers to construct an unboxed sum in a line.
+hUnboxedSum :: [Printer ()] -> Printer ()
+hUnboxedSum = unboxedParens . hBarSep
+
+-- | Runs printers to construct an unboxed sum where the elements are
+-- aligned vertically.
+--
+-- The enclosing parenthesis will be printed on the same line as the last
+-- element.
+vUnboxedSum' :: [Printer ()] -> Printer ()
+vUnboxedSum' = vWrappedLineup' '|' ("(#", " #)")
+
 -- | Applies 'hFields' if the result fits in a line or 'vFields' otherwise.
 hvFields :: [Printer ()] -> Printer ()
 hvFields = (<-|>) <$> hFields <*> vFields

From 8a4bca9614658bf3f2cec1e17e5bc7f9b6d25dcf Mon Sep 17 00:00:00 2001
From: Hiroki Tokunaga <tokusan441@gmail.com>
Date: Wed, 28 Dec 2022 09:27:02 +0900
Subject: [PATCH 5/5] Print unboxed tuple type signatures correctly

---
 TESTS.md                                 | 16 +++++++++++++---
 src/HIndent/Pretty.hs                    |  2 +-
 src/HIndent/Pretty/Combinators/Lineup.hs | 13 ++++++++++++-
 3 files changed, 26 insertions(+), 5 deletions(-)

diff --git a/TESTS.md b/TESTS.md
index b36d2436c..eeb12481d 100644
--- a/TESTS.md
+++ b/TESTS.md
@@ -1753,9 +1753,9 @@ f :: (a :?: b) => (a, b)
 f' :: ((:?:) a b) => (a, b)
 ```
 
-#### `UnboxedSums`
+#### Unboxed types
 
-Short
+Short unboxed sums
 
 ```haskell
 {-# LANGUAGE UnboxedSums #-}
@@ -1763,7 +1763,7 @@ Short
 f :: (# (# Int, String #) | String #) -> (# Int | String #)
 ```
 
-Long
+Long unboxed sums
 
 ```haskell
 {-# LANGUAGE UnboxedSums #-}
@@ -1779,6 +1779,16 @@ f' ::
   -> (# Int | String #)
 ```
 
+Large unboxed tuples
+
+```haskell
+{-# LANGUAGE UnboxedTuples #-}
+
+f :: (# Looooooooooooooooooooooooooooooooooooooooooooong
+      , Looooooooooooooooooooooooooooooooooooooooooooong
+      , Looooooooooooooooooooooooooooooooooooooooooooong #)
+```
+
 ### Type synonym declarations
 
 Short
diff --git a/src/HIndent/Pretty.hs b/src/HIndent/Pretty.hs
index 14fd15a43..48890e3c5 100644
--- a/src/HIndent/Pretty.hs
+++ b/src/HIndent/Pretty.hs
@@ -1021,7 +1021,7 @@ prettyHsType (HsFunTy _ _ a b) = (pretty a >> string " -> ") |=> pretty b
 prettyHsType (HsListTy _ xs) = brackets $ pretty xs
 prettyHsType (HsTupleTy _ HsUnboxedTuple []) = string "(# #)"
 prettyHsType (HsTupleTy _ HsBoxedOrConstraintTuple []) = string "()"
-prettyHsType (HsTupleTy _ HsUnboxedTuple xs) = hUnboxedTuple $ fmap pretty xs
+prettyHsType (HsTupleTy _ HsUnboxedTuple xs) = hvUnboxedTuple' $ fmap pretty xs
 prettyHsType (HsTupleTy _ HsBoxedOrConstraintTuple xs) =
   hvTuple' $ fmap pretty xs
 prettyHsType (HsSumTy _ xs) = hvUnboxedSum' $ fmap pretty xs
diff --git a/src/HIndent/Pretty/Combinators/Lineup.hs b/src/HIndent/Pretty/Combinators/Lineup.hs
index 280fc39f2..6baafce54 100644
--- a/src/HIndent/Pretty/Combinators/Lineup.hs
+++ b/src/HIndent/Pretty/Combinators/Lineup.hs
@@ -7,7 +7,8 @@ module HIndent.Pretty.Combinators.Lineup
   , vTuple
   , vTuple'
   , hPromotedTuple
-  , hUnboxedTuple
+  , -- * Unboxed tuples
+    hvUnboxedTuple'
   , -- * Unboxed sums
     hvUnboxedSum'
   , -- * Records
@@ -72,10 +73,20 @@ vTuple' = vCommaSepWrapped' ("(", ")")
 hPromotedTuple :: [Printer ()] -> Printer ()
 hPromotedTuple = promotedTupleParens . hCommaSep
 
+-- | Runs printers to construct an unboxed tuple. The elements are aligned
+-- either in a line or vertically.
+hvUnboxedTuple' :: [Printer ()] -> Printer ()
+hvUnboxedTuple' = (<-|>) <$> hUnboxedTuple <*> vUnboxedTuple'
+
 -- | Runs printers to construct an unboxed tuple in a line.
 hUnboxedTuple :: [Printer ()] -> Printer ()
 hUnboxedTuple = unboxedParens . hCommaSep
 
+-- | Runs printers to construct an unboxed tuple where the elements are
+-- aligned vertically.
+vUnboxedTuple' :: [Printer ()] -> Printer ()
+vUnboxedTuple' = vCommaSepWrapped' ("(#", " #)")
+
 -- | Runs printers to construct an unboxed sum. The elements are aligned
 -- either in a line or vertically.
 --