mirror of
https://github.com/unisonweb/unison.git
synced 2024-11-11 06:05:12 +03:00
Only return old slurp result
This commit is contained in:
parent
d33c2009a9
commit
6b5db96cde
@ -152,6 +152,7 @@ import Data.Set.NonEmpty (NESet)
|
||||
import Unison.Symbol (Symbol)
|
||||
import qualified Unison.Codebase.Editor.Input as Input
|
||||
import qualified Unison.Codebase.Editor.Slurp as NewSlurp
|
||||
import qualified Unison.Codebase.Editor.SlurpResult as SlurpResult
|
||||
|
||||
defaultPatchNameSegment :: NameSegment
|
||||
defaultPatchNameSegment = "patch"
|
||||
@ -261,16 +262,11 @@ loop = do
|
||||
let lexed = L.lexer (Text.unpack sourceName) (Text.unpack text)
|
||||
withFile [] sourceName (text, lexed) $ \unisonFile -> do
|
||||
currentNames <- currentPathNames
|
||||
let sr = NewSlurp.results . NewSlurp.analyzeTypecheckedUnisonFile unisonFile
|
||||
mempty
|
||||
$ currentNames
|
||||
let oldSlurpResult = NewSlurp.toSlurpResult unisonFile NewSlurp.UpdateOp Nothing sr
|
||||
& addAliases currentNames unisonFile currentPath'
|
||||
-- sr <- toSlurpResult currentPath' unisonFile <$> slurpResultNames
|
||||
let sr = NewSlurp.analyzeTypecheckedUnisonFile unisonFile mempty Nothing currentNames currentPath'
|
||||
names <- displayNames unisonFile
|
||||
pped <- prettyPrintEnvDecl names
|
||||
let ppe = PPE.suffixifiedPPE pped
|
||||
respond $ Typechecked sourceName ppe oldSlurpResult unisonFile
|
||||
respond $ Typechecked sourceName ppe sr unisonFile
|
||||
unlessError' EvaluationFailure do
|
||||
(bindings, e) <- ExceptT . eval . Evaluate ppe $ unisonFile
|
||||
lift do
|
||||
@ -1263,46 +1259,28 @@ loop = do
|
||||
Nothing -> respond NoUnisonFile
|
||||
Just uf -> do
|
||||
currentNames <- currentPathNames
|
||||
let sr = NewSlurp.results . NewSlurp.analyzeTypecheckedUnisonFile uf
|
||||
vars
|
||||
$ currentNames
|
||||
-- sr <-
|
||||
-- Slurp.disallowUpdates
|
||||
-- . applySelection hqs uf
|
||||
-- . toSlurpResult currentPath' uf
|
||||
-- <$> slurpResultNames
|
||||
let adds = NewSlurp.sortVars . fromMaybe mempty . Map.lookup NewSlurp.Add $ sr
|
||||
let sr = NewSlurp.analyzeTypecheckedUnisonFile uf vars (Just NewSlurp.AddOp) currentNames currentPath'
|
||||
let adds = SlurpResult.adds sr
|
||||
stepAtNoSync Branch.CompressHistory (Path.unabsolute currentPath', doSlurpAdds adds uf)
|
||||
eval . AddDefsToCodebase . NewSlurp.selectDefinitions adds $ uf
|
||||
ppe <- prettyPrintEnvDecl =<< displayNames uf
|
||||
let oldSlurpResult = NewSlurp.toSlurpResult uf NewSlurp.AddOp (Just vars) sr
|
||||
& addAliases currentNames uf currentPath'
|
||||
respond $ SlurpOutput input (PPE.suffixifiedPPE ppe) oldSlurpResult
|
||||
-- respond $ NewSlurpOutput input (PPE.suffixifiedPPE ppe) NewSlurp.AddOp sr
|
||||
respond $ SlurpOutput input (PPE.suffixifiedPPE ppe) sr
|
||||
addDefaultMetadata adds
|
||||
syncRoot
|
||||
PreviewAddI names -> case (latestFile', uf) of
|
||||
(Just (sourceName, _), Just uf) -> do
|
||||
let vars = Set.map Name.toVar names
|
||||
currentNames <- currentPathNames
|
||||
let sr = NewSlurp.results . NewSlurp.analyzeTypecheckedUnisonFile uf
|
||||
vars
|
||||
$ currentNames
|
||||
let oldSlurpResult = NewSlurp.toSlurpResult uf NewSlurp.UpdateOp (Just vars) sr
|
||||
& addAliases currentNames uf currentPath'
|
||||
previewResponse sourceName oldSlurpResult uf
|
||||
let sr = NewSlurp.analyzeTypecheckedUnisonFile uf vars (Just NewSlurp.AddOp) currentNames currentPath'
|
||||
previewResponse sourceName sr uf
|
||||
_ -> respond NoUnisonFile
|
||||
UpdateI maybePatchPath names -> handleUpdate input maybePatchPath names
|
||||
PreviewUpdateI names -> case (latestFile', uf) of
|
||||
(Just (sourceName, _), Just uf) -> do
|
||||
let vars = Set.map Name.toVar names
|
||||
currentNames <- currentPathNames
|
||||
let sr = NewSlurp.results . NewSlurp.analyzeTypecheckedUnisonFile uf
|
||||
vars
|
||||
$ currentNames
|
||||
let oldSlurpResult = NewSlurp.toSlurpResult uf NewSlurp.UpdateOp (Just vars) sr
|
||||
& addAliases currentNames uf currentPath'
|
||||
previewResponse sourceName oldSlurpResult uf
|
||||
let sr = NewSlurp.analyzeTypecheckedUnisonFile uf vars (Just NewSlurp.UpdateOp) currentNames currentPath'
|
||||
previewResponse sourceName sr uf
|
||||
_ -> respond NoUnisonFile
|
||||
TodoI patchPath branchPath' -> do
|
||||
patch <- getPatchAt (fromMaybe defaultPatchPath patchPath)
|
||||
@ -1840,16 +1818,7 @@ handleUpdate input maybePatchPath names = do
|
||||
let patchPath = fromMaybe defaultPatchPath maybePatchPath
|
||||
slurpCheckNames <- slurpResultNames
|
||||
let currentPathNames = slurpCheckNames
|
||||
let newSR = NewSlurp.results . NewSlurp.analyzeTypecheckedUnisonFile uf
|
||||
vars
|
||||
$ slurpCheckNames
|
||||
let sr = NewSlurp.toSlurpResult uf NewSlurp.UpdateOp (Just vars) newSR
|
||||
& addAliases slurpCheckNames uf currentPath'
|
||||
-- let sr :: SlurpResult v
|
||||
-- sr =
|
||||
-- applySelection hqs uf
|
||||
-- . toSlurpResult currentPath' uf
|
||||
-- $ slurpCheckNames
|
||||
let sr = NewSlurp.analyzeTypecheckedUnisonFile uf vars (Just NewSlurp.UpdateOp) slurpCheckNames currentPath'
|
||||
addsAndUpdates :: SlurpComponent v
|
||||
addsAndUpdates = Slurp.updates sr <> Slurp.adds sr
|
||||
fileNames :: Names
|
||||
@ -2770,205 +2739,6 @@ getEndangeredDependents getDependents namesToDelete rootNames = do
|
||||
in NESet.nonEmptySet remainingEndangered
|
||||
pure extinctToEndangered
|
||||
|
||||
-- Applies the selection filter to the adds/updates of a slurp result,
|
||||
-- meaning that adds/updates should only contain the selection or its transitive
|
||||
-- dependencies, any unselected transitive dependencies of the selection will
|
||||
-- be added to `extraDefinitions`.
|
||||
_applySelection ::
|
||||
forall v a.
|
||||
Var v =>
|
||||
[HQ'.HashQualified Name] ->
|
||||
UF.TypecheckedUnisonFile v a ->
|
||||
SlurpResult v ->
|
||||
SlurpResult v
|
||||
_applySelection [] _ = id
|
||||
_applySelection hqs file = \sr@SlurpResult {adds, updates} ->
|
||||
sr
|
||||
{ adds = adds `SC.intersection` closed,
|
||||
updates = updates `SC.intersection` closed,
|
||||
extraDefinitions = closed `SC.difference` selection
|
||||
}
|
||||
where
|
||||
selectedNames =
|
||||
Names.filterByHQs (Set.fromList hqs) (UF.typecheckedToNames file)
|
||||
selection, closed :: SlurpComponent v
|
||||
selection = SlurpComponent selectedTypes selectedTerms
|
||||
closed = SC.closeWithDependencies file selection
|
||||
selectedTypes, selectedTerms :: Set v
|
||||
selectedTypes = Set.map var $ R.dom (Names.types selectedNames)
|
||||
selectedTerms = Set.map var $ R.dom (Names.terms selectedNames)
|
||||
|
||||
var :: Var v => Name -> v
|
||||
var name = Var.named (Name.toText name)
|
||||
|
||||
-- _toSlurpResult ::
|
||||
-- forall v.
|
||||
-- Var v =>
|
||||
-- Path.Absolute ->
|
||||
-- UF.TypecheckedUnisonFile v Ann ->
|
||||
-- Names ->
|
||||
-- SlurpResult v
|
||||
-- _toSlurpResult curPath uf existingNames =
|
||||
-- Slurp.subtractComponent (conflicts <> ctorCollisions) $
|
||||
-- SlurpResult
|
||||
-- uf
|
||||
-- mempty
|
||||
-- adds
|
||||
-- dups
|
||||
-- mempty
|
||||
-- conflicts
|
||||
-- updates
|
||||
-- termCtorCollisions
|
||||
-- ctorTermCollisions
|
||||
-- termAliases
|
||||
-- typeAliases
|
||||
-- mempty
|
||||
-- where
|
||||
-- fileNames = UF.typecheckedToNames uf
|
||||
|
||||
-- sc :: R.Relation Name Referent -> R.Relation Name Reference -> SlurpComponent v
|
||||
-- sc terms types =
|
||||
-- SlurpComponent
|
||||
-- { terms = Set.map var (R.dom terms),
|
||||
-- types = Set.map var (R.dom types)
|
||||
-- }
|
||||
|
||||
-- -- conflict (n,r) if n is conflicted in names0
|
||||
-- conflicts :: SlurpComponent v
|
||||
-- conflicts = sc terms types
|
||||
-- where
|
||||
-- terms =
|
||||
-- R.filterDom
|
||||
-- (conflicted . Names.termsNamed existingNames)
|
||||
-- (Names.terms fileNames)
|
||||
-- types =
|
||||
-- R.filterDom
|
||||
-- (conflicted . Names.typesNamed existingNames)
|
||||
-- (Names.types fileNames)
|
||||
-- conflicted s = Set.size s > 1
|
||||
|
||||
-- ctorCollisions :: SlurpComponent v
|
||||
-- ctorCollisions =
|
||||
-- mempty {SC.terms = termCtorCollisions <> ctorTermCollisions}
|
||||
|
||||
-- -- termCtorCollision (n,r) if (n, r' /= r) exists in existingNames and
|
||||
-- -- r is Ref and r' is Con
|
||||
-- termCtorCollisions :: Set v
|
||||
-- termCtorCollisions =
|
||||
-- Set.fromList
|
||||
-- [ var n
|
||||
-- | (n, Referent.Ref {}) <- R.toList (Names.terms fileNames),
|
||||
-- [r@Referent.Con {}] <- [toList $ Names.termsNamed existingNames n],
|
||||
-- -- ignore collisions w/ ctors of types being updated
|
||||
-- Set.notMember (Referent.toReference r) typesToUpdate
|
||||
-- ]
|
||||
|
||||
-- -- the set of typerefs that are being updated by this file
|
||||
-- typesToUpdate :: Set Reference
|
||||
-- typesToUpdate =
|
||||
-- Set.fromList
|
||||
-- [ r
|
||||
-- | (n, r') <- R.toList (Names.types fileNames),
|
||||
-- r <- toList (Names.typesNamed existingNames n),
|
||||
-- r /= r'
|
||||
-- ]
|
||||
|
||||
-- -- ctorTermCollisions (n,r) if (n, r' /= r) exists in names0 and r is Con
|
||||
-- -- and r' is Ref except we relaxed it to where r' can be Con or Ref
|
||||
-- -- what if (n,r) and (n,r' /= r) exists in names and r, r' are Con
|
||||
-- ctorTermCollisions :: Set v
|
||||
-- ctorTermCollisions =
|
||||
-- Set.fromList
|
||||
-- [ var n
|
||||
-- | (n, Referent.Con {}) <- R.toList (Names.terms fileNames),
|
||||
-- r <- toList $ Names.termsNamed existingNames n,
|
||||
-- -- ignore collisions w/ ctors of types being updated
|
||||
-- Set.notMember (Referent.toReference r) typesToUpdate,
|
||||
-- Set.notMember (var n) (terms dups)
|
||||
-- ]
|
||||
|
||||
-- -- duplicate (n,r) if (n,r) exists in names0
|
||||
-- dups :: SlurpComponent v
|
||||
-- dups = sc terms types
|
||||
-- where
|
||||
-- terms = R.intersection (Names.terms existingNames) (Names.terms fileNames)
|
||||
-- types = R.intersection (Names.types existingNames) (Names.types fileNames)
|
||||
|
||||
-- -- update (n,r) if (n,r' /= r) exists in existingNames and r, r' are Ref
|
||||
-- updates :: SlurpComponent v
|
||||
-- updates = SlurpComponent (Set.fromList types) (Set.fromList terms)
|
||||
-- where
|
||||
-- terms =
|
||||
-- [ var n
|
||||
-- | (n, r'@Referent.Ref {}) <- R.toList (Names.terms fileNames),
|
||||
-- [r@Referent.Ref {}] <- [toList $ Names.termsNamed existingNames n],
|
||||
-- r' /= r
|
||||
-- ]
|
||||
-- types =
|
||||
-- [ var n
|
||||
-- | (n, r') <- R.toList (Names.types fileNames),
|
||||
-- [r] <- [toList $ Names.typesNamed existingNames n],
|
||||
-- r' /= r
|
||||
-- ]
|
||||
|
||||
|
||||
-- -- (n,r) is in `adds` if n isn't in existingNames
|
||||
-- adds = sc terms types
|
||||
-- where
|
||||
-- terms = addTerms (Names.terms existingNames) (Names.terms fileNames)
|
||||
-- types = addTypes (Names.types existingNames) (Names.types fileNames)
|
||||
-- addTerms existingNames = R.filter go
|
||||
-- where
|
||||
-- go (n, Referent.Ref {}) = (not . R.memberDom n) existingNames
|
||||
-- go _ = False
|
||||
-- addTypes existingNames = R.filter go
|
||||
-- where
|
||||
-- go (n, _) = (not . R.memberDom n) existingNames
|
||||
|
||||
|
||||
addAliases :: forall v a. (Ord v, Var v) => Names -> UF.TypecheckedUnisonFile v a -> Path.Absolute -> SlurpResult v -> SlurpResult v
|
||||
addAliases existingNames uf curPath sr = sr{ termAlias=termAliases, typeAlias=typeAliases }
|
||||
where
|
||||
fileNames = UF.typecheckedToNames uf
|
||||
buildAliases ::
|
||||
R.Relation Name Referent ->
|
||||
R.Relation Name Referent ->
|
||||
Set v ->
|
||||
Map v Slurp.Aliases
|
||||
buildAliases existingNames namesFromFile dups =
|
||||
Map.fromList
|
||||
[ ( var n,
|
||||
if null aliasesOfOld
|
||||
then Slurp.AddAliases aliasesOfNew
|
||||
else Slurp.UpdateAliases aliasesOfOld aliasesOfNew
|
||||
)
|
||||
| (n, r@Referent.Ref {}) <- R.toList namesFromFile,
|
||||
-- All the refs whose names include `n`, and are not `r`
|
||||
let refs = Set.delete r $ R.lookupDom n existingNames
|
||||
aliasesOfNew =
|
||||
Set.map (Path.unprefixName curPath) . Set.delete n $
|
||||
R.lookupRan r existingNames
|
||||
aliasesOfOld =
|
||||
Set.map (Path.unprefixName curPath) . Set.delete n . R.dom $
|
||||
R.restrictRan existingNames refs,
|
||||
not (null aliasesOfNew && null aliasesOfOld),
|
||||
Set.notMember (var n) dups
|
||||
]
|
||||
|
||||
termAliases :: Map v Slurp.Aliases
|
||||
termAliases =
|
||||
buildAliases
|
||||
(Names.terms existingNames)
|
||||
(Names.terms fileNames)
|
||||
(SC.terms (duplicates sr))
|
||||
|
||||
typeAliases :: Map v Slurp.Aliases
|
||||
typeAliases =
|
||||
buildAliases
|
||||
(R.mapRan Referent.Ref $ Names.types existingNames)
|
||||
(R.mapRan Referent.Ref $ Names.types fileNames)
|
||||
(SC.types (duplicates sr))
|
||||
|
||||
displayI ::
|
||||
Monad m =>
|
||||
Names ->
|
||||
|
@ -64,7 +64,6 @@ import qualified Unison.WatchKind as WK
|
||||
import Data.Set.NonEmpty (NESet)
|
||||
import qualified Unison.CommandLine.InputPattern as Input
|
||||
import Data.List.NonEmpty (NonEmpty)
|
||||
import qualified Unison.Codebase.Editor.Slurp as NewSlurp
|
||||
|
||||
type ListDetailed = Bool
|
||||
|
||||
@ -160,7 +159,6 @@ data Output v
|
||||
| ListOfPatches (Set Name)
|
||||
| -- show the result of add/update
|
||||
SlurpOutput Input PPE.PrettyPrintEnv (SlurpResult v)
|
||||
| NewSlurpOutput Input PPE.PrettyPrintEnv NewSlurp.SlurpOp (NewSlurp.Result v)
|
||||
| -- Original source, followed by the errors:
|
||||
ParseErrors Text [Parser.Err v]
|
||||
| TypeErrors Text PPE.PrettyPrintEnv [Context.ErrorNote v Ann]
|
||||
@ -316,7 +314,6 @@ isFailure o = case o of
|
||||
ListOfDefinitions _ _ ds -> null ds
|
||||
ListOfPatches s -> Set.null s
|
||||
SlurpOutput _ _ sr -> not $ SR.isOk sr
|
||||
NewSlurpOutput _ _ _ sr -> NewSlurp.anyErrors sr
|
||||
ParseErrors {} -> True
|
||||
TypeErrors {} -> True
|
||||
CompilerBugs {} -> True
|
||||
|
@ -1,6 +1,6 @@
|
||||
module Unison.Codebase.Editor.Slurp
|
||||
( SlurpOp (..),
|
||||
Result,
|
||||
VarsByStatus,
|
||||
BlockStatus (..),
|
||||
anyErrors,
|
||||
results,
|
||||
@ -22,8 +22,10 @@ import Debug.Pretty.Simple (pTraceShow, pTraceShowId)
|
||||
import Unison.Codebase.Editor.SlurpComponent (SlurpComponent (..))
|
||||
import qualified Unison.Codebase.Editor.SlurpComponent as SC
|
||||
import qualified Unison.Codebase.Editor.SlurpResult as OldSlurp
|
||||
import qualified Unison.Codebase.Editor.SlurpResult as SR
|
||||
import Unison.Codebase.Editor.TermsAndTypes (TermedOrTyped (Termed, Typed))
|
||||
import qualified Unison.Codebase.Editor.TermsAndTypes as TT
|
||||
import qualified Unison.Codebase.Path as Path
|
||||
import qualified Unison.DataDeclaration as DD
|
||||
import qualified Unison.LabeledDependency as LD
|
||||
import Unison.Name (Name)
|
||||
@ -32,25 +34,17 @@ import Unison.Names (Names)
|
||||
import qualified Unison.Names as Names
|
||||
import Unison.Parser.Ann (Ann)
|
||||
import Unison.Prelude
|
||||
import Unison.Referent (Referent)
|
||||
import qualified Unison.Referent as Referent
|
||||
import qualified Unison.Referent' as Referent
|
||||
import qualified Unison.UnisonFile as UF
|
||||
import qualified Unison.UnisonFile.Names as UF
|
||||
import qualified Unison.Util.Relation as Rel
|
||||
import qualified Unison.Util.Set as Set
|
||||
import Unison.Var (Var)
|
||||
import qualified Unison.Var as Var
|
||||
import Unison.WatchKind (pattern TestWatch)
|
||||
|
||||
-- Determine which components we're considering, i.e. find the components of all provided
|
||||
-- vars, then include any components they depend on.
|
||||
--
|
||||
-- Then, compute any deprecations and build the env
|
||||
-- Then, consider all vars in each component and get status (collision, add, or update)
|
||||
-- Collect and collapse the statuses of each component.
|
||||
-- I.e., if any definition has an error, the whole component is an error
|
||||
-- if any piece needs an update
|
||||
--
|
||||
--
|
||||
-- Does depending on a type also mean depending on all its constructors
|
||||
|
||||
data SlurpOp = AddOp | UpdateOp
|
||||
deriving (Eq, Show)
|
||||
|
||||
@ -99,26 +93,12 @@ data DefinitionNotes
|
||||
| DefErr SlurpErr
|
||||
deriving (Show)
|
||||
|
||||
type SlurpResult v = Map (TermedOrTyped v) (DefinitionNotes, Map (TermedOrTyped v) DefinitionNotes)
|
||||
type SlurpAnalysis v = Map (TermedOrTyped v) (DefinitionNotes, Map (TermedOrTyped v) DefinitionNotes)
|
||||
|
||||
type Result v = Map (BlockStatus v) (Set (TermedOrTyped v))
|
||||
|
||||
-- data Result v = Result
|
||||
-- { addable :: SlurpComponent v,
|
||||
-- needUpdate :: SlurpComponent v,
|
||||
-- duplicate :: SlurpComponent v,
|
||||
-- blockedTerms :: Map (SlurpErr v) (Set v)
|
||||
-- }
|
||||
|
||||
-- instance Semigroup (Result v) where
|
||||
-- Result adds1 updates1 duplicates1 tcColl1 ctColl1 <> Result adds2 updates2 duplicates2 tcColl2 ctColl2 =
|
||||
-- Result (adds1 <> adds2) (updates1 <> updates2) (duplicates1 <> duplicates2) (tcColl1 <> tcColl2) (ctColl1 <> ctColl2)
|
||||
|
||||
-- instance Monoid (Result v) where
|
||||
-- mempty = Result mempty mempty mempty mempty mempty
|
||||
type VarsByStatus v = Map (BlockStatus v) (Set (TermedOrTyped v))
|
||||
|
||||
-- Compute all definitions which can be added, or the reasons why a def can't be added.
|
||||
results :: forall v. (Ord v, Show v) => SlurpResult v -> Result v
|
||||
results :: forall v. (Ord v, Show v) => SlurpAnalysis v -> VarsByStatus v
|
||||
results sr =
|
||||
pTraceShowId $ analyzed
|
||||
where
|
||||
@ -153,9 +133,11 @@ analyzeTypecheckedUnisonFile ::
|
||||
Var v =>
|
||||
UF.TypecheckedUnisonFile v Ann ->
|
||||
Set v ->
|
||||
Maybe SlurpOp ->
|
||||
Names ->
|
||||
(Map (TermedOrTyped v) (DefinitionNotes, Map (TermedOrTyped v) (DefinitionNotes)))
|
||||
analyzeTypecheckedUnisonFile uf defsToConsider unalteredCodebaseNames =
|
||||
Path.Absolute ->
|
||||
SR.SlurpResult v
|
||||
analyzeTypecheckedUnisonFile uf defsToConsider slurpOp unalteredCodebaseNames currentPath =
|
||||
let varRelation :: Rel.Relation (TermedOrTyped v) LD.LabeledDependency
|
||||
varRelation = labelling uf
|
||||
involvedVars :: Set (TermedOrTyped v)
|
||||
@ -164,9 +146,15 @@ analyzeTypecheckedUnisonFile uf defsToConsider unalteredCodebaseNames =
|
||||
codebaseNames = computeNamesWithDeprecations uf unalteredCodebaseNames involvedVars
|
||||
varDeps :: Map (TermedOrTyped v) (Set (TermedOrTyped v))
|
||||
varDeps = computeVarDeps uf involvedVars
|
||||
statusMap :: Map (TermedOrTyped v) (DefinitionNotes, Map (TermedOrTyped v) DefinitionNotes)
|
||||
statusMap = computeVarStatuses varDeps varRelation codebaseNames
|
||||
in pTraceShowId statusMap
|
||||
analysis :: SlurpAnalysis v
|
||||
analysis = computeVarStatuses varDeps varRelation codebaseNames
|
||||
varsByStatus :: VarsByStatus v
|
||||
varsByStatus = results analysis
|
||||
slurpResult :: SR.SlurpResult v
|
||||
slurpResult =
|
||||
toSlurpResult uf (fromMaybe UpdateOp slurpOp) defsToConsider varsByStatus
|
||||
& addAliases codebaseNames currentPath
|
||||
in pTraceShowId slurpResult
|
||||
|
||||
computeNamesWithDeprecations ::
|
||||
Var v =>
|
||||
@ -395,21 +383,20 @@ toSlurpResult ::
|
||||
(Ord v, Show v) =>
|
||||
UF.TypecheckedUnisonFile v Ann ->
|
||||
SlurpOp ->
|
||||
Maybe (Set v) ->
|
||||
Result v ->
|
||||
Set v ->
|
||||
VarsByStatus v ->
|
||||
OldSlurp.SlurpResult v
|
||||
toSlurpResult uf op mvs r =
|
||||
toSlurpResult uf op requestedVars varsByStatus =
|
||||
pTraceShowId $
|
||||
-- TODO: Do a proper partition to speed this up.
|
||||
OldSlurp.SlurpResult
|
||||
{ OldSlurp.originalFile = uf,
|
||||
OldSlurp.extraDefinitions =
|
||||
case mvs of
|
||||
Nothing -> mempty
|
||||
Just vs ->
|
||||
let allVars = fold r
|
||||
if Set.null requestedVars
|
||||
then mempty
|
||||
else
|
||||
let allVars = fold varsByStatus
|
||||
desired =
|
||||
vs
|
||||
requestedVars
|
||||
& Set.flatMap (\v -> Set.fromList [Typed v, Termed v])
|
||||
in sortVars $ Set.difference allVars desired,
|
||||
OldSlurp.adds = adds,
|
||||
@ -430,7 +417,7 @@ toSlurpResult uf op mvs r =
|
||||
where
|
||||
adds, duplicates, updates, termCtorColl, ctorTermColl, blocked, conflicts :: SlurpComponent v
|
||||
(adds, duplicates, updates, termCtorColl, (ctorTermColl, blocked, conflicts)) =
|
||||
r
|
||||
varsByStatus
|
||||
& ifoldMap
|
||||
( \k tvs ->
|
||||
let sc = sortVars $ tvs
|
||||
@ -455,7 +442,7 @@ toSlurpResult uf op mvs r =
|
||||
Typed v -> SlurpComponent {terms = mempty, types = Set.singleton v}
|
||||
Termed v -> SlurpComponent {terms = Set.singleton v, types = mempty}
|
||||
|
||||
anyErrors :: Result v -> Bool
|
||||
anyErrors :: VarsByStatus v -> Bool
|
||||
anyErrors r =
|
||||
any isError . Map.keys $ Map.filter (not . null) r
|
||||
where
|
||||
@ -481,3 +468,49 @@ mingleVars :: Ord v => SlurpComponent v -> Set (TermedOrTyped v)
|
||||
mingleVars SlurpComponent {terms, types} =
|
||||
Set.map Typed types
|
||||
<> Set.map Termed terms
|
||||
|
||||
addAliases :: forall v. (Ord v, Var v) => Names -> Path.Absolute -> SR.SlurpResult v -> SR.SlurpResult v
|
||||
addAliases existingNames curPath sr = sr {SR.termAlias = termAliases, SR.typeAlias = typeAliases}
|
||||
where
|
||||
fileNames = UF.typecheckedToNames $ SR.originalFile sr
|
||||
buildAliases ::
|
||||
Rel.Relation Name Referent ->
|
||||
Rel.Relation Name Referent ->
|
||||
Set v ->
|
||||
Map v SR.Aliases
|
||||
buildAliases existingNames namesFromFile dups =
|
||||
Map.fromList
|
||||
[ ( var n,
|
||||
if null aliasesOfOld
|
||||
then SR.AddAliases aliasesOfNew
|
||||
else SR.UpdateAliases aliasesOfOld aliasesOfNew
|
||||
)
|
||||
| (n, r@Referent.Ref {}) <- Rel.toList namesFromFile,
|
||||
-- All the refs whose names include `n`, and are not `r`
|
||||
let refs = Set.delete r $ Rel.lookupDom n existingNames
|
||||
aliasesOfNew =
|
||||
Set.map (Path.unprefixName curPath) . Set.delete n $
|
||||
Rel.lookupRan r existingNames
|
||||
aliasesOfOld =
|
||||
Set.map (Path.unprefixName curPath) . Set.delete n . Rel.dom $
|
||||
Rel.restrictRan existingNames refs,
|
||||
not (null aliasesOfNew && null aliasesOfOld),
|
||||
Set.notMember (var n) dups
|
||||
]
|
||||
|
||||
termAliases :: Map v SR.Aliases
|
||||
termAliases =
|
||||
buildAliases
|
||||
(Names.terms existingNames)
|
||||
(Names.terms fileNames)
|
||||
(SC.terms (SR.duplicates sr))
|
||||
|
||||
typeAliases :: Map v SR.Aliases
|
||||
typeAliases =
|
||||
buildAliases
|
||||
(Rel.mapRan Referent.Ref $ Names.types existingNames)
|
||||
(Rel.mapRan Referent.Ref $ Names.types fileNames)
|
||||
(SC.types (SR.duplicates sr))
|
||||
|
||||
var :: Var v => Name -> v
|
||||
var name = Var.named (Name.toText name)
|
||||
|
@ -750,12 +750,6 @@ notifyUser dir o = case o of
|
||||
Input.UpdateI {} -> True
|
||||
_ -> False
|
||||
in pure $ SlurpResult.pretty isPast ppe s
|
||||
NewSlurpOutput input ppe slurpOp result ->
|
||||
let isPast = case input of
|
||||
Input.AddI {} -> True
|
||||
Input.UpdateI {} -> True
|
||||
_ -> False
|
||||
in pure $ undefined isPast ppe slurpOp result
|
||||
NoExactTypeMatches ->
|
||||
pure . P.callout "☝️" $ P.wrap "I couldn't find exact type matches, resorting to fuzzy matching..."
|
||||
TypeParseError src e ->
|
||||
|
Loading…
Reference in New Issue
Block a user