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.Foldable (toList)
|
||||||
import Data.List (intercalate)
|
import Data.List (intercalate)
|
||||||
import qualified Data.Map as Map
|
|
||||||
import qualified Data.Set as Set
|
import qualified Data.Set as Set
|
||||||
import Data.String (fromString)
|
import Data.String (fromString)
|
||||||
import qualified Data.Text as Text
|
import qualified Data.Text as Text
|
||||||
@ -22,10 +21,10 @@ import qualified Unison.Codebase.Branch as Branch
|
|||||||
import Unison.Codebase.Editor (Input (..))
|
import Unison.Codebase.Editor (Input (..))
|
||||||
import qualified Unison.Codebase.Editor as E
|
import qualified Unison.Codebase.Editor as E
|
||||||
import Unison.CommandLine
|
import Unison.CommandLine
|
||||||
|
import qualified Unison.CommandLine.InputPattern as I
|
||||||
import Unison.CommandLine.InputPattern (ArgumentType (ArgumentType),
|
import Unison.CommandLine.InputPattern (ArgumentType (ArgumentType),
|
||||||
InputPattern (InputPattern,
|
InputPattern (InputPattern,
|
||||||
aliases,
|
aliases,
|
||||||
help,
|
|
||||||
patternName),
|
patternName),
|
||||||
noSuggestions)
|
noSuggestions)
|
||||||
import qualified Unison.HashQualified as HQ
|
import qualified Unison.HashQualified as HQ
|
||||||
@ -40,172 +39,143 @@ showPatternHelp i = P.lines [
|
|||||||
(if not . null $ aliases i
|
(if not . null $ aliases i
|
||||||
then " (or " <> intercalate ", " (aliases i) <> ")"
|
then " (or " <> intercalate ", " (aliases i) <> ")"
|
||||||
else ""),
|
else ""),
|
||||||
help i ]
|
P.wrap $ I.help i ]
|
||||||
|
|
||||||
validInputs :: [InputPattern]
|
validInputs :: [InputPattern]
|
||||||
validInputs = validPatterns
|
validInputs =
|
||||||
where
|
[ InputPattern
|
||||||
commandNames = patternName <$> validPatterns
|
"help" ["?"] [(True, commandNameArg)]
|
||||||
commandMap = Map.fromList (commandNames `zip` validPatterns)
|
"`help` shows general help and `help <cmd>` shows help for one command."
|
||||||
helpPattern = InputPattern
|
(\case
|
||||||
"help"
|
[] -> Left $ intercalateMap "\n\n" showPatternHelp validInputs
|
||||||
["?"]
|
[cmd] -> case lookup cmd (commandNames `zip` validInputs) of
|
||||||
[(True, commandName)]
|
Nothing -> Left . warn $ "I don't know of that command. Try `help`."
|
||||||
"`help` shows general help and `help <cmd>` shows help for one command."
|
Just pat -> Left $ I.help pat
|
||||||
(\case
|
_ -> Left $ warn "Use `help <cmd>` or `help`.")
|
||||||
[] -> Left $ intercalateMap "\n\n" showPatternHelp validPatterns
|
, InputPattern "add" [] []
|
||||||
[cmd] -> case Map.lookup cmd commandMap of
|
"`add` adds to the codebase all the definitions from the most recently typechecked file."
|
||||||
Nothing -> Left . warn $ "I don't know of that command. Try `help`."
|
(\ws -> if not $ null ws
|
||||||
Just pat -> Left $ help pat
|
then Left $ warn "`add` doesn't take any arguments."
|
||||||
_ -> Left $ warn "Use `help <cmd>` or `help`."
|
else pure $ SlurpFileI False)
|
||||||
)
|
, InputPattern "branch" [] [(True, branchArg)]
|
||||||
commandName =
|
(P.wrapColumn2
|
||||||
ArgumentType "command" $ \q _ _ -> pure $ autoComplete q commandNames
|
[ ("`branch`", "lists all branches in the codebase.")
|
||||||
branchArg = ArgumentType "branch" $ \q codebase _b -> do
|
, ( "`branch foo`", "switches to the branch named 'foo', creating it first if it doesn't exist.")
|
||||||
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
|
|
||||||
]
|
]
|
||||||
|
)
|
||||||
|
(\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]
|
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 qualified System.Console.ANSI as Console
|
||||||
import System.Directory (canonicalizePath,
|
import System.Directory (canonicalizePath,
|
||||||
doesFileExist)
|
doesFileExist)
|
||||||
import Unison.Codebase.Branch (Branch)
|
import Unison.Codebase.Branch (Branch, Branch0)
|
||||||
import qualified Unison.Codebase.Branch as Branch
|
import qualified Unison.Codebase.Branch as Branch
|
||||||
import Unison.Codebase.Editor (DisplayThing (..), Input (..),
|
import Unison.Codebase.Editor (DisplayThing (..), Input (..),
|
||||||
Output (..))
|
Output (..))
|
||||||
@ -52,6 +52,7 @@ import qualified Unison.Referent as Referent
|
|||||||
import qualified Unison.Result as Result
|
import qualified Unison.Result as Result
|
||||||
import Unison.Term (AnnotatedTerm)
|
import Unison.Term (AnnotatedTerm)
|
||||||
import qualified Unison.TermPrinter as TermPrinter
|
import qualified Unison.TermPrinter as TermPrinter
|
||||||
|
import Unison.Type (AnnotatedType)
|
||||||
import qualified Unison.TypePrinter as TypePrinter
|
import qualified Unison.TypePrinter as TypePrinter
|
||||||
import qualified Unison.Typechecker.TypeLookup as TL
|
import qualified Unison.Typechecker.TypeLookup as TL
|
||||||
import qualified Unison.UnisonFile as UF
|
import qualified Unison.UnisonFile as UF
|
||||||
@ -94,16 +95,12 @@ notifyUser dir o = case o of
|
|||||||
AliasOutput existingName newName r -> do
|
AliasOutput existingName newName r -> do
|
||||||
nameChange "alias" "aliased" existingName newName r
|
nameChange "alias" "aliased" existingName newName r
|
||||||
UnknownName branchName nameTarget name ->
|
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 ->
|
NameAlreadyExists branchName nameTarget name ->
|
||||||
putPrettyLn
|
putPrettyLn
|
||||||
. warn
|
. warn
|
||||||
@ -144,176 +141,8 @@ notifyUser dir o = case o of
|
|||||||
else " " <> P.text n
|
else " " <> P.text n
|
||||||
in intercalateMap "\n" go (sort branches)
|
in intercalateMap "\n" go (sort branches)
|
||||||
ListOfDefinitions branch terms types ->
|
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
|
ParseErrors src es -> do
|
||||||
Console.setTitle "Unison ☹︎"
|
Console.setTitle "Unison ☹︎"
|
||||||
traverse_ (putStrLn . CT.toANSI . prettyParseError (Text.unpack src)) es
|
traverse_ (putStrLn . CT.toANSI . prettyParseError (Text.unpack src)) es
|
||||||
@ -349,24 +178,16 @@ notifyUser dir o = case o of
|
|||||||
Console.setTitle "Unison ☺︎"
|
Console.setTitle "Unison ☺︎"
|
||||||
-- todo: we should just print this the same way as everything else
|
-- todo: we should just print this the same way as everything else
|
||||||
let defs = prettyTypecheckedFile uf errorEnv
|
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
|
TodoOutput branch todo -> todoOutput branch todo
|
||||||
|
|
||||||
where
|
where
|
||||||
renderFileName = P.group . P.blue . fromString
|
renderFileName = P.group . P.blue . fromString
|
||||||
|
|
||||||
nameChange cmd pastTenseCmd oldName newName r = do
|
nameChange cmd pastTenseCmd oldName newName r = do
|
||||||
when (not . Set.null $ E.changedSuccessfully r) . putPrettyLn . P.okCallout $
|
when (not . Set.null $ E.changedSuccessfully r) . putPrettyLn . P.okCallout $
|
||||||
P.wrap $ "I" <> pastTenseCmd <> "the"
|
P.wrap $ "I" <> pastTenseCmd <> "the"
|
||||||
@ -398,11 +219,11 @@ notifyUser dir o = case o of
|
|||||||
formatMissingStuff :: (Show tm, Show typ) =>
|
formatMissingStuff :: (Show tm, Show typ) =>
|
||||||
[(HQ.HashQualified, tm)] -> [(HQ.HashQualified, typ)] -> P.Pretty P.ColorText
|
[(HQ.HashQualified, tm)] -> [(HQ.HashQualified, typ)] -> P.Pretty P.ColorText
|
||||||
formatMissingStuff terms types =
|
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:"
|
P.wrap "The following terms have a missing or corrupted type signature:"
|
||||||
<> "\n\n"
|
<> "\n\n"
|
||||||
<> P.column2 [ (prettyHashQualified name, fromString (show ref)) | (name, ref) <- terms ]) <>
|
<> 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:"
|
P.wrap "The following types weren't found in the codebase:"
|
||||||
<> "\n\n"
|
<> "\n\n"
|
||||||
<> P.column2 [ (prettyHashQualified name, fromString (show ref)) | (name, ref) <- types ])
|
<> P.column2 [ (prettyHashQualified name, fromString (show ref)) | (name, ref) <- types ])
|
||||||
@ -499,15 +320,12 @@ renderNameConflicts conflictedTypeNames conflictedTermNames =
|
|||||||
renderEditConflicts ::
|
renderEditConflicts ::
|
||||||
PPE.PrettyPrintEnv -> Branch.Branch0 -> P.Pretty CT.ColorText
|
PPE.PrettyPrintEnv -> Branch.Branch0 -> P.Pretty CT.ColorText
|
||||||
renderEditConflicts ppe (Branch.editConflicts -> editConflicts) =
|
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"
|
P.wrap $ "These" <> P.bold "definitions were edited differently"
|
||||||
<> "in branches that have been merged into this branch."
|
<> "in branches that have been merged into this branch."
|
||||||
<> "You'll have to tell me what to use as the new definition:",
|
<> "You'll have to tell me what to use as the new definition:",
|
||||||
P.indentN 2 (P.lines (formatConflict <$> editConflicts)),
|
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
|
where
|
||||||
name = either (typeName . fst) (termName . fst)
|
name = either (typeName . fst) (termName . fst)
|
||||||
@ -567,3 +385,172 @@ todoOutput (Branch.head -> branch) todo =
|
|||||||
(goodTerms $ unscore <$> dirtyTerms))
|
(goodTerms $ unscore <$> dirtyTerms))
|
||||||
, formatMissingStuff corruptTerms corruptTypes
|
, 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,
|
toANSI,
|
||||||
toPlain,
|
toPlain,
|
||||||
wrap,
|
wrap,
|
||||||
|
wrapColumn2,
|
||||||
wrapString,
|
wrapString,
|
||||||
black, red, green, yellow, blue, purple, cyan, white, hiBlack, hiRed, hiGreen, hiYellow, hiBlue, hiPurple, hiCyan, hiWhite, bold,
|
black, red, green, yellow, blue, purple, cyan, white, hiBlack, hiRed, hiGreen, hiYellow, hiBlue, hiPurple, hiCyan, hiWhite, bold,
|
||||||
border
|
border
|
||||||
@ -177,7 +178,8 @@ render availableWidth p = go mempty [Right p] where
|
|||||||
in maxCol (cur' <> delta p) < availableWidth
|
in maxCol (cur' <> delta p) < availableWidth
|
||||||
|
|
||||||
newline :: IsString s => Pretty s
|
newline :: IsString s => Pretty s
|
||||||
newline = lit' (chDelta '\n') (fromString "\n")
|
newline = "\n"
|
||||||
|
|
||||||
|
|
||||||
spaceIfBreak :: IsString s => Pretty s
|
spaceIfBreak :: IsString s => Pretty s
|
||||||
spaceIfBreak = "" `orElse` " "
|
spaceIfBreak = "" `orElse` " "
|
||||||
@ -279,6 +281,13 @@ column2
|
|||||||
:: (LL.ListLike s Char, IsString s) => [(Pretty s, Pretty s)] -> Pretty s
|
:: (LL.ListLike s Char, IsString s) => [(Pretty s, Pretty s)] -> Pretty s
|
||||||
column2 rows = lines (group <$> align rows)
|
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)
|
align :: (LL.ListLike s Char, IsString s)
|
||||||
=> [(Pretty s, Pretty s)]
|
=> [(Pretty s, Pretty s)]
|
||||||
-> [Pretty s]
|
-> [Pretty s]
|
||||||
|
Loading…
Reference in New Issue
Block a user