prettyUpdate{Type,Term}

parser-typechecker/src/Unison/CommandLine/OutputMessages.hs

@@ -110,6 +110,7 @@ import qualified Unison.Util.List              as List
 import qualified Unison.Util.Monoid            as Monoid
 import Data.Tuple (swap)
 import Unison.Codebase.ShortBranchHash (ShortBranchHash)
+import Control.Lens (view, _1)
 
 type Pretty = P.Pretty P.ColorText
 
@@ -1209,7 +1210,7 @@ showDiffNamespace ppe d@OBD.BranchDiffOutput{..} =
   -- updateIndicator = " └─ "
 
   prettyUpdateType :: OBD.UpdateTypeDisplay v Ann -> _ Pretty
-  {- 
+  {-
      1. ability Foo#pqr x y
         2. - AllRightsReserved : License
         3. + MIT               : License
@@ -1217,9 +1218,9 @@ showDiffNamespace ppe d@OBD.BranchDiffOutput{..} =
         5. - apiDocs : License
         6. + MIT     : License
   -}
-  prettyUpdateType (Nothing, mdUps) = 
+  prettyUpdateType (Nothing, mdUps) =
     fmap P.linesNonEmpty $ traverse mdTypeLine mdUps
-  {- 
+  {-
       1. ┌ ability Foo#pqr x y
       2. └ ability Foo#xyz a b
          ⧩ replaced with
@@ -1238,32 +1239,50 @@ showDiffNamespace ppe d@OBD.BranchDiffOutput{..} =
   -}
   prettyUpdateType (Just olds, news) =
     fmap P.linesNonEmpty $ do
-      olds <- P.boxLeft <$> 
+      olds <- P.boxLeft <$>
         traverse mdTypeLine [ (name,decl,mempty) | (name,decl) <- olds ]
-      news <- P.boxLeft <$> 
+      news <- P.boxLeft <$>
         traverse mdTypeLine news
       pure $ olds <> [downArrow] <> news
 
   downArrow = P.bold "⧩ replaced with"
   mdTypeLine (hq, otype, mddiff) = do
-    n <- num 
-    fmap P.linesNonEmpty . sequence $ 
+    n <- num
+    fmap P.linesNonEmpty . sequence $
       [ pure $ n <> prettyDecl hq otype
       , P.indentN leftNumsWidth <$> prettyMetadataDiff mddiff ]
-    
-  prettyUpdateTerm (Nothing, terms) = undefined 
+  mdTermLine namesWidth (hq, otype, mddiff) = do
+    n <- num
+    fmap P.linesNonEmpty . sequence $
+      [ pure $ P.rightPad namesWidth (phq' hq) <> " : " <> prettyType otype
+      , P.indentN leftNumsWidth <$> prettyMetadataDiff mddiff ]
+
+  prettyUpdateTerm (Nothing, newTerms) =
+    if null newTerms then error "Super invalid UpdateTermDisplay" else
+    fmap P.linesNonEmpty $ traverse (mdTermLine namesWidth) newTerms
+    where namesWidth = foldl1' max $ fmap (HQ'.nameLength . view _1) newTerms
+  prettyUpdateTerm (Just olds, news) =
+    fmap P.linesNonEmpty $ do
+      olds <- P.boxLeft <$>
+        traverse (mdTermLine namesWidth) [ (name,typ,mempty) | (name,typ) <- olds ]
+      news <- P.boxLeft <$>
+        traverse (mdTermLine namesWidth) news
+      pure $ olds <> [downArrow] <> news
+    where namesWidth = foldl1' max $ fmap (HQ'.nameLength . view _1) news
+                                   <> fmap (HQ'.nameLength . view _1) olds
+
 
   prettyMetadataDiff OBD.MetadataDiff{..} = P.column2M $
     map (elem " - ") removedMetadata <>
     map (elem " + ") addedMetadata
-    where 
+    where
     elem x (hq, otype) = do
       num <- num
       pure (x <> num <> phq' hq, " : " <> prettyType otype)
 
-  prettyType = maybe (P.red "type not found") (TypePrinter.pretty ppe) 
+  prettyType = maybe (P.red "type not found") (TypePrinter.pretty ppe)
   prettyDecl hq =
-    maybe (P.red "type not found") 
+    maybe (P.red "type not found")
           (P.syntaxToColor . DeclPrinter.prettyDeclOrBuiltinHeader (HQ'.toHQ hq))
   phq' = P.syntaxToColor . prettyHashQualified'
   --
@@ -1277,7 +1296,7 @@ showDiffNamespace ppe d@OBD.BranchDiffOutput{..} =
   padNumber :: Int -> Pretty
   padNumber n = P.hiBlack . P.rightPad leftNumsWidth $ P.shown n <> ". "
   leftNumsWidth = 4 -- length (show . max d) + length ". "
-  
+
 noResults :: Pretty
 noResults = P.callout "😶" $
     P.wrap $ "No results. Check your spelling, or try using tab completion "

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

@@ -146,7 +146,7 @@ wrapImpl (p:ps) = wrap_ . Seq.fromList $
 wrapString :: (LL.ListLike s Char, IsString s) => String -> Pretty s
 wrapString s = wrap (lit $ fromString s)
 
--- 0. Preserve all leading and trailing whitespace 
+-- 0. Preserve all leading and trailing whitespace
 -- 1. Preserve all newlines
 -- 2. Wrap all text in between newlines
 paragraphyText :: (LL.ListLike s Char, IsString s) => Text -> Pretty s
@@ -582,10 +582,10 @@ bracket :: (LL.ListLike s Char, IsString s) => Pretty s -> Pretty s
 bracket = indent "  "
 
 boxLeft :: forall s . (LL.ListLike s Char, IsString s) => [Pretty s] -> [Pretty s]
-boxLeft ps = go ps where
-  go [] = []
-  go [p] = [decorate singleton p]
-  go (Seq.fromList -> a Seq.:<| (mid Seq.:|> b)) = 
+boxLeft ps = go (Seq.fromList ps) where
+  go Seq.Empty = []
+  go (p Seq.:<| Seq.Empty) = [decorate singleton p]
+  go (a Seq.:<| (mid Seq.:|> b)) =
     [decorate first a] ++ toList (decorate middle <$> mid) ++ [decorate last b]
   decorate (first, mid) p = first <> indentAfterNewline mid p
   first     = ("┌", "│")

unison-core/src/Unison/HashQualified'.hs

@@ -34,13 +34,16 @@ fromHQ = \case
   HQ.HashOnly{} -> Nothing
 
 unsafeFromHQ :: HQ.HashQualified' n -> HashQualified' n
-unsafeFromHQ = fromJust . fromHQ 
+unsafeFromHQ = fromJust . fromHQ
 
 toName :: HashQualified' n -> n
 toName = \case
   NameOnly name        ->  name
   HashQualified name _ ->  name
 
+nameLength :: HashQualified' Name -> Int
+nameLength = Text.length . Name.toText . toName
+
 take :: Int -> HashQualified' n -> HashQualified' n
 take i = \case
   n@(NameOnly _)    -> n