mirror of
https://github.com/unisonweb/unison.git
synced 2024-09-20 14:57:41 +03:00
Pairing checkpoint
This commit is contained in:
parent
502b89f6d5
commit
d761a5eb2c
@ -1,10 +1,12 @@
|
||||
{-# LANGUAGE RankNTypes #-}
|
||||
{-# LANGUAGE ScopedTypeVariables #-}
|
||||
{-# LANGUAGE TypeApplications #-}
|
||||
{-# LANGUAGE DataKinds #-}
|
||||
{-# LANGUAGE DeriveGeneric #-}
|
||||
{-# LANGUAGE RecordWildCards #-}
|
||||
|
||||
module U.Codebase.Sqlite.Branch.Full where
|
||||
|
||||
import Data.Map (Map)
|
||||
import Data.Set (Set)
|
||||
import U.Codebase.Reference (Reference')
|
||||
import U.Codebase.Referent (Referent')
|
||||
import U.Codebase.Sqlite.DbId (BranchObjectId, CausalHashId, ObjectId, PatchObjectId, TextId)
|
||||
@ -12,6 +14,8 @@ import U.Codebase.Sqlite.LocalIds (LocalBranchChildId, LocalDefnId, LocalPatchOb
|
||||
import qualified U.Util.Map as Map
|
||||
import Data.Bifunctor (Bifunctor(bimap))
|
||||
import qualified Data.Set as Set
|
||||
import Control.Lens (Traversal)
|
||||
import Unison.Prelude
|
||||
|
||||
type LocalBranch = Branch' LocalTextId LocalDefnId LocalPatchObjectId LocalBranchChildId
|
||||
|
||||
@ -25,8 +29,61 @@ data Branch' t h p c = Branch
|
||||
patches :: Map t p,
|
||||
children :: Map t c
|
||||
}
|
||||
deriving Show
|
||||
deriving (Show, Generic)
|
||||
|
||||
branchHashes_ :: Traversal (Branch' t h p c) (Branch' t h' p c) h h'
|
||||
branchHashes_ _f _ = undefined
|
||||
-- Branch <$> traverse (\m -> Map.mapKeys)
|
||||
|
||||
branchCausalHashes_ :: Traversal (Branch' t h p c) (Branch' t h p c') c c'
|
||||
branchCausalHashes_ f Branch{..} =
|
||||
Branch terms types patches <$> traverse f children
|
||||
|
||||
|
||||
-- convertBranch :: (DB m, MonadState MigrationState m) => DbBranch -> m DbBranch
|
||||
-- convertBranch dbBranch = _
|
||||
|
||||
-- DbBranch -- migrate --> DbBranch -- hydrate for the hash --> Hashing.V2.Branch -- put (Hash, toBranchFormat(DbBranch)) --> COOL
|
||||
|
||||
-- function that reads a DbBranch out of codebase
|
||||
|
||||
-- Traversal' DbBranch SomeReferenceObjectId
|
||||
-- DB m => LensLike' m SomeReferenceObjectId SomeReferenceId
|
||||
-- MonadState MigrationState m => SomeReferenceId -> m SomeReferenceId
|
||||
|
||||
-- Traversal' DbBranch (BranchId, CausalHashId)
|
||||
-- MonadState MigrationState m => (BranchId, CausalHashId) -> m (BranchId, CausalHashId)
|
||||
|
||||
-- Traversal' DbBranch PatchId
|
||||
-- MonadState MigrationState m => PatchObjectId -> m PatchObjectId
|
||||
|
||||
-- totalThing :: (MonadState MigrationState DB m => LensLike' m DbBranch SomeReferenceId
|
||||
-- totalThing = intoHashes . overSomeRefs
|
||||
|
||||
-- Store (Old ObjectId) -> (New ObjectId) sky map
|
||||
-- Store (New ObjectId) -> (New Hash) map/cache
|
||||
|
||||
-- function which lifts a function over SomeReference's to run over a DBBranch by inflating Hashes
|
||||
-- function which remaps references in a Branch
|
||||
|
||||
-- function that takes DbBranch to (LocalIds, LocalBranch)
|
||||
|
||||
-- function that takes a DbBranch to a Hashing.V2.Branch
|
||||
|
||||
-- function that writes (Hash, LocalBranch) to codebase
|
||||
|
||||
-- database has a root CausalHashId
|
||||
-- from CausalHashId, we can look up ValueHashId and
|
||||
--
|
||||
-- old object id --db--> old hash --mem--> new hash --db--> new object id
|
||||
|
||||
--
|
||||
-- Branch
|
||||
-- { terms :: Map TextId (Map (Referent'' TextId ObjectId) (MetadataSetFormat' TextId ObjectId)),
|
||||
-- types :: Map TextId (Map (Reference' TextId ObjectId) (MetadataSetFormat' TextId ObjectId)),
|
||||
-- patches :: Map TextId PatchObjectId,
|
||||
-- children :: Map TextId (BranchObjectId, CausalHashId)
|
||||
-- }
|
||||
|
||||
|
||||
type LocalMetadataSet = MetadataSetFormat' LocalTextId LocalDefnId
|
||||
|
25
codebase2/codebase-sqlite/U/Codebase/Sqlite/Causal.hs
Normal file
25
codebase2/codebase-sqlite/U/Codebase/Sqlite/Causal.hs
Normal file
@ -0,0 +1,25 @@
|
||||
{-# LANGUAGE RecordWildCards #-}
|
||||
module U.Codebase.Sqlite.Causal where
|
||||
|
||||
import Unison.Prelude
|
||||
|
||||
data GDbCausal causalHash valueHash =
|
||||
DbCausal { selfHash :: causalHash, valueHash :: valueHash, parents :: Set causalHash }
|
||||
|
||||
-- type DbCausal = GDbCausal CausalHashId BranchHashId
|
||||
|
||||
-- causalHashes_ :: Traversal (GDbCausal ch vh) (GDbCausal ch' vh) ch ch'
|
||||
-- causalHashes_ f DbCausal {..} =
|
||||
-- DbCausal <$> f selfHash <*> pure valueHash <*> (fmap Set.fromList . traverse f . Set.toList $ parents)
|
||||
|
||||
-- valueHashes_ :: Lens (GDbCausal ch vh) (GDbCausal ch vh) vh vh'
|
||||
-- valueHashes_ f DbCausal{..} =
|
||||
-- (\p vh -> DbCausal selfHash vh p) parents <$> f valueHash
|
||||
|
||||
|
||||
-- data Causal m hc he e = Causal
|
||||
-- { causalHash :: hc,
|
||||
-- valueHash :: he,
|
||||
-- parents :: Map hc (m (Causal m hc he e)),
|
||||
-- value :: m e
|
||||
-- }
|
@ -1,6 +1,22 @@
|
||||
name: unison-codebase-sqlite
|
||||
github: unisonweb/unison
|
||||
|
||||
default-extensions:
|
||||
- ApplicativeDo
|
||||
- BlockArguments
|
||||
- DeriveFunctor
|
||||
- DerivingStrategies
|
||||
- DoAndIfThenElse
|
||||
- FlexibleContexts
|
||||
- FlexibleInstances
|
||||
- LambdaCase
|
||||
- MultiParamTypeClasses
|
||||
- NamedFieldPuns
|
||||
- PatternSynonyms
|
||||
- ScopedTypeVariables
|
||||
- TupleSections
|
||||
- TypeApplications
|
||||
|
||||
library:
|
||||
source-dirs: .
|
||||
|
||||
@ -15,6 +31,7 @@ dependencies:
|
||||
- extra
|
||||
- here
|
||||
- lens
|
||||
- generic-lens
|
||||
- monad-validate
|
||||
- mtl
|
||||
- safe
|
||||
@ -26,6 +43,7 @@ dependencies:
|
||||
- unison-codebase
|
||||
- unison-codebase-sync
|
||||
- unison-core
|
||||
- unison-prelude
|
||||
- unison-util
|
||||
- unison-util-serialization
|
||||
- unison-util-term
|
||||
|
@ -4,7 +4,7 @@ cabal-version: 1.12
|
||||
--
|
||||
-- see: https://github.com/sol/hpack
|
||||
--
|
||||
-- hash: 3106bd32bedf162883882818669a81a3e1ca7c60af26ec9cd945fadb39f0d5aa
|
||||
-- hash: 4227133c6f1df043f279939d16c10379d28386b6b9604af6c8e17bd0a87748ce
|
||||
|
||||
name: unison-codebase-sqlite
|
||||
version: 0.0.0
|
||||
@ -23,6 +23,7 @@ library
|
||||
U.Codebase.Sqlite.Branch.Diff
|
||||
U.Codebase.Sqlite.Branch.Format
|
||||
U.Codebase.Sqlite.Branch.Full
|
||||
U.Codebase.Sqlite.Causal
|
||||
U.Codebase.Sqlite.Connection
|
||||
U.Codebase.Sqlite.DbId
|
||||
U.Codebase.Sqlite.Decl.Format
|
||||
@ -46,12 +47,28 @@ library
|
||||
Paths_unison_codebase_sqlite
|
||||
hs-source-dirs:
|
||||
./
|
||||
default-extensions:
|
||||
ApplicativeDo
|
||||
BlockArguments
|
||||
DeriveFunctor
|
||||
DerivingStrategies
|
||||
DoAndIfThenElse
|
||||
FlexibleContexts
|
||||
FlexibleInstances
|
||||
LambdaCase
|
||||
MultiParamTypeClasses
|
||||
NamedFieldPuns
|
||||
PatternSynonyms
|
||||
ScopedTypeVariables
|
||||
TupleSections
|
||||
TypeApplications
|
||||
build-depends:
|
||||
base
|
||||
, bytes
|
||||
, bytestring
|
||||
, containers
|
||||
, extra
|
||||
, generic-lens
|
||||
, here
|
||||
, lens
|
||||
, monad-validate
|
||||
@ -63,6 +80,7 @@ library
|
||||
, unison-codebase
|
||||
, unison-codebase-sync
|
||||
, unison-core
|
||||
, unison-prelude
|
||||
, unison-util
|
||||
, unison-util-serialization
|
||||
, unison-util-term
|
||||
|
@ -6,6 +6,7 @@ default-extensions:
|
||||
- ApplicativeDo
|
||||
- BlockArguments
|
||||
- DeriveFunctor
|
||||
- DeriveGeneric
|
||||
- DerivingStrategies
|
||||
- DoAndIfThenElse
|
||||
- FlexibleContexts
|
||||
|
@ -47,6 +47,7 @@ import qualified Unison.Type as Type
|
||||
import Unison.Var (Var)
|
||||
import U.Codebase.HashTags (CausalHash)
|
||||
import qualified U.Codebase.Causal as C
|
||||
import qualified U.Codebase.Sqlite.Branch.Full as S
|
||||
|
||||
-- lookupCtor :: ConstructorMapping -> ObjectId -> Pos -> ConstructorId -> Maybe (Pos, ConstructorId)
|
||||
-- lookupCtor (ConstructorMapping cm) oid pos cid =
|
||||
@ -239,6 +240,13 @@ migrateCausal conn causalHash = runDB conn $ do
|
||||
-- children :: Map NameSegment (Causal m)
|
||||
-- }
|
||||
|
||||
-- data Branch' t h p c = Branch
|
||||
-- { terms :: Map t (Map (Referent'' t h) (MetadataSetFormat' t h)),
|
||||
-- types :: Map t (Map (Reference' t h) (MetadataSetFormat' t h)),
|
||||
-- patches :: Map t p,
|
||||
-- children :: Map t c
|
||||
-- }
|
||||
|
||||
migrateBranch :: Monad m => Connection -> ObjectId -> StateT MigrationState m (Sync.TrySyncResult Entity)
|
||||
migrateBranch conn objectID = fmap (either id id) . runExceptT $ do
|
||||
-- note for tomorrow: we want to just load the (Branch m) instead, forget the DbBranch
|
||||
@ -268,8 +276,29 @@ migrateBranch conn objectID = fmap (either id id) . runExceptT $ do
|
||||
|
||||
-- Migrate branch
|
||||
|
||||
|
||||
error "not implemented"
|
||||
|
||||
dbBranchObjRefs_ :: Traversal' S.DbBranch (SomeReference ObjectId)
|
||||
dbBranchObjRefs_ = _
|
||||
|
||||
-- convertBranch :: (DB m, MonadState MigrationState m) => DbBranch -> m DbBranch
|
||||
-- convertBranch dbBranch = _
|
||||
|
||||
-- DbBranch -- migrate --> DbBranch -- hydrate for the hash --> Hashing.V2.Branch -- put (Hash, toBranchFormat(DbBranch)) --> COOL
|
||||
|
||||
-- function that reads a DbBranch out of codebase
|
||||
|
||||
-- Traversal' DbBranch SomeReferenceObjectId
|
||||
-- DB m => LensLike' m SomeReferenceObjectId SomeReferenceId
|
||||
-- MonadState MigrationState m => SomeReferenceId -> m SomeReferenceId
|
||||
|
||||
-- Traversal' DbBranch (BranchId, CausalHashId)
|
||||
-- MonadState MigrationState m => (BranchId, CausalHashId) -> m (BranchId, CausalHashId)
|
||||
|
||||
-- Traversal' DbBranch PatchId
|
||||
-- MonadState MigrationState m => PatchObjectId -> m PatchObjectId
|
||||
|
||||
|
||||
-- type DbBranch = Branch' TextId ObjectId PatchObjectId (BranchObjectId, CausalHashId)
|
||||
|
||||
|
@ -2,14 +2,23 @@
|
||||
{-# LANGUAGE RankNTypes #-}
|
||||
{-# LANGUAGE RecordWildCards #-}
|
||||
|
||||
module Unison.Hashing.V2.Causal (Causal (..)) where
|
||||
module Unison.Hashing.V2.Causal (Causal (..),
|
||||
hashCausal) where
|
||||
|
||||
import Data.Set (Set)
|
||||
import Unison.Hash (Hash)
|
||||
import Unison.Hashable (Hashable)
|
||||
import qualified Unison.Hashable as H
|
||||
import qualified Data.Set as Set
|
||||
|
||||
data Causal e = Causal {current :: e, parents :: Set Hash}
|
||||
hashCausal :: H.Accumulate h => Causal -> [(H.Token h)]
|
||||
hashCausal c = H.tokens $
|
||||
[ selfHash c
|
||||
, branchHash c
|
||||
] ++ (Set.toList $ parents c)
|
||||
|
||||
instance Hashable e => Hashable (Causal e) where
|
||||
tokens c = H.tokens (current c, parents c)
|
||||
data Causal =
|
||||
Causal { selfHash :: Hash, branchHash :: Hash, parents :: Set Hash }
|
||||
|
||||
instance Hashable Causal where
|
||||
tokens c = hashCausal c
|
||||
|
@ -213,7 +213,7 @@ hashDecls' ::
|
||||
Var v =>
|
||||
Map v (Memory.DD.Decl v a) ->
|
||||
ResolutionResult v a [(v, Memory.Reference.Id, Memory.DD.Decl v a)]
|
||||
hashDecls' memDecls = undefined
|
||||
hashDecls' = undefined
|
||||
|
||||
m2hDecl :: Ord v => Memory.DD.DataDeclaration v a -> Hashing.DD.DataDeclaration v a
|
||||
m2hDecl (Memory.DD.DataDeclaration mod ann bound ctors) =
|
||||
@ -308,14 +308,15 @@ _hashBranch = H.accumulate . _tokensBranch
|
||||
_tokensBranch :: Accumulate h => Memory.Branch.Branch m -> [Token h]
|
||||
_tokensBranch = H.tokens . _m2hCausal . Memory.Branch._history
|
||||
|
||||
_m2hCausal :: Memory.Branch.UnwrappedBranch m -> Hashing.Causal.Causal Hashing.Branch.Raw
|
||||
_m2hCausal = \case
|
||||
Memory.Causal.One _h e ->
|
||||
Hashing.Causal.Causal (m2hBranch e) mempty
|
||||
Memory.Causal.Cons _h e (ht, _) ->
|
||||
Hashing.Causal.Causal (m2hBranch e) $ Set.singleton (Memory.Causal.unRawHash ht)
|
||||
Memory.Causal.Merge _h e ts ->
|
||||
Hashing.Causal.Causal (m2hBranch e) $ Set.map Memory.Causal.unRawHash (Map.keysSet ts)
|
||||
_m2hCausal :: Memory.Branch.UnwrappedBranch m -> Hashing.Causal.Causal -- Hashing.Branch.Raw
|
||||
_m2hCausal = undefined -- TODO: re-implement
|
||||
-- \case
|
||||
--Memory.Causal.One _h e ->
|
||||
-- Hashing.Causal.Causal (m2hBranch e) mempty
|
||||
--Memory.Causal.Cons _h e (ht, _) ->
|
||||
-- Hashing.Causal.Causal (m2hBranch e) $ Set.singleton (Memory.Causal.unRawHash ht)
|
||||
--Memory.Causal.Merge _h e ts ->
|
||||
-- Hashing.Causal.Causal (m2hBranch e) $ Set.map Memory.Causal.unRawHash (Map.keysSet ts)
|
||||
|
||||
m2hBranch :: Memory.Branch.Branch0 m -> Hashing.Branch.Raw
|
||||
m2hBranch b =
|
||||
|
@ -202,6 +202,7 @@ library
|
||||
ApplicativeDo
|
||||
BlockArguments
|
||||
DeriveFunctor
|
||||
DeriveGeneric
|
||||
DerivingStrategies
|
||||
DoAndIfThenElse
|
||||
FlexibleContexts
|
||||
@ -324,6 +325,7 @@ executable prettyprintdemo
|
||||
ApplicativeDo
|
||||
BlockArguments
|
||||
DeriveFunctor
|
||||
DeriveGeneric
|
||||
DerivingStrategies
|
||||
DoAndIfThenElse
|
||||
FlexibleContexts
|
||||
@ -391,6 +393,7 @@ executable tests
|
||||
ApplicativeDo
|
||||
BlockArguments
|
||||
DeriveFunctor
|
||||
DeriveGeneric
|
||||
DerivingStrategies
|
||||
DoAndIfThenElse
|
||||
FlexibleContexts
|
||||
@ -447,6 +450,7 @@ benchmark runtime
|
||||
ApplicativeDo
|
||||
BlockArguments
|
||||
DeriveFunctor
|
||||
DeriveGeneric
|
||||
DerivingStrategies
|
||||
DoAndIfThenElse
|
||||
FlexibleContexts
|
||||
|
Loading…
Reference in New Issue
Block a user