mirror of
https://github.com/unisonweb/unison.git
synced 2024-09-21 23:37:23 +03:00
fix up merge compilation errors
and formatting differences
This commit is contained in:
parent
63fc75416c
commit
acff5af2be
@ -23,6 +23,7 @@ import qualified Data.Text.Lazy as TL
|
||||
import qualified Data.Text.Lazy.IO as TL
|
||||
import Data.Void
|
||||
import Text.Pretty.Simple
|
||||
import U.Codebase.HashTags (BranchHash (..))
|
||||
import qualified U.Codebase.Sqlite.Branch.Full as DBBranch
|
||||
import qualified U.Codebase.Sqlite.DbId as DB
|
||||
import qualified U.Codebase.Sqlite.Operations as Ops
|
||||
@ -51,11 +52,11 @@ data IntegrityError
|
||||
| -- (causal hash, branch hash)
|
||||
DetectedCausalsWithoutCorrespondingBranchObjects (NESet (Hash, Hash))
|
||||
| DetectedCausalsWithCausalHashAsBranchHash (NESet Hash)
|
||||
| DetectedBranchErrors Hash (NESet BranchError)
|
||||
| DetectedBranchErrors BranchHash (NESet BranchError)
|
||||
deriving stock (Show, Eq, Ord)
|
||||
|
||||
data BranchError
|
||||
= IncorrectHashForBranch Hash Hash
|
||||
= IncorrectHashForBranch BranchHash BranchHash
|
||||
| MismatchedObjectForChild Hash DB.BranchObjectId DB.BranchObjectId
|
||||
| MissingObjectForChildCausal Hash
|
||||
| MissingObject DB.BranchObjectId
|
||||
@ -151,7 +152,7 @@ integrityCheckAllBranches = do
|
||||
integrityCheckBranch objId = do
|
||||
dbBranch <- Ops.expectDbBranch objId
|
||||
expectedBranchHash <- Helpers.dbBranchHash dbBranch
|
||||
actualBranchHash <- Q.expectPrimaryHashByObjectId (DB.unBranchObjectId objId)
|
||||
actualBranchHash <- BranchHash <$> Q.expectPrimaryHashByObjectId (DB.unBranchObjectId objId)
|
||||
branchHashCheck <- assertExpectedBranchHash expectedBranchHash actualBranchHash
|
||||
branchChildChecks <- flip foldMapM (toListOf DBBranch.childrenHashes_ dbBranch) $ \(childObjId, childCausalHashId) -> do
|
||||
let checks =
|
||||
@ -164,7 +165,7 @@ integrityCheckAllBranches = do
|
||||
Nothing -> pure NoIntegrityErrors
|
||||
Just errs -> pure . IntegrityErrorDetected . NESet.singleton $ DetectedBranchErrors actualBranchHash errs
|
||||
where
|
||||
assertExpectedBranchHash :: Hash -> Hash -> Sqlite.Transaction (Set BranchError)
|
||||
assertExpectedBranchHash :: BranchHash -> BranchHash -> Sqlite.Transaction (Set BranchError)
|
||||
assertExpectedBranchHash expectedBranchHash actualBranchHash = do
|
||||
if (expectedBranchHash /= actualBranchHash)
|
||||
then do
|
||||
@ -236,7 +237,7 @@ prettyPrintIntegrityErrors xs
|
||||
(P.commas (prettyHash <$> toList ns))
|
||||
DetectedBranchErrors bh errs ->
|
||||
P.hang
|
||||
("Detected errors in branch: " <> prettyHash bh)
|
||||
("Detected errors in branch: " <> prettyHash (unBranchHash bh))
|
||||
(P.lines . fmap (<> "\n") . fmap prettyBranchError . toList $ errs)
|
||||
)
|
||||
& fmap (<> "\n")
|
||||
@ -252,7 +253,7 @@ prettyPrintIntegrityErrors xs
|
||||
prettyBranchError :: BranchError -> P.Pretty P.ColorText
|
||||
prettyBranchError =
|
||||
P.wrap . \case
|
||||
IncorrectHashForBranch expected actual -> "The Branch hash for this branch is incorrect. Expected Hash: " <> prettyHash expected <> ", Actual Hash: " <> prettyHash actual
|
||||
IncorrectHashForBranch expected actual -> "The Branch hash for this branch is incorrect. Expected Hash: " <> prettyHash (unBranchHash expected) <> ", Actual Hash: " <> prettyHash (unBranchHash actual)
|
||||
MismatchedObjectForChild ha obj1 obj2 ->
|
||||
"The child with causal hash: " <> prettyHash ha <> " is mapped to object ID " <> prettyBranchObjectId obj1 <> " but should map to " <> prettyBranchObjectId obj2 <> "."
|
||||
MissingObjectForChildCausal ha ->
|
||||
|
@ -43,7 +43,7 @@ migrations getDeclType termBuffer declBuffer =
|
||||
[ (2, migrateSchema1To2 getDeclType termBuffer declBuffer),
|
||||
(3, migrateSchema2To3),
|
||||
(4, migrateSchema3To4),
|
||||
(5, migrateSchema4To5),
|
||||
(5, migrateSchema4To5)
|
||||
]
|
||||
|
||||
-- | Migrates a codebase up to the most recent version known to ucm.
|
||||
|
@ -12,7 +12,6 @@ import Data.Semigroup
|
||||
import qualified Data.Set as Set
|
||||
import Data.Set.Lens (setOf)
|
||||
import Data.String.Here.Uninterpolated (here)
|
||||
import qualified U.Codebase.HashTags as H
|
||||
import qualified U.Codebase.Sqlite.Branch.Format as S.BranchFormat
|
||||
import qualified U.Codebase.Sqlite.Branch.Full as DBBranch
|
||||
import qualified U.Codebase.Sqlite.DbId as DB
|
||||
@ -230,7 +229,7 @@ rehashAndCanonicalizeNamespace causalHashId possiblyIncorrectNamespaceHashId obj
|
||||
liftT $ replaceBranch objId remappedBranch
|
||||
correctNamespaceHash <- liftT $ Helpers.dbBranchHash remappedBranch
|
||||
liftT . debugLog $ "Correct namespace hash: " <> show correctNamespaceHash
|
||||
correctNamespaceHashId <- liftT $ Q.saveBranchHash (H.BranchHash correctNamespaceHash)
|
||||
correctNamespaceHashId <- liftT $ Q.saveBranchHash correctNamespaceHash
|
||||
|
||||
when (correctNamespaceHashId == possiblyIncorrectNamespaceHashId) $ do
|
||||
-- If the existing hash for this namespace was already correct, we don't need to
|
||||
|
@ -2271,7 +2271,7 @@ importRemoteShareBranch ReadShareRemoteNamespace {server, repo, path} =
|
||||
liftIO (Share.pull authHTTPClient (shareRepoToBaseUrl server) connection shareFlavoredPath) >>= \case
|
||||
Left e -> pure (Left (Output.ShareErrorPull e))
|
||||
Right causalHash -> do
|
||||
(eval . Eval) (Codebase.getBranchForHash codebase (Cv.branchHash2to1 causalHash)) >>= \case
|
||||
(eval . Eval) (Codebase.getBranchForHash codebase (Cv.causalHash2to1 causalHash)) >>= \case
|
||||
Nothing -> error $ reportBug "E412939" "`pull` \"succeeded\", but I can't find the result in the codebase. (This is a bug.)"
|
||||
Just branch -> pure (Right branch)
|
||||
|
||||
|
Loading…
Reference in New Issue
Block a user