mirror of
https://github.com/unisonweb/unison.git
synced 2024-09-24 08:47:19 +03:00
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.
This commit is contained in:
parent
e872dea777
commit
4606280fc1
@ -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,172 +39,143 @@ 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
|
||||
where
|
||||
commandNames = patternName <$> validPatterns
|
||||
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
|
||||
[cmd] -> case Map.lookup cmd commandMap of
|
||||
Nothing -> Left . warn $ "I don't know of that command. Try `help`."
|
||||
Just pat -> Left $ help pat
|
||||
_ -> 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 "
|
||||
<> "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
|
||||
[ ("`branch`"
|
||||
, P.wrap "lists all branches in the codebase.")
|
||||
, ( "`branch foo`"
|
||||
, P.wrap "switches to the branch named 'foo', creating it first if it doesn't exist.")
|
||||
]
|
||||
)
|
||||
(\case
|
||||
[] -> pure ListBranchesI
|
||||
[b] -> pure . SwitchBranchI $ Text.pack b
|
||||
_ -> Left . warn . P.wrap $ "Use `branch` to list all branches "
|
||||
<> "or `branch foo` to switch to or create the branch 'foo'."
|
||||
)
|
||||
, InputPattern "fork" [] [(False, branchArg)]
|
||||
(P.wrap
|
||||
"`fork foo` creates the branch 'foo' as a fork of the current branch.")
|
||||
(\case
|
||||
[b] -> pure . ForkBranchI $ Text.pack b
|
||||
_ -> Left . warn . P.wrap $ "Use `fork foo` to create the branch 'foo'"
|
||||
<> "from the current branch."
|
||||
)
|
||||
, InputPattern "find" ["ls","list"] [(True, definitionQueryArg)]
|
||||
(P.column2
|
||||
[ ("`find`"
|
||||
, P.wrap "lists all definitions in the current branch.")
|
||||
, ( "`find foo`"
|
||||
, P.wrap "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.")
|
||||
]
|
||||
)
|
||||
(pure . SearchByNameI)
|
||||
, InputPattern "merge" [] [(False, branchArg)]
|
||||
(P.wrap "`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`.")
|
||||
(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.")
|
||||
(pure . ShowDefinitionI E.LatestFileLocation)
|
||||
, InputPattern "rename" ["mv"]
|
||||
[(False, definitionQueryArg), (False, noCompletions)]
|
||||
(P.wrap "`rename foo bar` renames `foo` to `bar`.")
|
||||
(\case
|
||||
[oldName, newName] ->
|
||||
Right $ RenameUnconflictedI
|
||||
allTargets
|
||||
(fromString oldName)
|
||||
(fromString newName)
|
||||
_ -> Left . P.warnCallout $ P.wrap
|
||||
"`rename` takes two arguments, like `rename oldname newname`."
|
||||
)
|
||||
, InputPattern
|
||||
"rename"
|
||||
["mv"]
|
||||
[(False, definitionQueryArg), (False, noCompletions)]
|
||||
(P.wrap "`rename foo bar` renames `foo` to `bar`.")
|
||||
(\case
|
||||
[oldName, newName] -> Right $ RenameUnconflictedI
|
||||
allTargets
|
||||
(fromString oldName)
|
||||
(fromString newName)
|
||||
_ -> Left . P.warnCallout $ P.wrap
|
||||
"`rename` takes two arguments, like `rename oldname newname`.")
|
||||
, InputPattern
|
||||
"alias"
|
||||
["cp"]
|
||||
[(False, definitionQueryArg), (False, noCompletions)]
|
||||
(P.wrap
|
||||
"`alias foo bar` introduces `bar` with the same definition as `foo`.")
|
||||
(\case
|
||||
[oldName, newName] -> Right $ AliasUnconflictedI
|
||||
allTargets
|
||||
(fromString oldName)
|
||||
(fromString newName)
|
||||
_ -> Left . warn $ P.wrap
|
||||
"`alias` takes two arguments, like `alias oldname newname`."
|
||||
)
|
||||
, InputPattern
|
||||
"update"
|
||||
[]
|
||||
[]
|
||||
( 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
|
||||
"propagate"
|
||||
[]
|
||||
[]
|
||||
(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
|
||||
"todo"
|
||||
[]
|
||||
[]
|
||||
(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
|
||||
validInputs =
|
||||
[ InputPattern
|
||||
"help" ["?"] [(True, commandNameArg)]
|
||||
"`help` shows general help and `help <cmd>` shows help for one command."
|
||||
(\case
|
||||
[] -> Left $ intercalateMap "\n\n" showPatternHelp validInputs
|
||||
[cmd] -> case lookup cmd (commandNames `zip` validInputs) of
|
||||
Nothing -> Left . warn $ "I don't know of that command. Try `help`."
|
||||
Just pat -> Left $ I.help pat
|
||||
_ -> Left $ warn "Use `help <cmd>` or `help`.")
|
||||
, InputPattern "add" [] []
|
||||
"`add` adds to the codebase all the definitions from 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.wrapColumn2
|
||||
[ ("`branch`", "lists all branches in the codebase.")
|
||||
, ( "`branch foo`", "switches to the branch named 'foo', creating it first if it doesn't exist.")
|
||||
]
|
||||
)
|
||||
(\case
|
||||
[] -> pure ListBranchesI
|
||||
[b] -> pure . SwitchBranchI $ Text.pack b
|
||||
_ -> Left . warn . P.wrap $ "Use `branch` to list all branches "
|
||||
<> "or `branch foo` to switch to or create the branch 'foo'."
|
||||
)
|
||||
, InputPattern "fork" [] [(False, branchArg)]
|
||||
(P.wrap
|
||||
"`fork foo` creates the branch 'foo' as a fork of the current branch.")
|
||||
(\case
|
||||
[b] -> pure . ForkBranchI $ Text.pack b
|
||||
_ -> Left . warn . P.wrap $ "Use `fork foo` to create the branch 'foo'"
|
||||
<> "from the current branch."
|
||||
)
|
||||
, InputPattern "find" ["ls","list"] [(True, definitionQueryArg)]
|
||||
(P.wrapColumn2
|
||||
[ ("`find`"
|
||||
, "lists all definitions in the current branch.")
|
||||
, ( "`find foo`"
|
||||
, "lists all definitions with a name similar to 'foo' in the current branch.")
|
||||
, ( "`find foo bar`"
|
||||
, "lists all definitions with a name similar to 'foo' or 'bar' in the current branch.")
|
||||
]
|
||||
)
|
||||
(pure . SearchByNameI)
|
||||
, InputPattern "merge" [] [(False, branchArg)]
|
||||
"`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)]
|
||||
"`view foo` prints the definition of `foo`."
|
||||
(pure . ShowDefinitionI E.ConsoleLocation)
|
||||
, InputPattern "edit" [] [(False, definitionQueryArg)]
|
||||
"`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)]
|
||||
(P.wrap "`rename foo bar` renames `foo` to `bar`.")
|
||||
(\case
|
||||
[oldName, newName] ->
|
||||
Right $ RenameUnconflictedI
|
||||
allTargets
|
||||
(fromString oldName)
|
||||
(fromString newName)
|
||||
_ -> Left . P.warnCallout $ P.wrap
|
||||
"`rename` takes two arguments, like `rename oldname newname`."
|
||||
)
|
||||
, InputPattern "rename" ["mv"]
|
||||
[(False, definitionQueryArg), (False, noCompletions)]
|
||||
"`rename foo bar` renames `foo` to `bar`."
|
||||
(\case
|
||||
[oldName, newName] -> Right $ RenameUnconflictedI
|
||||
allTargets
|
||||
(fromString oldName)
|
||||
(fromString newName)
|
||||
_ -> Left . P.warnCallout $ P.wrap
|
||||
"`rename` takes two arguments, like `rename oldname newname`.")
|
||||
, InputPattern "alias" ["cp"]
|
||||
[(False, definitionQueryArg), (False, noCompletions)]
|
||||
"`alias foo bar` introduces `bar` with the same definition as `foo`."
|
||||
(\case
|
||||
[oldName, newName] -> Right $ AliasUnconflictedI
|
||||
allTargets
|
||||
(fromString oldName)
|
||||
(fromString newName)
|
||||
_ -> Left . warn $ P.wrap
|
||||
"`alias` takes two arguments, like `alias oldname newname`."
|
||||
)
|
||||
, InputPattern "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."
|
||||
(\ws -> if not $ null ws
|
||||
then Left $ warn "`update` doesn't take any arguments."
|
||||
else pure $ SlurpFileI True
|
||||
)
|
||||
, InputPattern "propagate" [] []
|
||||
"`propagate` rewrites any definitions that depend on definitions with type-preserving edits to use the updated versions of these dependencies."
|
||||
(const $ pure PropagateI)
|
||||
, InputPattern "todo" [] []
|
||||
"`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)
|
||||
, 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
|
||||
|
@ -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
|
||||
. warn
|
||||
. P.wrap
|
||||
$ "I don't know of any "
|
||||
<> fromString (Names.renderNameTarget nameTarget)
|
||||
<> " named "
|
||||
<> P.red (prettyName name)
|
||||
<> " in the branch "
|
||||
<> P.blue (P.text branchName)
|
||||
<> "."
|
||||
putPrettyLn . warn . P.wrap $
|
||||
"I don't know of any " <> targets <> " named " <> n <> " in the branch " <> b <> "."
|
||||
where
|
||||
targets = fromString (Names.renderNameTarget nameTarget)
|
||||
n = P.red (prettyName name)
|
||||
b = 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)
|
||||
sigs0 = (\(name, _, typ) -> (name, typ)) <$> terms
|
||||
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)
|
||||
)
|
||||
)
|
||||
listOfDefinitions (Branch.head branch) terms types
|
||||
SlurpOutput s -> slurpOutput s
|
||||
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" <>) $
|
||||
P.okCallout $
|
||||
P.lines [
|
||||
P.wrap (
|
||||
"I found and" <> P.bold "typechecked" <> "these definitions in " <>
|
||||
P.group (P.text sourceName <> ":")
|
||||
),
|
||||
"",
|
||||
P.lit defs,
|
||||
P.wrap $
|
||||
"Now evaluating any watch expressions (lines starting with `>`)"
|
||||
<> "..."
|
||||
]
|
||||
when (not $ null defs) . putPrettyLn' . ("\n" <>) . P.okCallout . P.lines$
|
||||
[ P.wrap $ "I found and" <> P.bold "typechecked" <> "these definitions in " <> 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
|
||||
P.callout "❓" . P.sep "\n\n" $ [
|
||||
unlessM (null editConflicts) . 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" <>
|
||||
P.group ("`resolve-edit " <> name (head editConflicts) <> " <replacement>")
|
||||
<> "to pick a replacement." -- todo: eventually something with `edit`
|
||||
tip $ "Use " <> backtick ("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)
|
||||
|
@ -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]
|
||||
|
Loading…
Reference in New Issue
Block a user