unisonweb/unison
1
0
Fork 0
mirror of https://github.com/unisonweb/unison.git synced 2024-10-05 06:07:21 +03:00
Code Issues Projects Releases Wiki Activity

Merge pull request #3692 from unisonweb/22-12-12-hash-tags-in-core

Browse Source 
Cleanup: share hash tags newtypes in codebase/parser-typechecker
This commit is contained in:
Mitchell Rosen 2022-12-14 17:42:46 -05:00 committed by GitHub
commit 2dbb867a3c
No known key found for this signature in database
GPG Key ID: 4AEE18F83AFDEB23
36 changed files with 173 additions and 224 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

1
codebase2/codebase/U/Codebase/Branch/Type.hs
View File

@ -9,7 +9,6 @@ module U.Codebase.Branch.Type
MetadataValue,
MdValues (..),
NameSegment (..),
CausalHash,
NamespaceStats (..),
hasDefinitions,
childAt,

1
codebase2/codebase/unison-codebase.cabal
View File

@ -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

11
codebase2/codebase/U/Codebase/HashTags.hs → codebase2/core/U/Codebase/HashTags.hs
View File

@ -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) ++ ")"

1
codebase2/core/package.yaml
View File

@ -12,6 +12,7 @@ dependencies:
- containers
- vector
- unison-util
- unison-util-base32hex
default-extensions:
- ApplicativeDo

2
codebase2/core/unison-core.cabal
View File

@ -16,6 +16,7 @@ source-repository head
library
exposed-modules:
U.Codebase.HashTags
U.Core.ABT
U.Core.ABT.Var
hs-source-dirs:
@ -50,5 +51,6 @@ library
base
, containers
, unison-util
, unison-util-base32hex
, vector
default-language: Haskell2010

7
parser-typechecker/src/Unison/Codebase.hs
View File

@ -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
@ -231,7 +232,7 @@ getShallowBranchAtPath path mayBranch = do
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)

23
parser-typechecker/src/Unison/Codebase/Branch.hs
View File

@ -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)

10
parser-typechecker/src/Unison/Codebase/Branch/Merge.hs
View File

@ -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)

13
parser-typechecker/src/Unison/Codebase/Branch/Type.hs
View File

@ -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})

3
parser-typechecker/src/Unison/Codebase/BranchDiff.hs
View File

@ -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

3
parser-typechecker/src/Unison/Codebase/Causal.hs
View File

@ -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,

5
parser-typechecker/src/Unison/Codebase/Causal/FoldHistory.hs
View File

@ -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

9
parser-typechecker/src/Unison/Codebase/Causal/Type.hs
View File

@ -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

25
parser-typechecker/src/Unison/Codebase/SqliteCodebase.hs
View File

@ -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
@ -285,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})
@ -301,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)
@ -433,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]
@ -460,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)
@ -471,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
@ -670,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 ()
@ -679,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.

9
parser-typechecker/src/Unison/Codebase/SqliteCodebase/Branch/Dependencies.hs
View File

@ -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

53
parser-typechecker/src/Unison/Codebase/SqliteCodebase/Conversions.hs
View File

@ -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
@ -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)
@ -470,8 +459,8 @@ 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 V1.NameSegment (PatchHash, m V1.Patch) -> Map V2.Branch.NameSegment (PatchHash, m V2.Branch.Patch)
doPatches = Map.bimap namesegment1to2 (fmap (fmap patch1to2))
doChildren :: Map V1.NameSegment (V1.Branch.Branch m) -> Map V2.Branch.NameSegment (V2.Branch.CausalBranch m)
doChildren = Map.bimap namesegment1to2 causalbranch1to2
@ -519,12 +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
@ -543,7 +526,7 @@ branch2to1 branchCache lookupCT (V2.Branch.Branch v2terms v2types v2patches v2ch
v1children <- Map.bitraverse (pure . namesegment2to1) (causalbranch2to1 branchCache lookupCT) v2children
pure $ V1.Branch.branch0 v1terms v1types v1children v1patches
where
v1patches = Map.bimap namesegment2to1 (bimap edithash2to1 (fmap patch2to1)) v2patches
v1patches = Map.bimap namesegment2to1 (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

43
parser-typechecker/src/Unison/Codebase/SqliteCodebase/Operations.hs
View File

@ -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)
@ -36,7 +36,6 @@ 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
@ -400,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
@ -414,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 =
@ -554,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
@ -577,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.

7
parser-typechecker/src/Unison/Codebase/Type.hs
View File

@ -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)
@ -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.
--
@ -144,7 +143,7 @@ data GitPushBehavior
data GitError
= GitProtocolError GitProtocolError
| GitCodebaseError (GitCodebaseError Branch.CausalHash)
| GitCodebaseError (GitCodebaseError CausalHash)
| GitSqliteCodebaseError GitSqliteCodebaseError
deriving (Show)

14
parser-typechecker/src/Unison/Hashing/V2/Convert.hs
View File

@ -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
@ -360,12 +360,12 @@ hashPatch = Hashing.Patch.hashPatch . m2hPatch
hashBranch0 :: Memory.Branch.Branch0 m -> Hash
hashBranch0 = Hashing.Branch.hashBranch . m2hBranch0
hashCausal :: Hashable e => e -> Set Memory.Causal.CausalHash -> (Memory.Causal.CausalHash, HashFor e)
hashCausal :: Hashable e => e -> Set CausalHash -> (CausalHash, HashFor e)
hashCausal e tails =
let valueHash@(HashFor vh) = (Hashable.hashFor e)
causalHash =
Memory.Causal.CausalHash . Hashing.Causal.hashCausal $
Hashing.Causal.Causal vh (Set.map Memory.Causal.unCausalHash tails)
CausalHash . Hashing.Causal.hashCausal $
Hashing.Causal.Causal vh (Set.map unCausalHash tails)
in (causalHash, valueHash)
m2hBranch0 :: Memory.Branch.Branch0 m -> Hashing.Branch.Raw
@ -411,14 +411,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.Branch.NameSegment Hash
doPatches = Map.bimap m2hNameSegment fst
doPatches = Map.bimap m2hNameSegment (unPatchHash . fst)
doChildren ::
Map Memory.NameSegment.NameSegment (Memory.Branch.Branch m) ->
Map Hashing.Branch.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.Branch.NameSegment
m2hNameSegment (Memory.NameSegment.NameSegment s) = Hashing.Branch.NameSegment s

1
unison-cli/package.yaml
View File

@ -71,6 +71,7 @@ dependencies:
- unison-codebase-sqlite
- unison-codebase-sqlite-hashing-v2
- unison-sqlite
- unison-core
- unison-core1
- unison-parser-typechecker
- unison-prelude

6
unison-cli/src/Unison/Cli/Monad.hs
View File

@ -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,

11
unison-cli/src/Unison/Cli/MonadUtils.hs
View File

@ -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

13
unison-cli/src/Unison/Codebase/Editor/HandleInput.hs
View File

@ -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))
@ -1343,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
@ -1351,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))
@ -1411,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)
@ -2267,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.

4
unison-cli/src/Unison/Codebase/Editor/Input.hs
View File

@ -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"

14
unison-cli/src/Unison/Codebase/Editor/Output.hs
View File

@ -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

11
unison-cli/src/Unison/Codebase/Editor/Output/DumpNamespace.hs
View File

@ -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)

23
unison-cli/src/Unison/CommandLine/OutputMessages.hs
View File

@ -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 =

5
unison-cli/unison-cli.cabal
View File

@ -184,6 +184,7 @@ library
, unison-codebase
, unison-codebase-sqlite
, unison-codebase-sqlite-hashing-v2
, unison-core
, unison-core1
, unison-parser-typechecker
, unison-prelude
@ -310,6 +311,7 @@ executable cli-integration-tests
, unison-codebase
, unison-codebase-sqlite
, unison-codebase-sqlite-hashing-v2
, unison-core
, unison-core1
, unison-parser-typechecker
, unison-prelude
@ -430,6 +432,7 @@ executable transcripts
, unison-codebase
, unison-codebase-sqlite
, unison-codebase-sqlite-hashing-v2
, unison-core
, unison-core1
, unison-parser-typechecker
, unison-prelude
@ -557,6 +560,7 @@ executable unison
, unison-codebase
, unison-codebase-sqlite
, unison-codebase-sqlite-hashing-v2
, unison-core
, unison-core1
, unison-parser-typechecker
, unison-prelude
@ -687,6 +691,7 @@ test-suite cli-tests
, unison-codebase
, unison-codebase-sqlite
, unison-codebase-sqlite-hashing-v2
, unison-core
, unison-core1
, unison-parser-typechecker
, unison-prelude

1
unison-share-api/package.yaml
View File

@ -42,6 +42,7 @@ dependencies:
- transformers
- unison-codebase
- unison-codebase-sqlite
- unison-core
- unison-core1
- unison-parser-typechecker
- unison-prelude

29
unison-share-api/src/Unison/Server/Backend.hs
View File

@ -31,6 +31,7 @@ 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
@ -42,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)
@ -120,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)
@ -142,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)
@ -571,7 +571,7 @@ lsBranch codebase b0 = do
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 (Cv.namesegment2to1 ns) (V2Causal.causalHash $ h) stats
patchEntries :: [ShallowListEntry Symbol Ann] = do
(ns, _h) <- Map.toList $ V2Branch.patches b0
pure $ ShallowPatchEntry (Cv.namesegment2to1 ns)
@ -784,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
@ -796,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
@ -831,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 ->
@ -844,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
@ -1134,12 +1134,11 @@ scopedNamesForBranchHash codebase mbh path = do
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)
@ -1160,14 +1159,14 @@ scopedNamesForBranchHash codebase mbh path = do
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
@ -1186,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?)

2
unison-share-api/src/Unison/Server/Endpoints/FuzzyFind.hs
View File

@ -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

18
unison-share-api/src/Unison/Server/Endpoints/NamespaceListing.hs
View File

@ -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

7
unison-share-api/src/Unison/Server/Endpoints/Projects.hs
View File

@ -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

4
unison-share-api/src/Unison/Server/Errors.hs
View File

@ -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 =

7
unison-share-api/src/Unison/Server/Types.hs
View File

@ -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

1
unison-share-api/unison-share-api.cabal
View File

@ -101,6 +101,7 @@ library
, transformers
, unison-codebase
, unison-codebase-sqlite
, unison-core
, unison-core1
, unison-parser-typechecker
, unison-prelude