Pairing checkpoint

codebase2/codebase-sqlite/U/Codebase/Sqlite/Branch/Full.hs

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

codebase2/codebase-sqlite/U/Codebase/Sqlite/Causal.hs

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

codebase2/codebase-sqlite/package.yaml

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

codebase2/codebase-sqlite/unison-codebase-sqlite.cabal

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

parser-typechecker/package.yaml

@@ -6,6 +6,7 @@ default-extensions:
   - ApplicativeDo
   - BlockArguments
   - DeriveFunctor
+  - DeriveGeneric
   - DerivingStrategies
   - DoAndIfThenElse
   - FlexibleContexts

parser-typechecker/src/Unison/Codebase/SqliteCodebase/MigrateSchema12.hs

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

parser-typechecker/src/Unison/Hashing/V2/Causal.hs

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

parser-typechecker/src/Unison/Hashing/V2/Convert.hs

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

parser-typechecker/unison-parser-typechecker.cabal

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