mirror of
https://github.com/unisonweb/unison.git
synced 2024-09-11 10:35:57 +03:00
⅄ trunk → 22-12-14-tidy-up-hashing-package
This commit is contained in:
commit
4be5ff5346
@ -26,6 +26,8 @@ dependencies:
|
||||
|
||||
library:
|
||||
source-dirs: src
|
||||
exposed-modules:
|
||||
- U.Codebase.Sqlite.V2.HashHandle
|
||||
when:
|
||||
- condition: false
|
||||
other-modules: Paths_unison_codebase_sqlite_hashing_v2
|
||||
|
@ -1,24 +0,0 @@
|
||||
module U.Codebase.Sqlite.V2.Decl
|
||||
( saveDeclComponent,
|
||||
)
|
||||
where
|
||||
|
||||
import qualified U.Codebase.Decl as V2
|
||||
import U.Codebase.Sqlite.DbId (ObjectId)
|
||||
import qualified U.Codebase.Sqlite.Queries as U.Sqlite
|
||||
import U.Codebase.Sqlite.Symbol (Symbol)
|
||||
import U.Codebase.Sqlite.V2.HashHandle
|
||||
import U.Util.Hash (Hash)
|
||||
import Unison.Prelude
|
||||
import Unison.Sqlite
|
||||
|
||||
saveDeclComponent ::
|
||||
-- | The serialized decl component if we already have it e.g. via sync
|
||||
Maybe ByteString ->
|
||||
-- | decl component hash
|
||||
Hash ->
|
||||
-- | decl component
|
||||
[V2.Decl Symbol] ->
|
||||
Transaction ObjectId
|
||||
saveDeclComponent =
|
||||
U.Sqlite.saveDeclComponent v2HashHandle
|
@ -1,11 +0,0 @@
|
||||
module U.Codebase.Sqlite.V2.SyncEntity where
|
||||
|
||||
import qualified U.Codebase.Sqlite.DbId as Db
|
||||
import U.Codebase.Sqlite.Entity (SyncEntity)
|
||||
import qualified U.Codebase.Sqlite.Queries as Q
|
||||
import U.Codebase.Sqlite.V2.HashHandle
|
||||
import U.Util.Hash32 (Hash32)
|
||||
import Unison.Sqlite
|
||||
|
||||
saveSyncEntity :: Hash32 -> SyncEntity -> Transaction (Either Db.CausalHashId Db.ObjectId)
|
||||
saveSyncEntity = Q.saveSyncEntity v2HashHandle
|
@ -1,24 +0,0 @@
|
||||
module U.Codebase.Sqlite.V2.Term
|
||||
( saveTermComponent,
|
||||
)
|
||||
where
|
||||
|
||||
import U.Codebase.Sqlite.DbId (ObjectId)
|
||||
import qualified U.Codebase.Sqlite.Queries as U.Sqlite
|
||||
import U.Codebase.Sqlite.Symbol (Symbol)
|
||||
import U.Codebase.Sqlite.V2.HashHandle
|
||||
import qualified U.Codebase.Term as V2
|
||||
import U.Util.Hash (Hash)
|
||||
import Unison.Prelude
|
||||
import Unison.Sqlite
|
||||
|
||||
saveTermComponent ::
|
||||
-- | The serialized term component if we already have it e.g. via sync
|
||||
Maybe ByteString ->
|
||||
-- | term component hash
|
||||
Hash ->
|
||||
-- | term component
|
||||
[(V2.Term Symbol, V2.Type Symbol)] ->
|
||||
Transaction ObjectId
|
||||
saveTermComponent =
|
||||
U.Sqlite.saveTermComponent v2HashHandle
|
@ -1,7 +1,6 @@
|
||||
-- | Description: Converts V2 types to the V2 hashing types
|
||||
module Unison.Hashing.V2.Convert2
|
||||
( v2ToH2Term,
|
||||
v2ToH2Type,
|
||||
( v2ToH2Type,
|
||||
v2ToH2TypeD,
|
||||
h2ToV2Reference,
|
||||
)
|
||||
@ -9,75 +8,13 @@ where
|
||||
|
||||
import qualified U.Codebase.Kind as V2
|
||||
import qualified U.Codebase.Reference as V2
|
||||
import qualified U.Codebase.Referent as V2.Referent
|
||||
import qualified U.Codebase.Term as V2 (F, F' (..), MatchCase (..), Pattern (..), SeqOp (..), TermRef, TypeRef)
|
||||
import qualified U.Codebase.Term as V2 (TypeRef)
|
||||
import qualified U.Codebase.Type as V2.Type
|
||||
import qualified U.Core.ABT as ABT
|
||||
import Unison.Hash (Hash)
|
||||
import qualified Unison.Hashing.V2 as H2
|
||||
import Unison.Prelude
|
||||
|
||||
v2ToH2Term :: forall v. Ord v => Hash -> ABT.Term (V2.F v) v () -> H2.Term v ()
|
||||
v2ToH2Term thisTermComponentHash = ABT.transform convertF
|
||||
where
|
||||
convertF :: forall x. V2.F v x -> H2.TermF v () () x
|
||||
convertF = \case
|
||||
V2.Int x -> H2.TermInt x
|
||||
V2.Nat x -> H2.TermNat x
|
||||
V2.Float x -> H2.TermFloat x
|
||||
V2.Boolean x -> H2.TermBoolean x
|
||||
V2.Text x -> H2.TermText x
|
||||
V2.Char x -> H2.TermChar x
|
||||
V2.Ref x -> H2.TermRef (convertTermRef thisTermComponentHash x)
|
||||
V2.Constructor a b -> H2.TermConstructor (convertReference a) b
|
||||
V2.Request a b -> H2.TermRequest (convertReference a) b
|
||||
V2.Handle a b -> H2.TermHandle a b
|
||||
V2.App a b -> H2.TermApp a b
|
||||
V2.Ann a b -> H2.TermAnn a (v2ToH2Type b)
|
||||
V2.List a -> H2.TermList a
|
||||
V2.If a b c -> H2.TermIf a b c
|
||||
V2.And a b -> H2.TermAnd a b
|
||||
V2.Or a b -> H2.TermOr a b
|
||||
V2.Lam a -> H2.TermLam a
|
||||
V2.LetRec a b -> H2.TermLetRec a b
|
||||
V2.Let a b -> H2.TermLet a b
|
||||
V2.Match a b -> H2.TermMatch a (map convertMatchCase b)
|
||||
V2.TermLink a -> H2.TermTermLink (convertReferent thisTermComponentHash a)
|
||||
V2.TypeLink a -> H2.TermTypeLink (convertReference a)
|
||||
|
||||
convertMatchCase :: V2.MatchCase Text V2.TypeRef x -> H2.MatchCase () x
|
||||
convertMatchCase (V2.MatchCase pat a b) = H2.MatchCase (convertPattern pat) a b
|
||||
|
||||
convertPattern :: V2.Pattern Text V2.TypeRef -> H2.Pattern ()
|
||||
convertPattern = \case
|
||||
V2.PUnbound -> H2.PatternUnbound ()
|
||||
V2.PVar -> H2.PatternVar ()
|
||||
V2.PBoolean a -> H2.PatternBoolean () a
|
||||
V2.PInt a -> H2.PatternInt () a
|
||||
V2.PNat a -> H2.PatternNat () a
|
||||
V2.PFloat a -> H2.PatternFloat () a
|
||||
V2.PText a -> H2.PatternText () a
|
||||
V2.PChar a -> H2.PatternChar () a
|
||||
V2.PConstructor a b c -> H2.PatternConstructor () (convertReference a) b (map convertPattern c)
|
||||
V2.PAs a -> H2.PatternAs () (convertPattern a)
|
||||
V2.PEffectPure a -> H2.PatternEffectPure () (convertPattern a)
|
||||
V2.PEffectBind a b c d -> H2.PatternEffectBind () (convertReference a) b (map convertPattern c) (convertPattern d)
|
||||
V2.PSequenceLiteral a -> H2.PatternSequenceLiteral () (map convertPattern a)
|
||||
V2.PSequenceOp a b c -> H2.PatternSequenceOp () (convertPattern a) (convertSeqOp b) (convertPattern c)
|
||||
where
|
||||
convertSeqOp = \case
|
||||
V2.PCons -> H2.Cons
|
||||
V2.PSnoc -> H2.Snoc
|
||||
V2.PConcat -> H2.Concat
|
||||
|
||||
convertReferent ::
|
||||
Hash ->
|
||||
V2.Referent.Referent' (V2.Reference' Text (Maybe Hash)) (V2.Reference' Text Hash) ->
|
||||
H2.Referent
|
||||
convertReferent defaultHash = \case
|
||||
V2.Referent.Ref x -> H2.ReferentRef (convertTermRef defaultHash x)
|
||||
V2.Referent.Con x cid -> H2.ReferentCon (convertReference x) cid
|
||||
|
||||
convertId :: Hash -> V2.Id' (Maybe Hash) -> H2.ReferenceId
|
||||
convertId defaultHash = \case
|
||||
V2.Id m p -> H2.ReferenceId (fromMaybe defaultHash m) p
|
||||
@ -85,9 +22,6 @@ convertId defaultHash = \case
|
||||
convertReference :: V2.Reference -> H2.Reference
|
||||
convertReference = convertReference' (\(V2.Id a b) -> H2.ReferenceId a b)
|
||||
|
||||
convertTermRef :: Hash -> V2.TermRef -> H2.Reference
|
||||
convertTermRef = convertReference' . convertId
|
||||
|
||||
convertReference' :: (V2.Id' hash -> H2.ReferenceId) -> V2.Reference' Text hash -> H2.Reference
|
||||
convertReference' idConv = \case
|
||||
V2.ReferenceBuiltin x -> H2.ReferenceBuiltin x
|
||||
|
@ -17,10 +17,8 @@ source-repository head
|
||||
|
||||
library
|
||||
exposed-modules:
|
||||
U.Codebase.Sqlite.V2.Decl
|
||||
U.Codebase.Sqlite.V2.HashHandle
|
||||
U.Codebase.Sqlite.V2.SyncEntity
|
||||
U.Codebase.Sqlite.V2.Term
|
||||
other-modules:
|
||||
Unison.Hashing.V2.Convert2
|
||||
hs-source-dirs:
|
||||
src
|
||||
|
@ -9,6 +9,7 @@ where
|
||||
import U.Codebase.Branch.Type as X
|
||||
import qualified U.Codebase.Causal as Causal
|
||||
import qualified U.Codebase.Sqlite.Operations as Ops
|
||||
import Unison.NameSegment (NameSegment)
|
||||
import Unison.Prelude
|
||||
import Unison.Sqlite (Transaction)
|
||||
|
||||
|
@ -166,6 +166,8 @@ import qualified U.Util.Base32Hex as Base32Hex
|
||||
import qualified U.Util.Hash as H
|
||||
import qualified U.Util.Hash32 as Hash32
|
||||
import qualified U.Util.Serialization as S
|
||||
import Unison.NameSegment (NameSegment (NameSegment))
|
||||
import qualified Unison.NameSegment as NameSegment
|
||||
import Unison.Prelude
|
||||
import Unison.Sqlite
|
||||
import qualified Unison.Util.Map as Map
|
||||
@ -513,35 +515,35 @@ s2cBranch (S.Branch.Full.Branch tms tps patches children) =
|
||||
|
||||
doTerms ::
|
||||
Map Db.TextId (Map S.Referent S.DbMetadataSet) ->
|
||||
Transaction (Map C.Branch.NameSegment (Map C.Referent (Transaction C.Branch.MdValues)))
|
||||
Transaction (Map NameSegment (Map C.Referent (Transaction C.Branch.MdValues)))
|
||||
doTerms =
|
||||
Map.bitraverse
|
||||
(fmap C.Branch.NameSegment . Q.expectText)
|
||||
(fmap NameSegment . Q.expectText)
|
||||
( Map.bitraverse s2cReferent \case
|
||||
S.MetadataSet.Inline rs ->
|
||||
pure $ C.Branch.MdValues <$> loadTypesForMetadata rs
|
||||
)
|
||||
doTypes ::
|
||||
Map Db.TextId (Map S.Reference S.DbMetadataSet) ->
|
||||
Transaction (Map C.Branch.NameSegment (Map C.Reference (Transaction C.Branch.MdValues)))
|
||||
Transaction (Map NameSegment (Map C.Reference (Transaction C.Branch.MdValues)))
|
||||
doTypes =
|
||||
Map.bitraverse
|
||||
(fmap C.Branch.NameSegment . Q.expectText)
|
||||
(fmap NameSegment . Q.expectText)
|
||||
( Map.bitraverse s2cReference \case
|
||||
S.MetadataSet.Inline rs ->
|
||||
pure $ C.Branch.MdValues <$> loadTypesForMetadata rs
|
||||
)
|
||||
doPatches ::
|
||||
Map Db.TextId Db.PatchObjectId ->
|
||||
Transaction (Map C.Branch.NameSegment (PatchHash, Transaction C.Branch.Patch))
|
||||
doPatches = Map.bitraverse (fmap C.Branch.NameSegment . Q.expectText) \patchId -> do
|
||||
Transaction (Map NameSegment (PatchHash, Transaction C.Branch.Patch))
|
||||
doPatches = Map.bitraverse (fmap NameSegment . Q.expectText) \patchId -> do
|
||||
h <- PatchHash <$> (Q.expectPrimaryHashByObjectId . Db.unPatchObjectId) patchId
|
||||
pure (h, expectPatch patchId)
|
||||
|
||||
doChildren ::
|
||||
Map Db.TextId (Db.BranchObjectId, Db.CausalHashId) ->
|
||||
Transaction (Map C.Branch.NameSegment (C.Causal Transaction CausalHash BranchHash (C.Branch.Branch Transaction)))
|
||||
doChildren = Map.bitraverse (fmap C.Branch.NameSegment . Q.expectText) \(boId, chId) ->
|
||||
Transaction (Map NameSegment (C.Causal Transaction CausalHash BranchHash (C.Branch.Branch Transaction)))
|
||||
doChildren = Map.bitraverse (fmap NameSegment . Q.expectText) \(boId, chId) ->
|
||||
C.Causal <$> Q.expectCausalHash chId
|
||||
<*> expectValueHashByCausalHashId chId
|
||||
<*> headParents chId
|
||||
@ -671,8 +673,8 @@ saveBranch hh (C.Causal hc he parents me) = do
|
||||
<*> Map.bitraverse saveNameSegment savePatchObjectId patches
|
||||
<*> Map.bitraverse saveNameSegment (saveBranch hh) children
|
||||
|
||||
saveNameSegment :: C.Branch.NameSegment -> Transaction Db.TextId
|
||||
saveNameSegment = Q.saveText . C.Branch.unNameSegment
|
||||
saveNameSegment :: NameSegment -> Transaction Db.TextId
|
||||
saveNameSegment = Q.saveText . NameSegment.toText
|
||||
|
||||
c2sMetadata :: Transaction C.Branch.MdValues -> Transaction S.Branch.Full.DbMetadataSet
|
||||
c2sMetadata mm = do
|
||||
@ -1081,9 +1083,7 @@ updateNameIndex (newTermNames, removedTermNames) (newTypeNames, removedTypeNames
|
||||
|
||||
data NamesByPath = NamesByPath
|
||||
{ termNamesInPath :: [S.NamedRef (C.Referent, Maybe C.ConstructorType)],
|
||||
termNamesExternalToPath :: [S.NamedRef (C.Referent, Maybe C.ConstructorType)],
|
||||
typeNamesInPath :: [S.NamedRef C.Reference],
|
||||
typeNamesExternalToPath :: [S.NamedRef C.Reference]
|
||||
typeNamesInPath :: [S.NamedRef C.Reference]
|
||||
}
|
||||
|
||||
-- | Get all the term and type names for the root namespace from the lookup table.
|
||||
@ -1092,14 +1092,12 @@ rootNamesByPath ::
|
||||
Maybe Text ->
|
||||
Transaction NamesByPath
|
||||
rootNamesByPath path = do
|
||||
(termNamesInPath, termNamesExternalToPath) <- Q.rootTermNamesByPath path
|
||||
(typeNamesInPath, typeNamesExternalToPath) <- Q.rootTypeNamesByPath path
|
||||
termNamesInPath <- Q.rootTermNamesByPath path
|
||||
typeNamesInPath <- Q.rootTypeNamesByPath path
|
||||
pure $
|
||||
NamesByPath
|
||||
{ termNamesInPath = convertTerms <$> termNamesInPath,
|
||||
termNamesExternalToPath = convertTerms <$> termNamesExternalToPath,
|
||||
typeNamesInPath = convertTypes <$> typeNamesInPath,
|
||||
typeNamesExternalToPath = convertTypes <$> typeNamesExternalToPath
|
||||
typeNamesInPath = convertTypes <$> typeNamesInPath
|
||||
}
|
||||
where
|
||||
convertTerms = fmap (bimap s2cTextReferent (fmap s2cConstructorType))
|
||||
|
@ -1750,37 +1750,35 @@ insertTypeNames names =
|
||||
|]
|
||||
|
||||
-- | Get the list of a term names in the root namespace according to the name lookup index
|
||||
rootTermNamesByPath :: Maybe Text -> Transaction ([NamedRef (Referent.TextReferent, Maybe NamedRef.ConstructorType)], [NamedRef (Referent.TextReferent, Maybe NamedRef.ConstructorType)])
|
||||
rootTermNamesByPath :: Maybe Text -> Transaction [NamedRef (Referent.TextReferent, Maybe NamedRef.ConstructorType)]
|
||||
rootTermNamesByPath mayNamespace = do
|
||||
let (namespace, subnamespace) = case mayNamespace of
|
||||
Nothing -> ("", "*")
|
||||
Just namespace -> (namespace, globEscape namespace <> ".*")
|
||||
results :: [Only Bool :. NamedRef (Referent.TextReferent :. Only (Maybe NamedRef.ConstructorType))] <- queryListRow sql (subnamespace, namespace, subnamespace, namespace)
|
||||
let (namesInNamespace, namesOutsideNamespace) = span (\(Only inNamespace :. _) -> inNamespace) results
|
||||
pure (fmap unRow . dropTag <$> namesInNamespace, fmap unRow . dropTag <$> namesOutsideNamespace)
|
||||
results :: [NamedRef (Referent.TextReferent :. Only (Maybe NamedRef.ConstructorType))] <- queryListRow sql (subnamespace, namespace, subnamespace, namespace)
|
||||
pure (fmap unRow <$> results)
|
||||
where
|
||||
dropTag (_ :. name) = name
|
||||
unRow (a :. Only b) = (a, b)
|
||||
sql =
|
||||
[here|
|
||||
SELECT namespace GLOB ? OR namespace = ?, reversed_name, referent_builtin, referent_component_hash, referent_component_index, referent_constructor_index, referent_constructor_type FROM term_name_lookup
|
||||
SELECT reversed_name, referent_builtin, referent_component_hash, referent_component_index, referent_constructor_index, referent_constructor_type FROM term_name_lookup
|
||||
WHERE (namespace GLOB ? OR namespace = ?)
|
||||
ORDER BY (namespace GLOB ? OR namespace = ?) DESC
|
||||
|]
|
||||
|
||||
-- | Get the list of a type names in the root namespace according to the name lookup index
|
||||
rootTypeNamesByPath :: Maybe Text -> Transaction ([NamedRef Reference.TextReference], [NamedRef Reference.TextReference])
|
||||
rootTypeNamesByPath :: Maybe Text -> Transaction [NamedRef Reference.TextReference]
|
||||
rootTypeNamesByPath mayNamespace = do
|
||||
let (namespace, subnamespace) = case mayNamespace of
|
||||
Nothing -> ("", "*")
|
||||
Just namespace -> (namespace, globEscape namespace <> ".*")
|
||||
results :: [Only Bool :. NamedRef Reference.TextReference] <- queryListRow sql (subnamespace, namespace, subnamespace, namespace)
|
||||
let (namesInNamespace, namesOutsideNamespace) = span (\(Only inNamespace :. _) -> inNamespace) results
|
||||
pure (dropTag <$> namesInNamespace, dropTag <$> namesOutsideNamespace)
|
||||
results :: [NamedRef Reference.TextReference] <- queryListRow sql (subnamespace, namespace, subnamespace, namespace)
|
||||
pure results
|
||||
where
|
||||
dropTag (_ :. name) = name
|
||||
sql =
|
||||
[here|
|
||||
SELECT namespace GLOB ? OR namespace = ?, reversed_name, reference_builtin, reference_component_hash, reference_component_index FROM type_name_lookup
|
||||
SELECT reversed_name, reference_builtin, reference_component_hash, reference_component_index FROM type_name_lookup
|
||||
WHERE namespace GLOB ? OR namespace = ?
|
||||
ORDER BY (namespace GLOB ? OR namespace = ?) DESC
|
||||
|]
|
||||
|
||||
|
@ -8,8 +8,6 @@ module U.Codebase.Branch.Type
|
||||
MetadataType,
|
||||
MetadataValue,
|
||||
MdValues (..),
|
||||
NameSegment (..),
|
||||
CausalHash,
|
||||
NamespaceStats (..),
|
||||
hasDefinitions,
|
||||
childAt,
|
||||
@ -29,10 +27,9 @@ import U.Codebase.Reference (Reference)
|
||||
import U.Codebase.Referent (Referent)
|
||||
import U.Codebase.TermEdit (TermEdit)
|
||||
import U.Codebase.TypeEdit (TypeEdit)
|
||||
import Unison.NameSegment (NameSegment)
|
||||
import Unison.Prelude
|
||||
|
||||
newtype NameSegment = NameSegment {unNameSegment :: Text} deriving (Eq, Ord, Show)
|
||||
|
||||
type MetadataType = Reference
|
||||
|
||||
type MetadataValue = Reference
|
||||
|
@ -19,7 +19,6 @@ library
|
||||
U.Codebase.Branch.Type
|
||||
U.Codebase.Causal
|
||||
U.Codebase.Decl
|
||||
U.Codebase.HashTags
|
||||
U.Codebase.Kind
|
||||
U.Codebase.Reference
|
||||
U.Codebase.Referent
|
||||
|
@ -4,14 +4,11 @@ import U.Util.Hash (Hash)
|
||||
|
||||
newtype BranchHash = BranchHash {unBranchHash :: Hash} deriving (Eq, Ord)
|
||||
|
||||
-- | Represents a hash of a causal containing values of the provided type.
|
||||
newtype CausalHash = CausalHash {unCausalHash :: Hash} deriving (Eq, Ord)
|
||||
|
||||
newtype EditHash = EditHash {unEditHash :: Hash} deriving (Eq, Ord)
|
||||
|
||||
newtype PatchHash = PatchHash {unPatchHash :: Hash} deriving (Eq, Ord)
|
||||
|
||||
newtype DefnHash = DefnHash {unDefnHash :: Hash} deriving (Eq, Ord)
|
||||
|
||||
instance Show BranchHash where
|
||||
show h = "BranchHash (" ++ show (unBranchHash h) ++ ")"
|
||||
|
||||
@ -20,9 +17,3 @@ instance Show CausalHash where
|
||||
|
||||
instance Show PatchHash where
|
||||
show h = "PatchHash (" ++ show (unPatchHash h) ++ ")"
|
||||
|
||||
instance Show EditHash where
|
||||
show h = "EditHash (" ++ show (unEditHash h) ++ ")"
|
||||
|
||||
instance Show DefnHash where
|
||||
show h = "DefnHash (" ++ show (unDefnHash h) ++ ")"
|
@ -10,7 +10,11 @@ library:
|
||||
dependencies:
|
||||
- base
|
||||
- containers
|
||||
- rfc5051
|
||||
- text
|
||||
- vector
|
||||
- unison-hash
|
||||
- unison-prelude
|
||||
- unison-util
|
||||
- unison-util-base32hex
|
||||
|
||||
|
@ -16,8 +16,11 @@ source-repository head
|
||||
|
||||
library
|
||||
exposed-modules:
|
||||
U.Codebase.HashTags
|
||||
U.Core.ABT
|
||||
U.Core.ABT.Var
|
||||
Unison.NameSegment
|
||||
Unison.Util.Alphabetical
|
||||
hs-source-dirs:
|
||||
./
|
||||
default-extensions:
|
||||
@ -49,6 +52,10 @@ library
|
||||
build-depends:
|
||||
base
|
||||
, containers
|
||||
, rfc5051
|
||||
, text
|
||||
, unison-hash
|
||||
, unison-prelude
|
||||
, unison-util
|
||||
, unison-util-base32hex
|
||||
, vector
|
||||
|
@ -20,9 +20,9 @@ import qualified U.Codebase.Branch.Type as Branch
|
||||
import qualified U.Codebase.Causal as Causal
|
||||
import U.Codebase.Reference (Reference)
|
||||
import U.Codebase.Referent (Referent)
|
||||
import qualified Unison.Codebase.SqliteCodebase.Conversions as Cv
|
||||
import Unison.Name (Name)
|
||||
import qualified Unison.Name as Name
|
||||
import Unison.NameSegment (NameSegment)
|
||||
import Unison.Prelude
|
||||
|
||||
data Diff a = Diff
|
||||
@ -163,10 +163,10 @@ nameChanges namePrefix (TreeDiff (DefinitionDiffs {termDiffs, typeDiffs} :< chil
|
||||
in NameChanges {termNameAdds, termNameRemovals, typeNameAdds, typeNameRemovals} <> childNameChanges
|
||||
where
|
||||
appendName :: NameSegment -> Name
|
||||
appendName ns =
|
||||
appendName =
|
||||
case namePrefix of
|
||||
Nothing -> Name.fromSegment . Cv.namesegment2to1 $ ns
|
||||
Just prefix -> prefix Lens.|> Cv.namesegment2to1 ns
|
||||
Nothing -> Name.fromSegment
|
||||
Just prefix -> (prefix Lens.|>)
|
||||
listifyNames :: (Name -> Set ref -> [(Name, ref)])
|
||||
listifyNames name xs =
|
||||
xs
|
||||
|
40
parser-typechecker/src/U/Codebase/Projects.hs
Normal file
40
parser-typechecker/src/U/Codebase/Projects.hs
Normal file
@ -0,0 +1,40 @@
|
||||
module U.Codebase.Projects where
|
||||
|
||||
import qualified Control.Lens.Cons as Cons
|
||||
import Control.Monad.Reader
|
||||
import Control.Monad.Writer.Strict (WriterT, execWriterT, tell)
|
||||
import qualified Data.Map as Map
|
||||
import Data.Monoid (Last (..))
|
||||
import U.Codebase.Branch
|
||||
import qualified U.Codebase.Causal as Causal
|
||||
import Unison.Codebase.Path
|
||||
import qualified Unison.Codebase.Path as Path
|
||||
import Unison.NameSegment (NameSegment (..))
|
||||
import Unison.Prelude
|
||||
import qualified Unison.Sqlite as Sqlite
|
||||
|
||||
libSegment :: NameSegment
|
||||
libSegment = NameSegment "lib"
|
||||
|
||||
-- | Infers path to use for loading names.
|
||||
-- Currently this means finding the closest parent with a "lib" child.
|
||||
inferNamesRoot :: Path -> Branch Sqlite.Transaction -> Sqlite.Transaction (Maybe Path)
|
||||
inferNamesRoot p _b | Just match <- specialCases p = pure $ Just match
|
||||
where
|
||||
specialCases :: Path -> Maybe Path
|
||||
specialCases ("public" Cons.:< "base" Cons.:< release Cons.:< _rest) = Just (Path.fromList ["public", "base", release])
|
||||
specialCases _ = Nothing
|
||||
inferNamesRoot p b = getLast <$> execWriterT (runReaderT (go p b) Path.empty)
|
||||
where
|
||||
go :: Path -> Branch Sqlite.Transaction -> ReaderT Path (WriterT (Last Path) Sqlite.Transaction) ()
|
||||
go p b = do
|
||||
childMap <- lift . lift $ nonEmptyChildren b
|
||||
when (isJust $ Map.lookup libSegment childMap) $ ask >>= tell . Last . Just
|
||||
case p of
|
||||
Empty -> pure ()
|
||||
(nextChild Cons.:< pathRemainder) ->
|
||||
case Map.lookup (coerce nextChild) childMap of
|
||||
Nothing -> pure ()
|
||||
Just childCausal -> do
|
||||
childBranch <- lift . lift $ Causal.value childCausal
|
||||
local (Cons.|> nextChild) (go pathRemainder childBranch)
|
@ -118,6 +118,7 @@ import qualified Data.Set as Set
|
||||
import qualified U.Codebase.Branch as V2
|
||||
import qualified U.Codebase.Branch as V2Branch
|
||||
import qualified U.Codebase.Causal as V2Causal
|
||||
import U.Codebase.HashTags (CausalHash)
|
||||
import qualified U.Codebase.Referent as V2
|
||||
import qualified U.Codebase.Sqlite.Operations as Operations
|
||||
import qualified U.Codebase.Sqlite.Queries as Queries
|
||||
@ -175,7 +176,7 @@ runTransaction Codebase {withConnection} action =
|
||||
|
||||
getShallowCausalFromRoot ::
|
||||
-- Optional root branch, if Nothing use the codebase's root branch.
|
||||
Maybe V2.CausalHash ->
|
||||
Maybe CausalHash ->
|
||||
Path.Path ->
|
||||
Sqlite.Transaction (V2Branch.CausalBranch Sqlite.Transaction)
|
||||
getShallowCausalFromRoot mayRootHash p = do
|
||||
@ -207,9 +208,9 @@ getShallowCausalAtPath path mayCausal = do
|
||||
causal <- whenNothing mayCausal getShallowRootCausal
|
||||
case path of
|
||||
Path.Empty -> pure causal
|
||||
(ns Path.:< p) -> do
|
||||
ns Path.:< p -> do
|
||||
b <- V2Causal.value causal
|
||||
case (V2Branch.childAt (Cv.namesegment1to2 ns) b) of
|
||||
case V2Branch.childAt ns b of
|
||||
Nothing -> pure (Cv.causalbranch1to2 Branch.empty)
|
||||
Just childCausal -> getShallowCausalAtPath p (Just childCausal)
|
||||
|
||||
@ -223,15 +224,15 @@ getShallowBranchAtPath path mayBranch = do
|
||||
branch <- whenNothing mayBranch (getShallowRootCausal >>= V2Causal.value)
|
||||
case path of
|
||||
Path.Empty -> pure branch
|
||||
(ns Path.:< p) -> do
|
||||
case (V2Branch.childAt (Cv.namesegment1to2 ns) branch) of
|
||||
ns Path.:< p -> do
|
||||
case V2Branch.childAt ns branch of
|
||||
Nothing -> pure V2Branch.empty
|
||||
Just childCausal -> do
|
||||
childBranch <- V2Causal.value childCausal
|
||||
getShallowBranchAtPath p (Just childBranch)
|
||||
|
||||
-- | Get a branch from the codebase.
|
||||
getBranchForHash :: Monad m => Codebase m v a -> Branch.CausalHash -> m (Maybe (Branch m))
|
||||
getBranchForHash :: Monad m => Codebase m v a -> CausalHash -> m (Maybe (Branch m))
|
||||
getBranchForHash codebase h =
|
||||
-- Attempt to find the Branch in the current codebase cache and root up to 3 levels deep
|
||||
-- If not found, attempt to find it in the Codebase (sqlite)
|
||||
@ -270,7 +271,7 @@ lca code b1@(Branch.headHash -> h1) b2@(Branch.headHash -> h2) = do
|
||||
eb2 <- SqliteCodebase.Operations.branchExists h2
|
||||
if eb1 && eb2
|
||||
then do
|
||||
SqliteCodebase.Operations.sqlLca h1 h2 >>= \case
|
||||
Operations.lca h1 h2 >>= \case
|
||||
Just h -> pure (getBranchForHash code h)
|
||||
Nothing -> pure (pure Nothing) -- no common ancestor
|
||||
else pure (Branch.lca b1 b2)
|
||||
@ -360,7 +361,7 @@ typeLookupForDependencies codebase s = do
|
||||
|
||||
toCodeLookup :: MonadIO m => Codebase m Symbol Parser.Ann -> CL.CodeLookup Symbol m Parser.Ann
|
||||
toCodeLookup c =
|
||||
CL.CodeLookup (getTerm c) (runTransaction c . getTypeDeclaration c)
|
||||
CL.CodeLookup (runTransaction c . getTerm c) (runTransaction c . getTypeDeclaration c)
|
||||
<> Builtin.codeLookup
|
||||
<> IOSource.codeLookupM
|
||||
|
||||
@ -499,7 +500,7 @@ unsafeGetComponentLength h =
|
||||
Just size -> pure size
|
||||
|
||||
-- | Like 'getTerm', for when the term is known to exist in the codebase.
|
||||
unsafeGetTerm :: (HasCallStack, Monad m) => Codebase m v a -> Reference.Id -> m (Term v a)
|
||||
unsafeGetTerm :: HasCallStack => Codebase m v a -> Reference.Id -> Sqlite.Transaction (Term v a)
|
||||
unsafeGetTerm codebase rid =
|
||||
getTerm codebase rid >>= \case
|
||||
Nothing -> error (reportBug "E520818" ("term " ++ show rid ++ " not found"))
|
||||
@ -520,7 +521,7 @@ unsafeGetTypeOfTermById codebase rid =
|
||||
Just ty -> pure ty
|
||||
|
||||
-- | Like 'unsafeGetTerm', but returns the type of the term, too.
|
||||
unsafeGetTermWithType :: (HasCallStack, MonadIO m) => Codebase m v a -> Reference.Id -> m (Term v a, Type v a)
|
||||
unsafeGetTermWithType :: HasCallStack => Codebase m v a -> Reference.Id -> Sqlite.Transaction (Term v a, Type v a)
|
||||
unsafeGetTermWithType codebase rid = do
|
||||
term <- unsafeGetTerm codebase rid
|
||||
ty <-
|
||||
@ -528,7 +529,7 @@ unsafeGetTermWithType codebase rid = do
|
||||
-- inferred type). In this case, we can avoid looking up the type separately.
|
||||
case term of
|
||||
Term.Ann' _ ty -> pure ty
|
||||
_ -> runTransaction codebase (unsafeGetTypeOfTermById codebase rid)
|
||||
_ -> unsafeGetTypeOfTermById codebase rid
|
||||
pure (term, ty)
|
||||
|
||||
-- | Like 'getTermComponentWithTypes', for when the term component is known to exist in the codebase.
|
||||
|
@ -12,8 +12,6 @@ module Unison.Codebase.Branch
|
||||
Raw,
|
||||
Star,
|
||||
NamespaceHash,
|
||||
CausalHash,
|
||||
EditHash,
|
||||
|
||||
-- * Branch construction
|
||||
branch0,
|
||||
@ -94,12 +92,11 @@ import qualified Data.Sequence as Seq
|
||||
import qualified Data.Set as Set
|
||||
import Data.These (These (..))
|
||||
import U.Codebase.Branch.Type (NamespaceStats (..))
|
||||
import U.Codebase.HashTags (PatchHash (..))
|
||||
import Unison.Codebase.Branch.Raw (Raw)
|
||||
import Unison.Codebase.Branch.Type
|
||||
( Branch (..),
|
||||
Branch0 (..),
|
||||
CausalHash (..),
|
||||
EditHash,
|
||||
NamespaceHash,
|
||||
Star,
|
||||
UnwrappedBranch,
|
||||
@ -189,7 +186,7 @@ branch0 ::
|
||||
Metadata.Star Referent NameSegment ->
|
||||
Metadata.Star TypeReference NameSegment ->
|
||||
Map NameSegment (Branch m) ->
|
||||
Map NameSegment (EditHash, m Patch) ->
|
||||
Map NameSegment (PatchHash, m Patch) ->
|
||||
Branch0 m
|
||||
branch0 terms types children edits =
|
||||
Branch0
|
||||
@ -330,13 +327,13 @@ deriveDeepEdits :: forall m. Branch0 m -> Branch0 m
|
||||
deriveDeepEdits branch =
|
||||
branch {deepEdits = makeDeepEdits branch}
|
||||
where
|
||||
makeDeepEdits :: Branch0 m -> Map Name EditHash
|
||||
makeDeepEdits :: Branch0 m -> Map Name PatchHash
|
||||
makeDeepEdits branch = State.evalState (go (Seq.singleton ([], 0, branch)) mempty) Set.empty
|
||||
where
|
||||
go :: (Seq (DeepChildAcc m)) -> Map Name EditHash -> DeepState m (Map Name EditHash)
|
||||
go :: (Seq (DeepChildAcc m)) -> Map Name PatchHash -> DeepState m (Map Name PatchHash)
|
||||
go Seq.Empty acc = pure acc
|
||||
go (e@(reversePrefix, _, b0) Seq.:<| work) acc = do
|
||||
let edits :: Map Name EditHash
|
||||
let edits :: Map Name PatchHash
|
||||
edits =
|
||||
Map.mapKeysMonotonic
|
||||
(Name.fromReverseSegments . (NonEmpty.:| reversePrefix))
|
||||
@ -378,16 +375,16 @@ head_ :: Lens' (Branch m) (Branch0 m)
|
||||
head_ = history . Causal.head_
|
||||
|
||||
-- | a version of `deepEdits` that returns the `m Patch` as well.
|
||||
deepEdits' :: Branch0 m -> Map Name (EditHash, m Patch)
|
||||
deepEdits' :: Branch0 m -> Map Name (PatchHash, m Patch)
|
||||
deepEdits' = go id
|
||||
where
|
||||
-- can change this to an actual prefix once Name is a [NameSegment]
|
||||
go :: (Name -> Name) -> Branch0 m -> Map Name (EditHash, m Patch)
|
||||
go :: (Name -> Name) -> Branch0 m -> Map Name (PatchHash, m Patch)
|
||||
go addPrefix Branch0 {_children, _edits} =
|
||||
Map.mapKeys (addPrefix . Name.fromSegment) _edits
|
||||
<> foldMap f (Map.toList _children)
|
||||
where
|
||||
f :: (NameSegment, Branch m) -> Map Name (EditHash, m Patch)
|
||||
f :: (NameSegment, Branch m) -> Map Name (PatchHash, m Patch)
|
||||
f (c, b) = go (addPrefix . Name.cons c) (head b)
|
||||
|
||||
-- | Discards the history of a Branch0's children, recursively
|
||||
@ -555,10 +552,10 @@ modifyPatches seg f = mapMOf edits update
|
||||
Nothing -> pure $ f Patch.empty
|
||||
Just (_, p) -> f <$> p
|
||||
let h = H.hashPatch p'
|
||||
pure $ Map.insert seg (h, pure p') m
|
||||
pure $ Map.insert seg (PatchHash h, pure p') m
|
||||
|
||||
replacePatch :: Applicative m => NameSegment -> Patch -> Branch0 m -> Branch0 m
|
||||
replacePatch n p = over edits (Map.insert n (H.hashPatch p, pure p))
|
||||
replacePatch n p = over edits (Map.insert n (PatchHash (H.hashPatch p), pure p))
|
||||
|
||||
deletePatch :: NameSegment -> Branch0 m -> Branch0 m
|
||||
deletePatch n = over edits (Map.delete n)
|
||||
|
@ -12,10 +12,10 @@ where
|
||||
|
||||
import qualified Data.Map as Map
|
||||
import qualified Data.Map.Merge.Lazy as Map
|
||||
import U.Codebase.HashTags (PatchHash (..))
|
||||
import Unison.Codebase.Branch
|
||||
( Branch (..),
|
||||
Branch0 (_children, _edits, _terms, _types),
|
||||
EditHash,
|
||||
branch0,
|
||||
cons,
|
||||
discardHistory0,
|
||||
@ -88,7 +88,7 @@ merge'' lca mode (Branch x) (Branch y) =
|
||||
let newPatches = makePatch <$> Map.difference changedPatches (_edits b0)
|
||||
makePatch Patch.PatchDiff {..} =
|
||||
let p = Patch.Patch _addedTermEdits _addedTypeEdits
|
||||
in (H.hashPatch p, pure p)
|
||||
in (PatchHash (H.hashPatch p), pure p)
|
||||
pure $
|
||||
branch0
|
||||
(Star3.difference (_terms b0) removedTerms <> addedTerms)
|
||||
@ -107,7 +107,7 @@ merge'' lca mode (Branch x) (Branch y) =
|
||||
R.difference (Patch._typeEdits p) _removedTypeEdits
|
||||
<> _addedTypeEdits
|
||||
}
|
||||
pure (H.hashPatch np, pure np)
|
||||
pure (PatchHash (H.hashPatch np), pure np)
|
||||
|
||||
merge0 ::
|
||||
forall m.
|
||||
@ -127,10 +127,10 @@ merge0 lca mode b1 b2 = do
|
||||
c3
|
||||
e3
|
||||
where
|
||||
g :: (EditHash, m Patch) -> (EditHash, m Patch) -> m (EditHash, m Patch)
|
||||
g :: (PatchHash, m Patch) -> (PatchHash, m Patch) -> m (PatchHash, m Patch)
|
||||
g (h1, m1) (h2, _) | h1 == h2 = pure (h1, m1)
|
||||
g (_, m1) (_, m2) = do
|
||||
e1 <- m1
|
||||
e2 <- m2
|
||||
let e3 = e1 <> e2
|
||||
pure (H.hashPatch e3, pure e3)
|
||||
pure (PatchHash (H.hashPatch e3), pure e3)
|
||||
|
@ -2,7 +2,6 @@
|
||||
|
||||
module Unison.Codebase.Branch.Type
|
||||
( NamespaceHash,
|
||||
CausalHash (..),
|
||||
head,
|
||||
headHash,
|
||||
namespaceHash,
|
||||
@ -11,7 +10,6 @@ module Unison.Codebase.Branch.Type
|
||||
history,
|
||||
edits,
|
||||
Star,
|
||||
EditHash,
|
||||
UnwrappedBranch,
|
||||
)
|
||||
where
|
||||
@ -19,7 +17,8 @@ where
|
||||
import Control.Lens
|
||||
import Data.Map (Map)
|
||||
import Data.Set (Set)
|
||||
import Unison.Codebase.Causal.Type (Causal, CausalHash)
|
||||
import U.Codebase.HashTags (CausalHash, PatchHash)
|
||||
import Unison.Codebase.Causal.Type (Causal)
|
||||
import qualified Unison.Codebase.Causal.Type as Causal
|
||||
import qualified Unison.Codebase.Metadata as Metadata
|
||||
import Unison.Codebase.Patch (Patch)
|
||||
@ -42,8 +41,6 @@ type UnwrappedBranch m = Causal m (Branch0 m)
|
||||
-- | A Hash for a namespace itself, it doesn't incorporate any history.
|
||||
type NamespaceHash m = Hash.HashFor (Branch0 m)
|
||||
|
||||
type EditHash = Hash.Hash
|
||||
|
||||
type Star r n = Metadata.Star r n
|
||||
|
||||
head :: Branch m -> Branch0 m
|
||||
@ -69,7 +66,7 @@ data Branch0 m = Branch0
|
||||
-- | Note the 'Branch' here, not 'Branch0'.
|
||||
-- Every level in the tree has a history.
|
||||
_children :: Map NameSegment (Branch m),
|
||||
_edits :: Map NameSegment (EditHash, m Patch),
|
||||
_edits :: Map NameSegment (PatchHash, m Patch),
|
||||
-- | True if a branch and its children have no definitions or edits in them.
|
||||
-- (Computed recursively, and small enough to justify storing here to avoid computing more than once.)
|
||||
isEmpty0 :: Bool,
|
||||
@ -80,7 +77,7 @@ data Branch0 m = Branch0
|
||||
deepTermMetadata :: Metadata.R4 Referent Name,
|
||||
deepTypeMetadata :: Metadata.R4 Reference Name,
|
||||
deepPaths :: Set Path,
|
||||
deepEdits :: Map Name EditHash
|
||||
deepEdits :: Map Name PatchHash
|
||||
}
|
||||
|
||||
instance Eq (Branch0 m) where
|
||||
@ -93,5 +90,5 @@ instance Eq (Branch0 m) where
|
||||
history :: Iso' (Branch m) (UnwrappedBranch m)
|
||||
history = iso _history Branch
|
||||
|
||||
edits :: Lens' (Branch0 m) (Map NameSegment (EditHash, m Patch))
|
||||
edits :: Lens' (Branch0 m) (Map NameSegment (PatchHash, m Patch))
|
||||
edits = lens _edits (\b0 e -> b0 {_edits = e})
|
||||
|
@ -2,6 +2,7 @@ module Unison.Codebase.BranchDiff where
|
||||
|
||||
import qualified Data.Map as Map
|
||||
import qualified Data.Set as Set
|
||||
import U.Codebase.HashTags (PatchHash)
|
||||
import Unison.Codebase.Branch (Branch0 (..))
|
||||
import qualified Unison.Codebase.Branch as Branch
|
||||
import qualified Unison.Codebase.Metadata as Metadata
|
||||
@ -57,7 +58,7 @@ diff0 old new = BranchDiff terms types <$> patchDiff old new
|
||||
|
||||
patchDiff :: forall m. Monad m => Branch0 m -> Branch0 m -> m (Map Name (DiffType PatchDiff))
|
||||
patchDiff old new = do
|
||||
let oldDeepEdits, newDeepEdits :: Map Name (Branch.EditHash, m Patch)
|
||||
let oldDeepEdits, newDeepEdits :: Map Name (PatchHash, m Patch)
|
||||
oldDeepEdits = Branch.deepEdits' old
|
||||
newDeepEdits = Branch.deepEdits' new
|
||||
added <- do
|
||||
|
@ -8,7 +8,6 @@ module Unison.Codebase.Causal
|
||||
pattern One,
|
||||
pattern Cons,
|
||||
pattern Merge,
|
||||
CausalHash (..),
|
||||
head_,
|
||||
one,
|
||||
cons,
|
||||
@ -34,6 +33,7 @@ import qualified Control.Monad.Reader as Reader
|
||||
import qualified Control.Monad.State as State
|
||||
import qualified Data.Map as Map
|
||||
import qualified Data.Set as Set
|
||||
import U.Codebase.HashTags (CausalHash)
|
||||
import Unison.Codebase.Causal.Type
|
||||
( Causal
|
||||
( UnsafeCons,
|
||||
@ -44,7 +44,6 @@ import Unison.Codebase.Causal.Type
|
||||
tail,
|
||||
tails
|
||||
),
|
||||
CausalHash (..),
|
||||
before,
|
||||
lca,
|
||||
predecessors,
|
||||
|
@ -6,7 +6,8 @@ module Unison.Codebase.Causal.FoldHistory (FoldHistoryResult (..), foldHistoryUn
|
||||
import qualified Data.Map as Map
|
||||
import qualified Data.Sequence as Seq
|
||||
import qualified Data.Set as Set
|
||||
import Unison.Codebase.Causal (Causal (..), CausalHash, pattern Cons, pattern Merge, pattern One)
|
||||
import U.Codebase.HashTags (CausalHash)
|
||||
import Unison.Codebase.Causal (Causal (..), pattern Cons, pattern Merge, pattern One)
|
||||
import Unison.Prelude
|
||||
import Prelude hiding (head, tail)
|
||||
|
||||
@ -33,7 +34,7 @@ foldHistoryUntil f a c = step a mempty (pure c)
|
||||
step a _seen Seq.Empty = pure (Unsatisfied a)
|
||||
step a seen (c Seq.:<| rest)
|
||||
| currentHash c `Set.member` seen =
|
||||
step a seen rest
|
||||
step a seen rest
|
||||
step a seen (c Seq.:<| rest) = case f a (head c) of
|
||||
(a, True) -> pure (Satisfied a)
|
||||
(a, False) -> do
|
||||
|
@ -4,7 +4,6 @@
|
||||
|
||||
module Unison.Codebase.Causal.Type
|
||||
( Causal (..),
|
||||
CausalHash (..),
|
||||
pattern One,
|
||||
pattern Cons,
|
||||
pattern Merge,
|
||||
@ -17,7 +16,8 @@ where
|
||||
import qualified Data.Map as Map
|
||||
import qualified Data.Sequence as Seq
|
||||
import qualified Data.Set as Set
|
||||
import Unison.Hash (Hash, HashFor (..))
|
||||
import U.Codebase.HashTags (CausalHash)
|
||||
import Unison.Hash (HashFor (..))
|
||||
import Unison.Prelude
|
||||
import Prelude hiding (head, read, tail)
|
||||
|
||||
@ -41,11 +41,6 @@ import Prelude hiding (head, read, tail)
|
||||
* `head (sequence c1 c2) == head c2`
|
||||
-}
|
||||
|
||||
-- | Represents a hash of a causal containing values of the provided type.
|
||||
newtype CausalHash = CausalHash {unCausalHash :: Hash}
|
||||
deriving newtype (Show)
|
||||
deriving stock (Eq, Ord, Generic)
|
||||
|
||||
instance (Show e) => Show (Causal m e) where
|
||||
show = \case
|
||||
UnsafeOne h eh e -> "One " ++ (take 3 . show) h ++ " " ++ (take 3 . show) eh ++ " " ++ show e
|
||||
|
@ -27,7 +27,7 @@ import qualified System.Console.ANSI as ANSI
|
||||
import System.FileLock (SharedExclusive (Exclusive), withTryFileLock)
|
||||
import qualified System.FilePath as FilePath
|
||||
import qualified System.FilePath.Posix as FilePath.Posix
|
||||
import U.Codebase.HashTags (BranchHash, CausalHash (CausalHash))
|
||||
import U.Codebase.HashTags (BranchHash, CausalHash, PatchHash (..))
|
||||
import qualified U.Codebase.Reflog as Reflog
|
||||
import qualified U.Codebase.Sqlite.Operations as Ops
|
||||
import qualified U.Codebase.Sqlite.Queries as Q
|
||||
@ -39,7 +39,6 @@ import Unison.Codebase (Codebase, CodebasePath)
|
||||
import qualified Unison.Codebase as Codebase1
|
||||
import Unison.Codebase.Branch (Branch (..))
|
||||
import qualified Unison.Codebase.Branch as Branch
|
||||
import qualified Unison.Codebase.Causal.Type as Causal
|
||||
import Unison.Codebase.Editor.Git (gitIn, gitInCaptured, gitTextIn, withRepo)
|
||||
import qualified Unison.Codebase.Editor.Git as Git
|
||||
import Unison.Codebase.Editor.RemoteRepo
|
||||
@ -236,9 +235,7 @@ sqliteCodebase debugName root localOrRemote lockOption migrationStrategy action
|
||||
printBuffer "Terms:" terms
|
||||
|
||||
flip finally finalizer do
|
||||
getTermTransaction <- CodebaseOps.makeMaybeCachedTransaction 8192 (CodebaseOps.getTerm getDeclType)
|
||||
let getTerm id = runTransaction (getTermTransaction id)
|
||||
|
||||
getTerm <- CodebaseOps.makeMaybeCachedTransaction 8192 (CodebaseOps.getTerm getDeclType)
|
||||
getTypeOfTermImpl <- CodebaseOps.makeMaybeCachedTransaction 8192 (CodebaseOps.getTypeOfTermImpl)
|
||||
getTypeDeclaration <- CodebaseOps.makeMaybeCachedTransaction 1024 CodebaseOps.getTypeDeclaration
|
||||
|
||||
@ -287,9 +284,9 @@ sqliteCodebase debugName root localOrRemote lockOption migrationStrategy action
|
||||
-- Transaction is applied to the same db connection.
|
||||
let branch1Trans = Branch.transform (Sqlite.unsafeIO . runInIO) branch1
|
||||
putRootBranchTrans :: Sqlite.Transaction () = do
|
||||
let emptyCausalHash = Cv.causalHash1to2 (Branch.headHash Branch.empty)
|
||||
let emptyCausalHash = Branch.headHash Branch.empty
|
||||
fromRootCausalHash <- fromMaybe emptyCausalHash <$> Ops.loadRootCausalHash
|
||||
let toRootCausalHash = Cv.causalHash1to2 (Branch.headHash branch1)
|
||||
let toRootCausalHash = Branch.headHash branch1
|
||||
CodebaseOps.putRootBranch branch1Trans
|
||||
Ops.appendReflog (Reflog.Entry {time = now, fromRootCausalHash, toRootCausalHash, reason})
|
||||
|
||||
@ -303,7 +300,7 @@ sqliteCodebase debugName root localOrRemote lockOption migrationStrategy action
|
||||
|
||||
-- if this blows up on cromulent hashes, then switch from `hashToHashId`
|
||||
-- to one that returns Maybe.
|
||||
getBranchForHash :: Branch.CausalHash -> m (Maybe (Branch m))
|
||||
getBranchForHash :: CausalHash -> m (Maybe (Branch m))
|
||||
getBranchForHash h =
|
||||
fmap (Branch.transform runTransaction) <$> runTransaction (CodebaseOps.getBranchForHash branchCache getDeclType h)
|
||||
|
||||
@ -343,9 +340,9 @@ sqliteCodebase debugName root localOrRemote lockOption migrationStrategy action
|
||||
termsMentioningTypeImpl =
|
||||
CodebaseOps.termsMentioningTypeImpl getDeclType
|
||||
|
||||
referentsByPrefix :: ShortHash -> m (Set Referent.Id)
|
||||
referentsByPrefix sh =
|
||||
runTransaction (CodebaseOps.referentsByPrefix getDeclType sh)
|
||||
referentsByPrefix :: ShortHash -> Sqlite.Transaction (Set Referent.Id)
|
||||
referentsByPrefix =
|
||||
CodebaseOps.referentsByPrefix getDeclType
|
||||
|
||||
updateNameLookup :: Path -> Maybe BranchHash -> BranchHash -> Sqlite.Transaction ()
|
||||
updateNameLookup =
|
||||
@ -435,8 +432,7 @@ syncInternal progress runSrc runDest b = time "syncInternal" do
|
||||
processBranches rest
|
||||
do
|
||||
when debugProcessBranches $ traceM $ " " ++ show b0 ++ " doesn't exist in dest db"
|
||||
let h2 = CausalHash $ Causal.unCausalHash h
|
||||
runSrc (Q.loadCausalHashIdByCausalHash h2) >>= \case
|
||||
runSrc (Q.loadCausalHashIdByCausalHash h) >>= \case
|
||||
Just chId -> do
|
||||
when debugProcessBranches $ traceM $ " " ++ show b0 ++ " exists in source db, so delegating to direct sync"
|
||||
doSync [Sync22.C chId]
|
||||
@ -462,7 +458,7 @@ syncInternal progress runSrc runDest b = time "syncInternal" do
|
||||
processBranches rest
|
||||
else do
|
||||
let bs = map (uncurry B) cs
|
||||
os = map O (es <> ts <> ds)
|
||||
os = map O (coerce @[PatchHash] @[Hash] es <> ts <> ds)
|
||||
processBranches (os ++ bs ++ b0 : rest)
|
||||
O h : rest -> do
|
||||
when debugProcessBranches $ traceM $ "processBranches O " ++ take 10 (show h)
|
||||
@ -473,7 +469,7 @@ syncInternal progress runSrc runDest b = time "syncInternal" do
|
||||
time "SyncInternal.processBranches" $ processBranches [B bHash (pure b)]
|
||||
|
||||
data Entity m
|
||||
= B Branch.CausalHash (m (Branch m))
|
||||
= B CausalHash (m (Branch m))
|
||||
| O Hash
|
||||
|
||||
instance Show (Entity m) where
|
||||
@ -672,7 +668,7 @@ pushGitBranch srcConn repo (PushGitBranchOpts behavior _syncMode) action = Unlif
|
||||
runDest Ops.loadRootCausalHash >>= \case
|
||||
Nothing -> pure ()
|
||||
Just oldRootHash -> do
|
||||
runDest (CodebaseOps.before (Cv.causalHash2to1 oldRootHash) newBranchHash) >>= \case
|
||||
runDest (CodebaseOps.before oldRootHash newBranchHash) >>= \case
|
||||
False -> throwIO . C.GitProtocolError $ GitError.PushDestinationHasNewStuff repo
|
||||
True -> pure ()
|
||||
CreatedCodebase -> pure ()
|
||||
@ -681,11 +677,10 @@ pushGitBranch srcConn repo (PushGitBranchOpts behavior _syncMode) action = Unlif
|
||||
C.GitPushBehaviorGist -> pure ()
|
||||
C.GitPushBehaviorFf -> overwriteRoot False
|
||||
C.GitPushBehaviorForce -> overwriteRoot True
|
||||
setRepoRoot :: Branch.CausalHash -> Sqlite.Transaction ()
|
||||
setRepoRoot :: CausalHash -> Sqlite.Transaction ()
|
||||
setRepoRoot h = do
|
||||
let h2 = Cv.causalHash1to2 h
|
||||
err = error $ "Called SqliteCodebase.setNamespaceRoot on unknown causal hash " ++ show h2
|
||||
chId <- fromMaybe err <$> Q.loadCausalHashIdByCausalHash h2
|
||||
let err = error $ "Called SqliteCodebase.setNamespaceRoot on unknown causal hash " ++ show h
|
||||
chId <- fromMaybe err <$> Q.loadCausalHashIdByCausalHash h
|
||||
Q.setNamespaceRoot chId
|
||||
|
||||
-- This function makes sure that the result of git status is valid.
|
||||
|
@ -12,6 +12,7 @@ import Data.Monoid.Generic (GenericMonoid (..), GenericSemigroup (..))
|
||||
import Data.Set (Set)
|
||||
import qualified Data.Set as Set
|
||||
import GHC.Generics (Generic)
|
||||
import U.Codebase.HashTags (CausalHash, PatchHash)
|
||||
import Unison.Codebase.Branch.Type as Branch
|
||||
import qualified Unison.Codebase.Causal as Causal
|
||||
import Unison.Codebase.Patch (Patch)
|
||||
@ -24,10 +25,10 @@ import qualified Unison.Referent as Referent
|
||||
import qualified Unison.Util.Relation as R
|
||||
import qualified Unison.Util.Star3 as Star3
|
||||
|
||||
type Branches m = [(Branch.CausalHash, m (Branch m))]
|
||||
type Branches m = [(CausalHash, m (Branch m))]
|
||||
|
||||
data Dependencies = Dependencies
|
||||
{ patches :: Set EditHash,
|
||||
{ patches :: Set PatchHash,
|
||||
terms :: Set Hash,
|
||||
decls :: Set Hash
|
||||
}
|
||||
@ -37,7 +38,7 @@ data Dependencies = Dependencies
|
||||
deriving (Monoid) via GenericMonoid Dependencies
|
||||
|
||||
data Dependencies' = Dependencies'
|
||||
{ patches' :: [EditHash],
|
||||
{ patches' :: [PatchHash],
|
||||
terms' :: [Hash],
|
||||
decls' :: [Hash]
|
||||
}
|
||||
@ -86,5 +87,5 @@ fromBranch0 b =
|
||||
where
|
||||
terms = Set.fromList [h | (Derived h _) <- mdValues s]
|
||||
decls = Set.fromList [h | (Derived h _) <- references s]
|
||||
fromEdits :: Map NameSegment (EditHash, m Patch) -> Dependencies
|
||||
fromEdits :: Map NameSegment (PatchHash, m Patch) -> Dependencies
|
||||
fromEdits m = Dependencies (Set.fromList . fmap fst $ toList m) mempty mempty
|
||||
|
@ -9,7 +9,7 @@ import Data.Text (pack, unpack)
|
||||
import qualified U.Codebase.Branch as V2.Branch
|
||||
import qualified U.Codebase.Causal as V2
|
||||
import qualified U.Codebase.Decl as V2.Decl
|
||||
import qualified U.Codebase.HashTags as V2
|
||||
import U.Codebase.HashTags
|
||||
import qualified U.Codebase.Kind as V2.Kind
|
||||
import qualified U.Codebase.Reference as V2
|
||||
import qualified U.Codebase.Reference as V2.Reference
|
||||
@ -38,7 +38,7 @@ import qualified Unison.DataDeclaration as V1.Decl
|
||||
import Unison.Hash (Hash, base32Hex)
|
||||
import qualified Unison.Hash as V1
|
||||
import qualified Unison.Kind as V1.Kind
|
||||
import qualified Unison.NameSegment as V1
|
||||
import Unison.NameSegment (NameSegment)
|
||||
import Unison.Parser.Ann (Ann)
|
||||
import qualified Unison.Parser.Ann as Ann
|
||||
import qualified Unison.Pattern as V1.Pattern
|
||||
@ -273,14 +273,11 @@ rreferenceid1to2 h (V1.Reference.Id h' i) = V2.Reference.Id oh i
|
||||
where
|
||||
oh = if h == h' then Nothing else Just h'
|
||||
|
||||
branchHash1to2 :: V1.Branch.NamespaceHash m -> V2.BranchHash
|
||||
branchHash1to2 = V2.BranchHash . V1.genericHash
|
||||
branchHash1to2 :: V1.Branch.NamespaceHash m -> BranchHash
|
||||
branchHash1to2 = BranchHash . V1.genericHash
|
||||
|
||||
branchHash2to1 :: forall m. V2.BranchHash -> V1.Branch.NamespaceHash m
|
||||
branchHash2to1 = V1.HashFor . V2.unBranchHash
|
||||
|
||||
patchHash1to2 :: V1.Branch.EditHash -> V2.PatchHash
|
||||
patchHash1to2 = V2.PatchHash
|
||||
branchHash2to1 :: forall m. BranchHash -> V1.Branch.NamespaceHash m
|
||||
branchHash2to1 = V1.HashFor . unBranchHash
|
||||
|
||||
reference2to1 :: V2.Reference -> V1.Reference
|
||||
reference2to1 = \case
|
||||
@ -334,12 +331,6 @@ constructorType2to1 = \case
|
||||
V2.DataConstructor -> CT.Data
|
||||
V2.EffectConstructor -> CT.Effect
|
||||
|
||||
causalHash2to1 :: V2.CausalHash -> V1.Branch.CausalHash
|
||||
causalHash2to1 = V1.Causal.CausalHash . V2.unCausalHash
|
||||
|
||||
causalHash1to2 :: V1.Branch.CausalHash -> V2.CausalHash
|
||||
causalHash1to2 = V2.CausalHash . V1.Causal.unCausalHash
|
||||
|
||||
ttype2to1 :: V2.Term.Type V2.Symbol -> V1.Type.Type V1.Symbol Ann
|
||||
ttype2to1 = type2to1' reference2to1
|
||||
|
||||
@ -406,30 +397,28 @@ causalbranch2to1 branchCache lookupCT cb = do
|
||||
pure b
|
||||
|
||||
causalbranch2to1' :: Monad m => BranchCache m -> (V2.Reference -> m CT.ConstructorType) -> V2.Branch.CausalBranch m -> m (V1.Branch.UnwrappedBranch m)
|
||||
causalbranch2to1' branchCache lookupCT (V2.Causal hc eh (Map.toList -> parents) me) = do
|
||||
let currentHash = causalHash2to1 hc
|
||||
branchHash = branchHash2to1 eh
|
||||
causalbranch2to1' branchCache lookupCT (V2.Causal currentHash eh (Map.toList -> parents) me) = do
|
||||
let branchHash = branchHash2to1 eh
|
||||
case parents of
|
||||
[] -> V1.Causal.UnsafeOne currentHash branchHash <$> (me >>= branch2to1 branchCache lookupCT)
|
||||
[(hp, mp)] -> do
|
||||
let parentHash = causalHash2to1 hp
|
||||
[(parentHash, mp)] -> do
|
||||
V1.Causal.UnsafeCons currentHash branchHash
|
||||
<$> (me >>= branch2to1 branchCache lookupCT)
|
||||
<*> pure (parentHash, causalbranch2to1' branchCache lookupCT =<< mp)
|
||||
merge -> do
|
||||
let tailsList = map (bimap causalHash2to1 (causalbranch2to1' branchCache lookupCT =<<)) merge
|
||||
let tailsList = map (fmap (causalbranch2to1' branchCache lookupCT =<<)) merge
|
||||
e <- me
|
||||
V1.Causal.UnsafeMerge currentHash branchHash <$> branch2to1 branchCache lookupCT e <*> pure (Map.fromList tailsList)
|
||||
|
||||
causalbranch1to2 :: forall m. Monad m => V1.Branch.Branch m -> V2.Branch.CausalBranch m
|
||||
causalbranch1to2 (V1.Branch.Branch c) =
|
||||
causal1to2 causalHash1to2 branchHash1to2 branch1to2 c
|
||||
causal1to2 branchHash1to2 branch1to2 c
|
||||
where
|
||||
causal1to2 :: forall m h2c h2e e e2. (Monad m, Ord h2c) => (V1.Causal.CausalHash -> h2c) -> (V1.HashFor e -> h2e) -> (e -> m e2) -> V1.Causal.Causal m e -> V2.Causal m h2c h2e e2
|
||||
causal1to2 h1to2 eh1to2 e1to2 = \case
|
||||
V1.Causal.One hc eh e -> V2.Causal (h1to2 hc) (eh1to2 eh) Map.empty (e1to2 e)
|
||||
V1.Causal.Cons hc eh e (ht, mt) -> V2.Causal (h1to2 hc) (eh1to2 eh) (Map.singleton (h1to2 ht) (causal1to2 h1to2 eh1to2 e1to2 <$> mt)) (e1to2 e)
|
||||
V1.Causal.Merge hc eh e parents -> V2.Causal (h1to2 hc) (eh1to2 eh) (Map.bimap h1to2 (causal1to2 h1to2 eh1to2 e1to2 <$>) parents) (e1to2 e)
|
||||
causal1to2 :: forall m h2e e e2. Monad m => (V1.HashFor e -> h2e) -> (e -> m e2) -> V1.Causal.Causal m e -> V2.Causal m CausalHash h2e e2
|
||||
causal1to2 eh1to2 e1to2 = \case
|
||||
V1.Causal.One hc eh e -> V2.Causal hc (eh1to2 eh) Map.empty (e1to2 e)
|
||||
V1.Causal.Cons hc eh e (ht, mt) -> V2.Causal hc (eh1to2 eh) (Map.singleton ht (causal1to2 eh1to2 e1to2 <$> mt)) (e1to2 e)
|
||||
V1.Causal.Merge hc eh e parents -> V2.Causal hc (eh1to2 eh) (Map.map (causal1to2 eh1to2 e1to2 <$>) parents) (e1to2 e)
|
||||
|
||||
-- todo: this could be a pure function
|
||||
branch1to2 :: forall m. Monad m => V1.Branch.Branch0 m -> m (V2.Branch.Branch m)
|
||||
@ -442,10 +431,10 @@ causalbranch1to2 (V1.Branch.Branch c) =
|
||||
(doChildren (V1.Branch._children b))
|
||||
where
|
||||
-- is there a more readable way to structure these that's also linear?
|
||||
doTerms :: V1.Branch.Star V1.Referent.Referent V1.NameSegment -> Map V2.Branch.NameSegment (Map V2.Referent.Referent (m V2.Branch.MdValues))
|
||||
doTerms :: V1.Branch.Star V1.Referent.Referent NameSegment -> Map NameSegment (Map V2.Referent.Referent (m V2.Branch.MdValues))
|
||||
doTerms s =
|
||||
Map.fromList
|
||||
[ (namesegment1to2 ns, m2)
|
||||
[ (ns, m2)
|
||||
| ns <- toList . Relation.ran $ V1.Star3.d1 s,
|
||||
let m2 =
|
||||
Map.fromList
|
||||
@ -456,10 +445,10 @@ causalbranch1to2 (V1.Branch.Branch c) =
|
||||
]
|
||||
]
|
||||
|
||||
doTypes :: V1.Branch.Star V1.Reference.Reference V1.NameSegment -> Map V2.Branch.NameSegment (Map V2.Reference.Reference (m V2.Branch.MdValues))
|
||||
doTypes :: V1.Branch.Star V1.Reference.Reference NameSegment -> Map NameSegment (Map V2.Reference.Reference (m V2.Branch.MdValues))
|
||||
doTypes s =
|
||||
Map.fromList
|
||||
[ (namesegment1to2 ns, m2)
|
||||
[ (ns, m2)
|
||||
| ns <- toList . Relation.ran $ V1.Star3.d1 s,
|
||||
let m2 =
|
||||
Map.fromList
|
||||
@ -470,11 +459,11 @@ causalbranch1to2 (V1.Branch.Branch c) =
|
||||
]
|
||||
]
|
||||
|
||||
doPatches :: Map V1.NameSegment (V1.Branch.EditHash, m V1.Patch) -> Map V2.Branch.NameSegment (V2.PatchHash, m V2.Branch.Patch)
|
||||
doPatches = Map.bimap namesegment1to2 (bimap edithash1to2 (fmap patch1to2))
|
||||
doPatches :: Map NameSegment (PatchHash, m V1.Patch) -> Map NameSegment (PatchHash, m V2.Branch.Patch)
|
||||
doPatches = Map.map (fmap (fmap patch1to2))
|
||||
|
||||
doChildren :: Map V1.NameSegment (V1.Branch.Branch m) -> Map V2.Branch.NameSegment (V2.Branch.CausalBranch m)
|
||||
doChildren = Map.bimap namesegment1to2 causalbranch1to2
|
||||
doChildren :: Map NameSegment (V1.Branch.Branch m) -> Map NameSegment (V2.Branch.CausalBranch m)
|
||||
doChildren = Map.map causalbranch1to2
|
||||
|
||||
patch2to1 :: V2.Branch.Patch -> V1.Patch
|
||||
patch2to1 (V2.Branch.Patch v2termedits v2typeedits) =
|
||||
@ -519,18 +508,6 @@ patch1to2 (V1.Patch v1termedits v1typeedits) = V2.Branch.Patch v2termedits v2typ
|
||||
V1.TermEdit.Subtype -> V2.TermEdit.Subtype
|
||||
V1.TermEdit.Different -> V2.TermEdit.Different
|
||||
|
||||
edithash2to1 :: V2.PatchHash -> V1.Branch.EditHash
|
||||
edithash2to1 = V2.unPatchHash
|
||||
|
||||
edithash1to2 :: V1.Branch.EditHash -> V2.PatchHash
|
||||
edithash1to2 = V2.PatchHash
|
||||
|
||||
namesegment2to1 :: V2.Branch.NameSegment -> V1.NameSegment
|
||||
namesegment2to1 (V2.Branch.NameSegment t) = V1.NameSegment t
|
||||
|
||||
namesegment1to2 :: V1.NameSegment -> V2.Branch.NameSegment
|
||||
namesegment1to2 (V1.NameSegment t) = V2.Branch.NameSegment t
|
||||
|
||||
branch2to1 ::
|
||||
Monad m =>
|
||||
BranchCache m ->
|
||||
@ -538,12 +515,12 @@ branch2to1 ::
|
||||
V2.Branch.Branch m ->
|
||||
m (V1.Branch.Branch0 m)
|
||||
branch2to1 branchCache lookupCT (V2.Branch.Branch v2terms v2types v2patches v2children) = do
|
||||
v1terms <- toStar reference2to1 <$> Map.bitraverse (pure . namesegment2to1) (Map.bitraverse (referent2to1 lookupCT) id) v2terms
|
||||
v1types <- toStar reference2to1 <$> Map.bitraverse (pure . namesegment2to1) (Map.bitraverse (pure . reference2to1) id) v2types
|
||||
v1children <- Map.bitraverse (pure . namesegment2to1) (causalbranch2to1 branchCache lookupCT) v2children
|
||||
v1terms <- toStar reference2to1 <$> traverse (Map.bitraverse (referent2to1 lookupCT) id) v2terms
|
||||
v1types <- toStar reference2to1 <$> traverse (Map.bitraverse (pure . reference2to1) id) v2types
|
||||
v1children <- traverse (causalbranch2to1 branchCache lookupCT) v2children
|
||||
pure $ V1.Branch.branch0 v1terms v1types v1children v1patches
|
||||
where
|
||||
v1patches = Map.bimap namesegment2to1 (bimap edithash2to1 (fmap patch2to1)) v2patches
|
||||
v1patches = Map.map (fmap (fmap patch2to1)) v2patches
|
||||
toStar :: forall name ref. (Ord name, Ord ref) => (V2.Reference -> V1.Reference) -> Map name (Map ref V2.Branch.MdValues) -> V1.Metadata.Star ref name
|
||||
toStar mdref2to1 m = foldl' insert mempty (Map.toList m)
|
||||
where
|
||||
|
@ -20,7 +20,7 @@ import qualified Data.Text as Text
|
||||
import qualified U.Codebase.Branch as V2Branch
|
||||
import qualified U.Codebase.Branch.Diff as BranchDiff
|
||||
import qualified U.Codebase.Causal as V2Causal
|
||||
import U.Codebase.HashTags (BranchHash, CausalHash (unCausalHash))
|
||||
import U.Codebase.HashTags (BranchHash, CausalHash (unCausalHash), PatchHash)
|
||||
import qualified U.Codebase.Reference as C.Reference
|
||||
import qualified U.Codebase.Referent as C.Referent
|
||||
import U.Codebase.Sqlite.DbId (ObjectId)
|
||||
@ -29,16 +29,13 @@ import qualified U.Codebase.Sqlite.ObjectType as OT
|
||||
import U.Codebase.Sqlite.Operations (NamesByPath (..))
|
||||
import qualified U.Codebase.Sqlite.Operations as Ops
|
||||
import qualified U.Codebase.Sqlite.Queries as Q
|
||||
import U.Codebase.Sqlite.V2.Decl (saveDeclComponent)
|
||||
import U.Codebase.Sqlite.V2.HashHandle (v2HashHandle)
|
||||
import U.Codebase.Sqlite.V2.Term (saveTermComponent)
|
||||
import qualified U.Util.Cache as Cache
|
||||
import qualified U.Util.Hash as H2
|
||||
import qualified Unison.Builtin as Builtins
|
||||
import Unison.Codebase.Branch (Branch (..))
|
||||
import qualified Unison.Codebase.Branch as Branch
|
||||
import qualified Unison.Codebase.Branch.Names as V1Branch
|
||||
import qualified Unison.Codebase.Causal.Type as Causal
|
||||
import Unison.Codebase.Patch (Patch)
|
||||
import Unison.Codebase.Path (Path)
|
||||
import qualified Unison.Codebase.Path as Path
|
||||
@ -296,7 +293,7 @@ tryFlushTermBuffer termBuffer =
|
||||
let loop h =
|
||||
tryFlushBuffer
|
||||
termBuffer
|
||||
(\h2 component -> void $ saveTermComponent Nothing h2 (Cv.termComponent1to2 h component))
|
||||
(\h2 component -> void $ Q.saveTermComponent v2HashHandle Nothing h2 (Cv.termComponent1to2 h component))
|
||||
loop
|
||||
h
|
||||
in loop
|
||||
@ -367,7 +364,8 @@ tryFlushDeclBuffer termBuffer declBuffer =
|
||||
declBuffer
|
||||
( \h2 component ->
|
||||
void $
|
||||
saveDeclComponent
|
||||
Q.saveDeclComponent
|
||||
v2HashHandle
|
||||
Nothing
|
||||
h2
|
||||
(fmap (Cv.decl1to2 h) component)
|
||||
@ -401,10 +399,10 @@ getBranchForHash ::
|
||||
-- | A 'getDeclType'-like lookup, possibly backed by a cache.
|
||||
BranchCache Sqlite.Transaction ->
|
||||
(C.Reference.Reference -> Transaction CT.ConstructorType) ->
|
||||
Branch.CausalHash ->
|
||||
CausalHash ->
|
||||
Transaction (Maybe (Branch Transaction))
|
||||
getBranchForHash branchCache doGetDeclType h = do
|
||||
Ops.loadCausalBranchByCausalHash (Cv.causalHash1to2 h) >>= \case
|
||||
Ops.loadCausalBranchByCausalHash h >>= \case
|
||||
Nothing -> pure Nothing
|
||||
Just causal2 -> do
|
||||
branch1 <- Cv.causalbranch2to1 branchCache doGetDeclType causal2
|
||||
@ -415,29 +413,29 @@ putBranch =
|
||||
void . Ops.saveBranch v2HashHandle . Cv.causalbranch1to2
|
||||
|
||||
-- | Check whether the given branch exists in the codebase.
|
||||
branchExists :: Branch.CausalHash -> Transaction Bool
|
||||
branchExists (Causal.CausalHash h) =
|
||||
Q.loadHashIdByHash h >>= \case
|
||||
branchExists :: CausalHash -> Transaction Bool
|
||||
branchExists h =
|
||||
Q.loadHashIdByHash (unCausalHash h) >>= \case
|
||||
Nothing -> pure False
|
||||
Just hId -> Q.isCausalHash hId
|
||||
|
||||
getPatch :: Branch.EditHash -> Transaction (Maybe Patch)
|
||||
getPatch :: PatchHash -> Transaction (Maybe Patch)
|
||||
getPatch h =
|
||||
runMaybeT do
|
||||
patchId <- MaybeT (Q.loadPatchObjectIdForPrimaryHash (Cv.patchHash1to2 h))
|
||||
patchId <- MaybeT (Q.loadPatchObjectIdForPrimaryHash h)
|
||||
patch <- lift (Ops.expectPatch patchId)
|
||||
pure (Cv.patch2to1 patch)
|
||||
|
||||
-- | Put a patch into the codebase.
|
||||
--
|
||||
-- Note that 'putBranch' may also put patches.
|
||||
putPatch :: Branch.EditHash -> Patch -> Transaction ()
|
||||
putPatch :: PatchHash -> Patch -> Transaction ()
|
||||
putPatch h p =
|
||||
void $ Ops.savePatch v2HashHandle (Cv.patchHash1to2 h) (Cv.patch1to2 p)
|
||||
void $ Ops.savePatch v2HashHandle h (Cv.patch1to2 p)
|
||||
|
||||
-- | Check whether the given patch exists in the codebase.
|
||||
patchExists :: Branch.EditHash -> Transaction Bool
|
||||
patchExists h = fmap isJust $ Q.loadPatchObjectIdForPrimaryHash (Cv.patchHash1to2 h)
|
||||
patchExists :: PatchHash -> Transaction Bool
|
||||
patchExists h = fmap isJust $ Q.loadPatchObjectIdForPrimaryHash h
|
||||
|
||||
dependentsImpl :: Q.DependentsSelector -> Reference -> Transaction (Set Reference.Id)
|
||||
dependentsImpl selector r =
|
||||
@ -555,22 +553,12 @@ referentsByPrefix doGetDeclType (SH.ShortHash prefix (fmap Cv.shortHashSuffix1to
|
||||
pure . Set.fromList $ termReferents <> declReferents
|
||||
|
||||
-- | Get the set of branches whose hash matches the given prefix.
|
||||
causalHashesByPrefix :: ShortCausalHash -> Transaction (Set Branch.CausalHash)
|
||||
causalHashesByPrefix :: ShortCausalHash -> Transaction (Set CausalHash)
|
||||
causalHashesByPrefix sh = do
|
||||
-- given that a Branch is shallow, it's really `CausalHash` that you'd
|
||||
-- refer to to specify a full namespace w/ history.
|
||||
-- but do we want to be able to refer to a namespace without its history?
|
||||
cs <- Ops.causalHashesByPrefix (Cv.sch1to2 sh)
|
||||
pure $ Set.map (Causal.CausalHash . unCausalHash) cs
|
||||
|
||||
-- returns `Nothing` to not implemented, fallback to in-memory
|
||||
-- also `Nothing` if no LCA
|
||||
-- The result is undefined if the two hashes are not in the codebase.
|
||||
-- Use `Codebase.lca` which wraps this in a nice API.
|
||||
sqlLca :: Branch.CausalHash -> Branch.CausalHash -> Transaction (Maybe Branch.CausalHash)
|
||||
sqlLca h1 h2 = do
|
||||
h3 <- Ops.lca (Cv.causalHash1to2 h1) (Cv.causalHash1to2 h2)
|
||||
pure (Cv.causalHash2to1 <$> h3)
|
||||
Ops.causalHashesByPrefix (Cv.sch1to2 sh)
|
||||
|
||||
-- well one or the other. :zany_face: the thinking being that they wouldn't hash-collide
|
||||
termExists, declExists :: Hash -> Transaction Bool
|
||||
@ -578,9 +566,9 @@ termExists = fmap isJust . Q.loadObjectIdForPrimaryHash
|
||||
declExists = termExists
|
||||
|
||||
-- `before b1 b2` is undefined if `b2` not in the codebase
|
||||
before :: Branch.CausalHash -> Branch.CausalHash -> Transaction Bool
|
||||
before :: CausalHash -> CausalHash -> Transaction Bool
|
||||
before h1 h2 =
|
||||
fromJust <$> Ops.before (Cv.causalHash1to2 h1) (Cv.causalHash1to2 h2)
|
||||
fromJust <$> Ops.before h1 h2
|
||||
|
||||
-- | Construct a 'ScopedNames' which can produce names which are relative to the provided
|
||||
-- Path.
|
||||
@ -588,35 +576,30 @@ before h1 h2 =
|
||||
-- NOTE: this method requires an up-to-date name lookup index, which is
|
||||
-- currently not kept up-to-date automatically (because it's slow to do so).
|
||||
namesAtPath ::
|
||||
-- Include ALL names within this path
|
||||
Path ->
|
||||
-- Make names within this path relative to this path, other names will be absolute.
|
||||
Path ->
|
||||
Transaction ScopedNames
|
||||
namesAtPath path = do
|
||||
let namespace = if path == Path.empty then Nothing else Just $ tShow path
|
||||
NamesByPath {termNamesInPath, termNamesExternalToPath, typeNamesInPath, typeNamesExternalToPath} <- Ops.rootNamesByPath namespace
|
||||
namesAtPath namesRootPath relativeToPath = do
|
||||
let namesRoot = if namesRootPath == Path.empty then Nothing else Just $ tShow namesRootPath
|
||||
NamesByPath {termNamesInPath, typeNamesInPath} <- Ops.rootNamesByPath namesRoot
|
||||
let termsInPath = convertTerms termNamesInPath
|
||||
let typesInPath = convertTypes typeNamesInPath
|
||||
let termsOutsidePath = convertTerms termNamesExternalToPath
|
||||
let typesOutsidePath = convertTypes typeNamesExternalToPath
|
||||
let allTerms :: [(Name, Referent.Referent)]
|
||||
allTerms = termsInPath <> termsOutsidePath
|
||||
let allTypes :: [(Name, Reference.Reference)]
|
||||
allTypes = typesInPath <> typesOutsidePath
|
||||
let rootTerms = Rel.fromList allTerms
|
||||
let rootTypes = Rel.fromList allTypes
|
||||
let rootTerms = Rel.fromList termsInPath
|
||||
let rootTypes = Rel.fromList typesInPath
|
||||
let absoluteRootNames = Names.makeAbsolute $ Names {terms = rootTerms, types = rootTypes}
|
||||
let absoluteExternalNames = Names.makeAbsolute $ Names {terms = Rel.fromList termsOutsidePath, types = Rel.fromList typesOutsidePath}
|
||||
let relativeScopedNames =
|
||||
case path of
|
||||
case relativeToPath of
|
||||
Path.Empty -> (Names.makeRelative $ absoluteRootNames)
|
||||
p ->
|
||||
let reversedPathSegments = reverse . Path.toList $ p
|
||||
relativeTerms = stripPathPrefix reversedPathSegments <$> termsInPath
|
||||
relativeTypes = stripPathPrefix reversedPathSegments <$> typesInPath
|
||||
relativeTerms = mapMaybe (stripPathPrefix reversedPathSegments) termsInPath
|
||||
relativeTypes = mapMaybe (stripPathPrefix reversedPathSegments) typesInPath
|
||||
in (Names {terms = Rel.fromList relativeTerms, types = Rel.fromList relativeTypes})
|
||||
pure $
|
||||
ScopedNames
|
||||
{ absoluteExternalNames,
|
||||
relativeScopedNames,
|
||||
{ relativeScopedNames,
|
||||
absoluteRootNames
|
||||
}
|
||||
where
|
||||
@ -632,11 +615,11 @@ namesAtPath path = do
|
||||
-- on the left, otherwise it's left as-is and collected on the right.
|
||||
-- >>> stripPathPrefix ["b", "a"] ("a.b.c", ())
|
||||
-- ([(c,())])
|
||||
stripPathPrefix :: [NameSegment] -> (Name, r) -> (Name, r)
|
||||
stripPathPrefix :: [NameSegment] -> (Name, r) -> Maybe (Name, r)
|
||||
stripPathPrefix reversedPathSegments (n, ref) =
|
||||
case Name.stripReversedPrefix n reversedPathSegments of
|
||||
Nothing -> error $ "Expected name to be in namespace" <> show (n, reverse reversedPathSegments)
|
||||
Just stripped -> (Name.makeRelative stripped, ref)
|
||||
Nothing -> Nothing
|
||||
Just stripped -> Just (Name.makeRelative stripped, ref)
|
||||
|
||||
-- | Update the root namespace names index which is used by the share server for serving api
|
||||
-- requests.
|
||||
@ -739,7 +722,7 @@ initializeNameLookupIndexFromV2Root getDeclType = do
|
||||
-- Collects two maps, one with all term names and one with all type names.
|
||||
-- Note that unlike the `Name` type in `unison-core1`, this list of name segments is
|
||||
-- in reverse order, e.g. `["map", "List", "base"]`
|
||||
nameMapsFromV2Branch :: Monad m => [V2Branch.NameSegment] -> V2Branch.CausalBranch m -> m (Map (NonEmpty V2Branch.NameSegment) (Set C.Referent.Referent), Map (NonEmpty V2Branch.NameSegment) (Set C.Reference.Reference))
|
||||
nameMapsFromV2Branch :: Monad m => [NameSegment] -> V2Branch.CausalBranch m -> m (Map (NonEmpty NameSegment) (Set C.Referent.Referent), Map (NonEmpty NameSegment) (Set C.Reference.Reference))
|
||||
nameMapsFromV2Branch reversedNamePrefix cb = do
|
||||
b <- V2Causal.value cb
|
||||
let (shallowTermNames, shallowTypeNames) = (Map.keysSet <$> V2Branch.terms b, Map.keysSet <$> V2Branch.types b)
|
||||
|
@ -13,10 +13,9 @@ module Unison.Codebase.Type
|
||||
)
|
||||
where
|
||||
|
||||
import U.Codebase.HashTags (BranchHash)
|
||||
import U.Codebase.HashTags (BranchHash, CausalHash)
|
||||
import qualified U.Codebase.Reference as V2
|
||||
import Unison.Codebase.Branch (Branch)
|
||||
import qualified Unison.Codebase.Branch as Branch
|
||||
import qualified Unison.Codebase.Editor.Git as Git
|
||||
import Unison.Codebase.Editor.RemoteRepo (ReadGitRemoteNamespace, ReadGitRepo, WriteGitRepo)
|
||||
import Unison.Codebase.GitError (GitCodebaseError, GitProtocolError)
|
||||
@ -50,7 +49,7 @@ data Codebase m v a = Codebase
|
||||
--
|
||||
-- Note that it is possible to call 'putTerm', then 'getTerm', and receive @Nothing@, per the semantics of
|
||||
-- 'putTerm'.
|
||||
getTerm :: Reference.Id -> m (Maybe (Term v a)),
|
||||
getTerm :: Reference.Id -> Sqlite.Transaction (Maybe (Term v a)),
|
||||
-- | Get the type of a user-defined term.
|
||||
--
|
||||
-- Note that it is possible to call 'putTerm', then 'getTypeOfTermImpl', and receive @Nothing@, per the semantics of
|
||||
@ -81,7 +80,7 @@ data Codebase m v a = Codebase
|
||||
Text -> -- Reason for the change, will be recorded in the reflog
|
||||
Branch m ->
|
||||
m (),
|
||||
getBranchForHashImpl :: Branch.CausalHash -> m (Maybe (Branch m)),
|
||||
getBranchForHashImpl :: CausalHash -> m (Maybe (Branch m)),
|
||||
-- | Put a branch into the codebase, which includes its children, its patches, and the branch itself, if they don't
|
||||
-- already exist.
|
||||
--
|
||||
@ -101,7 +100,7 @@ data Codebase m v a = Codebase
|
||||
-- | Get the set of user-defined terms-or-constructors mention the given type anywhere in their signature.
|
||||
termsMentioningTypeImpl :: Reference -> Sqlite.Transaction (Set Referent.Id),
|
||||
-- | Get the set of user-defined terms-or-constructors whose hash matches the given prefix.
|
||||
termReferentsByPrefix :: ShortHash -> m (Set Referent.Id),
|
||||
termReferentsByPrefix :: ShortHash -> Sqlite.Transaction (Set Referent.Id),
|
||||
-- Updates the root namespace names index from an old BranchHash to a new one.
|
||||
-- This isn't run automatically because it can be a bit slow.
|
||||
updateNameLookup ::
|
||||
@ -144,7 +143,7 @@ data GitPushBehavior
|
||||
|
||||
data GitError
|
||||
= GitProtocolError GitProtocolError
|
||||
| GitCodebaseError (GitCodebaseError Branch.CausalHash)
|
||||
| GitCodebaseError (GitCodebaseError CausalHash)
|
||||
| GitSqliteCodebaseError GitSqliteCodebaseError
|
||||
deriving (Show)
|
||||
|
||||
|
@ -28,9 +28,9 @@ import Data.Map (Map)
|
||||
import qualified Data.Map as Map
|
||||
import Data.Set (Set)
|
||||
import qualified Data.Set as Set
|
||||
import U.Codebase.HashTags (CausalHash (..), PatchHash (..))
|
||||
import qualified Unison.ABT as ABT
|
||||
import qualified Unison.Codebase.Branch.Type as Memory.Branch
|
||||
import qualified Unison.Codebase.Causal.Type as Memory.Causal
|
||||
import qualified Unison.Codebase.Patch as Memory.Patch
|
||||
import qualified Unison.Codebase.TermEdit as Memory.TermEdit
|
||||
import qualified Unison.Codebase.TypeEdit as Memory.TypeEdit
|
||||
@ -349,12 +349,12 @@ hashPatch = contentHash . m2hPatch
|
||||
hashBranch0 :: Memory.Branch.Branch0 m -> Hash
|
||||
hashBranch0 = contentHash . m2hBranch0
|
||||
|
||||
hashCausal :: ContentAddressable e => e -> Set Memory.Causal.CausalHash -> (Memory.Causal.CausalHash, HashFor e)
|
||||
hashCausal :: ContentAddressable e => e -> Set CausalHash -> (CausalHash, HashFor e)
|
||||
hashCausal e tails =
|
||||
let valueHash = contentHash e
|
||||
causalHash =
|
||||
Memory.Causal.CausalHash . contentHash $
|
||||
Hashing.Causal valueHash (Set.map Memory.Causal.unCausalHash tails)
|
||||
CausalHash . contentHash $
|
||||
Hashing.Causal valueHash (Set.map unCausalHash tails)
|
||||
in (causalHash, HashFor valueHash)
|
||||
|
||||
m2hBranch0 :: Memory.Branch.Branch0 m -> Hashing.Branch
|
||||
@ -400,14 +400,14 @@ m2hBranch0 b =
|
||||
]
|
||||
|
||||
doPatches ::
|
||||
Map Memory.NameSegment.NameSegment (Memory.Branch.EditHash, m Memory.Patch.Patch) ->
|
||||
Map Memory.NameSegment.NameSegment (PatchHash, m Memory.Patch.Patch) ->
|
||||
Map Hashing.NameSegment Hash
|
||||
doPatches = Map.bimap m2hNameSegment fst
|
||||
doPatches = Map.bimap m2hNameSegment (unPatchHash . fst)
|
||||
|
||||
doChildren ::
|
||||
Map Memory.NameSegment.NameSegment (Memory.Branch.Branch m) ->
|
||||
Map Hashing.NameSegment Hash
|
||||
doChildren = Map.bimap m2hNameSegment (Memory.Causal.unCausalHash . Memory.Branch.headHash)
|
||||
doChildren = Map.bimap m2hNameSegment (unCausalHash . Memory.Branch.headHash)
|
||||
|
||||
m2hNameSegment :: Memory.NameSegment.NameSegment -> Hashing.NameSegment
|
||||
m2hNameSegment (Memory.NameSegment.NameSegment s) = Hashing.NameSegment s
|
||||
|
@ -24,6 +24,7 @@ flag optimized
|
||||
library
|
||||
exposed-modules:
|
||||
U.Codebase.Branch.Diff
|
||||
U.Codebase.Projects
|
||||
Unison.Builtin
|
||||
Unison.Builtin.Decls
|
||||
Unison.Builtin.Terms
|
||||
|
@ -70,6 +70,7 @@ dependencies:
|
||||
- unison-codebase
|
||||
- unison-codebase-sqlite
|
||||
- unison-codebase-sqlite-hashing-v2
|
||||
- unison-core
|
||||
- unison-core1
|
||||
- unison-hash
|
||||
- unison-parser-typechecker
|
||||
|
@ -60,7 +60,7 @@ import Data.Unique (Unique, newUnique)
|
||||
import GHC.OverloadedLabels (IsLabel (..))
|
||||
import System.CPUTime (getCPUTime)
|
||||
import Text.Printf (printf)
|
||||
import qualified U.Codebase.Branch as V2Branch
|
||||
import U.Codebase.HashTags (CausalHash)
|
||||
import Unison.Auth.CredentialManager (CredentialManager)
|
||||
import Unison.Auth.HTTPClient (AuthenticatedHttpClient)
|
||||
import Unison.Codebase (Codebase)
|
||||
@ -166,7 +166,7 @@ data Env = Env
|
||||
-- There's an additional pseudo @"currentPath"@ field lens, for convenience.
|
||||
data LoopState = LoopState
|
||||
{ root :: TMVar (Branch IO),
|
||||
lastSavedRootHash :: V2Branch.CausalHash,
|
||||
lastSavedRootHash :: CausalHash,
|
||||
-- the current position in the namespace
|
||||
currentPathStack :: List.NonEmpty Path.Absolute,
|
||||
-- TBD
|
||||
@ -204,7 +204,7 @@ instance
|
||||
)
|
||||
|
||||
-- | Create an initial loop state given a root branch and the current path.
|
||||
loopState0 :: V2Branch.CausalHash -> TMVar (Branch IO) -> Path.Absolute -> LoopState
|
||||
loopState0 :: CausalHash -> TMVar (Branch IO) -> Path.Absolute -> LoopState
|
||||
loopState0 lastSavedRootHash b p = do
|
||||
LoopState
|
||||
{ root = b,
|
||||
|
@ -80,13 +80,13 @@ import qualified Data.Configurator.Types as Configurator
|
||||
import qualified Data.Set as Set
|
||||
import qualified U.Codebase.Branch as V2Branch
|
||||
import qualified U.Codebase.Causal as V2Causal
|
||||
import U.Codebase.HashTags (CausalHash (..))
|
||||
import Unison.Cli.Monad (Cli)
|
||||
import qualified Unison.Cli.Monad as Cli
|
||||
import qualified Unison.Codebase as Codebase
|
||||
import Unison.Codebase.Branch (Branch (..), Branch0 (..))
|
||||
import qualified Unison.Codebase.Branch as Branch
|
||||
import qualified Unison.Codebase.BranchUtil as BranchUtil
|
||||
import qualified Unison.Codebase.Causal as Causal
|
||||
import qualified Unison.Codebase.Editor.Input as Input
|
||||
import qualified Unison.Codebase.Editor.Output as Output
|
||||
import Unison.Codebase.Patch (Patch (..))
|
||||
@ -95,7 +95,6 @@ import Unison.Codebase.Path (Path, Path' (..))
|
||||
import qualified Unison.Codebase.Path as Path
|
||||
import Unison.Codebase.ShortCausalHash (ShortCausalHash)
|
||||
import qualified Unison.Codebase.ShortCausalHash as SCH
|
||||
import qualified Unison.Codebase.SqliteCodebase.Conversions as Cv
|
||||
import qualified Unison.HashQualified' as HQ'
|
||||
import Unison.NameSegment (NameSegment)
|
||||
import Unison.Parser.Ann (Ann (..))
|
||||
@ -147,7 +146,7 @@ resolveAbsBranchId = \case
|
||||
|
||||
-- | Resolve a @BranchId@ to the corresponding @Branch IO@, or fail if no such branch hash is found. (Non-existent
|
||||
-- branches by path are OK - the empty branch will be returned).
|
||||
resolveBranchId :: Input.BranchId -> Cli (Branch IO)
|
||||
resolveBranchId :: Input.BranchId -> Cli (Branch IO)
|
||||
resolveBranchId branchId = do
|
||||
absBranchId <- traverseOf _Right resolvePath' branchId
|
||||
resolveAbsBranchId absBranchId
|
||||
@ -212,13 +211,13 @@ getCurrentBranch0 = do
|
||||
Branch.head <$> getCurrentBranch
|
||||
|
||||
-- | Get the last saved root hash.
|
||||
getLastSavedRootHash :: Cli V2Branch.CausalHash
|
||||
getLastSavedRootHash :: Cli CausalHash
|
||||
getLastSavedRootHash = do
|
||||
use #lastSavedRootHash
|
||||
|
||||
-- | Set a new root branch.
|
||||
-- Note: This does _not_ update the codebase, the caller is responsible for that.
|
||||
setLastSavedRootHash :: V2Branch.CausalHash -> Cli ()
|
||||
setLastSavedRootHash :: CausalHash -> Cli ()
|
||||
setLastSavedRootHash ch = do
|
||||
#lastSavedRootHash .= ch
|
||||
|
||||
@ -384,7 +383,7 @@ updateRoot :: Branch IO -> Text -> Cli ()
|
||||
updateRoot new reason =
|
||||
Cli.time "updateRoot" do
|
||||
Cli.Env {codebase} <- ask
|
||||
let newHash = Cv.causalHash1to2 $ Branch.headHash new
|
||||
let newHash = Branch.headHash new
|
||||
oldHash <- getLastSavedRootHash
|
||||
when (oldHash /= newHash) do
|
||||
setRootBranch new
|
||||
|
@ -118,7 +118,6 @@ import Unison.Codebase.PushBehavior (PushBehavior)
|
||||
import qualified Unison.Codebase.PushBehavior as PushBehavior
|
||||
import qualified Unison.Codebase.Runtime as Runtime
|
||||
import qualified Unison.Codebase.ShortCausalHash as SCH
|
||||
import qualified Unison.Codebase.SqliteCodebase.Conversions as Cv
|
||||
import qualified Unison.Codebase.SyncMode as SyncMode
|
||||
import Unison.Codebase.TermEdit (TermEdit (..))
|
||||
import qualified Unison.Codebase.TermEdit as TermEdit
|
||||
@ -565,7 +564,7 @@ loop e = do
|
||||
history <- liftIO (doHistory schLength 0 branch [])
|
||||
Cli.respondNumbered history
|
||||
where
|
||||
doHistory :: Int -> Int -> Branch IO -> [(Causal.CausalHash, NamesWithHistory.Diff)] -> IO NumberedOutput
|
||||
doHistory :: Int -> Int -> Branch IO -> [(CausalHash, NamesWithHistory.Diff)] -> IO NumberedOutput
|
||||
doHistory schLength !n b acc =
|
||||
if maybe False (n >=) resultsCap
|
||||
then pure (History diffCap schLength acc (PageEnd (Branch.headHash b) n))
|
||||
@ -604,7 +603,7 @@ loop e = do
|
||||
src <- traverseOf _Right Cli.resolveSplit' src'
|
||||
srcTerms <-
|
||||
either
|
||||
(liftIO . Backend.termReferentsByShortHash codebase)
|
||||
(Cli.runTransaction . Backend.termReferentsByShortHash codebase)
|
||||
Cli.getTermsAt
|
||||
src
|
||||
srcTerm <-
|
||||
@ -1288,23 +1287,24 @@ loop e = do
|
||||
rootBranch <- Cli.getRootBranch
|
||||
for_ lds \ld -> do
|
||||
dependencies :: Set Reference <-
|
||||
let tp r@(Reference.DerivedId i) =
|
||||
Codebase.getTypeDeclaration codebase i <&> \case
|
||||
Nothing -> error $ "What happened to " ++ show i ++ "?"
|
||||
Just decl -> Set.delete r . DD.dependencies $ DD.asDataDecl decl
|
||||
tp _ = pure mempty
|
||||
tm (Referent.Ref r@(Reference.DerivedId i)) =
|
||||
liftIO (Codebase.getTerm codebase i) <&> \case
|
||||
Nothing -> error $ "What happened to " ++ show i ++ "?"
|
||||
Just tm -> Set.delete r $ Term.dependencies tm
|
||||
tm con@(Referent.Con (ConstructorReference (Reference.DerivedId i) cid) _ct) =
|
||||
Cli.runTransaction (Codebase.getTypeDeclaration codebase i) <&> \case
|
||||
Nothing -> error $ "What happened to " ++ show i ++ "?"
|
||||
Just decl -> case DD.typeOfConstructor (DD.asDataDecl decl) cid of
|
||||
Nothing -> error $ "What happened to " ++ show con ++ "?"
|
||||
Just tp -> Type.dependencies tp
|
||||
tm _ = pure mempty
|
||||
in LD.fold (Cli.runTransaction . tp) tm ld
|
||||
Cli.runTransaction do
|
||||
let tp r@(Reference.DerivedId i) =
|
||||
Codebase.getTypeDeclaration codebase i <&> \case
|
||||
Nothing -> error $ "What happened to " ++ show i ++ "?"
|
||||
Just decl -> Set.delete r . DD.dependencies $ DD.asDataDecl decl
|
||||
tp _ = pure mempty
|
||||
tm (Referent.Ref r@(Reference.DerivedId i)) =
|
||||
Codebase.getTerm codebase i <&> \case
|
||||
Nothing -> error $ "What happened to " ++ show i ++ "?"
|
||||
Just tm -> Set.delete r $ Term.dependencies tm
|
||||
tm con@(Referent.Con (ConstructorReference (Reference.DerivedId i) cid) _ct) =
|
||||
Codebase.getTypeDeclaration codebase i <&> \case
|
||||
Nothing -> error $ "What happened to " ++ show i ++ "?"
|
||||
Just decl -> case DD.typeOfConstructor (DD.asDataDecl decl) cid of
|
||||
Nothing -> error $ "What happened to " ++ show con ++ "?"
|
||||
Just tp -> Type.dependencies tp
|
||||
tm _ = pure mempty
|
||||
in LD.fold tp tm ld
|
||||
(missing, names0) <- liftIO (Branch.findHistoricalRefs' dependencies rootBranch)
|
||||
let types = R.toList $ Names.types names0
|
||||
let terms = fmap (second Referent.toReference) $ R.toList $ Names.terms names0
|
||||
@ -1312,11 +1312,13 @@ loop e = do
|
||||
#numberedArgs .= fmap (Text.unpack . Reference.toText) ((fmap snd names) <> toList missing)
|
||||
Cli.respond $ ListDependencies hqLength ld names missing
|
||||
NamespaceDependenciesI namespacePath' -> do
|
||||
Cli.Env {codebase} <- ask
|
||||
path <- maybe Cli.getCurrentPath Cli.resolvePath' namespacePath'
|
||||
Cli.getMaybeBranchAt path >>= \case
|
||||
Nothing -> Cli.respond $ BranchEmpty (Right (Path.absoluteToPath' path))
|
||||
Just b -> do
|
||||
externalDependencies <- NamespaceDependencies.namespaceDependencies (Branch.head b)
|
||||
externalDependencies <-
|
||||
Cli.runTransaction (NamespaceDependencies.namespaceDependencies codebase (Branch.head b))
|
||||
ppe <- PPE.unsuffixifiedPPE <$> currentPrettyPrintEnvDecl Backend.Within
|
||||
Cli.respond $ ListNamespaceDependencies ppe path externalDependencies
|
||||
DebugNumberedArgsI -> do
|
||||
@ -1340,7 +1342,7 @@ loop e = do
|
||||
let seen h = State.gets (Set.member h)
|
||||
set h = State.modify (Set.insert h)
|
||||
getCausal b = (Branch.headHash b, pure $ Branch._history b)
|
||||
goCausal :: forall m. Monad m => [(Branch.CausalHash, m (Branch.UnwrappedBranch m))] -> StateT (Set Branch.CausalHash) m ()
|
||||
goCausal :: forall m. Monad m => [(CausalHash, m (Branch.UnwrappedBranch m))] -> StateT (Set CausalHash) m ()
|
||||
goCausal [] = pure ()
|
||||
goCausal ((h, mc) : queue) = do
|
||||
ifM (seen h) (goCausal queue) do
|
||||
@ -1348,7 +1350,7 @@ loop e = do
|
||||
Causal.One h _bh b -> goBranch h b mempty queue
|
||||
Causal.Cons h _bh b tail -> goBranch h b [fst tail] (tail : queue)
|
||||
Causal.Merge h _bh b (Map.toList -> tails) -> goBranch h b (map fst tails) (tails ++ queue)
|
||||
goBranch :: forall m. Monad m => Branch.CausalHash -> Branch0 m -> [Branch.CausalHash] -> [(Branch.CausalHash, m (Branch.UnwrappedBranch m))] -> StateT (Set Branch.CausalHash) m ()
|
||||
goBranch :: forall m. Monad m => CausalHash -> Branch0 m -> [CausalHash] -> [(CausalHash, m (Branch.UnwrappedBranch m))] -> StateT (Set CausalHash) m ()
|
||||
goBranch h b (Set.fromList -> causalParents) queue = case b of
|
||||
Branch0 terms0 types0 children0 patches0 _ _ _ _ _ _ _ ->
|
||||
let wrangleMetadata :: (Ord r, Ord n) => Metadata.Star r n -> r -> (r, (Set n, Set Metadata.Value))
|
||||
@ -1408,8 +1410,8 @@ loop e = do
|
||||
([fromCH], [toCH]) -> pure (fromCH, toCH)
|
||||
output <-
|
||||
Cli.runTransaction do
|
||||
fromBranch <- (Codebase.expectCausalBranchByCausalHash $ Cv.causalHash1to2 fromCH) >>= V2Causal.value
|
||||
toBranch <- (Codebase.expectCausalBranchByCausalHash $ Cv.causalHash1to2 toCH) >>= V2Causal.value
|
||||
fromBranch <- (Codebase.expectCausalBranchByCausalHash fromCH) >>= V2Causal.value
|
||||
toBranch <- (Codebase.expectCausalBranchByCausalHash toCH) >>= V2Causal.value
|
||||
treeDiff <- V2Branch.diffBranches fromBranch toBranch
|
||||
let nameChanges = V2Branch.nameChanges Nothing treeDiff
|
||||
pure (DisplayDebugNameDiff nameChanges)
|
||||
@ -2071,7 +2073,7 @@ handleShowDefinition outputLoc showDefinitionScope inputQuery = do
|
||||
pure (currentNames, ppe)
|
||||
Backend.DefinitionResults terms types misses <- do
|
||||
let nameSearch = Backend.makeNameSearch hqLength names
|
||||
liftIO (Backend.definitionsBySuffixes codebase nameSearch includeCycles query)
|
||||
Cli.runTransaction (Backend.definitionsBySuffixes codebase nameSearch includeCycles query)
|
||||
outputPath <- getOutputPath
|
||||
when (not (null types && null terms)) do
|
||||
let ppe = PPED.biasTo (mapMaybe HQ.toName inputQuery) unbiasedPPE
|
||||
@ -2153,7 +2155,7 @@ handleTest TestInput {includeLibNamespace, showFailures, showSuccesses} = do
|
||||
computedTests <- fmap join . for (toList toCompute `zip` [1 ..]) $ \(r, n) ->
|
||||
case r of
|
||||
Reference.DerivedId rid ->
|
||||
liftIO (Codebase.getTerm codebase rid) >>= \case
|
||||
Cli.runTransaction (Codebase.getTerm codebase rid) >>= \case
|
||||
Nothing -> do
|
||||
hqLength <- Cli.runTransaction Codebase.hashLength
|
||||
Cli.respond (TermNotFound' . SH.take hqLength . Reference.toShortHash $ Reference.DerivedId rid)
|
||||
@ -2264,7 +2266,7 @@ importRemoteShareBranch rrn@(ReadShareRemoteNamespace {server, repo, path}) = do
|
||||
(Cli.returnEarly . Output.ShareError) case err0 of
|
||||
Share.SyncError err -> Output.ShareErrorPull err
|
||||
Share.TransportError err -> Output.ShareErrorTransport err
|
||||
liftIO (Codebase.getBranchForHash codebase (Cv.causalHash2to1 causalHash)) & onNothingM do
|
||||
liftIO (Codebase.getBranchForHash codebase causalHash) & onNothingM do
|
||||
error $ reportBug "E412939" "`pull` \"succeeded\", but I can't find the result in the codebase. (This is a bug.)"
|
||||
where
|
||||
-- Provide the given action a callback that display to the terminal.
|
||||
@ -2300,8 +2302,11 @@ resolveHQToLabeledDependencies = \case
|
||||
where
|
||||
resolveHashOnly sh = do
|
||||
Cli.Env {codebase} <- ask
|
||||
terms <- liftIO (Backend.termReferentsByShortHash codebase sh)
|
||||
types <- Cli.runTransaction (Backend.typeReferencesByShortHash sh)
|
||||
(terms, types) <-
|
||||
Cli.runTransaction do
|
||||
terms <- Backend.termReferentsByShortHash codebase sh
|
||||
types <- Backend.typeReferencesByShortHash sh
|
||||
pure (terms, types)
|
||||
pure $ Set.map LD.referent terms <> Set.map LD.typeRef types
|
||||
|
||||
doDisplay :: OutputLocation -> NamesWithHistory -> Term Symbol () -> Cli ()
|
||||
@ -2320,23 +2325,23 @@ doDisplay outputLoc names tm = do
|
||||
fmap ErrorUtil.hush . fmap (fmap Term.unannotate) $
|
||||
evalUnisonTermE True (PPE.suffixifiedPPE ppe) useCache (Term.amap (const External) tm)
|
||||
loadTerm (Reference.DerivedId r) = case Map.lookup r tms of
|
||||
Nothing -> fmap (fmap Term.unannotate) $ liftIO (Codebase.getTerm codebase r)
|
||||
Nothing -> fmap (fmap Term.unannotate) $ Cli.runTransaction (Codebase.getTerm codebase r)
|
||||
Just (tm, _) -> pure (Just $ Term.unannotate tm)
|
||||
loadTerm _ = pure Nothing
|
||||
loadDecl (Reference.DerivedId r) = case Map.lookup r typs of
|
||||
Nothing -> fmap (fmap $ DD.amap (const ())) $ Codebase.getTypeDeclaration codebase r
|
||||
Nothing -> fmap (fmap $ DD.amap (const ())) $ Cli.runTransaction $ Codebase.getTypeDeclaration codebase r
|
||||
Just decl -> pure (Just $ DD.amap (const ()) decl)
|
||||
loadDecl _ = pure Nothing
|
||||
loadTypeOfTerm' (Referent.Ref (Reference.DerivedId r))
|
||||
| Just (_, ty) <- Map.lookup r tms = pure $ Just (void ty)
|
||||
loadTypeOfTerm' r = fmap (fmap void) . loadTypeOfTerm codebase $ r
|
||||
loadTypeOfTerm' r = fmap (fmap void) . Cli.runTransaction . loadTypeOfTerm codebase $ r
|
||||
rendered <-
|
||||
DisplayValues.displayTerm
|
||||
ppe
|
||||
(liftIO . loadTerm)
|
||||
(Cli.runTransaction . loadTypeOfTerm')
|
||||
loadTerm
|
||||
loadTypeOfTerm'
|
||||
evalTerm
|
||||
(Cli.runTransaction . loadDecl)
|
||||
loadDecl
|
||||
tm
|
||||
Cli.respond $ DisplayRendered loc rendered
|
||||
|
||||
@ -3197,10 +3202,11 @@ hqNameQuery query = do
|
||||
Cli.Env {codebase} <- ask
|
||||
root' <- Cli.getRootBranch
|
||||
currentPath <- Cli.getCurrentPath
|
||||
hqLength <- Cli.runTransaction Codebase.hashLength
|
||||
let parseNames = Backend.parseNamesForBranch root' (Backend.AllNames (Path.unabsolute currentPath))
|
||||
let nameSearch = Backend.makeNameSearch hqLength (NamesWithHistory.fromCurrentNames parseNames)
|
||||
liftIO (Backend.hqNameQuery codebase nameSearch query)
|
||||
Cli.runTransaction do
|
||||
hqLength <- Codebase.hashLength
|
||||
let parseNames = Backend.parseNamesForBranch root' (Backend.AllNames (Path.unabsolute currentPath))
|
||||
let nameSearch = Backend.makeNameSearch hqLength (NamesWithHistory.fromCurrentNames parseNames)
|
||||
Backend.hqNameQuery codebase nameSearch query
|
||||
|
||||
-- | Select a definition from the given branch.
|
||||
-- Returned names will match the provided 'Position' type.
|
||||
|
@ -171,4 +171,4 @@ getHQTerms = \case
|
||||
where
|
||||
hashOnly sh = do
|
||||
Cli.Env {codebase} <- ask
|
||||
liftIO (Backend.termReferentsByShortHash codebase sh)
|
||||
Cli.runTransaction (Backend.termReferentsByShortHash codebase sh)
|
||||
|
@ -3,12 +3,10 @@ module Unison.Codebase.Editor.HandleInput.NamespaceDependencies
|
||||
)
|
||||
where
|
||||
|
||||
import Control.Monad.Reader (ask)
|
||||
import Control.Monad.Trans.Maybe
|
||||
import qualified Data.Map as Map
|
||||
import qualified Data.Set as Set
|
||||
import Unison.Cli.Monad (Cli, Env (..))
|
||||
import qualified Unison.Cli.Monad as Cli
|
||||
import Unison.Codebase (Codebase)
|
||||
import qualified Unison.Codebase as Codebase
|
||||
import Unison.Codebase.Branch (Branch0)
|
||||
import qualified Unison.Codebase.Branch as Branch
|
||||
@ -21,6 +19,8 @@ import Unison.Reference (Reference)
|
||||
import qualified Unison.Reference as Reference
|
||||
import Unison.Referent (Referent)
|
||||
import qualified Unison.Referent as Referent
|
||||
import qualified Unison.Sqlite as Sqlite
|
||||
import Unison.Symbol (Symbol)
|
||||
import qualified Unison.Term as Term
|
||||
import qualified Unison.Util.Relation as Relation
|
||||
import qualified Unison.Util.Relation3 as Relation3
|
||||
@ -38,21 +38,18 @@ import qualified Unison.Util.Relation4 as Relation4
|
||||
--
|
||||
-- Returns a Set of names rather than using the PPE since we already have the correct names in
|
||||
-- scope on this branch, and also want to list ALL names of dependents, including aliases.
|
||||
namespaceDependencies :: Branch0 m -> Cli (Map LabeledDependency (Set Name))
|
||||
namespaceDependencies branch = do
|
||||
Env {codebase} <- ask
|
||||
|
||||
namespaceDependencies :: Codebase m Symbol a -> Branch0 m -> Sqlite.Transaction (Map LabeledDependency (Set Name))
|
||||
namespaceDependencies codebase branch = do
|
||||
typeDeps <-
|
||||
Cli.runTransaction do
|
||||
for (Map.toList currentBranchTypeRefs) $ \(typeRef, names) -> fmap (fromMaybe Map.empty) . runMaybeT $ do
|
||||
refId <- MaybeT . pure $ Reference.toId typeRef
|
||||
decl <- MaybeT $ Codebase.getTypeDeclaration codebase refId
|
||||
let typeDeps = Set.map LD.typeRef $ DD.dependencies (DD.asDataDecl decl)
|
||||
pure $ foldMap (`Map.singleton` names) typeDeps
|
||||
for (Map.toList currentBranchTypeRefs) $ \(typeRef, names) -> fmap (fromMaybe Map.empty) . runMaybeT $ do
|
||||
refId <- MaybeT . pure $ Reference.toId typeRef
|
||||
decl <- MaybeT $ Codebase.getTypeDeclaration codebase refId
|
||||
let typeDeps = Set.map LD.typeRef $ DD.dependencies (DD.asDataDecl decl)
|
||||
pure $ foldMap (`Map.singleton` names) typeDeps
|
||||
|
||||
termDeps <- for (Map.toList currentBranchTermRefs) $ \(termRef, names) -> fmap (fromMaybe Map.empty) . runMaybeT $ do
|
||||
refId <- MaybeT . pure $ Referent.toReferenceId termRef
|
||||
term <- MaybeT $ liftIO (Codebase.getTerm codebase refId)
|
||||
term <- MaybeT $ Codebase.getTerm codebase refId
|
||||
let termDeps = Term.labeledDependencies term
|
||||
pure $ foldMap (`Map.singleton` names) termDeps
|
||||
|
||||
|
@ -24,7 +24,7 @@ module Unison.Codebase.Editor.Input
|
||||
where
|
||||
|
||||
import qualified Data.Text as Text
|
||||
import qualified Unison.Codebase.Branch as Branch
|
||||
import U.Codebase.HashTags (CausalHash)
|
||||
import qualified Unison.Codebase.Branch.Merge as Branch
|
||||
import Unison.Codebase.Editor.RemoteRepo
|
||||
import Unison.Codebase.Path (Path')
|
||||
@ -44,7 +44,7 @@ import qualified Unison.Util.Pretty as P
|
||||
|
||||
data Event
|
||||
= UnisonFileChanged SourceName Source
|
||||
| IncomingRootBranch (Set Branch.CausalHash)
|
||||
| IncomingRootBranch (Set CausalHash)
|
||||
|
||||
type Source = Text -- "id x = x\nconst a b = a"
|
||||
|
||||
|
@ -21,8 +21,8 @@ import Data.Time (UTCTime)
|
||||
import Network.URI (URI)
|
||||
import qualified System.Console.Haskeline as Completion
|
||||
import U.Codebase.Branch.Diff (NameChanges)
|
||||
import U.Codebase.HashTags (CausalHash)
|
||||
import Unison.Auth.Types (CredentialFailure)
|
||||
import qualified Unison.Codebase.Branch as Branch
|
||||
import Unison.Codebase.Editor.DisplayObject (DisplayObject)
|
||||
import Unison.Codebase.Editor.Input
|
||||
import Unison.Codebase.Editor.Output.BranchDiff (BranchDiffOutput)
|
||||
@ -104,7 +104,7 @@ data NumberedOutput
|
||||
History
|
||||
(Maybe Int) -- Amount of history to print
|
||||
HashLength
|
||||
[(Branch.CausalHash, Names.Diff)]
|
||||
[(CausalHash, Names.Diff)]
|
||||
HistoryTail -- 'origin point' of this view of history.
|
||||
| ListEdits Patch PPE.PrettyPrintEnv
|
||||
|
||||
@ -257,11 +257,11 @@ data Output
|
||||
Path.Absolute -- The namespace we're checking dependencies for.
|
||||
(Map LabeledDependency (Set Name)) -- Mapping of external dependencies to their local dependents.
|
||||
| DumpNumberedArgs NumberedArgs
|
||||
| DumpBitBooster Branch.CausalHash (Map Branch.CausalHash [Branch.CausalHash])
|
||||
| DumpBitBooster CausalHash (Map CausalHash [CausalHash])
|
||||
| DumpUnisonFileHashes Int [(Name, Reference.Id)] [(Name, Reference.Id)] [(Name, Reference.Id)]
|
||||
| BadName String
|
||||
| DefaultMetadataNotification
|
||||
| CouldntLoadBranch Branch.CausalHash
|
||||
| CouldntLoadBranch CausalHash
|
||||
| HelpMessage Input.InputPattern
|
||||
| NamespaceEmpty (NonEmpty AbsBranchId)
|
||||
| NoOp
|
||||
@ -286,9 +286,9 @@ data ShareError
|
||||
| ShareErrorTransport Sync.CodeserverTransportError
|
||||
|
||||
data HistoryTail
|
||||
= EndOfLog Branch.CausalHash
|
||||
| MergeTail Branch.CausalHash [Branch.CausalHash]
|
||||
| PageEnd Branch.CausalHash Int -- PageEnd nextHash nextIndex
|
||||
= EndOfLog CausalHash
|
||||
| MergeTail CausalHash [CausalHash]
|
||||
| PageEnd CausalHash Int -- PageEnd nextHash nextIndex
|
||||
deriving (Show)
|
||||
|
||||
data TestReportStats
|
||||
|
@ -1,17 +1,16 @@
|
||||
module Unison.Codebase.Editor.Output.DumpNamespace where
|
||||
|
||||
import Data.Map (Map)
|
||||
import Data.Set (Set)
|
||||
import qualified Unison.Codebase.Branch as Branch
|
||||
import U.Codebase.HashTags (CausalHash, PatchHash)
|
||||
import Unison.NameSegment (NameSegment)
|
||||
import Unison.Prelude
|
||||
import Unison.Reference (Reference)
|
||||
import Unison.Referent (Referent)
|
||||
|
||||
data DumpNamespace = DumpNamespace
|
||||
{ terms :: Map Referent (Set NameSegment, Set Reference),
|
||||
types :: Map Reference (Set NameSegment, Set Reference),
|
||||
patches :: Map NameSegment Branch.EditHash,
|
||||
children :: Map NameSegment Branch.CausalHash,
|
||||
causalParents :: Set Branch.CausalHash
|
||||
patches :: Map NameSegment PatchHash,
|
||||
children :: Map NameSegment CausalHash,
|
||||
causalParents :: Set CausalHash
|
||||
}
|
||||
deriving (Show)
|
||||
|
@ -166,7 +166,7 @@ completeWithinNamespace compTypes query currentPath = do
|
||||
case querySuffix of
|
||||
"" -> pure []
|
||||
suffix -> do
|
||||
case Map.lookup (Cv.namesegment1to2 suffix) nonEmptyChildren of
|
||||
case Map.lookup suffix nonEmptyChildren of
|
||||
Nothing -> pure []
|
||||
Just childCausal -> do
|
||||
childBranch <- V2Causal.value childCausal
|
||||
@ -181,29 +181,29 @@ completeWithinNamespace compTypes query currentPath = do
|
||||
namesInBranch :: Int -> V2Branch.Branch Sqlite.Transaction -> Sqlite.Transaction [(Bool, Text)]
|
||||
namesInBranch hashLen b = do
|
||||
nonEmptyChildren <- V2Branch.nonEmptyChildren b
|
||||
let textifyHQ :: (V2Branch.NameSegment -> r -> HQ'.HashQualified V2Branch.NameSegment) -> Map V2Branch.NameSegment (Map r metadata) -> [(Bool, Text)]
|
||||
let textifyHQ :: (NameSegment -> r -> HQ'.HashQualified NameSegment) -> Map NameSegment (Map r metadata) -> [(Bool, Text)]
|
||||
textifyHQ f xs =
|
||||
xs
|
||||
& hashQualifyCompletions f
|
||||
& fmap (HQ'.toTextWith V2Branch.unNameSegment)
|
||||
& fmap (HQ'.toTextWith NameSegment.toText)
|
||||
& fmap (True,)
|
||||
pure $
|
||||
((False,) <$> dotifyNamespaces (fmap V2Branch.unNameSegment . Map.keys $ nonEmptyChildren))
|
||||
((False,) <$> dotifyNamespaces (fmap NameSegment.toText . Map.keys $ nonEmptyChildren))
|
||||
<> Monoid.whenM (NESet.member TermCompletion compTypes) (textifyHQ (hqFromNamedV2Referent hashLen) $ V2Branch.terms b)
|
||||
<> Monoid.whenM (NESet.member TypeCompletion compTypes) (textifyHQ (hqFromNamedV2Reference hashLen) $ V2Branch.types b)
|
||||
<> Monoid.whenM (NESet.member PatchCompletion compTypes) (fmap ((True,) . V2Branch.unNameSegment) . Map.keys $ V2Branch.patches b)
|
||||
<> Monoid.whenM (NESet.member PatchCompletion compTypes) (fmap ((True,) . NameSegment.toText) . Map.keys $ V2Branch.patches b)
|
||||
|
||||
-- Regrettably there'shqFromNamedV2Referencenot a great spot to combinators for V2 references and shorthashes right now.
|
||||
hqFromNamedV2Referent :: Int -> V2Branch.NameSegment -> Referent.Referent -> HQ'.HashQualified V2Branch.NameSegment
|
||||
hqFromNamedV2Referent :: Int -> NameSegment -> Referent.Referent -> HQ'.HashQualified NameSegment
|
||||
hqFromNamedV2Referent hashLen n r = HQ'.HashQualified n (Cv.referent2toshorthash1 (Just hashLen) r)
|
||||
hqFromNamedV2Reference :: Int -> V2Branch.NameSegment -> Reference.Reference -> HQ'.HashQualified V2Branch.NameSegment
|
||||
hqFromNamedV2Reference :: Int -> NameSegment -> Reference.Reference -> HQ'.HashQualified NameSegment
|
||||
hqFromNamedV2Reference hashLen n r = HQ'.HashQualified n (Cv.reference2toshorthash1 (Just hashLen) r)
|
||||
hashQualifyCompletions :: forall r metadata. (V2Branch.NameSegment -> r -> HQ'.HashQualified V2Branch.NameSegment) -> Map V2Branch.NameSegment (Map r metadata) -> [HQ'.HashQualified V2Branch.NameSegment]
|
||||
hashQualifyCompletions :: forall r metadata. (NameSegment -> r -> HQ'.HashQualified NameSegment) -> Map NameSegment (Map r metadata) -> [HQ'.HashQualified NameSegment]
|
||||
hashQualifyCompletions qualify defs = ifoldMap qualifyRefs defs
|
||||
where
|
||||
-- Qualify any conflicted definitions. If the query has a "#" in it, then qualify ALL
|
||||
-- completions.
|
||||
qualifyRefs :: V2Branch.NameSegment -> (Map r metadata) -> [HQ'.HashQualified V2Branch.NameSegment]
|
||||
qualifyRefs :: NameSegment -> (Map r metadata) -> [HQ'.HashQualified NameSegment]
|
||||
qualifyRefs n refs
|
||||
| ((Text.isInfixOf "#" . NameSegment.toText) querySuffix) || length refs > 1 =
|
||||
refs
|
||||
|
@ -38,6 +38,7 @@ import System.Directory
|
||||
)
|
||||
import U.Codebase.Branch (NamespaceStats (..))
|
||||
import U.Codebase.Branch.Diff (NameChanges (..))
|
||||
import U.Codebase.HashTags (CausalHash (..))
|
||||
import U.Codebase.Sqlite.DbId (SchemaVersion (SchemaVersion))
|
||||
import U.Util.Base32Hex (Base32Hex)
|
||||
import qualified U.Util.Base32Hex as Base32Hex
|
||||
@ -48,8 +49,6 @@ import qualified U.Util.Monoid as Monoid
|
||||
import qualified Unison.ABT as ABT
|
||||
import qualified Unison.Auth.Types as Auth
|
||||
import qualified Unison.Builtin.Decls as DD
|
||||
import qualified Unison.Codebase.Branch as Branch
|
||||
import qualified Unison.Codebase.Causal as Causal
|
||||
import Unison.Codebase.Editor.DisplayObject (DisplayObject (BuiltinObject, MissingObject, UserObject))
|
||||
import qualified Unison.Codebase.Editor.Input as Input
|
||||
import Unison.Codebase.Editor.Output
|
||||
@ -367,16 +366,16 @@ notifyNumbered o = case o of
|
||||
"",
|
||||
tailMsg
|
||||
]
|
||||
branchHashes :: [Branch.CausalHash]
|
||||
branchHashes :: [CausalHash]
|
||||
branchHashes = (fst <$> reversedHistory) <> tailHashes
|
||||
in (msg, displayBranchHash <$> branchHashes)
|
||||
where
|
||||
toSCH :: Branch.CausalHash -> ShortCausalHash
|
||||
toSCH :: CausalHash -> ShortCausalHash
|
||||
toSCH h = SCH.fromHash schLength h
|
||||
reversedHistory = reverse history
|
||||
showNum :: Int -> Pretty
|
||||
showNum n = P.shown n <> ". "
|
||||
handleTail :: Int -> (Pretty, [Branch.CausalHash])
|
||||
handleTail :: Int -> (Pretty, [CausalHash])
|
||||
handleTail n = case tail of
|
||||
E.EndOfLog h ->
|
||||
( P.lines
|
||||
@ -1233,7 +1232,7 @@ notifyUser dir o = case o of
|
||||
CouldntLoadRootBranch repo hash ->
|
||||
P.wrap $
|
||||
"I couldn't load the designated root hash"
|
||||
<> P.group ("(" <> P.text (Hash.base32Hex $ Causal.unCausalHash hash) <> ")")
|
||||
<> P.group ("(" <> P.text (Hash.base32Hex $ unCausalHash hash) <> ")")
|
||||
<> "from the repository at"
|
||||
<> prettyReadGitRepo repo
|
||||
CouldntLoadSyncedBranch ns h ->
|
||||
@ -1528,10 +1527,10 @@ notifyUser dir o = case o of
|
||||
Nothing -> go (renderLine head [] : output) queue
|
||||
Just tails -> go (renderLine head tails : output) (queue ++ tails)
|
||||
where
|
||||
renderHash = take 10 . Text.unpack . Hash.base32Hex . Causal.unCausalHash
|
||||
renderHash = take 10 . Text.unpack . Hash.base32Hex . unCausalHash
|
||||
renderLine head tail =
|
||||
(renderHash head) ++ "|" ++ intercalateMap " " renderHash tail
|
||||
++ case Map.lookup (Hash.base32Hex . Causal.unCausalHash $ head) tags of
|
||||
++ case Map.lookup (Hash.base32Hex . unCausalHash $ head) tags of
|
||||
Just t -> "|tag: " ++ t
|
||||
Nothing -> ""
|
||||
-- some specific hashes that we want to label in the output
|
||||
@ -1929,8 +1928,8 @@ prettyAbsolute = P.blue . P.shown
|
||||
prettySCH :: IsString s => ShortCausalHash -> P.Pretty s
|
||||
prettySCH hash = P.group $ "#" <> P.text (SCH.toText hash)
|
||||
|
||||
prettyCausalHash :: IsString s => Causal.CausalHash -> P.Pretty s
|
||||
prettyCausalHash hash = P.group $ "#" <> P.text (Hash.toBase32HexText . Causal.unCausalHash $ hash)
|
||||
prettyCausalHash :: IsString s => CausalHash -> P.Pretty s
|
||||
prettyCausalHash hash = P.group $ "#" <> P.text (Hash.toBase32HexText . unCausalHash $ hash)
|
||||
|
||||
prettyBase32Hex :: IsString s => Base32Hex -> P.Pretty s
|
||||
prettyBase32Hex = P.text . Base32Hex.toText
|
||||
@ -3213,8 +3212,8 @@ endangeredDependentsTable ppeDecl m =
|
||||
& P.lines
|
||||
|
||||
-- | Displays a full, non-truncated Branch.CausalHash to a string, e.g. #abcdef
|
||||
displayBranchHash :: Branch.CausalHash -> String
|
||||
displayBranchHash = ("#" <>) . Text.unpack . Hash.base32Hex . Causal.unCausalHash
|
||||
displayBranchHash :: CausalHash -> String
|
||||
displayBranchHash = ("#" <>) . Text.unpack . Hash.base32Hex . unCausalHash
|
||||
|
||||
prettyHumanReadableTime :: UTCTime -> UTCTime -> Pretty
|
||||
prettyHumanReadableTime now time =
|
||||
|
@ -184,6 +184,7 @@ library
|
||||
, unison-codebase
|
||||
, unison-codebase-sqlite
|
||||
, unison-codebase-sqlite-hashing-v2
|
||||
, unison-core
|
||||
, unison-core1
|
||||
, unison-hash
|
||||
, unison-parser-typechecker
|
||||
@ -311,6 +312,7 @@ executable cli-integration-tests
|
||||
, unison-codebase
|
||||
, unison-codebase-sqlite
|
||||
, unison-codebase-sqlite-hashing-v2
|
||||
, unison-core
|
||||
, unison-core1
|
||||
, unison-hash
|
||||
, unison-parser-typechecker
|
||||
@ -432,6 +434,7 @@ executable transcripts
|
||||
, unison-codebase
|
||||
, unison-codebase-sqlite
|
||||
, unison-codebase-sqlite-hashing-v2
|
||||
, unison-core
|
||||
, unison-core1
|
||||
, unison-hash
|
||||
, unison-parser-typechecker
|
||||
@ -560,6 +563,7 @@ executable unison
|
||||
, unison-codebase
|
||||
, unison-codebase-sqlite
|
||||
, unison-codebase-sqlite-hashing-v2
|
||||
, unison-core
|
||||
, unison-core1
|
||||
, unison-hash
|
||||
, unison-parser-typechecker
|
||||
@ -691,6 +695,7 @@ test-suite cli-tests
|
||||
, unison-codebase
|
||||
, unison-codebase-sqlite
|
||||
, unison-codebase-sqlite-hashing-v2
|
||||
, unison-core
|
||||
, unison-core1
|
||||
, unison-hash
|
||||
, unison-parser-typechecker
|
||||
|
@ -1,12 +1,10 @@
|
||||
module Unison.Names.Scoped where
|
||||
|
||||
import Unison.Names (Names)
|
||||
import qualified Unison.Names as Names
|
||||
|
||||
-- | Contains all useful permutations of names scoped to a given branch.
|
||||
data ScopedNames = ScopedNames
|
||||
{ absoluteExternalNames :: Names,
|
||||
relativeScopedNames :: Names,
|
||||
{ relativeScopedNames :: Names,
|
||||
absoluteRootNames :: Names
|
||||
}
|
||||
|
||||
@ -21,4 +19,4 @@ parseNames (ScopedNames {relativeScopedNames, absoluteRootNames}) = relativeScop
|
||||
-- | Includes includes relative names for anything in the path, and absolute names for
|
||||
-- everything else.
|
||||
prettyNames :: ScopedNames -> Names
|
||||
prettyNames (ScopedNames {relativeScopedNames, absoluteExternalNames}) = relativeScopedNames `Names.unionLeft` absoluteExternalNames
|
||||
prettyNames (ScopedNames {relativeScopedNames}) = relativeScopedNames
|
||||
|
@ -41,7 +41,6 @@ library
|
||||
Unison.Names
|
||||
Unison.Names.ResolutionResult
|
||||
Unison.Names.Scoped
|
||||
Unison.NameSegment
|
||||
Unison.NamesWithHistory
|
||||
Unison.Pattern
|
||||
Unison.Position
|
||||
@ -54,7 +53,6 @@ library
|
||||
Unison.Term
|
||||
Unison.Type
|
||||
Unison.Type.Names
|
||||
Unison.Util.Alphabetical
|
||||
Unison.Util.Components
|
||||
Unison.Util.List
|
||||
Unison.Var
|
||||
|
@ -42,6 +42,7 @@ dependencies:
|
||||
- transformers
|
||||
- unison-codebase
|
||||
- unison-codebase-sqlite
|
||||
- unison-core
|
||||
- unison-core1
|
||||
- unison-hash
|
||||
- unison-hash-orphans-aeson
|
||||
|
@ -31,6 +31,8 @@ import qualified Text.FuzzyFind as FZF
|
||||
import U.Codebase.Branch (NamespaceStats (..))
|
||||
import qualified U.Codebase.Branch as V2Branch
|
||||
import qualified U.Codebase.Causal as V2Causal
|
||||
import U.Codebase.HashTags (CausalHash (..))
|
||||
import U.Codebase.Projects as Projects
|
||||
import qualified U.Codebase.Referent as V2Referent
|
||||
import qualified U.Codebase.Sqlite.Operations as Operations
|
||||
import qualified Unison.ABT as ABT
|
||||
@ -41,7 +43,6 @@ import qualified Unison.Codebase as Codebase
|
||||
import Unison.Codebase.Branch (Branch)
|
||||
import qualified Unison.Codebase.Branch as Branch
|
||||
import qualified Unison.Codebase.Branch.Names as Branch
|
||||
import qualified Unison.Codebase.Causal.Type as Causal
|
||||
import Unison.Codebase.Editor.DisplayObject
|
||||
import qualified Unison.Codebase.Editor.DisplayObject as DisplayObject
|
||||
import Unison.Codebase.Path (Path)
|
||||
@ -119,7 +120,7 @@ type SyntaxText = UST.SyntaxText' Reference
|
||||
data ShallowListEntry v a
|
||||
= ShallowTermEntry (TermEntry v a)
|
||||
| ShallowTypeEntry TypeEntry
|
||||
| ShallowBranchEntry NameSegment Branch.CausalHash NamespaceStats
|
||||
| ShallowBranchEntry NameSegment CausalHash NamespaceStats
|
||||
| ShallowPatchEntry NameSegment
|
||||
deriving (Eq, Ord, Show, Generic)
|
||||
|
||||
@ -141,8 +142,8 @@ data BackendError
|
||||
| CouldntExpandBranchHash ShortCausalHash
|
||||
| AmbiguousBranchHash ShortCausalHash (Set ShortCausalHash)
|
||||
| AmbiguousHashForDefinition ShortHash
|
||||
| NoBranchForHash Branch.CausalHash
|
||||
| CouldntLoadBranch Branch.CausalHash
|
||||
| NoBranchForHash CausalHash
|
||||
| CouldntLoadBranch CausalHash
|
||||
| MissingSignatureForTerm Reference
|
||||
| NoSuchDefinition (HQ.HashQualified Name)
|
||||
deriving stock (Show)
|
||||
@ -227,13 +228,13 @@ shallowNames :: forall m v a. Monad m => Codebase m v a -> V2Branch.Branch m ->
|
||||
shallowNames codebase b = do
|
||||
newTerms <-
|
||||
V2Branch.terms b
|
||||
& Map.mapKeys (Name.fromSegment . Cv.namesegment2to1)
|
||||
& Map.mapKeys Name.fromSegment
|
||||
& fmap Map.keysSet
|
||||
& traverse . Set.traverse %%~ Cv.referent2to1 (Codebase.getDeclType codebase)
|
||||
|
||||
let newTypes =
|
||||
V2Branch.types b
|
||||
& Map.mapKeys (Name.fromSegment . Cv.namesegment2to1)
|
||||
& Map.mapKeys Name.fromSegment
|
||||
& fmap Map.keysSet
|
||||
& traverse . Set.traverse %~ Cv.reference2to1
|
||||
pure (Names (R.fromMultimap newTerms) (R.fromMultimap newTypes))
|
||||
@ -361,7 +362,7 @@ findShallowReadmeInBranchAndRender width runtime codebase ppe namespaceBranch =
|
||||
|
||||
-- choose the first term (among conflicted terms) matching any of these names, in this order.
|
||||
-- we might later want to return all of them to let the front end decide
|
||||
toCheck = V2Branch.NameSegment <$> ["README", "Readme", "ReadMe", "readme"]
|
||||
toCheck = NameSegment <$> ["README", "Readme", "ReadMe", "readme"]
|
||||
readme :: Maybe Reference
|
||||
readme = listToMaybe $ do
|
||||
name <- toCheck
|
||||
@ -427,7 +428,7 @@ termListEntry codebase branch (ExactName nameSegment ref) = do
|
||||
isConflicted =
|
||||
branch
|
||||
& V2Branch.terms
|
||||
& Map.lookup (coerce @NameSegment @V2Branch.NameSegment nameSegment)
|
||||
& Map.lookup nameSegment
|
||||
& maybe 0 Map.size
|
||||
& (> 1)
|
||||
|
||||
@ -495,7 +496,7 @@ typeListEntry codebase b (ExactName nameSegment ref) = do
|
||||
isConflicted =
|
||||
b
|
||||
& V2Branch.types
|
||||
& Map.lookup (coerce @NameSegment @V2Branch.NameSegment nameSegment)
|
||||
& Map.lookup nameSegment
|
||||
& maybe 0 Map.size
|
||||
& (> 1)
|
||||
|
||||
@ -554,26 +555,26 @@ lsBranch ::
|
||||
V2Branch.Branch n ->
|
||||
m [ShallowListEntry Symbol Ann]
|
||||
lsBranch codebase b0 = do
|
||||
let flattenRefs :: Map V2Branch.NameSegment (Map ref v) -> [(ref, V2Branch.NameSegment)]
|
||||
let flattenRefs :: Map NameSegment (Map ref v) -> [(ref, NameSegment)]
|
||||
flattenRefs m = do
|
||||
(ns, refs) <- Map.toList m
|
||||
r <- Map.keys refs
|
||||
pure (r, ns)
|
||||
termEntries <- for (flattenRefs $ V2Branch.terms b0) $ \(r, ns) -> do
|
||||
ShallowTermEntry <$> termListEntry codebase b0 (ExactName (coerce @V2Branch.NameSegment ns) r)
|
||||
ShallowTermEntry <$> termListEntry codebase b0 (ExactName ns r)
|
||||
typeEntries <-
|
||||
Codebase.runTransaction codebase do
|
||||
for (flattenRefs $ V2Branch.types b0) \(r, ns) -> do
|
||||
let v1Ref = Cv.reference2to1 r
|
||||
ShallowTypeEntry <$> typeListEntry codebase b0 (ExactName (coerce @V2Branch.NameSegment ns) v1Ref)
|
||||
ShallowTypeEntry <$> typeListEntry codebase b0 (ExactName ns v1Ref)
|
||||
childrenWithStats <- Codebase.runTransaction codebase (V2Branch.childStats b0)
|
||||
let branchEntries :: [ShallowListEntry Symbol Ann] = do
|
||||
(ns, (h, stats)) <- Map.toList $ childrenWithStats
|
||||
guard $ V2Branch.hasDefinitions stats
|
||||
pure $ ShallowBranchEntry (Cv.namesegment2to1 ns) (Cv.causalHash2to1 . V2Causal.causalHash $ h) stats
|
||||
pure $ ShallowBranchEntry ns (V2Causal.causalHash h) stats
|
||||
patchEntries :: [ShallowListEntry Symbol Ann] = do
|
||||
(ns, _h) <- Map.toList $ V2Branch.patches b0
|
||||
pure $ ShallowPatchEntry (Cv.namesegment2to1 ns)
|
||||
pure $ ShallowPatchEntry ns
|
||||
pure . List.sortOn listEntryName $
|
||||
termEntries
|
||||
++ typeEntries
|
||||
@ -600,7 +601,7 @@ termReferencesByShortHash sh = do
|
||||
pure (fromBuiltins <> Set.mapMonotonic Reference.DerivedId fromCodebase)
|
||||
|
||||
-- | Look up terms in the codebase by short hash, and include builtins.
|
||||
termReferentsByShortHash :: Monad m => Codebase m v a -> ShortHash -> m (Set Referent)
|
||||
termReferentsByShortHash :: Codebase m v a -> ShortHash -> Sqlite.Transaction (Set Referent)
|
||||
termReferentsByShortHash codebase sh = do
|
||||
fromCodebase <- Codebase.termReferentsByPrefix codebase sh
|
||||
let fromBuiltins =
|
||||
@ -721,11 +722,10 @@ applySearch Search {lookupNames, lookupRelativeHQRefs', makeResult, matchesNamed
|
||||
in makeResult (HQ'.toHQ primaryName) ref aliases
|
||||
|
||||
hqNameQuery ::
|
||||
MonadIO m =>
|
||||
Codebase m v Ann ->
|
||||
NameSearch ->
|
||||
[HQ.HashQualified Name] ->
|
||||
m QueryResult
|
||||
Sqlite.Transaction QueryResult
|
||||
hqNameQuery codebase NameSearch {typeSearch, termSearch} hqs = do
|
||||
-- Split the query into hash-only and hash-qualified-name queries.
|
||||
let (hashes, hqnames) = partitionEithers (map HQ'.fromHQ2 hqs)
|
||||
@ -737,11 +737,10 @@ hqNameQuery codebase NameSearch {typeSearch, termSearch} hqs = do
|
||||
hashes
|
||||
-- Find types with those hashes.
|
||||
typeRefs <-
|
||||
Codebase.runTransaction codebase do
|
||||
filter (not . Set.null . snd) . zip hashes
|
||||
<$> traverse
|
||||
typeReferencesByShortHash
|
||||
hashes
|
||||
filter (not . Set.null . snd) . zip hashes
|
||||
<$> traverse
|
||||
typeReferencesByShortHash
|
||||
hashes
|
||||
-- Now do the name queries.
|
||||
let mkTermResult sh r = SR.termResult (HQ.HashOnly sh) r Set.empty
|
||||
mkTypeResult sh r = SR.typeResult (HQ.HashOnly sh) r Set.empty
|
||||
@ -785,7 +784,7 @@ data DefinitionResults v = DefinitionResults
|
||||
noResults :: [HQ.HashQualified Name]
|
||||
}
|
||||
|
||||
expandShortCausalHash :: ShortCausalHash -> Backend Sqlite.Transaction Branch.CausalHash
|
||||
expandShortCausalHash :: ShortCausalHash -> Backend Sqlite.Transaction CausalHash
|
||||
expandShortCausalHash hash = do
|
||||
hashSet <- lift $ Codebase.causalHashesByPrefix hash
|
||||
len <- lift $ Codebase.branchHashLength
|
||||
@ -797,13 +796,13 @@ expandShortCausalHash hash = do
|
||||
|
||||
-- | Efficiently resolve a root hash and path to a shallow branch's causal.
|
||||
getShallowCausalAtPathFromRootHash ::
|
||||
Maybe Branch.CausalHash ->
|
||||
Maybe CausalHash ->
|
||||
Path ->
|
||||
Sqlite.Transaction (V2Branch.CausalBranch Sqlite.Transaction)
|
||||
getShallowCausalAtPathFromRootHash mayRootHash path = do
|
||||
shallowRoot <- case mayRootHash of
|
||||
Nothing -> Codebase.getShallowRootCausal
|
||||
Just h -> Codebase.expectCausalBranchByCausalHash (Cv.causalHash1to2 h)
|
||||
Just h -> Codebase.expectCausalBranchByCausalHash h
|
||||
Codebase.getShallowCausalAtPath path (Just shallowRoot)
|
||||
|
||||
formatType' :: Var v => PPE.PrettyPrintEnv -> Width -> Type v a -> SyntaxText
|
||||
@ -832,7 +831,7 @@ prettyDefinitionsForHQName ::
|
||||
-- this path.
|
||||
Path ->
|
||||
-- | The root branch to use
|
||||
Maybe Branch.CausalHash ->
|
||||
Maybe CausalHash ->
|
||||
Maybe Width ->
|
||||
-- | Whether to suffixify bindings in the rendered syntax
|
||||
Suffixify ->
|
||||
@ -845,7 +844,7 @@ prettyDefinitionsForHQName ::
|
||||
prettyDefinitionsForHQName path mayRoot renderWidth suffixifyBindings rt codebase query = do
|
||||
(shallowRoot, hqLength) <-
|
||||
(lift . Codebase.runTransaction codebase) do
|
||||
shallowRoot <- resolveCausalHashV2 (fmap Cv.causalHash1to2 mayRoot)
|
||||
shallowRoot <- resolveCausalHashV2 mayRoot
|
||||
hqLength <- Codebase.hashLength
|
||||
pure (shallowRoot, hqLength)
|
||||
(localNamesOnly, unbiasedPPE) <- scopedNamesForBranchHash codebase (Just shallowRoot) path
|
||||
@ -862,11 +861,13 @@ prettyDefinitionsForHQName path mayRoot renderWidth suffixifyBindings rt codebas
|
||||
fqnPPE = PPED.unsuffixifiedPPE pped
|
||||
let nameSearch :: NameSearch
|
||||
nameSearch = makeNameSearch hqLength (NamesWithHistory.fromCurrentNames localNamesOnly)
|
||||
DefinitionResults terms types misses <- lift (definitionsBySuffixes codebase nameSearch DontIncludeCycles [query])
|
||||
branchAtPath <- do
|
||||
(DefinitionResults terms types misses, branchAtPath) <-
|
||||
(lift . Codebase.runTransaction codebase) do
|
||||
causalAtPath <- Codebase.getShallowCausalAtPath path (Just shallowRoot)
|
||||
V2Causal.value causalAtPath
|
||||
results <- definitionsBySuffixes codebase nameSearch DontIncludeCycles [query]
|
||||
branchAtPath <- do
|
||||
causalAtPath <- Codebase.getShallowCausalAtPath path (Just shallowRoot)
|
||||
V2Causal.value causalAtPath
|
||||
pure (results, branchAtPath)
|
||||
let width = mayDefaultWidth renderWidth
|
||||
-- Return only references which refer to docs.
|
||||
filterForDocs :: [Referent] -> Sqlite.Transaction [TermReference]
|
||||
@ -976,16 +977,16 @@ renderDoc ppe width rt codebase r = do
|
||||
in Doc.renderDoc
|
||||
ppe
|
||||
terms
|
||||
(Codebase.runTransaction codebase . typeOf)
|
||||
typeOf
|
||||
eval
|
||||
(Codebase.runTransaction codebase . decls)
|
||||
decls
|
||||
tm
|
||||
where
|
||||
terms r@(Reference.Builtin _) = pure (Just (Term.ref () r))
|
||||
terms (Reference.DerivedId r) =
|
||||
fmap Term.unannotate <$> Codebase.getTerm codebase r
|
||||
fmap Term.unannotate <$> Codebase.runTransaction codebase (Codebase.getTerm codebase r)
|
||||
|
||||
typeOf r = fmap void <$> Codebase.getTypeOfReferent codebase r
|
||||
typeOf r = fmap void <$> Codebase.runTransaction codebase (Codebase.getTypeOfReferent codebase r)
|
||||
eval (Term.amap (const mempty) -> tm) = do
|
||||
let ppes = PPED.suffixifiedPPE ppe
|
||||
let codeLookup = Codebase.toCodeLookup codebase
|
||||
@ -1001,7 +1002,8 @@ renderDoc ppe width rt codebase r = do
|
||||
Nothing -> pure ()
|
||||
pure $ r <&> Term.amap (const mempty)
|
||||
|
||||
decls (Reference.DerivedId r) = fmap (DD.amap (const ())) <$> Codebase.getTypeDeclaration codebase r
|
||||
decls (Reference.DerivedId r) =
|
||||
fmap (DD.amap (const ())) <$> Codebase.runTransaction codebase (Codebase.getTypeDeclaration codebase r)
|
||||
decls _ = pure Nothing
|
||||
|
||||
docsInBranchToHtmlFiles ::
|
||||
@ -1124,19 +1126,19 @@ scopedNamesForBranchHash codebase mbh path = do
|
||||
hashLen <- lift $ Codebase.runTransaction codebase Codebase.hashLength
|
||||
(parseNames, localNames) <- case mbh of
|
||||
Nothing
|
||||
| shouldUseNamesIndex -> lift $ Codebase.runTransaction codebase indexNames
|
||||
| shouldUseNamesIndex -> do
|
||||
lift $ Codebase.runTransaction codebase indexNames
|
||||
| otherwise -> do
|
||||
rootBranch <- lift $ Codebase.getRootBranch codebase
|
||||
let (parseNames, _prettyNames, localNames) = namesForBranch rootBranch (AllNames path)
|
||||
pure (parseNames, localNames)
|
||||
Just rootCausal -> do
|
||||
let ch = V2Causal.causalHash rootCausal
|
||||
let v1CausalHash = Cv.causalHash2to1 ch
|
||||
rootHash <- lift $ Codebase.runTransaction codebase Operations.expectRootCausalHash
|
||||
if (ch == rootHash) && shouldUseNamesIndex
|
||||
then lift $ Codebase.runTransaction codebase indexNames
|
||||
else do
|
||||
(parseNames, _pretty, localNames) <- flip namesForBranch (AllNames path) <$> resolveCausalHash (Just v1CausalHash) codebase
|
||||
(parseNames, _pretty, localNames) <- flip namesForBranch (AllNames path) <$> resolveCausalHash (Just ch) codebase
|
||||
pure (parseNames, localNames)
|
||||
|
||||
let localPPE = PPED.fromNamesDecl hashLen (NamesWithHistory.fromCurrentNames localNames)
|
||||
@ -1150,18 +1152,21 @@ scopedNamesForBranchHash codebase mbh path = do
|
||||
(PPED.suffixifiedPPE primary `PPE.addFallback` PPED.suffixifiedPPE addFallback)
|
||||
indexNames :: Sqlite.Transaction (Names, Names)
|
||||
indexNames = do
|
||||
scopedNames <- Codebase.namesAtPath path
|
||||
branch <- Codebase.getShallowRootBranch
|
||||
mayProjectRoot <- Projects.inferNamesRoot path branch
|
||||
let namesRoot = fromMaybe path mayProjectRoot
|
||||
scopedNames <- Codebase.namesAtPath namesRoot path
|
||||
pure (ScopedNames.parseNames scopedNames, ScopedNames.namesAtPath scopedNames)
|
||||
|
||||
resolveCausalHash ::
|
||||
Monad m => Maybe Branch.CausalHash -> Codebase m v a -> Backend m (Branch m)
|
||||
Monad m => Maybe CausalHash -> Codebase m v a -> Backend m (Branch m)
|
||||
resolveCausalHash h codebase = case h of
|
||||
Nothing -> lift (Codebase.getRootBranch codebase)
|
||||
Just bhash -> do
|
||||
mayBranch <- lift $ Codebase.getBranchForHash codebase bhash
|
||||
whenNothing mayBranch (throwError $ NoBranchForHash bhash)
|
||||
|
||||
resolveCausalHashV2 :: Maybe V2Branch.CausalHash -> Sqlite.Transaction (V2Branch.CausalBranch Sqlite.Transaction)
|
||||
resolveCausalHashV2 :: Maybe CausalHash -> Sqlite.Transaction (V2Branch.CausalBranch Sqlite.Transaction)
|
||||
resolveCausalHashV2 h = case h of
|
||||
Nothing -> Codebase.getShallowRootCausal
|
||||
Just ch -> Codebase.expectCausalBranchByCausalHash ch
|
||||
@ -1180,7 +1185,7 @@ resolveRootBranchHashV2 ::
|
||||
resolveRootBranchHashV2 mayRoot = case mayRoot of
|
||||
Nothing -> lift Codebase.getShallowRootCausal
|
||||
Just sch -> do
|
||||
h <- Cv.causalHash1to2 <$> expandShortCausalHash sch
|
||||
h <- expandShortCausalHash sch
|
||||
lift (resolveCausalHashV2 (Just h))
|
||||
|
||||
-- | Determines whether we include full cycles in the results, (e.g. if I search for `isEven`, will I find `isOdd` too?)
|
||||
@ -1195,13 +1200,11 @@ data IncludeCycles
|
||||
| DontIncludeCycles
|
||||
|
||||
definitionsBySuffixes ::
|
||||
forall m.
|
||||
MonadIO m =>
|
||||
Codebase m Symbol Ann ->
|
||||
NameSearch ->
|
||||
IncludeCycles ->
|
||||
[HQ.HashQualified Name] ->
|
||||
m (DefinitionResults Symbol)
|
||||
Sqlite.Transaction (DefinitionResults Symbol)
|
||||
definitionsBySuffixes codebase nameSearch includeCycles query = do
|
||||
QueryResult misses results <- hqNameQuery codebase nameSearch query
|
||||
-- todo: remember to replace this with getting components directly,
|
||||
@ -1211,12 +1214,11 @@ definitionsBySuffixes codebase nameSearch includeCycles query = do
|
||||
let typeRefsWithoutCycles = searchResultsToTypeRefs results
|
||||
typeRefs <- case includeCycles of
|
||||
IncludeCycles ->
|
||||
Codebase.runTransaction codebase do
|
||||
Monoid.foldMapM
|
||||
Codebase.componentReferencesForReference
|
||||
typeRefsWithoutCycles
|
||||
Monoid.foldMapM
|
||||
Codebase.componentReferencesForReference
|
||||
typeRefsWithoutCycles
|
||||
DontIncludeCycles -> pure typeRefsWithoutCycles
|
||||
Codebase.runTransaction codebase (Map.foldMapM (\ref -> (ref,) <$> displayType codebase ref) typeRefs)
|
||||
Map.foldMapM (\ref -> (ref,) <$> displayType codebase ref) typeRefs
|
||||
pure (DefinitionResults terms types misses)
|
||||
where
|
||||
searchResultsToTermRefs :: [SR.SearchResult] -> Set Reference
|
||||
@ -1232,7 +1234,7 @@ definitionsBySuffixes codebase nameSearch includeCycles query = do
|
||||
SR.Tp' _ r _ -> Just r
|
||||
_ -> Nothing
|
||||
|
||||
displayTerm :: MonadIO m => Codebase m Symbol Ann -> Reference -> m (DisplayObject (Type Symbol Ann) (Term Symbol Ann))
|
||||
displayTerm :: Codebase m Symbol Ann -> Reference -> Sqlite.Transaction (DisplayObject (Type Symbol Ann) (Term Symbol Ann))
|
||||
displayTerm codebase = \case
|
||||
ref@(Reference.Builtin _) -> do
|
||||
pure case Map.lookup ref B.termRefTypes of
|
||||
|
@ -141,7 +141,7 @@ serveFuzzyFind codebase mayRoot relativeTo limit typeWidth query = do
|
||||
rootCausal <-
|
||||
Backend.hoistBackend (Codebase.runTransaction codebase) do
|
||||
rootHash <- traverse Backend.expandShortCausalHash mayRoot
|
||||
lift (Backend.resolveCausalHashV2 (Cv.causalHash1to2 <$> rootHash))
|
||||
lift (Backend.resolveCausalHashV2 rootHash)
|
||||
(localNamesOnly, ppe) <- Backend.scopedNamesForBranchHash codebase (Just rootCausal) path
|
||||
relativeToBranch <- do
|
||||
(lift . Codebase.runTransaction codebase) do
|
||||
|
@ -25,18 +25,14 @@ import Servant.Docs
|
||||
)
|
||||
import Servant.OpenApi ()
|
||||
import U.Codebase.Branch (NamespaceStats (..))
|
||||
import qualified U.Codebase.Branch as V2Causal
|
||||
import qualified U.Codebase.Causal as V2Causal
|
||||
import U.Codebase.HashTags (CausalHash (..))
|
||||
import qualified U.Codebase.Sqlite.Operations as Operations
|
||||
import qualified U.Util.Hash as Hash
|
||||
import Unison.Codebase (Codebase)
|
||||
import qualified Unison.Codebase as Codebase
|
||||
import qualified Unison.Codebase.Branch as Branch
|
||||
import qualified Unison.Codebase.Causal as Causal
|
||||
import qualified Unison.Codebase.Path as Path
|
||||
import Unison.Codebase.ShortCausalHash (ShortCausalHash)
|
||||
import Unison.Codebase.SqliteCodebase.Conversions (causalHash2to1)
|
||||
import qualified Unison.Codebase.SqliteCodebase.Conversions as Cv
|
||||
import qualified Unison.NameSegment as NameSegment
|
||||
import Unison.Parser.Ann (Ann)
|
||||
import Unison.Prelude
|
||||
@ -157,7 +153,7 @@ backendListEntryToNamespaceObject ppe typeWidth = \case
|
||||
Subnamespace $
|
||||
NamedNamespace
|
||||
{ namespaceName = NameSegment.toText name,
|
||||
namespaceHash = "#" <> Hash.toBase32HexText (Causal.unCausalHash hash),
|
||||
namespaceHash = "#" <> Hash.toBase32HexText (unCausalHash hash),
|
||||
namespaceSize = numContainedTerms + numContainedTypes + numContainedPatches
|
||||
}
|
||||
Backend.ShallowPatchEntry name ->
|
||||
@ -199,12 +195,12 @@ serve codebase maySCH mayRelativeTo mayNamespaceName = do
|
||||
(True, Nothing) ->
|
||||
serveFromIndex codebase mayRootHash path'
|
||||
(True, Just rh)
|
||||
| rh == causalHash2to1 codebaseRootHash ->
|
||||
| rh == codebaseRootHash ->
|
||||
serveFromIndex codebase mayRootHash path'
|
||||
| otherwise -> do
|
||||
serveFromBranch codebase path' (Cv.causalHash1to2 rh)
|
||||
serveFromBranch codebase path' rh
|
||||
(False, Just rh) -> do
|
||||
serveFromBranch codebase path' (Cv.causalHash1to2 rh)
|
||||
serveFromBranch codebase path' rh
|
||||
(False, Nothing) -> do
|
||||
ch <- liftIO $ Codebase.runTransaction codebase Operations.expectRootCausalHash
|
||||
serveFromBranch codebase path' ch
|
||||
@ -212,7 +208,7 @@ serve codebase maySCH mayRelativeTo mayNamespaceName = do
|
||||
serveFromBranch ::
|
||||
Codebase IO Symbol Ann ->
|
||||
Path.Path' ->
|
||||
V2Causal.CausalHash ->
|
||||
CausalHash ->
|
||||
Backend.Backend IO NamespaceListing
|
||||
serveFromBranch codebase path' rootHash = do
|
||||
let absPath = Path.Absolute . Path.fromPath' $ path'
|
||||
@ -233,7 +229,7 @@ serveFromBranch codebase path' rootHash = do
|
||||
|
||||
serveFromIndex ::
|
||||
Codebase IO Symbol Ann ->
|
||||
Maybe Branch.CausalHash ->
|
||||
Maybe CausalHash ->
|
||||
Path.Path' ->
|
||||
Backend.Backend IO NamespaceListing
|
||||
serveFromIndex codebase mayRootHash path' = do
|
||||
|
@ -26,14 +26,13 @@ import Servant.Docs
|
||||
)
|
||||
import qualified U.Codebase.Branch as V2Branch
|
||||
import qualified U.Codebase.Causal as V2Causal
|
||||
import U.Codebase.HashTags (CausalHash (..))
|
||||
import qualified U.Util.Hash as Hash
|
||||
import Unison.Codebase (Codebase)
|
||||
import qualified Unison.Codebase as Codebase
|
||||
import qualified Unison.Codebase.Causal.Type as Causal
|
||||
import qualified Unison.Codebase.Path as Path
|
||||
import qualified Unison.Codebase.Path.Parse as Path
|
||||
import Unison.Codebase.ShortCausalHash (ShortCausalHash)
|
||||
import qualified Unison.Codebase.SqliteCodebase.Conversions as Cv
|
||||
import qualified Unison.NameSegment as NameSegment
|
||||
import Unison.Parser.Ann (Ann)
|
||||
import Unison.Prelude
|
||||
@ -111,7 +110,7 @@ backendListEntryToProjectListing owner = \case
|
||||
ProjectListing
|
||||
{ owner = owner,
|
||||
name = NameSegment.toText name,
|
||||
hash = "#" <> Hash.toBase32HexText (Causal.unCausalHash hash)
|
||||
hash = "#" <> Hash.toBase32HexText (unCausalHash hash)
|
||||
}
|
||||
_ -> Nothing
|
||||
|
||||
@ -141,7 +140,7 @@ serve codebase mayRoot mayOwner = projects
|
||||
Just sch -> do
|
||||
h <- Backend.expandShortCausalHash sch
|
||||
-- TODO: can this ever be missing?
|
||||
causal <- lift $ Codebase.expectCausalBranchByCausalHash (Cv.causalHash1to2 h)
|
||||
causal <- lift $ Codebase.expectCausalBranchByCausalHash h
|
||||
lift $ V2Causal.value causal
|
||||
|
||||
ownerEntries <- lift $ Backend.lsBranch codebase shallowRootBranch
|
||||
|
@ -10,7 +10,7 @@ import qualified Data.Set as Set
|
||||
import qualified Data.Text.Lazy as Text
|
||||
import qualified Data.Text.Lazy.Encoding as Text
|
||||
import Servant (ServerError (..), err400, err404, err409, err500)
|
||||
import qualified Unison.Codebase.Causal as Causal
|
||||
import U.Codebase.HashTags (CausalHash)
|
||||
import qualified Unison.Codebase.Path as Path
|
||||
import qualified Unison.Codebase.ShortCausalHash as SCH
|
||||
import qualified Unison.HashQualified as HQ
|
||||
@ -67,7 +67,7 @@ noSuchNamespace :: HashQualifiedName -> ServerError
|
||||
noSuchNamespace namespace =
|
||||
err404 {errBody = "The namespace " <> munge namespace <> " does not exist."}
|
||||
|
||||
couldntLoadBranch :: Causal.CausalHash -> ServerError
|
||||
couldntLoadBranch :: CausalHash -> ServerError
|
||||
couldntLoadBranch h =
|
||||
err404
|
||||
{ errBody =
|
||||
|
@ -39,9 +39,8 @@ import Servant.Docs (DocCapture (..), DocQueryParam (..), ParamKind (..), ToPara
|
||||
import qualified Servant.Docs as Docs
|
||||
import qualified U.Codebase.Branch as V2Branch
|
||||
import qualified U.Codebase.Causal as V2Causal
|
||||
import qualified U.Codebase.HashTags as V2
|
||||
import U.Codebase.HashTags
|
||||
import qualified Unison.Codebase.Branch as Branch
|
||||
import qualified Unison.Codebase.Causal as Causal
|
||||
import Unison.Codebase.Editor.DisplayObject
|
||||
( DisplayObject,
|
||||
)
|
||||
@ -316,8 +315,8 @@ setCacheControl = addHeader @"Cache-Control" "public"
|
||||
|
||||
branchToUnisonHash :: Branch.Branch m -> UnisonHash
|
||||
branchToUnisonHash b =
|
||||
("#" <>) . Hash.base32Hex . Causal.unCausalHash $ Branch.headHash b
|
||||
("#" <>) . Hash.base32Hex . unCausalHash $ Branch.headHash b
|
||||
|
||||
v2CausalBranchToUnisonHash :: V2Branch.CausalBranch m -> UnisonHash
|
||||
v2CausalBranchToUnisonHash b =
|
||||
("#" <>) . Hash.base32Hex . V2.unCausalHash $ V2Causal.causalHash b
|
||||
("#" <>) . Hash.base32Hex . unCausalHash $ V2Causal.causalHash b
|
||||
|
@ -101,6 +101,7 @@ library
|
||||
, transformers
|
||||
, unison-codebase
|
||||
, unison-codebase-sqlite
|
||||
, unison-core
|
||||
, unison-core1
|
||||
, unison-hash
|
||||
, unison-hash-orphans-aeson
|
||||
|
@ -1,27 +1,28 @@
|
||||
|
||||
Each 111202 # 111.202ms
|
||||
List.map 38240 # 38.24ms
|
||||
List.filter 39300 # 39.3ms
|
||||
random 80965 # 80.965ms
|
||||
simple_loop 93465 # 93.465ms
|
||||
fibonacci 48050 # 48.05ms
|
||||
Map 50077 # 50.077ms
|
||||
NatMap 54566 # 54.566ms
|
||||
stm_loop 241047 # 241.047ms
|
||||
encodeNat64be 40531 # 40.531ms
|
||||
TMap 893535 # 893.535ms
|
||||
TMap2 2439804 # 2.439804s
|
||||
TMap3 1475987 # 1.475987s
|
||||
TMap4 1767079 # 1.767079s
|
||||
TMap.empty 119670 # 119.67ms
|
||||
TVar Map concurrent (2) 3158616 # 3.158616s
|
||||
TVar Map concurrent (4) 5732858 # 5.732858s
|
||||
TVar Map concurrent (8) 12333688 # 12.333688s
|
||||
TVar Map concurrent (16) 25708170 # 25.70817s
|
||||
TVar Map concurrent (32) 55115180 # 55.11518s
|
||||
TMap.concurrent(2) 1098109 # 1.098109s
|
||||
TMap.concurrent(4) 1272848 # 1.272848s
|
||||
TMap.concurrent(8) 3273686 # 3.273686s
|
||||
TMap.concurrent(16) 5473991 # 5.473991s
|
||||
TMap.concurrent(32) 11992583 # 11.992583s
|
||||
array_sort 103266 # 103.266ms
|
||||
Each 117847 # 117.847ms
|
||||
List.map 40716 # 40.716ms
|
||||
List.filter 41946 # 41.946ms
|
||||
random 89320 # 89.32ms
|
||||
simple_loop 103033 # 103.033ms
|
||||
fibonacci 52511 # 52.511ms
|
||||
Map 54995 # 54.995ms
|
||||
NatMap 59753 # 59.753ms
|
||||
stm_loop 258013 # 258.013ms
|
||||
encodeNat64be 44693 # 44.693ms
|
||||
forkbomb (40k threads) 875093 # 875.093ms
|
||||
TMap 1023223 # 1.023223s
|
||||
TMap2 2816747 # 2.816747s
|
||||
TMap3 1683270 # 1.68327s
|
||||
TMap4 2031843 # 2.031843s
|
||||
TMap.empty 140388 # 140.388ms
|
||||
TVar Map concurrent (2) 3576610 # 3.57661s
|
||||
TVar Map concurrent (4) 6386835 # 6.386835s
|
||||
TVar Map concurrent (8) 12993929 # 12.993929s
|
||||
TVar Map concurrent (16) 27345687 # 27.345687s
|
||||
TVar Map concurrent (32) 60121265 # 1m
|
||||
TMap.concurrent(2) 1235590 # 1.23559s
|
||||
TMap.concurrent(4) 1501582 # 1.501582s
|
||||
TMap.concurrent(8) 3565150 # 3.56515s
|
||||
TMap.concurrent(16) 6214075 # 6.214075s
|
||||
TMap.concurrent(32) 12510994 # 12.510994s
|
||||
array_sort 141998 # 141.998ms
|
@ -3,6 +3,7 @@ N = 20000
|
||||
|
||||
main = do
|
||||
_baseline = timeit "encodeNat64be" '(baseline 0xs N)
|
||||
_a0 = timeit "forkbomb (40k threads)" '(forkbomb 40000)
|
||||
_a1 = timeit "TMap" '(go (atomically TMap.empty) N)
|
||||
_a2 = timeit "TMap2" '(go2 (atomically TMap2.empty) N)
|
||||
_a3 = timeit "TMap3" '(go3 (atomically TMap3.empty) N)
|
||||
@ -64,6 +65,14 @@ gos_TVar_Map k m n = match k with
|
||||
gos_TVar_Map (k-1) m n
|
||||
MVar.take lock
|
||||
|
||||
forkbomb k = match k with
|
||||
0 -> ()
|
||||
_ ->
|
||||
lock = !MVar.newEmpty
|
||||
goWrap = do MVar.put lock ()
|
||||
tid = fork '(catch goWrap)
|
||||
forkbomb (k-1)
|
||||
MVar.take lock
|
||||
|
||||
go2 m n =
|
||||
if n == 0 then atomically '(TMap2.lookup (encodeNat64be n) m)
|
||||
|
44
unison-src/transcripts/diff-namespace-to-patch.md
Normal file
44
unison-src/transcripts/diff-namespace-to-patch.md
Normal file
@ -0,0 +1,44 @@
|
||||
We can create a patch from the diff between two namespaces.
|
||||
|
||||
```ucm:hide
|
||||
.> builtins.merge
|
||||
```
|
||||
|
||||
```unison:hide
|
||||
one.a = 1
|
||||
one.b = 2
|
||||
oneconflicts.b = 20
|
||||
one.c = 3
|
||||
one.d = 4
|
||||
one.e = 4
|
||||
|
||||
two.a = 100
|
||||
two.b = 200
|
||||
two.c = 300
|
||||
twoconflicts.c = 30
|
||||
two.d = 5
|
||||
two.e = 6
|
||||
```
|
||||
|
||||
```ucm:hide
|
||||
.> add
|
||||
.> merge oneconflicts one
|
||||
.> merge twoconflicts two
|
||||
.> delete.namespace oneconflicts
|
||||
.> delete.namespace twoconflicts
|
||||
```
|
||||
|
||||
```ucm
|
||||
.> find one.
|
||||
.> find two.
|
||||
.> diff.namespace.to-patch one two thepatch
|
||||
```
|
||||
|
||||
A summary of the diff:
|
||||
|
||||
* `one.a` -> `two.a` is a normal update.
|
||||
* Even though `one.b` is conflicted, both `one.b#hash1` and `one.b#hash2` get mapped to `two.b`.
|
||||
* Because `two.c` is conflicted, `one.c` doesn't end up on the left-hand side of the patch.
|
||||
* Oops, a similar case slipped by - `one.d` and `one.e` map to `two.d` and `two.e` respectively, but because `one.d` and
|
||||
`one.e` were aliases, we end up with a busted patch that isn't a function. This is a bug.
|
||||
* Neither `one.f` nor `two.g` end up in the patch because the names `f` and `g` are not common to both namespaces.
|
60
unison-src/transcripts/diff-namespace-to-patch.output.md
Normal file
60
unison-src/transcripts/diff-namespace-to-patch.output.md
Normal file
@ -0,0 +1,60 @@
|
||||
We can create a patch from the diff between two namespaces.
|
||||
|
||||
```unison
|
||||
one.a = 1
|
||||
one.b = 2
|
||||
oneconflicts.b = 20
|
||||
one.c = 3
|
||||
one.d = 4
|
||||
one.e = 4
|
||||
|
||||
two.a = 100
|
||||
two.b = 200
|
||||
two.c = 300
|
||||
twoconflicts.c = 30
|
||||
two.d = 5
|
||||
two.e = 6
|
||||
```
|
||||
|
||||
```ucm
|
||||
.> find one.
|
||||
|
||||
1. one.a : Nat
|
||||
2. one.b#cp6 : Nat
|
||||
3. one.b#dcg : Nat
|
||||
4. one.c : Nat
|
||||
5. one.d : Nat
|
||||
|
||||
|
||||
.> find two.
|
||||
|
||||
1. two.a : Nat
|
||||
2. two.b : Nat
|
||||
3. two.c#k86 : Nat
|
||||
4. two.c#qpo : Nat
|
||||
5. two.d : Nat
|
||||
6. two.e : Nat
|
||||
|
||||
|
||||
.> diff.namespace.to-patch one two thepatch
|
||||
|
||||
Edited Terms:
|
||||
1. one.b#cp6ri8mtg0 -> 6. two.b
|
||||
2. one.b#dcgdua2lj6 -> 7. two.b
|
||||
3. one.a -> 8. two.a
|
||||
4. one.d -> 9. two.d
|
||||
5. one.d -> 10. two.e
|
||||
|
||||
Tip: To remove entries from a patch, use
|
||||
delete.term-replacement or delete.type-replacement, as
|
||||
appropriate.
|
||||
|
||||
```
|
||||
A summary of the diff:
|
||||
|
||||
* `one.a` -> `two.a` is a normal update.
|
||||
* Even though `one.b` is conflicted, both `one.b#hash1` and `one.b#hash2` get mapped to `two.b`.
|
||||
* Because `two.c` is conflicted, `one.c` doesn't end up on the left-hand side of the patch.
|
||||
* Oops, a similar case slipped by - `one.d` and `one.e` map to `two.d` and `two.e` respectively, but because `one.d` and
|
||||
`one.e` were aliases, we end up with a busted patch that isn't a function. This is a bug.
|
||||
* Neither `one.f` nor `two.g` end up in the patch because the names `f` and `g are not common to both namespaces.
|
@ -13,6 +13,7 @@ dependencies:
|
||||
- megaparsec
|
||||
- mtl
|
||||
- text
|
||||
- unison-core
|
||||
- unison-core1
|
||||
- unison-hash
|
||||
- unison-prelude
|
||||
|
@ -66,6 +66,7 @@ library
|
||||
, megaparsec
|
||||
, mtl
|
||||
, text
|
||||
, unison-core
|
||||
, unison-core1
|
||||
, unison-hash
|
||||
, unison-prelude
|
||||
@ -119,6 +120,7 @@ test-suite syntax-tests
|
||||
, megaparsec
|
||||
, mtl
|
||||
, text
|
||||
, unison-core
|
||||
, unison-core1
|
||||
, unison-hash
|
||||
, unison-prelude
|
||||
|
Loading…
Reference in New Issue
Block a user