3 failures to go

parser-typechecker/src/Unison/TermPrinter.hs

@@ -161,10 +161,21 @@ pretty n AmbientContext { precedence = p, blockContext = bc, infixContext = ic }
                             xs
         <> "]"
       where optSpace = PP.orElse "" " "
-    If' cond t f -> paren (p >= 2) $ PP.spaced [
-      "if" `PP.hang` pretty n (ac 2 Block) cond,
-      "then" `PP.hang` pretty n (ac 2 Block) t,
-      "else" `PP.hang` pretty n (ac 2 Block) f ]
+    If' cond t f -> paren (p >= 2) $
+      if height > 0 then PP.lines [
+        "if " <> pcond <> (" then") `PP.hang` pt,
+        "else" `PP.hang` pf
+       ]
+      else PP.spaced [
+        "if" `PP.hang` pcond,
+        "then" `PP.hang` pt,
+        "else" `PP.hang` pf
+       ]
+     where
+       height = PP.preferredHeight pt `max` PP.preferredHeight pf
+       pcond  = pretty n (ac 2 Block) cond
+       pt     = pretty n (ac 2 Block) t
+       pf     = pretty n (ac 2 Block) f
     And' x y ->
       paren (p >= 10) $ PP.spaced [
         "and", pretty n (ac 10 Normal) x,

parser-typechecker/src/Unison/Util/Pretty.hs

@@ -15,6 +15,8 @@ module Unison.Util.Pretty (
    group,
    hang',
    hang,
+   hangUngrouped',
+   hangUngrouped,
    indent,
    indentAfterNewline,
    indentN,
@@ -29,10 +31,12 @@ module Unison.Util.Pretty (
    newline,
    numbered,
    orElse,
+   orElses,
    parenthesize,
    parenthesizeCommas,
    parenthesizeIf,
    preferredWidth,
+   preferredHeight,
    render,
    renderUnbroken,
    rightPad,
@@ -53,7 +57,7 @@ module Unison.Util.Pretty (
   ) where
 
 import           Data.Foldable                  ( toList )
-import           Data.List                      ( foldl' , intersperse )
+import           Data.List                      ( foldl' , foldr1, intersperse )
 import           Data.Sequence                  ( Seq )
 import           Data.String                    ( IsString , fromString )
 import           Data.Text                      ( Text )
@@ -99,6 +103,10 @@ lit' d s = Pretty d d (Lit s)
 orElse :: Pretty s -> Pretty s -> Pretty s
 orElse p1 p2 = Pretty (delta p1) (minDelta p2) (OrElse p1 p2)
 
+orElses :: [Pretty s] -> Pretty s
+orElses [] = mempty
+orElses ps = foldr1 orElse ps
+
 wrap :: IsString s => [Pretty s] -> Pretty s
 wrap [] = mempty
 wrap (p:ps) = wrap_ . Seq.fromList $ p : fmap (softbreak <>) ps
@@ -232,8 +240,14 @@ hang' from by p = group $
   else (from <> " " <> group p) `orElse`
        (from <> "\n" <> group (indent by p))
 
--- onBreak :: Pretty s -> Pretty s
--- onBreak p = mempty `orElse` p
+hangUngrouped' :: (LL.ListLike s Char, IsString s) => Pretty s -> Pretty s -> Pretty s -> Pretty s
+hangUngrouped' from by p =
+  if preferredHeight p > 0 then from <> "\n" <> indent by p
+  else (from <> " " <> p) `orElse`
+       (from <> "\n" <> indent by p)
+
+hangUngrouped :: (LL.ListLike s Char, IsString s) => Pretty s -> Pretty s -> Pretty s
+hangUngrouped from p = hangUngrouped' from "  " p
 
 hang :: (LL.ListLike s Char, IsString s) => Pretty s -> Pretty s -> Pretty s
 hang from p = hang' from "  " p

parser-typechecker/tests/Unison/Test/TermPrinter.hs

@@ -230,16 +230,14 @@ test = scope "termprinter" . tests $
             \    f : Int -> Int\n\
             \    f x = x\n\
             \  13"
-            "if foo\n\
-            \then\n\
+            "if foo then\n\
             \  and true true\n\
             \  12\n\
             \else\n\
             \  baz.f : Int -> Int\n\
             \  baz.f x = x\n\
             \  13" 50
-  , tc_breaks 50 "if foo\n\
-                 \then\n\
+  , tc_breaks 50 "if foo then\n\
                  \  and true true\n\
                  \  12\n\
                  \else\n\