finish tying together unique type guid reuse

codebase2/codebase-sqlite/U/Codebase/Sqlite/Operations.hs

@@ -7,6 +7,8 @@ module U.Codebase.Sqlite.Operations
     expectRootBranchHash,
     loadCausalHashAtPath,
     expectCausalHashAtPath,
+    loadCausalBranchAtPath,
+    loadBranchAtPath,
     saveBranch,
     loadCausalBranchByCausalHash,
     expectCausalBranchByCausalHash,
@@ -27,6 +29,7 @@ module U.Codebase.Sqlite.Operations
     Q.saveDeclComponent,
     loadDeclComponent,
     loadDeclByReference,
+    expectDeclByReference,
     expectDeclTypeById,
 
     -- * terms/decls
@@ -131,6 +134,7 @@ import Data.Tuple.Extra (uncurry3, (***))
 import U.Codebase.Branch.Type (NamespaceStats (..))
 import U.Codebase.Branch.Type qualified as C.Branch
 import U.Codebase.Causal qualified as C
+import U.Codebase.Causal qualified as C.Causal
 import U.Codebase.Decl (ConstructorId)
 import U.Codebase.Decl qualified as C
 import U.Codebase.Decl qualified as C.Decl
@@ -265,6 +269,18 @@ expectCausalHashAtPath =
         hashId <- Q.expectNamespaceRoot
         go hashId path
 
+loadCausalBranchAtPath :: Q.TextPathSegments -> Transaction (Maybe (C.Branch.CausalBranch Transaction))
+loadCausalBranchAtPath path =
+  loadCausalHashAtPath path >>= \case
+    Nothing -> pure Nothing
+    Just causalHash -> Just <$> expectCausalBranchByCausalHash causalHash
+
+loadBranchAtPath :: Q.TextPathSegments -> Transaction (Maybe (C.Branch.Branch Transaction))
+loadBranchAtPath path =
+  loadCausalBranchAtPath path >>= \case
+    Nothing -> pure Nothing
+    Just causal -> Just <$> C.Causal.value causal
+
 -- * Reference transformations
 
 -- ** read existing references

parser-typechecker/package.yaml

@@ -132,6 +132,7 @@ dependencies:
   - vector
   - wai
   - warp
+  - witherable
   - x509
   - x509-store
   - x509-system

parser-typechecker/src/Unison/Codebase/UniqueTypeGuidLookup.hs

@@ -0,0 +1,45 @@
+-- | This module contains functionality related to computing a "unique type guid lookup" function, which resolves a
+-- name to a unique type's GUID to reuse.
+module Unison.Codebase.UniqueTypeGuidLookup
+  ( loadUniqueTypeGuid,
+  )
+where
+
+import Data.Map.Strict qualified as Map
+import U.Codebase.Branch qualified as Codebase.Branch
+import U.Codebase.Decl qualified as Codebase.Decl
+import U.Codebase.Reference qualified as Codebase.Reference
+import U.Codebase.Sqlite.Operations qualified as Operations
+import Unison.NameSegment (NameSegment)
+import Unison.Prelude
+import Unison.Sqlite qualified as Sqlite
+import Witherable (witherM)
+
+-- | @loadUniqueTypeGuid loadNamespaceAtPath path name@ looks up the GUID associated with the unique type named @name@
+-- at child namespace @path@ in the root namespace. If there are multiple such types, an arbitrary one is chosen.
+--
+-- For (potential) efficiency, this function accepts an argument that loads a namespace at a path, which may be backed
+-- by a cache.
+loadUniqueTypeGuid ::
+  ([NameSegment] -> Sqlite.Transaction (Maybe (Codebase.Branch.Branch Sqlite.Transaction))) ->
+  [NameSegment] ->
+  NameSegment ->
+  Sqlite.Transaction (Maybe Text)
+loadUniqueTypeGuid loadNamespaceAtPath path name =
+  loadNamespaceAtPath path >>= \case
+    Nothing -> pure Nothing
+    Just branch ->
+      case Map.lookup name (Codebase.Branch.types branch) of
+        Nothing -> pure Nothing
+        Just refs0 -> do
+          guids <-
+            Map.keys refs0 & witherM \case
+              Codebase.Reference.ReferenceBuiltin _ -> pure Nothing
+              Codebase.Reference.ReferenceDerived id -> do
+                decl <- Operations.expectDeclByReference id
+                pure case Codebase.Decl.modifier decl of
+                  Codebase.Decl.Structural -> Nothing
+                  Codebase.Decl.Unique guid -> Just guid
+          pure case guids of
+            [] -> Nothing
+            guid : _ -> Just guid

parser-typechecker/unison-parser-typechecker.cabal

@@ -90,6 +90,7 @@ library
       Unison.Codebase.TermEdit.Typing
       Unison.Codebase.Type
       Unison.Codebase.TypeEdit
+      Unison.Codebase.UniqueTypeGuidLookup
       Unison.Codebase.Verbosity
       Unison.CodebasePath
       Unison.FileParsers
@@ -320,6 +321,7 @@ library
     , vector
     , wai
     , warp
+    , witherable
     , x509
     , x509-store
     , x509-system
@@ -512,6 +514,7 @@ test-suite parser-typechecker-tests
     , vector
     , wai
     , warp
+    , witherable
     , x509
     , x509-store
     , x509-system

unison-cli/src/Unison/Cli/UniqueTypeGuidLookup.hs

@@ -0,0 +1,43 @@
+-- | This module contains functionality related to computing a "unique type guid lookup" function, which resolves a
+-- name to a unique type's GUID to reuse.
+module Unison.Cli.UniqueTypeGuidLookup
+  ( loadUniqueTypeGuid,
+  )
+where
+
+import Control.Lens (unsnoc)
+import Data.Foldable qualified as Foldable
+import Data.Maybe (fromJust)
+import U.Codebase.Branch qualified as Codebase.Branch
+import U.Codebase.Sqlite.Operations qualified as Operations
+import Unison.Codebase.Path qualified as Path
+import Unison.Codebase.UniqueTypeGuidLookup qualified as Codebase
+import Unison.Name (Name)
+import Unison.NameSegment (NameSegment)
+import Unison.NameSegment qualified as NameSegment
+import Unison.Prelude
+import Unison.Sqlite qualified as Sqlite
+
+loadUniqueTypeGuid :: Path.Absolute -> Name -> Sqlite.Transaction (Maybe Text)
+loadUniqueTypeGuid currentPath name0 = do
+  -- First, resolve the current path and the (probably/hopefully relative) name of the unique type to the full path
+  -- to the unique type, plus its final distinguished name segment.
+  let (branchPath, name) =
+        name0
+          & Path.fromName'
+          & Path.resolve currentPath
+          & Path.unabsolute
+          & Path.toSeq
+          & unsnoc
+          -- This is safe because we were handed a Name, which can't be empty
+          & fromJust
+
+  -- Define an operation to load a branch by its full path from the root namespace.
+  --
+  -- This ought to probably lean somewhat on a cache (so long as the caller is aware of the cache, and discrads it at
+  -- an appropriate time, such as after the current unison file finishes parsing).
+  let loadBranchAtPath :: [NameSegment] -> Sqlite.Transaction (Maybe (Codebase.Branch.Branch Sqlite.Transaction))
+      loadBranchAtPath segments =
+        Operations.loadBranchAtPath (map NameSegment.toText segments)
+
+  Codebase.loadUniqueTypeGuid loadBranchAtPath (Foldable.toList @Seq branchPath) name

unison-cli/src/Unison/Codebase/Editor/HandleInput.hs

@@ -56,6 +56,7 @@ import Unison.Cli.NamesUtils (basicParseNames, displayNames, findHistoricalHQs,
 import Unison.Cli.PrettyPrintUtils (currentPrettyPrintEnvDecl, prettyPrintEnvDecl)
 import Unison.Cli.ProjectUtils qualified as ProjectUtils
 import Unison.Cli.TypeCheck (computeTypecheckingEnvironment, typecheckTerm)
+import Unison.Cli.UniqueTypeGuidLookup qualified as Cli
 import Unison.Codebase (Codebase)
 import Unison.Codebase qualified as Codebase
 import Unison.Codebase.Branch (Branch (..), Branch0 (..))
@@ -1458,7 +1459,7 @@ loadUnisonFile sourceName text = do
       let parsingEnv =
             Parser.ParsingEnv
               { uniqueNames = uniqueName,
-                uniqueTypeGuid = wundefined,
+                uniqueTypeGuid = Cli.loadUniqueTypeGuid currentPath,
                 names = parseNames
               }
       unisonFile <-
@@ -2990,7 +2991,7 @@ parseType input src = do
   let parsingEnv =
         Parser.ParsingEnv
           { uniqueNames = mempty,
-            uniqueTypeGuid = wundefined,
+            uniqueTypeGuid = \_ -> pure Nothing,
             names
           }
   typ <-

unison-cli/src/Unison/LSP/FileAnalysis.hs

@@ -64,10 +64,12 @@ import Unison.Util.Pretty qualified as Pretty
 import Unison.Var qualified as Var
 import Unison.WatchKind (pattern TestWatch)
 import UnliftIO.STM
+import qualified Unison.Cli.UniqueTypeGuidLookup as Cli
 
 -- | Lex, parse, and typecheck a file.
 checkFile :: (HasUri d Uri) => d -> Lsp (Maybe FileAnalysis)
-checkFile doc = runMaybeT $ do
+checkFile doc = runMaybeT do
+  currentPath <- lift getCurrentPath
   let fileUri = doc ^. uri
   (fileVersion, contents) <- VFS.getFileContents fileUri
   parseNames <- lift getParseNames
@@ -80,7 +82,7 @@ checkFile doc = runMaybeT $ do
   let parsingEnv =
         Parser.ParsingEnv
           { uniqueNames = uniqueName,
-            uniqueTypeGuid = wundefined,
+            uniqueTypeGuid = Cli.loadUniqueTypeGuid currentPath,
             names = parseNames
           }
   (notes, parsedFile, typecheckedFile) <- do
@@ -105,7 +107,7 @@ checkFile doc = runMaybeT $ do
   let fileSummary = mkFileSummary parsedFile typecheckedFile
   let tokenMap = getTokenMap tokens
   let fileAnalysis = FileAnalysis {diagnostics = diagnosticRanges, codeActions = codeActionRanges, fileSummary, ..}
-  pure $ fileAnalysis
+  pure fileAnalysis
 
 -- | If a symbol is a 'User' symbol, return (Just sym), otherwise return Nothing.
 assertUserSym :: Symbol -> Maybe Symbol

unison-cli/tests/Unison/Test/LSP.hs

@@ -333,7 +333,7 @@ typecheckSrc name src = do
       let parsingEnv =
             Parser.ParsingEnv
               { uniqueNames = uniqueName,
-                uniqueTypeGuid = wundefined,
+                uniqueTypeGuid = \_ -> pure Nothing,
                 names = parseNames
               }
       Codebase.runTransaction codebase do

unison-cli/unison-cli.cabal

@@ -1,6 +1,6 @@
 cabal-version: 1.12
 
--- This file has been generated from package.yaml by hpack version 0.35.1.
+-- This file has been generated from package.yaml by hpack version 0.35.2.
 --
 -- see: https://github.com/sol/hpack
 
@@ -41,6 +41,7 @@ library
       Unison.Cli.Share.Projects
       Unison.Cli.Share.Projects.Types
       Unison.Cli.TypeCheck
+      Unison.Cli.UniqueTypeGuidLookup
       Unison.Cli.UnisonConfigUtils
       Unison.Codebase.Editor.AuthorInfo
       Unison.Codebase.Editor.HandleInput