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
-                        => (r, Reference, Reference)
+            terms = toList . getHQ'Terms =<< sources
-                        ->  Branch.Star r NameSegment
+            types = toList . getHQ'Types =<< sources
-                        ->  Branch.Star r NameSegment)
+        manageLinks'
-                    -> MaybeT (StateT (LoopState m v) (F m (Either Event Input) v)) ()
+          :: [(Path', NameSegment.HQSegment)]
-        manageLinks srcs mdValues op = do
+          -> [Referent]
+          -> [Reference]
+          -> (  forall r
+              . Ord r
+             => (r, Reference, Reference)
+             -> Branch.Star r NameSegment
+             -> Branch.Star r NameSegment
+             )
+          -> MaybeT (StateT (LoopState m v) (F m (Either Event Input) v)) ()
+        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
@@ -497,19 +504,20 @@ loop = do
                       let get = Branch.head <$> use root
                       before <- get
                       stepManyAt steps
-                      after             <- get
+                      after  <- get
                       (ppe, outputDiff) <- diffHelper before after
                       if OBranchDiff.isEmpty outputDiff
                         then success
-                        else respondNumbered $ ShowDiffNamespace Path.absoluteEmpty
+                        else respondNumbered $
-                                                                 Path.absoluteEmpty
+                               ShowDiffNamespace Path.absoluteEmpty
-                                                                 ppe
+                                                 Path.absoluteEmpty
-                                                                 outputDiff
+                                                 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,34 +1330,30 @@ 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
+          dm <- resolveDefaultMetadata currentPath'
-            addedVs = Set.toList $ SC.types adds <> SC.terms adds
+          case dm of
-            parseResult = (Path.parseHQSplit' . Var.nameStr) <$> addedVs
+            Nothing -> pure ()
-            (errs, addedNames) = partitionEithers parseResult
+            Just dm' -> do
-          case errs of
+              let hqs = traverse InputPatterns.parseHashQualifiedName dm'
-            e : _ ->
+              case hqs of
-              error $ "I couldn't parse a name I just added to the codebase! " <> e
+                Left e -> respond $
-            _ -> do
+                  ConfiguredMetadataParseError
-              dm <- resolveDefaultMetadata currentPath'
+                    (Path.absoluteToPath' currentPath') (show dm') e
-              case dm of
+                Right defaultMeta ->
-                Nothing -> pure ()
+                  let terms = view _1 . elems $ hashTermsId filtered
-                Just dm' -> do
+                      types = fst (elems (dataDeclarationsId' filtered))
-                  let hqs = traverse InputPatterns.parseHashQualifiedName dm'
+                        <> fst (elems (effectDeclarationsId' filtered))
-                  case hqs of
+                  in  manageLinks' terms types defaultMeta Metadata.insert
-                    Left e -> respond $
-                      ConfiguredMetadataParseError
-                        (Path.absoluteToPath' currentPath') (show dm') e
-                    Right defaultMeta ->
-                      manageLinks addedNames 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