mirror of
https://github.com/unisonweb/unison.git
synced 2024-09-11 10:35:57 +03:00
finish tying together unique type guid reuse
This commit is contained in:
parent
23d6568bfe
commit
5443781e7c
@ -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
|
||||
|
@ -132,6 +132,7 @@ dependencies:
|
||||
- vector
|
||||
- wai
|
||||
- warp
|
||||
- witherable
|
||||
- x509
|
||||
- x509-store
|
||||
- x509-system
|
||||
|
@ -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
|
@ -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
|
||||
|
43
unison-cli/src/Unison/Cli/UniqueTypeGuidLookup.hs
Normal file
43
unison-cli/src/Unison/Cli/UniqueTypeGuidLookup.hs
Normal file
@ -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
|
@ -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 <-
|
||||
|
@ -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
|
||||
|
@ -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
|
||||
|
@ -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
|
||||
|
Loading…
Reference in New Issue
Block a user