refactoring commands & output messages

Moved `P.wrap` calls from InputPattern.helpText initialization to the use site; introduced `P.wrapColumn2` since a use-site `P.wrap` can't penetrate the column group.

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

@@ -13,7 +13,6 @@ module Unison.CommandLine.InputPatterns where
 
 import           Data.Foldable                   (toList)
 import           Data.List                       (intercalate)
-import qualified Data.Map                        as Map
 import qualified Data.Set                        as Set
 import           Data.String                     (fromString)
 import qualified Data.Text                       as Text
@@ -22,10 +21,10 @@ import qualified Unison.Codebase.Branch          as Branch
 import           Unison.Codebase.Editor          (Input (..))
 import qualified Unison.Codebase.Editor          as E
 import           Unison.CommandLine
+import qualified Unison.CommandLine.InputPattern as I
 import           Unison.CommandLine.InputPattern (ArgumentType (ArgumentType),
                                                   InputPattern (InputPattern,
                                                                 aliases,
-                                                                help,
                                                                 patternName),
                                                   noSuggestions)
 import qualified Unison.HashQualified            as HQ
@@ -40,59 +39,28 @@ showPatternHelp i = P.lines [
     (if not . null $ aliases i
      then " (or " <> intercalate ", " (aliases i) <> ")"
      else ""),
-  help i ]
+  P.wrap $ I.help i ]
 
 validInputs :: [InputPattern]
-validInputs = validPatterns
+validInputs =
- where
+  [ InputPattern
-  commandNames = patternName <$> validPatterns
+      "help" ["?"] [(True, commandNameArg)]
-  commandMap   = Map.fromList (commandNames `zip` validPatterns)
-  helpPattern  = InputPattern
-    "help"
-    ["?"]
-    [(True, commandName)]
       "`help` shows general help and `help <cmd>` shows help for one command."
       (\case
-      []    -> Left $ intercalateMap "\n\n" showPatternHelp validPatterns
+        [] -> Left $ intercalateMap "\n\n" showPatternHelp validInputs
-      [cmd] -> case Map.lookup cmd commandMap of
+        [cmd] -> case lookup cmd (commandNames `zip` validInputs) of
           Nothing  -> Left . warn $ "I don't know of that command. Try `help`."
-        Just pat -> Left $ help pat
+          Just pat -> Left $ I.help pat
-      _ -> Left $ warn "Use `help <cmd>` or `help`."
+        _ -> Left $ warn "Use `help <cmd>` or `help`.")
-    )
-  commandName =
-    ArgumentType "command" $ \q _ _ -> pure $ autoComplete q commandNames
-  branchArg = ArgumentType "branch" $ \q codebase _b -> do
-    branches <- Codebase.branches codebase
-    let bs = Text.unpack <$> branches
-    pure $ autoComplete q bs
-  definitionQueryArg =
-    ArgumentType "definition query" $ \q _ (Branch.head -> b) -> do
-      let names = HQ.toString <$> toList (Branch.allNamesHashQualified b)
-      pure $ autoComplete q names
-  noCompletions = ArgumentType "a word" noSuggestions
-  quit          = InputPattern
-    "quit"
-    ["exit"]
-    []
-    "Exits the Unison command line interface."
-    (\case
-      [] -> pure QuitI
-      _  -> Left "Use `quit`, `exit`, or <Ctrl-D> to quit."
-    )
-  validPatterns
-    = [ helpPattern
   , InputPattern "add" [] []
-        (P.wrap $ "`add` adds to the codebase all the definitions from "
+    "`add` adds to the codebase all the definitions from the most recently typechecked file."
-               <> "the most recently typechecked file.")
     (\ws -> if not $ null ws
       then Left $ warn "`add` doesn't take any arguments."
       else pure $ SlurpFileI False)
   , InputPattern "branch" [] [(True, branchArg)]
-        (P.column2
+    (P.wrapColumn2
-          [ ("`branch`"
+      [ ("`branch`",      "lists all branches in the codebase.")
-            , P.wrap "lists all branches in the codebase.")
+      , ( "`branch foo`", "switches to the branch named 'foo', creating it first if it doesn't exist.")
-          , ( "`branch foo`"
-            , P.wrap "switches to the branch named 'foo', creating it first if it doesn't exist.")
       ]
     )
     (\case
@@ -110,28 +78,28 @@ validInputs = validPatterns
                                 <> "from the current branch."
     )
   , InputPattern "find" ["ls","list"] [(True, definitionQueryArg)]
-        (P.column2
+    (P.wrapColumn2
       [ ("`find`"
-            , P.wrap "lists all definitions in the current branch.")
+        , "lists all definitions in the current branch.")
       , ( "`find foo`"
-            , P.wrap "lists all definitions with a name similar to 'foo' in the current branch.")
+        , "lists all definitions with a name similar to 'foo' in the current branch.")
       , ( "`find foo bar`"
-            , P.wrap "lists all definitions with a name similar to 'foo' or 'bar' in the current branch.")
+        , "lists all definitions with a name similar to 'foo' or 'bar' in the current branch.")
       ]
     )
     (pure . SearchByNameI)
   , InputPattern "merge" [] [(False, branchArg)]
-        (P.wrap "`merge foo` merges the branch 'foo' into the current branch.")
+    "`merge foo` merges the branch 'foo' into the current branch."
     (\case
       [b] -> pure . MergeBranchI $ Text.pack b
       _ -> Left . warn . P.wrap $
         "Use `merge foo` to merge the branch 'foo' into the current branch."
     )
   , InputPattern "view" [] [(False, definitionQueryArg)]
-          (P.wrap "`view foo` prints the definition of `foo`.")
+      "`view foo` prints the definition of `foo`."
       (pure . ShowDefinitionI E.ConsoleLocation)
   , InputPattern "edit" [] [(False, definitionQueryArg)]
-          (P.wrap "`edit foo` prepends the definition of `foo` to the top of the most recently saved file.")
+      "`edit foo` prepends the definition of `foo` to the top of the most recently saved file."
       (pure . ShowDefinitionI E.LatestFileLocation)
   , InputPattern "rename" ["mv"]
     [(False, definitionQueryArg), (False, noCompletions)]
@@ -145,11 +113,9 @@ validInputs = validPatterns
       _ -> Left . P.warnCallout $ P.wrap
         "`rename` takes two arguments, like `rename oldname newname`."
     )
-      , InputPattern
+  , InputPattern "rename" ["mv"]
-        "rename"
-        ["mv"]
     [(False, definitionQueryArg), (False, noCompletions)]
-        (P.wrap "`rename foo bar` renames `foo` to `bar`.")
+    "`rename foo bar` renames `foo` to `bar`."
     (\case
       [oldName, newName] -> Right $ RenameUnconflictedI
         allTargets
@@ -157,12 +123,9 @@ validInputs = validPatterns
         (fromString newName)
       _ -> Left . P.warnCallout $ P.wrap
         "`rename` takes two arguments, like `rename oldname newname`.")
-      , InputPattern
+  , InputPattern "alias" ["cp"]
-        "alias"
-        ["cp"]
     [(False, definitionQueryArg), (False, noCompletions)]
-        (P.wrap
+    "`alias foo bar` introduces `bar` with the same definition as `foo`."
-          "`alias foo bar` introduces `bar` with the same definition as `foo`.")
     (\case
       [oldName, newName] -> Right $ AliasUnconflictedI
         allTargets
@@ -171,41 +134,48 @@ validInputs = validPatterns
       _ -> Left . warn $ P.wrap
         "`alias` takes two arguments, like `alias oldname newname`."
     )
-      , InputPattern
+  , InputPattern "update" [] []
-        "update"
+    "`update` works like `add`, except if a definition in the file has the same name as an existing definition, the name gets updated to point to the new definition. If the old definition has any dependents, `update` will add those dependents to a refactoring session."
-        []
-        []
-        (  P.wrap
-        $  "`update` works like `add`, except "
-        <> "if a definition in the file"
-        <> "has the same name as an existing definition, the name gets updated"
-        <> "to point to the new definition."
-        <> "If the old definition has any dependents, `update` will add"
-        <> "those dependents to a refactoring session."
-        )
     (\ws -> if not $ null ws
       then Left $ warn "`update` doesn't take any arguments."
       else pure $ SlurpFileI True
     )
-      , InputPattern
+  , InputPattern "propagate" [] []
-        "propagate"
+    "`propagate` rewrites any definitions that depend on definitions with type-preserving edits to use the updated versions of these dependencies."
-        []
-        []
-        (P.wrap $ "`propagate` rewrites any definitions that"
-               <> "depend on definitions with type-preserving edits to use"
-               <> "the updated versions of these dependencies.")
     (const $ pure PropagateI)
-      , InputPattern
+  , InputPattern "todo" [] []
-        "todo"
+    "`todo` lists the work remaining in the current branch to complete an ongoing refactoring."
-        []
-        []
-        (P.wrap
-        $ "`todo` lists the work remaining in the current branch " <>
-          "to complete an ongoing refactoring."
-        )
     (\ws -> if not $ null ws
                then Left $ warn "`todo` doesn't take any arguments."
                else pure $ TodoI)
-      , quit
+  , InputPattern "quit" ["exit"] []
+      "Exits the Unison command line interface."
+      (\case
+        [] -> pure QuitI
+        _  -> Left "Use `quit`, `exit`, or <Ctrl-D> to quit."
+      )
   ]
+  where
   allTargets = Set.fromList [Names.TermName, Names.TypeName]
+
+commandNames :: [String]
+commandNames = patternName <$> validInputs
+
+commandNameArg :: ArgumentType
+commandNameArg =
+  ArgumentType "command" $ \q _ _ -> pure (autoComplete q commandNames)
+
+branchArg :: ArgumentType
+branchArg = ArgumentType "branch" $ \q codebase _b -> do
+  branches <- Codebase.branches codebase
+  let bs = Text.unpack <$> branches
+  pure $ autoComplete q bs
+
+definitionQueryArg :: ArgumentType
+definitionQueryArg =
+  ArgumentType "definition query" $ \q _ (Branch.head -> b) -> do
+    let names = HQ.toString <$> toList (Branch.allNamesHashQualified b)
+    pure $ autoComplete q names
+
+noCompletions :: ArgumentType
+noCompletions = ArgumentType "a word" noSuggestions

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

@@ -26,7 +26,7 @@ import           Prelude                         hiding (readFile, writeFile)
 import qualified System.Console.ANSI             as Console
 import           System.Directory                (canonicalizePath,
                                                   doesFileExist)
-import           Unison.Codebase.Branch          (Branch)
+import           Unison.Codebase.Branch          (Branch, Branch0)
 import qualified Unison.Codebase.Branch          as Branch
 import           Unison.Codebase.Editor          (DisplayThing (..), Input (..),
                                                   Output (..))
@@ -52,6 +52,7 @@ import qualified Unison.Referent                 as Referent
 import qualified Unison.Result                   as Result
 import           Unison.Term                     (AnnotatedTerm)
 import qualified Unison.TermPrinter              as TermPrinter
+import           Unison.Type                     (AnnotatedType)
 import qualified Unison.TypePrinter              as TypePrinter
 import qualified Unison.Typechecker.TypeLookup   as TL
 import qualified Unison.UnisonFile               as UF
@@ -94,16 +95,12 @@ notifyUser dir o = case o of
   AliasOutput existingName newName r -> do
     nameChange "alias" "aliased" existingName newName r
   UnknownName branchName nameTarget name ->
-    putPrettyLn
+    putPrettyLn . warn . P.wrap $
-      .  warn
+     "I don't know of any " <> targets <> " named " <> n <> " in the branch " <> b <> "."
-      .  P.wrap
+    where
-      $  "I don't know of any "
+    targets = fromString (Names.renderNameTarget nameTarget)
-      <> fromString (Names.renderNameTarget nameTarget)
+    n = P.red (prettyName name)
-      <> " named "
+    b = P.blue (P.text branchName)
-      <> P.red (prettyName name)
-      <> " in the branch "
-      <> P.blue (P.text branchName)
-      <> "."
   NameAlreadyExists branchName nameTarget name ->
     putPrettyLn
       .  warn
@@ -144,176 +141,8 @@ notifyUser dir o = case o of
             else "  " <> P.text n
         in  intercalateMap "\n" go (sort branches)
   ListOfDefinitions branch terms types ->
-    let ppe  = Branch.prettyPrintEnv (Branch.head branch)
+    listOfDefinitions (Branch.head branch) terms types
-        sigs0 = (\(name, _, typ) -> (name, typ)) <$> terms
+  SlurpOutput s -> slurpOutput s
-        sigs = [(name,t) | (name, Just t) <- sigs0 ]
-        impossible = terms >>= \case
-          (name, r, Nothing) -> case r of
-            Referent.Ref (Reference.Builtin _) -> [(name,r)]
-            _                                  -> []
-          _ -> []
-        termsWithMissingTypes =
-          [ (name, r) | (name, Referent.Ref (Reference.DerivedId r), Nothing) <- terms ]
-        missingTypes = nubOrdOn snd $
-          [ (name, Reference.DerivedId r) | (name, _, MissingThing r) <- types ] <>
-          [ (name, r) | (name, Referent.toTypeReference -> Just r, Nothing) <- terms]
-        typeResults = map prettyDeclTriple types
-    in do
-      putPrettyLn . P.lines $
-        typeResults ++ TypePrinter.prettySignatures' ppe sigs ++
-        [formatMissingStuff termsWithMissingTypes missingTypes]
-      when (not $ null impossible) . error $ "Compiler bug, these referents are missing types: " <> show impossible
-
-  SlurpOutput s ->
-    putPrettyLn . P.sep "\n" . P.nonEmpty $ [
-        addMsg, updateMsg, dupeMsg, collMsg,
-        conflictMsg, aliasingMsg, termExistingCtorMsg,
-        ctorExistingTermMsg, blockedDependenciesMsg ]
-    where
-    -- todo: move this to a separate function
-    branch = E.updatedBranch s
-    file = E.originalFile s
-    E.SlurpComponent addedTypes addedTerms = E.adds s
-    E.SlurpComponent dupeTypes dupeTerms = E.duplicates s
-    E.SlurpComponent collidedTypes collidedTerms = E.collisions s
-    E.SlurpComponent conflictedTypes conflictedTerms = E.conflicts s
-    E.SlurpComponent updatedTypes updatedTerms = E.updates s
-    termTypesFromFile =
-      Map.fromList [ (v,t) | (v,_,t) <- join (UF.topLevelComponents file) ]
-    ppe =
-      Branch.prettyPrintEnv (Branch.head branch) `PPE.unionLeft`
-      Branch.prettyPrintEnv (Branch.fromTypecheckedFile file)
-    filterTermTypes vs =
-      [ (HQ.fromVar v,t) | v <- toList vs
-              , t <- maybe (error $ "There wasn't a type for " ++ show v ++ " in termTypesFromFile!") pure (Map.lookup v termTypesFromFile)]
-    prettyDeclHeader v = case UF.getDecl' file v of
-      Just (Left _)  -> TypePrinter.prettyEffectHeader (HQ.fromVar v)
-      Just (Right _) -> TypePrinter.prettyDataHeader (HQ.fromVar v)
-      Nothing        -> error "Wat."
-    addMsg = unlessM (null addedTypes && null addedTerms) . P.okCallout $
-      P.wrap ("I" <> P.bold "added" <> "these definitions:")
-      <> "\n\n" <> P.indentN 2
-        (P.lines (
-          (prettyDeclHeader <$> toList addedTypes) ++
-          TypePrinter.prettySignatures' ppe (filterTermTypes addedTerms))
-        )
-    updateMsg = unlessM (null updatedTypes && null updatedTerms) . P.okCallout $
-      P.wrap ("I" <> P.bold "updated" <> "these definitions:")
-      -- todo: show the partial hash too?
-      <> "\n\n"
-      <> P.indentN 2 (
-          P.lines (
-            (prettyDeclHeader <$> toList updatedTypes) ++
-            TypePrinter.prettySignatures' ppe (filterTermTypes updatedTerms))
-         )
-      -- todo "You probably have a bunch more work to do."
-    dupeMsg = unlessM (null dupeTypes && null dupeTerms) . P.callout "☑️" $
-      P.wrap ("I skipped these definitions because they have"
-               <> P.bold "already been added:")
-      <> "\n\n"
-      <> P.indentN 2 (
-          P.lines (
-            (prettyDeclHeader <$> toList dupeTypes) ++
-            TypePrinter.prettySignatures' ppe (filterTermTypes dupeTerms))
-        )
-    collMsg = unlessM (null collidedTypes && null collidedTerms) . P.warnCallout $
-      P.wrap ("I skipped these definitions because the" <> P.bold "names already exist," <> "but with different definitions:") <> "\n\n" <>
-      P.indentN 2 (
-        P.lines (
-          (prettyDeclHeader <$> toList collidedTypes) ++
-          TypePrinter.prettySignatures' ppe (filterTermTypes collidedTerms))
-        )
-        <> "\n\n"
-        <> tip ("You can use `update` if you're trying to replace the existing definitions and all their usages, or `rename` the existing definition to free up the name for the definitions in your .u file.")
-    conflictMsg = unlessM (null conflictedTypes && null conflictedTerms) . P.warnCallout $
-      let sampleName =
-            P.text . head . fmap Var.name . toList $
-              (conflictedTypes <> conflictedTerms)
-          sampleHash = "#abc" -- todo: get real hash prefix for sampleName
-          sampleNameHash = P.group (sampleName <> sampleHash)
-          sampleNameHash' = P.group (sampleNameHash <> "`")
-          sampleNameHash'' = P.group ("`" <> sampleNameHash <> "`")
-          -- todo: get real unused name from branch
-          sampleNewName = P.group (sampleName <> "2")
-          sampleNewName' = P.group (sampleNewName <> "`")
-          sampleName' = P.group (sampleName <>"`")
-          sampleName'' = P.group ("`" <> sampleName <>"`") in
-      P.wrap ("I didn't try to update these definitions because the names are" <>
-              P.bold "conflicted" <>
-              "(already associated with multiple definitions):")
-      <> P.newline
-      <> P.newline
-      <> P.indentN 2 (
-        P.lines (
-          (prettyDeclHeader <$> toList conflictedTypes) ++
-          TypePrinter.prettySignatures' ppe (filterTermTypes conflictedTerms))
-      ) <> "\n\n"
-        <> tip ("Use `view " <> sampleName' <> " to view the conflicting definitions and `rename " <> sampleNameHash <> " " <> sampleNewName' <> " to give each definition a distinct name. Alternatively, use `resolve " <> sampleNameHash' <> "to make" <> sampleNameHash'' <> " the canonical " <> sampleName'' <> "and remove the name from the other definitions.")
-    aliasingMsg = unlessM (R.null (Branch.termCollisions (E.needsAlias s))
-              && R.null (Branch.typeCollisions (E.needsAlias s))) . P.warnCallout $
-      let f = listToMaybe . Map.toList . R.domain
-          Just (sampleName0, sampleExistingName0) =
-            (f . Branch.typeCollisions) (E.needsAlias s) <|>
-            (f . Branch.termCollisions) (E.needsAlias s)
-          sampleNewName' = P.group (prettyName sampleName0 <> "`")
-          sampleOldName = prettyName . head . toList $ sampleExistingName0 in
-
-      P.wrap ("I skipped these definitions because they already" <> P.bold "exist with other names:") <> "\n\n" <>
-      P.indentN 2 (
-        P.lines . join $ [
-          P.align
-        -- ("type Optional", "aka " ++ commas existingNames)
-        -- todo: something is wrong here: only one oldName is being shown, instead of all
-          [(prettyDeclHeader $ Name.toVar newName,
-            "aka " <> P.commas (prettyName <$> toList oldNames)) |
-            (newName, oldNames) <-
-              Map.toList . R.domain . Branch.typeCollisions $ (E.needsAlias s) ],
-        TypePrinter.prettySignaturesAlt' ppe
-            -- foo, foo2, fasdf : a -> b -> c
-            -- note: this shit vvvv is not a Name.
-            [ (name : fmap HQ.fromName (toList oldNames), typ)
-            | (newName, oldNames) <-
-                Map.toList . R.domain . Branch.termCollisions $ (E.needsAlias s)
-            , (name, typ) <- filterTermTypes [Name.toVar newName]
-            ]
-        ])
-        <> "\n\n"
-        <> tip ("Use `alias" <> sampleOldName <> " " <> sampleNewName' <> "to create an additional name for this definition.")
-    termExistingCtorCollisions = E.termExistingConstructorCollisions s
-    termExistingCtorMsg =
-      unlessM (null termExistingCtorCollisions) . P.warnCallout $
-        P.wrap ("I can't update these terms because the" <> P.bold "names are currently assigned to constructors:") <> "\n\n" <>
-          P.indentN 2
-            (P.column2
-              [ (P.text $ Var.name v, "is a constructor for " <> go r)
-              | (v, r) <- Map.toList termExistingCtorCollisions ]
-            )
-            <> "\n\n"
-            <> tip "You can `rename` these constructors to free up the names for your new definitions."
-      where
-        go r = prettyHashQualified (PPE.typeName ppe (Referent.toReference r))
-    ctorExistingTermCollisions = E.constructorExistingTermCollisions s
-    commaRefs rs = P.wrap $ P.commas (map go rs) where
-      go r = prettyHashQualified (PPE.termName ppe r)
-    ctorExistingTermMsg = unlessM (null ctorExistingTermCollisions) . P.warnCallout $
-      P.wrap ("I can't update these types because one or more of the" <> P.bold "constructor names matches an existing term:") <> "\n\n" <>
-        P.indentN 2 (
-          P.column2 [
-            (P.text $ Var.name v, "has name collisions for: " <> commaRefs rs)
-            | (v, rs) <- Map.toList ctorExistingTermCollisions ]
-          )
-          <> "\n\n"
-          <> tip "You can `rename` existing definitions to free up the names for your new definitions."
-    blockedTerms = Map.keys (E.termsWithBlockedDependencies s)
-    blockedTypes = Map.keys (E.typesWithBlockedDependencies s)
-    blockedDependenciesMsg = unlessM (null blockedTerms && null blockedTypes) . P.warnCallout $
-        P.wrap ("I also skipped these definitions with a" <> P.bold "transitive dependency on a skipped definition" <> "mentioned above:") <> "\n\n"
-        <> P.indentN 2 (
-            P.lines (
-              (prettyDeclHeader <$> toList blockedTypes) ++
-              TypePrinter.prettySignatures' ppe (filterTermTypes blockedTerms)
-            )
-           )
   ParseErrors src es -> do
     Console.setTitle "Unison ☹︎"
     traverse_ (putStrLn . CT.toANSI . prettyParseError (Text.unpack src)) es
@@ -349,24 +178,16 @@ notifyUser dir o = case o of
     Console.setTitle "Unison ☺︎"
     -- todo: we should just print this the same way as everything else
     let defs       = prettyTypecheckedFile uf errorEnv
-    when (not $ null defs) . putPrettyLn' . ("\n" <>) $
+    when (not $ null defs) . putPrettyLn' . ("\n" <>) . P.okCallout . P.lines$
-      P.okCallout $
+     [ P.wrap $ "I found and" <> P.bold "typechecked" <> "these definitions in " <> P.group (P.text sourceName <> ":")
-        P.lines [
+     , ""
-          P.wrap (
+     , P.lit defs
-            "I found and" <> P.bold "typechecked" <> "these definitions in " <>
+     , P.wrap "Now evaluating any watch expressions (lines starting with `>`)..."
-            P.group (P.text sourceName <> ":")
-          ),
-          "",
-          P.lit defs,
-          P.wrap $
-            "Now evaluating any watch expressions (lines starting with `>`)"
-            <> "..."
      ]
   TodoOutput branch todo -> todoOutput branch todo
 
  where
   renderFileName = P.group . P.blue . fromString
-
   nameChange cmd pastTenseCmd oldName newName r = do
     when (not . Set.null $ E.changedSuccessfully r) . putPrettyLn . P.okCallout $
       P.wrap $ "I" <> pastTenseCmd <> "the"
@@ -398,11 +219,11 @@ notifyUser dir o = case o of
 formatMissingStuff :: (Show tm, Show typ) =>
   [(HQ.HashQualified, tm)] -> [(HQ.HashQualified, typ)] -> P.Pretty P.ColorText
 formatMissingStuff terms types =
-  (if null terms then mempty else P.fatalCallout $
+  (unlessM (null terms) . P.fatalCallout $
     P.wrap "The following terms have a missing or corrupted type signature:"
     <> "\n\n"
     <> P.column2 [ (prettyHashQualified name, fromString (show ref)) | (name, ref) <- terms ]) <>
-  (if null types then mempty else P.fatalCallout $
+  (unlessM (null types) . P.fatalCallout $
     P.wrap "The following types weren't found in the codebase:"
     <> "\n\n"
     <> P.column2 [ (prettyHashQualified name, fromString (show ref)) | (name, ref) <- types ])
@@ -499,15 +320,12 @@ renderNameConflicts conflictedTypeNames conflictedTermNames =
 renderEditConflicts ::
   PPE.PrettyPrintEnv -> Branch.Branch0 -> P.Pretty CT.ColorText
 renderEditConflicts ppe (Branch.editConflicts -> editConflicts) =
-  if null editConflicts then mempty else
+  unlessM (null editConflicts) . P.callout "❓" . P.sep "\n\n" $ [
-    P.callout "❓" . P.sep "\n\n" $ [
     P.wrap $ "These" <> P.bold "definitions were edited differently"
           <> "in branches that have been merged into this branch."
           <> "You'll have to tell me what to use as the new definition:",
     P.indentN 2 (P.lines (formatConflict <$> editConflicts)),
-    tip $ "Use" <>
+    tip $ "Use " <> backtick ("resolve-edit " <> name (head editConflicts) <> " <replacement>") <> " to pick a replacement." -- todo: eventually something with `edit`
-      P.group ("`resolve-edit " <> name (head editConflicts) <> " <replacement>")
-      <> "to pick a replacement." -- todo: eventually something with `edit`
     ]
   where
     name = either (typeName . fst) (termName . fst)
@@ -567,3 +385,172 @@ todoOutput (Branch.head -> branch) todo =
                 (goodTerms $ unscore <$> dirtyTerms))
       , formatMissingStuff corruptTerms corruptTypes
       ]
+
+listOfDefinitions :: Var v =>
+  Branch0
+  -> [(HQ.HashQualified, Referent.Referent, Maybe (AnnotatedType v a1))]
+  -> [(HQ.HashQualified, Reference.Reference, DisplayThing (TL.Decl v2 a2))]
+  -> IO ()
+listOfDefinitions branch terms types = do
+  putPrettyLn . P.lines $
+    typeResults ++
+    TypePrinter.prettySignatures' ppe termsWithTypes ++
+    [formatMissingStuff termsWithMissingTypes missingTypes]
+  unless (null impossible) . error $ "Compiler bug, these referents are missing types: " <> show impossible
+  where
+  ppe  = Branch.prettyPrintEnv branch
+  typeResults = map prettyDeclTriple types
+  termsWithTypes = [(name,t) | (name, Just t) <- sigs0 ]
+    where sigs0 = (\(name, _, typ) -> (name, typ)) <$> terms
+  termsWithMissingTypes =
+    [ (name, r) | (name, Referent.Ref (Reference.DerivedId r), Nothing) <- terms ]
+  missingTypes = nubOrdOn snd $
+    [ (name, Reference.DerivedId r) | (name, _, MissingThing r) <- types ] <>
+    [ (name, r) | (name, Referent.toTypeReference -> Just r, Nothing) <- terms]
+  impossible = terms >>= \case
+    (name, r@(Referent.Ref (Reference.Builtin _)), Nothing) -> [(name,r)]
+    _ -> []
+
+-- todo: could probably use more cleanup
+slurpOutput :: Var v => E.SlurpResult v -> IO ()
+slurpOutput s =
+  putPrettyLn . P.sep "\n" . P.nonEmpty $ [
+      addedMsg, updatedMsg, alreadyAddedMsg, namesExistMsg,
+      namesConflictedMsg, aliasingMsg, termExistingCtorMsg,
+      ctorExistingTermMsg, blockedDependenciesMsg ]
+  where
+  -- todo: move this to a separate function
+  branch = E.updatedBranch s
+  file = E.originalFile s
+  E.SlurpComponent addedTypes addedTerms = E.adds s
+  E.SlurpComponent dupeTypes dupeTerms = E.duplicates s
+  E.SlurpComponent collidedTypes collidedTerms = E.collisions s
+  E.SlurpComponent conflictedTypes conflictedTerms = E.conflicts s
+  E.SlurpComponent updatedTypes updatedTerms = E.updates s
+  termTypesFromFile =
+    Map.fromList [ (v,t) | (v,_,t) <- join (UF.topLevelComponents file) ]
+  ppe = Branch.prettyPrintEnv (Branch.head branch)
+    <> Branch.prettyPrintEnv (Branch.fromTypecheckedFile file)
+  filterTermTypes vs =
+    [ (HQ.fromVar v,t)
+    | v <- toList vs
+    , t <- maybe (error $ "There wasn't a type for " ++ show v ++ " in termTypesFromFile!") pure (Map.lookup v termTypesFromFile)]
+  prettyDeclHeader v = case UF.getDecl' file v of
+    Just (Left _)  -> TypePrinter.prettyEffectHeader (HQ.fromVar v)
+    Just (Right _) -> TypePrinter.prettyDataHeader (HQ.fromVar v)
+    Nothing        -> error "Wat."
+  addedMsg =
+    unlessM (null addedTypes && null addedTerms) . P.okCallout $
+    P.wrap ("I" <> P.bold "added" <> "these definitions:")
+    <> "\n\n"
+    <> (P.indentN 2 . P.lines $
+        (prettyDeclHeader <$> toList addedTypes) ++
+        TypePrinter.prettySignatures' ppe (filterTermTypes addedTerms))
+  updatedMsg =
+    unlessM (null updatedTypes && null updatedTerms) . P.okCallout $
+    P.wrap ("I" <> P.bold "updated" <> "these definitions:")
+    -- todo: show the partial hash too?
+    <> "\n\n"
+    <> (P.indentN 2 . P.lines $
+        (prettyDeclHeader <$> toList updatedTypes) ++
+        TypePrinter.prettySignatures' ppe (filterTermTypes updatedTerms))
+    -- todo "You probably have a bunch more work to do."
+  alreadyAddedMsg =
+    unlessM (null dupeTypes && null dupeTerms) . P.callout "☑️" $
+    P.wrap ("I skipped these definitions because they have"
+             <> P.bold "already been added:")
+    <> "\n\n"
+    <> (P.indentN 2 . P.lines $
+          (prettyDeclHeader <$> toList dupeTypes) ++
+          TypePrinter.prettySignatures' ppe (filterTermTypes dupeTerms))
+  namesExistMsg =
+    unlessM (null collidedTypes && null collidedTerms) . P.warnCallout $
+    P.wrap ("I skipped these definitions because the" <> P.bold "names already exist," <> "but with different definitions:")
+    <> "\n\n"
+    <> (P.indentN 2 . P.lines $
+        (prettyDeclHeader <$> toList collidedTypes) ++
+        TypePrinter.prettySignatures' ppe (filterTermTypes collidedTerms))
+    <> "\n\n"
+    <> tip ("You can use `update` if you're trying to replace the existing definitions and all their usages, or `rename` the existing definition to free up the name for the definitions in your .u file.")
+  namesConflictedMsg =
+    unlessM (null conflictedTypes && null conflictedTerms) . P.warnCallout $
+    P.wrap ("I didn't try to update these definitions because the names are" <> P.bold "conflicted" <> "(already associated with multiple definitions):")
+    <> "\n\n"
+    <> (P.indentN 2 . P.lines $
+        (prettyDeclHeader <$> toList conflictedTypes) ++
+        TypePrinter.prettySignatures' ppe (filterTermTypes conflictedTerms))
+    <> "\n\n"
+    <> tip ("Use " <> backtick ("view " <> sampleName) <> " to view the conflicting definitions and " <> backtick ("rename " <> sampleNameHash <> " " <> sampleNewName) <> " to give each definition a distinct name. Alternatively, use " <> backtick ("resolve " <> sampleNameHash) <> "to make" <> backtick sampleNameHash <> " the canonical " <> backtick sampleName <> "and remove the name from the other definitions.")
+    where
+    sampleName =
+      P.text . head . fmap Var.name . toList $ (conflictedTypes <> conflictedTerms)
+    sampleHash = "#abc" -- todo: get real hash prefix for sampleName
+    sampleNameHash = P.group (sampleName <> sampleHash)
+    -- todo: get real unused name from branch
+    sampleNewName = P.group (sampleName <> "2")
+  aliasingMsg =
+    unlessM (R.null (Branch.termCollisions (E.needsAlias s))
+        && R.null (Branch.typeCollisions (E.needsAlias s))) . P.warnCallout $
+    P.wrap ("I skipped these definitions because they already" <> P.bold "exist with other names:")
+    <> "\n\n"
+    <> P.indentN 2 (P.lines . join $ [
+        P.align
+      -- ("type Optional", "aka " ++ commas existingNames)
+      -- todo: something is wrong here: only one oldName is being shown, instead of all
+        [(prettyDeclHeader $ Name.toVar newName,
+          "aka " <> P.commas (prettyName <$> toList oldNames)) |
+          (newName, oldNames) <-
+            Map.toList . R.domain . Branch.typeCollisions $ (E.needsAlias s) ],
+      TypePrinter.prettySignaturesAlt' ppe
+          -- foo, foo2, fasdf : a -> b -> c
+          -- note: this shit vvvv is not a Name.
+          [ (name : fmap HQ.fromName (toList oldNames), typ)
+          | (newName, oldNames) <-
+              Map.toList . R.domain . Branch.termCollisions $ (E.needsAlias s)
+          , (name, typ) <- filterTermTypes [Name.toVar newName]
+          ]
+      ])
+      <> "\n\n"
+      <> tip ("Use " <> backtick ("alias " <> sampleOldName <> " " <> sampleNewName) <> "to create an additional name for this definition.")
+    where
+      f = listToMaybe . Map.toList . R.domain
+      Just (prettyName -> sampleNewName,
+            prettyName . head . toList -> sampleOldName) =
+            (f . Branch.typeCollisions) (E.needsAlias s) <|>
+            (f . Branch.termCollisions) (E.needsAlias s)
+  termExistingCtorMsg =
+    unlessM (null ctorCollisions) . P.warnCallout $
+    P.wrap ("I can't update these terms because the" <> P.bold "names are currently assigned to constructors:")
+    <> "\n\n"
+    <> (P.indentN 2 $
+        (P.column2 [ (P.text $ Var.name v, "is a constructor for " <> go r)
+                   | (v, r) <- Map.toList ctorCollisions ])
+        <> "\n\n"
+        <> tip "You can `rename` these constructors to free up the names for your new definitions.")
+    where
+      ctorCollisions = E.termExistingConstructorCollisions s
+      go r = prettyHashQualified (PPE.typeName ppe (Referent.toReference r))
+  ctorExistingTermMsg =
+    unlessM (null ctorExistingTermCollisions) . P.warnCallout $
+    P.wrap ("I can't update these types because one or more of the" <> P.bold "constructor names matches an existing term:") <> "\n\n" <>
+      P.indentN 2 (
+        P.column2 [
+          (P.text $ Var.name v, "has name collisions for: " <> commaRefs rs)
+          | (v, rs) <- Map.toList ctorExistingTermCollisions ]
+        )
+        <> "\n\n"
+        <> tip "You can `rename` existing definitions to free up the names for your new definitions."
+    where
+    ctorExistingTermCollisions = E.constructorExistingTermCollisions s
+    commaRefs rs = P.wrap $ P.commas (map go rs)
+    go r = prettyHashQualified (PPE.termName ppe r)
+  blockedDependenciesMsg =
+    unlessM (null blockedTerms && null blockedTypes) . P.warnCallout $
+    P.wrap ("I also skipped these definitions with a" <> P.bold "transitive dependency on a skipped definition" <> "mentioned above:")
+    <> "\n\n"
+    <> (P.indentN 2 . P.lines $
+        (prettyDeclHeader <$> toList blockedTypes) ++
+        TypePrinter.prettySignatures' ppe (filterTermTypes blockedTerms))
+    where
+      blockedTerms = Map.keys (E.termsWithBlockedDependencies s)
+      blockedTypes = Map.keys (E.typesWithBlockedDependencies s)

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

@@ -59,6 +59,7 @@ module Unison.Util.Pretty (
    toANSI,
    toPlain,
    wrap,
+   wrapColumn2,
    wrapString,
    black, red, green, yellow, blue, purple, cyan, white, hiBlack, hiRed, hiGreen, hiYellow, hiBlue, hiPurple, hiCyan, hiWhite, bold,
    border
@@ -177,7 +178,8 @@ render availableWidth p = go mempty [Right p] where
     in maxCol (cur' <> delta p) < availableWidth
 
 newline :: IsString s => Pretty s
-newline = lit' (chDelta '\n') (fromString "\n")
+newline = "\n"
+
 
 spaceIfBreak :: IsString s => Pretty s
 spaceIfBreak = "" `orElse` " "
@@ -279,6 +281,13 @@ column2
   :: (LL.ListLike s Char, IsString s) => [(Pretty s, Pretty s)] -> Pretty s
 column2 rows = lines (group <$> align rows)
 
+wrapColumn2 ::
+  (LL.ListLike s Char, IsString s) => [(Pretty s, Pretty s)] -> Pretty s
+wrapColumn2 rows = lines (align rows) where
+  align rows = let lwidth = foldl' max 0 (preferredWidth . fst <$> rows) + 1
+    in [ group (rightPad lwidth l <> indentNAfterNewline lwidth (wrap r))
+       | (l, r) <- rows]
+
 align :: (LL.ListLike s Char, IsString s)
   => [(Pretty s, Pretty s)]
   -> [Pretty s]