wip

parser-typechecker/src/Unison/Codebase/Editor/HandleCommand.hs

@@ -114,7 +114,9 @@ commandLine config awaitInput setBranchRef rt notifyUser notifyNumbered loadSour
     Input         -> awaitInput
     Notify output -> notifyUser output
     NotifyNumbered output -> notifyNumbered output
-    ConfigLookup name -> Config.lookup config name
+    ConfigLookup name -> do
+      traceM (show name)
+      Config.lookup config name
     LoadSource sourcePath -> loadSource sourcePath
 
     Typecheck ambient names sourceName source -> do

parser-typechecker/src/Unison/Codebase/Editor/HandleInput.hs

@@ -468,20 +468,27 @@ loop = do
         stepManyAt = Unison.Codebase.Editor.HandleInput.stepManyAt inputDescription
         stepManyAtM = Unison.Codebase.Editor.HandleInput.stepManyAtM inputDescription
         updateAtM = Unison.Codebase.Editor.HandleInput.updateAtM inputDescription
-        manageLinks :: [(Path', NameSegment.HQSegment)]
+        manageLinks path sources =
-                    -> [HQ.HashQualified]
+          manageLinks' path terms types
-                    -> (forall r. Ord r
+          where
+            terms = toList . getHQ'Terms =<< sources
+            types = toList . getHQ'Types =<< sources
+        manageLinks'
+          :: [(Path', NameSegment.HQSegment)]
+          -> [Referent]
+          -> [Reference]
+          -> (  forall r
+              . Ord r
              => (r, Reference, Reference)
              -> Branch.Star r NameSegment
-                        ->  Branch.Star r NameSegment)
+             -> Branch.Star r NameSegment
+             )
           -> MaybeT (StateT (LoopState m v) (F m (Either Event Input) v)) ()
-        manageLinks srcs mdValues op = do
+        manageLinks' !srcTerms !srcTypes mdValues op = do
           mdValuels <- fmap toList <$> traverse getHQTerms mdValues
           traverse_ go mdValuels
           where
             go mdl = do
-              let !srcle = toList . getHQ'Terms =<< srcs
-                  !srclt = toList . getHQ'Types =<< srcs
               names0 <- basicPrettyPrintNames0
               ppe <- PPE.suffixifiedPPE <$> prettyPrintEnvDecl (Names names0 mempty)
               case mdl of
@@ -501,15 +508,16 @@ loop = do
                       (ppe, outputDiff) <- diffHelper before after
                       if OBranchDiff.isEmpty outputDiff
                         then success
-                        else respondNumbered $ ShowDiffNamespace Path.absoluteEmpty
+                        else respondNumbered $
+                               ShowDiffNamespace Path.absoluteEmpty
                                                  Path.absoluteEmpty
                                                  ppe
                                                  outputDiff
                  where
                   step mdType b0 =
-                    let tmUpdates terms = foldl' go terms srcle
+                    let tmUpdates terms = foldl' go terms srcTerms
                             where go terms src = op (src, mdType, mdValue) terms
-                        tyUpdates types = foldl' go types srclt
+                        tyUpdates types = foldl' go types srcTypes
                             where go types src = op (src, mdType, mdValue) types
                     in  over Branch.terms tmUpdates . over Branch.types tyUpdates $ b0
                 mdValues -> respond $ MetadataAmbiguous ppe mdValues
@@ -1322,23 +1330,16 @@ loop = do
               . toSlurpResult currentPath' uf
              <$> slurpResultNames0
           let adds = Slurp.adds sr
+              filtered = filterBySlurpResult sr $ uf
           when (Slurp.isNonempty sr) $ do
             stepAt ( Path.unabsolute currentPath'
                    , doSlurpAdds adds uf)
-            eval . AddDefsToCodebase . filterBySlurpResult sr $ uf
+            eval $ AddDefsToCodebase filtered
           ppe <- prettyPrintEnvDecl =<<
             makeShadowedPrintNamesFromLabeled
               (UF.termSignatureExternalLabeledDependencies uf)
               (UF.typecheckedToNames0 uf)
           respond $ SlurpOutput input (PPE.suffixifiedPPE ppe) sr
-          let
-            addedVs = Set.toList $ SC.types adds <> SC.terms adds
-            parseResult = (Path.parseHQSplit' . Var.nameStr) <$> addedVs
-            (errs, addedNames) = partitionEithers parseResult
-          case errs of
-            e : _ ->
-              error $ "I couldn't parse a name I just added to the codebase! " <> e
-            _ -> do
           dm <- resolveDefaultMetadata currentPath'
           case dm of
             Nothing -> pure ()
@@ -1349,7 +1350,10 @@ loop = do
                   ConfiguredMetadataParseError
                     (Path.absoluteToPath' currentPath') (show dm') e
                 Right defaultMeta ->
-                      manageLinks addedNames defaultMeta Metadata.insert
+                  let terms = view _1 . elems $ hashTermsId filtered
+                      types = fst (elems (dataDeclarationsId' filtered))
+                        <> fst (elems (effectDeclarationsId' filtered))
+                  in  manageLinks' terms types defaultMeta Metadata.insert
 
       PreviewAddI hqs -> case (latestFile', uf) of
         (Just (sourceName, _), Just uf) -> do
@@ -1614,8 +1618,9 @@ loop = do
       success = respond Success
 
       resolveDefaultMetadata :: Path.Absolute -> Action' m v (Maybe [String])
-      resolveDefaultMetadata path =
+      resolveDefaultMetadata path = do
-        (eval . ConfigLookup) $ configKey "DefaultMetadata" path
+        mstr <- (eval . ConfigLookup) $ configKey "DefaultMetadata" path
+        pure mstr
 
       configKey k p =
         Text.intercalate "." . toList $ k :<| fmap