Merge pull request #2819 from nprindle/np/fix-boolean-operator-hanging

Fix incorrect hanging of boolean operators, and elide extra parentheses

CONTRIBUTORS.markdown

@@ -64,3 +64,4 @@ The format for this list: name, GitHub handle, and then optional blurb about wha
 * Shawn Bachlet (@shawn-bachlet)
 * Solomon Bothwell (@solomon-b)
 * Sameer Kolhar (@kolharsam)
+* Nicole Prindle (@nprindle)

parser-typechecker/src/Unison/TermPrinter.hs

@@ -277,18 +277,6 @@ pretty0
        pf     = branch f
        branch tm = let (im', uses) = calcImports im tm
                    in uses $ [pretty0 n (ac 0 Block im' doc) tm]
-    And' x y ->
-      paren (p >= 10) $ PP.spaced [
-        pretty0 n (ac 10 Normal im doc) x,
-        fmt S.ControlKeyword "&&",
-        pretty0 n (ac 10 Normal im doc) y
-      ]
-    Or' x y ->
-      paren (p >= 10) $ PP.spaced [
-        pretty0 n (ac 10 Normal im doc) x,
-        fmt S.ControlKeyword "||",
-        pretty0 n (ac 10 Normal im doc) y
-      ]
     LetBlock bs e ->
       let (im', uses) = calcImports im term
       in printLet elideUnit bc bs e im' uses
@@ -356,6 +344,13 @@ pretty0
       fmt S.BytesLiteral "0xs" <> (PP.shown $ Bytes.fromWord8s (map fromIntegral bs))
     BinaryAppsPred' apps lastArg -> paren (p >= 3) $
       binaryApps apps (pretty0 n (ac 3 Normal im doc) lastArg)
+    -- Note that && and || are at the same precedence, which can cause
+    -- confusion, so for clarity we do not want to elide the parentheses in a
+    -- case like `(x || y) && z`.
+    (Ands' xs lastArg, _) -> paren (p >= 10) $
+      booleanOps (fmt S.ControlKeyword "&&") xs (pretty0 n (ac 10 Normal im doc) lastArg)
+    (Ors' xs lastArg, _) -> paren (p >= 10) $
+      booleanOps (fmt S.ControlKeyword "||") xs (pretty0 n (ac 10 Normal im doc) lastArg)
     _ -> case (term, nonForcePred) of
       OverappliedBinaryAppPred' f a b r | binaryOpsPred f ->
         -- Special case for overapplied binary op
@@ -443,6 +438,30 @@ pretty0
       , pretty0 n (AmbientContext 10 Normal Infix im doc False) f
       ]
 
+  -- Render sequence of infix &&s or ||s, like [x2, x1],
+  -- meaning (x1 && x2) && (x3 rendered by the caller), producing
+  -- "x1 && x2 &&". The result is built from the right.
+  booleanOps
+    :: Var v
+    => Pretty SyntaxText
+    -> [Term3 v PrintAnnotation]
+    -> Pretty SyntaxText
+    -> Pretty SyntaxText
+  booleanOps op xs last = unbroken `PP.orElse` broken
+   where
+    unbroken = PP.spaced (ps ++ [last])
+    broken   = PP.hang (head ps) . PP.column2 . psCols $ (tail ps ++ [last])
+    psCols ps = case take 2 ps of
+      [x, y] -> (x, y) : psCols (drop 2 ps)
+      [x]    -> [(x, "")]
+      []     -> []
+      _      -> undefined
+    ps = r =<< reverse xs
+    r a =
+      [ pretty0 n (ac (if isBlock a then 12 else 10) Normal im doc) a
+      , op
+      ]
+
 prettyPattern
   :: forall v loc . Var v
   => PrettyPrintEnv

unison-core/src/Unison/Term.hs

@@ -428,6 +428,8 @@ pattern Or' x y <- (ABT.out -> ABT.Tm (Or x y))
 pattern Handle' h body <- (ABT.out -> ABT.Tm (Handle h body))
 pattern Apps' f args <- (unApps -> Just (f, args))
 -- begin pretty-printer helper patterns
+pattern Ands' ands lastArg <- (unAnds -> Just (ands, lastArg))
+pattern Ors' ors lastArg <- (unOrs -> Just (ors, lastArg))
 pattern AppsPred' f args <- (unAppsPred -> Just (f, args))
 pattern BinaryApp' f arg1 arg2 <- (unBinaryApp -> Just (f, arg1, arg2))
 pattern BinaryApps' apps lastArg <- (unBinaryApps -> Just (apps, lastArg))
@@ -763,6 +765,30 @@ unLetRec (unLetRecNamed -> Just (isTop, bs, e)) = Just
   )
 unLetRec _ = Nothing
 
+unAnds
+  :: Term2 vt at ap v a
+  -> Maybe
+       ( [Term2 vt at ap v a]
+       , Term2 vt at ap v a
+       )
+unAnds t = case t of
+  And' i o -> case unAnds i of
+    Just (as, xLast) -> Just (xLast:as, o)
+    Nothing -> Just ([i], o)
+  _ -> Nothing
+
+unOrs
+  :: Term2 vt at ap v a
+  -> Maybe
+       ( [Term2 vt at ap v a]
+       , Term2 vt at ap v a
+       )
+unOrs t = case t of
+  Or' i o -> case unOrs i of
+    Just (as, xLast) -> Just (xLast:as, o)
+    Nothing -> Just ([i], o)
+  _ -> Nothing
+
 unApps
   :: Term2 vt at ap v a
   -> Maybe (Term2 vt at ap v a, [Term2 vt at ap v a])

unison-src/transcripts/boolean-op-pretty-print-2819.md

@@ -0,0 +1,18 @@
+Regression test for https://github.com/unisonweb/unison/pull/2819
+
+```ucm:hide
+.> builtins.merge
+```
+
+```unison
+hangExample : Boolean
+hangExample =
+  ("a long piece of text to hang the line" == "")
+    && ("a long piece of text to hang the line" == "")
+```
+
+```ucm
+.> add
+.> view hangExample
+```
+

unison-src/transcripts/boolean-op-pretty-print-2819.output.md

@@ -0,0 +1,35 @@
+Regression test for https://github.com/unisonweb/unison/pull/2819
+
+```unison
+hangExample : Boolean
+hangExample =
+  ("a long piece of text to hang the line" == "")
+    && ("a long piece of text to hang the line" == "")
+```
+
+```ucm
+
+  I found and typechecked these definitions in scratch.u. If you
+  do an `add` or `update`, here's how your codebase would
+  change:
+  
+    ⍟ These new definitions are ok to `add`:
+    
+      hangExample : Boolean
+
+```
+```ucm
+.> add
+
+  ⍟ I've added these definitions:
+  
+    hangExample : Boolean
+
+.> view hangExample
+
+  hangExample : Boolean
+  hangExample =
+    ("a long piece of text to hang the line" == "")
+      && ("a long piece of text to hang the line" == "")
+
+```