{-# LANGUAGE ApplicativeDo #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE QuasiQuotes #-}
{-# LANGUAGE RecordWildCards #-}

module Unison.Codebase.SqliteCodebase.Migrations.MigrateSchema1To2
  ( migrateSchema1To2,
  )
where

import Control.Concurrent.STM (TVar)
import Control.Lens hiding (from)
import Control.Lens qualified as Lens
import Control.Monad.Except (runExceptT)
import Control.Monad.State.Strict
import Control.Monad.Trans.Except (throwE)
import Control.Monad.Trans.Writer.CPS (Writer, execWriter, tell)
import Data.Generics.Product
import Data.Generics.Sum (_Ctor)
import Data.List.Extra (nubOrd)
import Data.Map qualified as Map
import Data.Set qualified as Set
import Data.Tuple (swap)
import Data.Tuple.Extra ((***))
import Data.Zip qualified as Zip
import System.Environment (lookupEnv)
import System.IO.Unsafe (unsafePerformIO)
import U.Codebase.Branch (NamespaceStats (..))
import U.Codebase.HashTags (BranchHash (..), CausalHash (..), PatchHash (..))
import U.Codebase.Reference qualified as C.Reference
import U.Codebase.Reference qualified as UReference
import U.Codebase.Referent qualified as UReferent
import U.Codebase.Sqlite.Branch.Full qualified as S
import U.Codebase.Sqlite.Branch.Full qualified as S.Branch.Full
import U.Codebase.Sqlite.Causal (GDbCausal (..))
import U.Codebase.Sqlite.Causal qualified as SC.DbCausal (GDbCausal (..))
import U.Codebase.Sqlite.DbId
  ( BranchHashId (..),
    BranchObjectId (..),
    CausalHashId (..),
    HashId,
    ObjectId,
    PatchObjectId (..),
    TextId,
  )
import U.Codebase.Sqlite.LocalizeObject qualified as S.LocalizeObject
import U.Codebase.Sqlite.Operations qualified as Ops
import U.Codebase.Sqlite.Patch.Format qualified as S.Patch.Format
import U.Codebase.Sqlite.Patch.Full qualified as S
import U.Codebase.Sqlite.Patch.TermEdit qualified as TermEdit
import U.Codebase.Sqlite.Patch.TypeEdit qualified as TypeEdit
import U.Codebase.Sqlite.Queries qualified as Q
import U.Codebase.Sqlite.V2.HashHandle (v2HashHandle)
import U.Codebase.Sync (Sync (Sync))
import U.Codebase.Sync qualified as Sync
import U.Codebase.WatchKind (WatchKind)
import U.Codebase.WatchKind qualified as WK
import Unison.ABT qualified as ABT
import Unison.Codebase.SqliteCodebase.Conversions qualified as Cv
import Unison.Codebase.SqliteCodebase.Migrations.MigrateSchema1To2.DbHelpers qualified as Hashing
import Unison.Codebase.SqliteCodebase.Operations qualified as CodebaseOps
import Unison.ConstructorReference qualified as ConstructorReference
import Unison.ConstructorType qualified as CT
import Unison.DataDeclaration qualified as DD
import Unison.DataDeclaration.ConstructorId (ConstructorId)
import Unison.Hash (Hash)
import Unison.Hash qualified as Unison
import Unison.Hashing.V2 qualified as Hashing
import Unison.Hashing.V2.Convert qualified as Convert
import Unison.Parser.Ann (Ann)
import Unison.Pattern (Pattern)
import Unison.Pattern qualified as Pattern
import Unison.Prelude
import Unison.Reference qualified as Reference
import Unison.Referent qualified as Referent
import Unison.ReferentPrime qualified as Referent'
import Unison.Sqlite qualified as Sqlite
import Unison.Symbol (Symbol)
import Unison.Term qualified as Term
import Unison.Type (Type)
import Unison.Type qualified as Type
import Unison.Util.Monoid (foldMapM)
import Unison.Util.Set qualified as Set
import Prelude hiding (log)

verboseOutput :: Bool
verboseOutput :: Bool
verboseOutput =
  Maybe [Char] -> Bool
forall a. Maybe a -> Bool
isJust (IO (Maybe [Char]) -> Maybe [Char]
forall a. IO a -> a
unsafePerformIO ([Char] -> IO (Maybe [Char])
lookupEnv [Char]
"UNISON_MIGRATION_DEBUG"))
{-# NOINLINE verboseOutput #-}

migrateSchema1To2 ::
  -- | A 'getDeclType'-like lookup, possibly backed by a cache.
  (C.Reference.Reference -> Sqlite.Transaction CT.ConstructorType) ->
  TVar (Map Hash CodebaseOps.TermBufferEntry) ->
  TVar (Map Hash CodebaseOps.DeclBufferEntry) ->
  Sqlite.Transaction ()
migrateSchema1To2 :: (Reference -> Transaction ConstructorType)
-> TVar (Map (New Hash) TermBufferEntry)
-> TVar (Map (New Hash) DeclBufferEntry)
-> Transaction ()
migrateSchema1To2 Reference -> Transaction ConstructorType
getDeclType TVar (Map (New Hash) TermBufferEntry)
termBuffer TVar (Map (New Hash) DeclBufferEntry)
declBuffer = do
  [Char] -> Transaction ()
log [Char]
"Starting codebase migration. This may take a while, it's a good time to make some tea ☕️"
  [CausalHashId]
corruptedCausals <- Transaction [CausalHashId]
Q.getCausalsWithoutBranchObjects
  Bool -> Transaction () -> Transaction ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Bool -> Bool
not (Bool -> Bool)
-> ([CausalHashId] -> Bool) -> [CausalHashId] -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [CausalHashId] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null ([CausalHashId] -> Bool) -> [CausalHashId] -> Bool
forall a b. (a -> b) -> a -> b
$ [CausalHashId]
corruptedCausals) do
    [Char] -> Transaction ()
log ([Char] -> Transaction ()) -> [Char] -> Transaction ()
forall a b. (a -> b) -> a -> b
$ [Char]
"⚠️  I detected " [Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<> Int -> [Char]
forall a. Show a => a -> [Char]
show ([CausalHashId] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [CausalHashId]
corruptedCausals) [Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<> [Char]
" corrupted namespace(s) in the history of the codebase."
    [Char] -> Transaction ()
log [Char]
"This is due to a bug in a previous version of ucm."
    [Char] -> Transaction ()
log [Char]
"This only affects the history of your codebase, the most up-to-date iteration will remain intact."
    [Char] -> Transaction ()
log [Char]
"I'll go ahead with the migration, but will replace any corrupted namespaces with empty ones."

  [Char] -> Transaction ()
log [Char]
"Updating Namespace Root..."
  CausalHashId
rootCausalHashId <- Transaction CausalHashId
expectNamespaceRoot
  Int
numEntitiesToMigrate <- [Int] -> Int
forall a. Num a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum ([Int] -> Int) -> Transaction [Int] -> Transaction Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Transaction Int] -> Transaction [Int]
forall (t :: * -> *) (f :: * -> *) a.
(Traversable t, Applicative f) =>
t (f a) -> f (t a)
forall (f :: * -> *) a. Applicative f => [f a] -> f [a]
sequenceA [Transaction Int
Q.countObjects, Transaction Int
Q.countCausals, Transaction Int
Q.countWatches]
  (BranchHashId, BranchHash)
v2EmptyBranchHashInfo <- Transaction (BranchHashId, BranchHash)
saveV2EmptyBranch
  [Entity]
watches <-
    (WatchKind -> Transaction [Entity])
-> [WatchKind] -> Transaction [Entity]
forall (m :: * -> *) (f :: * -> *) b a.
(Monad m, Foldable f, Monoid b) =>
(a -> m b) -> f a -> m b
foldMapM
      (\WatchKind
watchKind -> (Old Id -> Entity) -> [Old Id] -> [Entity]
forall a b. (a -> b) -> [a] -> [b]
map (WatchKind -> Old Id -> Entity
W WatchKind
watchKind) ([Old Id] -> [Entity])
-> Transaction [Old Id] -> Transaction [Entity]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Char] -> Transaction [Old Id]
CodebaseOps.watches (WatchKind -> [Char]
Cv.watchKind2to1 WatchKind
watchKind))
      [WatchKind
WK.RegularWatch, WatchKind
WK.TestWatch]
  MigrationState
migrationState <-
    forall (m :: * -> *) h.
(Monad m, Show h) =>
Sync m h -> Progress m h -> [h] -> m ()
Sync.sync @_ @Entity ((Reference -> Transaction ConstructorType)
-> TVar (Map (New Hash) TermBufferEntry)
-> TVar (Map (New Hash) DeclBufferEntry)
-> Sync (StateT MigrationState Transaction) Entity
migrationSync Reference -> Transaction ConstructorType
getDeclType TVar (Map (New Hash) TermBufferEntry)
termBuffer TVar (Map (New Hash) DeclBufferEntry)
declBuffer) (Int -> Progress (StateT MigrationState Transaction) Entity
progress Int
numEntitiesToMigrate) (CausalHashId -> Entity
CausalE CausalHashId
rootCausalHashId Entity -> [Entity] -> [Entity]
forall a. a -> [a] -> [a]
: [Entity]
watches)
      StateT MigrationState Transaction ()
-> MigrationState -> Transaction MigrationState
forall (m :: * -> *) s a. Monad m => StateT s m a -> s -> m s
`execStateT` Map SomeReferenceId SomeReferenceId
-> Map CausalHashId (New (CausalHash, CausalHashId))
-> Map ObjectId (ObjectId, HashId, New Hash, New Hash)
-> Set (New Hash)
-> Int
-> (BranchHashId, BranchHash)
-> MigrationState
MigrationState Map SomeReferenceId SomeReferenceId
forall k a. Map k a
Map.empty Map CausalHashId (New (CausalHash, CausalHashId))
forall k a. Map k a
Map.empty Map ObjectId (ObjectId, HashId, New Hash, New Hash)
forall k a. Map k a
Map.empty Set (New Hash)
forall a. Set a
Set.empty Int
0 (BranchHashId, BranchHash)
v2EmptyBranchHashInfo
  let (CausalHash
_, CausalHashId
newRootCausalHashId) = MigrationState -> Map CausalHashId (New (CausalHash, CausalHashId))
causalMapping MigrationState
migrationState Map CausalHashId (New (CausalHash, CausalHashId))
-> Getting
     (Endo (New (CausalHash, CausalHashId)))
     (Map CausalHashId (New (CausalHash, CausalHashId)))
     (New (CausalHash, CausalHashId))
-> New (CausalHash, CausalHashId)
forall s a. HasCallStack => s -> Getting (Endo a) s a -> a
^?! Index (Map CausalHashId (New (CausalHash, CausalHashId)))
-> Traversal'
     (Map CausalHashId (New (CausalHash, CausalHashId)))
     (IxValue (Map CausalHashId (New (CausalHash, CausalHashId))))
forall m. Ixed m => Index m -> Traversal' m (IxValue m)
ix Index (Map CausalHashId (New (CausalHash, CausalHashId)))
CausalHashId
rootCausalHashId
  [Char] -> Transaction ()
log [Char]
"Updating Namespace Root..."
  CausalHashId -> Transaction ()
setNamespaceRoot CausalHashId
newRootCausalHashId
  [Char] -> Transaction ()
log [Char]
"Rewriting old object IDs..."
  Map ObjectId (ObjectId, HashId, New Hash, New Hash)
-> (ObjectId
    -> (ObjectId, HashId, New Hash, New Hash) -> Transaction ())
-> Transaction ()
forall i (t :: * -> *) (f :: * -> *) a b.
(FoldableWithIndex i t, Applicative f) =>
t a -> (i -> a -> f b) -> f ()
ifor_ (MigrationState
-> Map ObjectId (ObjectId, HashId, New Hash, New Hash)
objLookup MigrationState
migrationState) \ObjectId
oldObjId (ObjectId
newObjId, HashId
_, New Hash
_, New Hash
_) -> do
    ObjectId -> ObjectId -> Transaction ()
Q.recordObjectRehash ObjectId
oldObjId ObjectId
newObjId
  [Char] -> Transaction ()
log [Char]
"Garbage collecting orphaned objects..."
  Transaction ()
Q.garbageCollectObjectsWithoutHashes
  [Char] -> Transaction ()
log [Char]
"Garbage collecting orphaned watches..."
  Transaction ()
Q.garbageCollectWatchesWithoutObjects
  [Char] -> Transaction ()
log [Char]
"Updating Schema Version..."
  SchemaVersion -> Transaction ()
Q.setSchemaVersion SchemaVersion
2
  where
    progress :: Int -> Sync.Progress (StateT MigrationState Sqlite.Transaction) Entity
    progress :: Int -> Progress (StateT MigrationState Transaction) Entity
progress Int
numToMigrate =
      let incrementProgress :: StateT MigrationState Sqlite.Transaction ()
          incrementProgress :: StateT MigrationState Transaction ()
incrementProgress = do
            Int
numDone <- forall (field :: Symbol) s t a b.
HasField field s t a b =>
Lens s t a b
field @"numMigrated" ((Int -> (Int, Int)) -> MigrationState -> (Int, MigrationState))
-> Int -> StateT MigrationState Transaction Int
forall s (m :: * -> *) a.
(MonadState s m, Num a) =>
LensLike' ((,) a) s a -> a -> m a
<+= Int
1
            Transaction () -> StateT MigrationState Transaction ()
forall (m :: * -> *) a. Monad m => m a -> StateT MigrationState m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (Transaction () -> StateT MigrationState Transaction ())
-> Transaction () -> StateT MigrationState Transaction ()
forall a b. (a -> b) -> a -> b
$ IO () -> Transaction ()
forall a. HasCallStack => IO a -> Transaction a
Sqlite.unsafeIO (IO () -> Transaction ()) -> IO () -> Transaction ()
forall a b. (a -> b) -> a -> b
$ [Char] -> IO ()
putStr ([Char] -> IO ()) -> [Char] -> IO ()
forall a b. (a -> b) -> a -> b
$ [Char]
"\r 🏗  " [Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<> Int -> [Char]
forall a. Show a => a -> [Char]
show Int
numDone [Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<> [Char]
" / ~" [Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<> Int -> [Char]
forall a. Show a => a -> [Char]
show Int
numToMigrate [Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<> [Char]
" entities migrated. 🚧"
          need :: Entity -> StateT MigrationState Sqlite.Transaction ()
          need :: Entity -> StateT MigrationState Transaction ()
need Entity
e = Bool
-> StateT MigrationState Transaction ()
-> StateT MigrationState Transaction ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
verboseOutput (StateT MigrationState Transaction ()
 -> StateT MigrationState Transaction ())
-> StateT MigrationState Transaction ()
-> StateT MigrationState Transaction ()
forall a b. (a -> b) -> a -> b
$ Transaction () -> StateT MigrationState Transaction ()
forall (m :: * -> *) a. Monad m => m a -> StateT MigrationState m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (Transaction () -> StateT MigrationState Transaction ())
-> Transaction () -> StateT MigrationState Transaction ()
forall a b. (a -> b) -> a -> b
$ [Char] -> Transaction ()
log ([Char] -> Transaction ()) -> [Char] -> Transaction ()
forall a b. (a -> b) -> a -> b
$ [Char]
"Need: " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Entity -> [Char]
forall a. Show a => a -> [Char]
show Entity
e
          done :: Entity -> StateT MigrationState Sqlite.Transaction ()
          done :: Entity -> StateT MigrationState Transaction ()
done Entity
e = do
            Bool
-> StateT MigrationState Transaction ()
-> StateT MigrationState Transaction ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
verboseOutput (StateT MigrationState Transaction ()
 -> StateT MigrationState Transaction ())
-> StateT MigrationState Transaction ()
-> StateT MigrationState Transaction ()
forall a b. (a -> b) -> a -> b
$ Transaction () -> StateT MigrationState Transaction ()
forall (m :: * -> *) a. Monad m => m a -> StateT MigrationState m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (Transaction () -> StateT MigrationState Transaction ())
-> Transaction () -> StateT MigrationState Transaction ()
forall a b. (a -> b) -> a -> b
$ [Char] -> Transaction ()
log ([Char] -> Transaction ()) -> [Char] -> Transaction ()
forall a b. (a -> b) -> a -> b
$ [Char]
"Done: " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Entity -> [Char]
forall a. Show a => a -> [Char]
show Entity
e
            StateT MigrationState Transaction ()
incrementProgress
          errorHandler :: Entity -> StateT MigrationState Sqlite.Transaction ()
          errorHandler :: Entity -> StateT MigrationState Transaction ()
errorHandler Entity
e = do
            case Entity
e of
              -- We expect non-fatal errors when migrating watches.
              W {} -> () -> StateT MigrationState Transaction ()
forall a. a -> StateT MigrationState Transaction a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
              Entity
e -> Transaction () -> StateT MigrationState Transaction ()
forall (m :: * -> *) a. Monad m => m a -> StateT MigrationState m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (Transaction () -> StateT MigrationState Transaction ())
-> Transaction () -> StateT MigrationState Transaction ()
forall a b. (a -> b) -> a -> b
$ [Char] -> Transaction ()
log ([Char] -> Transaction ()) -> [Char] -> Transaction ()
forall a b. (a -> b) -> a -> b
$ [Char]
"Error: " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Entity -> [Char]
forall a. Show a => a -> [Char]
show Entity
e
            StateT MigrationState Transaction ()
incrementProgress
          allDone :: StateT MigrationState Sqlite.Transaction ()
          allDone :: StateT MigrationState Transaction ()
allDone = Transaction () -> StateT MigrationState Transaction ()
forall (m :: * -> *) a. Monad m => m a -> StateT MigrationState m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (Transaction () -> StateT MigrationState Transaction ())
-> Transaction () -> StateT MigrationState Transaction ()
forall a b. (a -> b) -> a -> b
$ [Char] -> Transaction ()
log ([Char] -> Transaction ()) -> [Char] -> Transaction ()
forall a b. (a -> b) -> a -> b
$ [Char]
"\nFinished migrating, initiating cleanup."
       in Sync.Progress {Entity -> StateT MigrationState Transaction ()
need :: Entity -> StateT MigrationState Transaction ()
need :: Entity -> StateT MigrationState Transaction ()
need, Entity -> StateT MigrationState Transaction ()
done :: Entity -> StateT MigrationState Transaction ()
done :: Entity -> StateT MigrationState Transaction ()
done, error :: Entity -> StateT MigrationState Transaction ()
error = Entity -> StateT MigrationState Transaction ()
errorHandler, StateT MigrationState Transaction ()
allDone :: StateT MigrationState Transaction ()
allDone :: StateT MigrationState Transaction ()
allDone}

expectNamespaceRoot :: Sqlite.Transaction CausalHashId
expectNamespaceRoot :: Transaction CausalHashId
expectNamespaceRoot =
  Sql -> Transaction CausalHashId
forall a. (FromField a, HasCallStack) => Sql -> Transaction a
Sqlite.queryOneCol Sql
loadNamespaceRootSql

loadNamespaceRootSql :: Sqlite.Sql
loadNamespaceRootSql :: Sql
loadNamespaceRootSql =
  [Sqlite.sql|
    SELECT causal_id
    FROM namespace_root
  |]

setNamespaceRoot :: CausalHashId -> Sqlite.Transaction ()
setNamespaceRoot :: CausalHashId -> Transaction ()
setNamespaceRoot CausalHashId
id =
  Sql -> Transaction Bool
forall a. (FromField a, HasCallStack) => Sql -> Transaction a
Sqlite.queryOneCol [Sqlite.sql| SELECT EXISTS (SELECT 1 FROM namespace_root) |] Transaction Bool -> (Bool -> Transaction ()) -> Transaction ()
forall a b. Transaction a -> (a -> Transaction b) -> Transaction b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    Bool
False -> HasCallStack => Sql -> Transaction ()
Sql -> Transaction ()
Sqlite.execute [Sqlite.sql| INSERT INTO namespace_root VALUES (:id) |]
    Bool
True -> HasCallStack => Sql -> Transaction ()
Sql -> Transaction ()
Sqlite.execute [Sqlite.sql| UPDATE namespace_root SET causal_id = :id |]

log :: String -> Sqlite.Transaction ()
log :: [Char] -> Transaction ()
log =
  IO () -> Transaction ()
forall a. HasCallStack => IO a -> Transaction a
Sqlite.unsafeIO (IO () -> Transaction ())
-> ([Char] -> IO ()) -> [Char] -> Transaction ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> IO ()
putStrLn

type Old a = a

type New a = a

type ConstructorName v = v

type DeclName v = v

data MigrationState = MigrationState
  -- Mapping between old cycle-position -> new cycle-position for a given Decl object.
  { MigrationState -> Map SomeReferenceId SomeReferenceId
referenceMapping :: Map (Old SomeReferenceId) (New SomeReferenceId),
    MigrationState -> Map CausalHashId (New (CausalHash, CausalHashId))
causalMapping :: Map (Old CausalHashId) (New (CausalHash, CausalHashId)),
    -- We also store the old hash for this object ID since we need a way to
    -- convert Object Reference IDs into Hash Reference IDs so we can use the referenceMapping.
    MigrationState
-> Map ObjectId (ObjectId, HashId, New Hash, New Hash)
objLookup :: Map (Old ObjectId) (New ObjectId, New HashId, New Hash, Old Hash),
    -- Remember the hashes of term/decls that we have already migrated to avoid migrating them twice.
    MigrationState -> Set (New Hash)
migratedDefnHashes :: Set (Old Hash),
    MigrationState -> Int
numMigrated :: Int,
    MigrationState -> (BranchHashId, BranchHash)
v2EmptyBranchHashInfo :: (BranchHashId, BranchHash)
  }
  deriving ((forall x. MigrationState -> Rep MigrationState x)
-> (forall x. Rep MigrationState x -> MigrationState)
-> Generic MigrationState
forall x. Rep MigrationState x -> MigrationState
forall x. MigrationState -> Rep MigrationState x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. MigrationState -> Rep MigrationState x
from :: forall x. MigrationState -> Rep MigrationState x
$cto :: forall x. Rep MigrationState x -> MigrationState
to :: forall x. Rep MigrationState x -> MigrationState
Generic)

data Entity
  = TermComponent Unison.Hash
  | DeclComponent Unison.Hash
  | CausalE CausalHashId
  | BranchE ObjectId
  | PatchE ObjectId
  | W WK.WatchKind Reference.Id
  deriving (Entity -> Entity -> Bool
(Entity -> Entity -> Bool)
-> (Entity -> Entity -> Bool) -> Eq Entity
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Entity -> Entity -> Bool
== :: Entity -> Entity -> Bool
$c/= :: Entity -> Entity -> Bool
/= :: Entity -> Entity -> Bool
Eq, Eq Entity
Eq Entity =>
(Entity -> Entity -> Ordering)
-> (Entity -> Entity -> Bool)
-> (Entity -> Entity -> Bool)
-> (Entity -> Entity -> Bool)
-> (Entity -> Entity -> Bool)
-> (Entity -> Entity -> Entity)
-> (Entity -> Entity -> Entity)
-> Ord Entity
Entity -> Entity -> Bool
Entity -> Entity -> Ordering
Entity -> Entity -> Entity
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: Entity -> Entity -> Ordering
compare :: Entity -> Entity -> Ordering
$c< :: Entity -> Entity -> Bool
< :: Entity -> Entity -> Bool
$c<= :: Entity -> Entity -> Bool
<= :: Entity -> Entity -> Bool
$c> :: Entity -> Entity -> Bool
> :: Entity -> Entity -> Bool
$c>= :: Entity -> Entity -> Bool
>= :: Entity -> Entity -> Bool
$cmax :: Entity -> Entity -> Entity
max :: Entity -> Entity -> Entity
$cmin :: Entity -> Entity -> Entity
min :: Entity -> Entity -> Entity
Ord, Int -> Entity -> [Char] -> [Char]
[Entity] -> [Char] -> [Char]
Entity -> [Char]
(Int -> Entity -> [Char] -> [Char])
-> (Entity -> [Char])
-> ([Entity] -> [Char] -> [Char])
-> Show Entity
forall a.
(Int -> a -> [Char] -> [Char])
-> (a -> [Char]) -> ([a] -> [Char] -> [Char]) -> Show a
$cshowsPrec :: Int -> Entity -> [Char] -> [Char]
showsPrec :: Int -> Entity -> [Char] -> [Char]
$cshow :: Entity -> [Char]
show :: Entity -> [Char]
$cshowList :: [Entity] -> [Char] -> [Char]
showList :: [Entity] -> [Char] -> [Char]
Show)

migrationSync ::
  -- | A 'getDeclType'-like lookup, possibly backed by a cache.
  (C.Reference.Reference -> Sqlite.Transaction CT.ConstructorType) ->
  TVar (Map Hash CodebaseOps.TermBufferEntry) ->
  TVar (Map Hash CodebaseOps.DeclBufferEntry) ->
  Sync (StateT MigrationState Sqlite.Transaction) Entity
migrationSync :: (Reference -> Transaction ConstructorType)
-> TVar (Map (New Hash) TermBufferEntry)
-> TVar (Map (New Hash) DeclBufferEntry)
-> Sync (StateT MigrationState Transaction) Entity
migrationSync Reference -> Transaction ConstructorType
getDeclType TVar (Map (New Hash) TermBufferEntry)
termBuffer TVar (Map (New Hash) DeclBufferEntry)
declBuffer = (Entity
 -> StateT MigrationState Transaction (TrySyncResult Entity))
-> Sync (StateT MigrationState Transaction) Entity
forall (m :: * -> *) entity.
(entity -> m (TrySyncResult entity)) -> Sync m entity
Sync \case
  TermComponent New Hash
hash -> (Reference -> Transaction ConstructorType)
-> TVar (Map (New Hash) TermBufferEntry)
-> TVar (Map (New Hash) DeclBufferEntry)
-> New Hash
-> StateT MigrationState Transaction (TrySyncResult Entity)
migrateTermComponent Reference -> Transaction ConstructorType
getDeclType TVar (Map (New Hash) TermBufferEntry)
termBuffer TVar (Map (New Hash) DeclBufferEntry)
declBuffer New Hash
hash
  DeclComponent New Hash
hash -> TVar (Map (New Hash) TermBufferEntry)
-> TVar (Map (New Hash) DeclBufferEntry)
-> New Hash
-> StateT MigrationState Transaction (TrySyncResult Entity)
migrateDeclComponent TVar (Map (New Hash) TermBufferEntry)
termBuffer TVar (Map (New Hash) DeclBufferEntry)
declBuffer New Hash
hash
  BranchE ObjectId
objectId -> ObjectId
-> StateT MigrationState Transaction (TrySyncResult Entity)
migrateBranch ObjectId
objectId
  CausalE CausalHashId
causalHashId -> CausalHashId
-> StateT MigrationState Transaction (TrySyncResult Entity)
migrateCausal CausalHashId
causalHashId
  PatchE ObjectId
objectId -> PatchObjectId
-> StateT MigrationState Transaction (TrySyncResult Entity)
migratePatch (ObjectId -> PatchObjectId
PatchObjectId ObjectId
objectId)
  W WatchKind
watchKind Old Id
watchId -> (Reference -> Transaction ConstructorType)
-> WatchKind
-> Old Id
-> StateT MigrationState Transaction (TrySyncResult Entity)
migrateWatch Reference -> Transaction ConstructorType
getDeclType WatchKind
watchKind Old Id
watchId

migrateCausal :: CausalHashId -> StateT MigrationState Sqlite.Transaction (Sync.TrySyncResult Entity)
migrateCausal :: CausalHashId
-> StateT MigrationState Transaction (TrySyncResult Entity)
migrateCausal CausalHashId
oldCausalHashId = (Either (TrySyncResult Entity) (TrySyncResult Entity)
 -> TrySyncResult Entity)
-> StateT
     MigrationState
     Transaction
     (Either (TrySyncResult Entity) (TrySyncResult Entity))
-> StateT MigrationState Transaction (TrySyncResult Entity)
forall a b.
(a -> b)
-> StateT MigrationState Transaction a
-> StateT MigrationState Transaction b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((TrySyncResult Entity -> TrySyncResult Entity)
-> (TrySyncResult Entity -> TrySyncResult Entity)
-> Either (TrySyncResult Entity) (TrySyncResult Entity)
-> TrySyncResult Entity
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either TrySyncResult Entity -> TrySyncResult Entity
forall a. a -> a
id TrySyncResult Entity -> TrySyncResult Entity
forall a. a -> a
id) (StateT
   MigrationState
   Transaction
   (Either (TrySyncResult Entity) (TrySyncResult Entity))
 -> StateT MigrationState Transaction (TrySyncResult Entity))
-> (ExceptT
      (TrySyncResult Entity)
      (StateT MigrationState Transaction)
      (TrySyncResult Entity)
    -> StateT
         MigrationState
         Transaction
         (Either (TrySyncResult Entity) (TrySyncResult Entity)))
-> ExceptT
     (TrySyncResult Entity)
     (StateT MigrationState Transaction)
     (TrySyncResult Entity)
-> StateT MigrationState Transaction (TrySyncResult Entity)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ExceptT
  (TrySyncResult Entity)
  (StateT MigrationState Transaction)
  (TrySyncResult Entity)
-> StateT
     MigrationState
     Transaction
     (Either (TrySyncResult Entity) (TrySyncResult Entity))
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT (ExceptT
   (TrySyncResult Entity)
   (StateT MigrationState Transaction)
   (TrySyncResult Entity)
 -> StateT MigrationState Transaction (TrySyncResult Entity))
-> ExceptT
     (TrySyncResult Entity)
     (StateT MigrationState Transaction)
     (TrySyncResult Entity)
-> StateT MigrationState Transaction (TrySyncResult Entity)
forall a b. (a -> b) -> a -> b
$ do
  ExceptT
  (TrySyncResult Entity) (StateT MigrationState Transaction) Bool
-> ExceptT
     (TrySyncResult Entity) (StateT MigrationState Transaction) ()
-> ExceptT
     (TrySyncResult Entity) (StateT MigrationState Transaction) ()
forall (m :: * -> *). Monad m => m Bool -> m () -> m ()
whenM (CausalHashId
-> Map CausalHashId (New (CausalHash, CausalHashId)) -> Bool
forall k a. Ord k => k -> Map k a -> Bool
Map.member CausalHashId
oldCausalHashId (Map CausalHashId (New (CausalHash, CausalHashId)) -> Bool)
-> ExceptT
     (TrySyncResult Entity)
     (StateT MigrationState Transaction)
     (Map CausalHashId (New (CausalHash, CausalHashId)))
-> ExceptT
     (TrySyncResult Entity) (StateT MigrationState Transaction) Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Getting
  (Map CausalHashId (New (CausalHash, CausalHashId)))
  MigrationState
  (Map CausalHashId (New (CausalHash, CausalHashId)))
-> ExceptT
     (TrySyncResult Entity)
     (StateT MigrationState Transaction)
     (Map CausalHashId (New (CausalHash, CausalHashId)))
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use (forall (field :: Symbol) s t a b.
HasField field s t a b =>
Lens s t a b
field @"causalMapping")) (TrySyncResult Entity
-> ExceptT
     (TrySyncResult Entity) (StateT MigrationState Transaction) ()
forall (m :: * -> *) e a. Monad m => e -> ExceptT e m a
throwE TrySyncResult Entity
forall entity. TrySyncResult entity
Sync.PreviouslyDone)

  BranchHashId
oldBranchHashId <- StateT MigrationState Transaction BranchHashId
-> ExceptT
     (TrySyncResult Entity)
     (StateT MigrationState Transaction)
     BranchHashId
forall (m :: * -> *) a.
Monad m =>
m a -> ExceptT (TrySyncResult Entity) m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (StateT MigrationState Transaction BranchHashId
 -> ExceptT
      (TrySyncResult Entity)
      (StateT MigrationState Transaction)
      BranchHashId)
-> (Transaction BranchHashId
    -> StateT MigrationState Transaction BranchHashId)
-> Transaction BranchHashId
-> ExceptT
     (TrySyncResult Entity)
     (StateT MigrationState Transaction)
     BranchHashId
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Transaction BranchHashId
-> StateT MigrationState Transaction BranchHashId
forall (m :: * -> *) a. Monad m => m a -> StateT MigrationState m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (Transaction BranchHashId
 -> ExceptT
      (TrySyncResult Entity)
      (StateT MigrationState Transaction)
      BranchHashId)
-> Transaction BranchHashId
-> ExceptT
     (TrySyncResult Entity)
     (StateT MigrationState Transaction)
     BranchHashId
forall a b. (a -> b) -> a -> b
$ CausalHashId -> Transaction BranchHashId
Q.expectCausalValueHashId CausalHashId
oldCausalHashId
  [CausalHashId]
oldCausalParentHashIds <- StateT MigrationState Transaction [CausalHashId]
-> ExceptT
     (TrySyncResult Entity)
     (StateT MigrationState Transaction)
     [CausalHashId]
forall (m :: * -> *) a.
Monad m =>
m a -> ExceptT (TrySyncResult Entity) m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (StateT MigrationState Transaction [CausalHashId]
 -> ExceptT
      (TrySyncResult Entity)
      (StateT MigrationState Transaction)
      [CausalHashId])
-> (Transaction [CausalHashId]
    -> StateT MigrationState Transaction [CausalHashId])
-> Transaction [CausalHashId]
-> ExceptT
     (TrySyncResult Entity)
     (StateT MigrationState Transaction)
     [CausalHashId]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Transaction [CausalHashId]
-> StateT MigrationState Transaction [CausalHashId]
forall (m :: * -> *) a. Monad m => m a -> StateT MigrationState m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (Transaction [CausalHashId]
 -> ExceptT
      (TrySyncResult Entity)
      (StateT MigrationState Transaction)
      [CausalHashId])
-> Transaction [CausalHashId]
-> ExceptT
     (TrySyncResult Entity)
     (StateT MigrationState Transaction)
     [CausalHashId]
forall a b. (a -> b) -> a -> b
$ CausalHashId -> Transaction [CausalHashId]
Q.loadCausalParents CausalHashId
oldCausalHashId

  Maybe ObjectId
maybeOldBranchObjId <-
    StateT MigrationState Transaction (Maybe ObjectId)
-> ExceptT
     (TrySyncResult Entity)
     (StateT MigrationState Transaction)
     (Maybe ObjectId)
forall (m :: * -> *) a.
Monad m =>
m a -> ExceptT (TrySyncResult Entity) m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (StateT MigrationState Transaction (Maybe ObjectId)
 -> ExceptT
      (TrySyncResult Entity)
      (StateT MigrationState Transaction)
      (Maybe ObjectId))
-> (Transaction (Maybe ObjectId)
    -> StateT MigrationState Transaction (Maybe ObjectId))
-> Transaction (Maybe ObjectId)
-> ExceptT
     (TrySyncResult Entity)
     (StateT MigrationState Transaction)
     (Maybe ObjectId)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Transaction (Maybe ObjectId)
-> StateT MigrationState Transaction (Maybe ObjectId)
forall (m :: * -> *) a. Monad m => m a -> StateT MigrationState m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (Transaction (Maybe ObjectId)
 -> ExceptT
      (TrySyncResult Entity)
      (StateT MigrationState Transaction)
      (Maybe ObjectId))
-> Transaction (Maybe ObjectId)
-> ExceptT
     (TrySyncResult Entity)
     (StateT MigrationState Transaction)
     (Maybe ObjectId)
forall a b. (a -> b) -> a -> b
$
      HashId -> Transaction (Maybe ObjectId)
Q.loadObjectIdForAnyHashId (BranchHashId -> HashId
unBranchHashId BranchHashId
oldBranchHashId)
  Map ObjectId (ObjectId, HashId, New Hash, New Hash)
migratedObjIds <- (MigrationState
 -> Map ObjectId (ObjectId, HashId, New Hash, New Hash))
-> ExceptT
     (TrySyncResult Entity)
     (StateT MigrationState Transaction)
     (Map ObjectId (ObjectId, HashId, New Hash, New Hash))
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets MigrationState
-> Map ObjectId (ObjectId, HashId, New Hash, New Hash)
objLookup
  -- If the branch for this causal hasn't been migrated, migrate it first.
  let unmigratedBranch :: [Entity]
unmigratedBranch =
        case Maybe ObjectId
maybeOldBranchObjId of
          Just ObjectId
branchObjId | ObjectId
branchObjId ObjectId
-> Map ObjectId (ObjectId, HashId, New Hash, New Hash) -> Bool
forall k a. Ord k => k -> Map k a -> Bool
`Map.notMember` Map ObjectId (ObjectId, HashId, New Hash, New Hash)
migratedObjIds -> [ObjectId -> Entity
BranchE ObjectId
branchObjId]
          Maybe ObjectId
_ -> []

  Map CausalHashId (New (CausalHash, CausalHashId))
migratedCausals <- (MigrationState
 -> Map CausalHashId (New (CausalHash, CausalHashId)))
-> ExceptT
     (TrySyncResult Entity)
     (StateT MigrationState Transaction)
     (Map CausalHashId (New (CausalHash, CausalHashId)))
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets MigrationState -> Map CausalHashId (New (CausalHash, CausalHashId))
causalMapping
  let unmigratedParents :: [Entity]
unmigratedParents =
        [CausalHashId]
oldCausalParentHashIds
          [CausalHashId]
-> ([CausalHashId] -> [CausalHashId]) -> [CausalHashId]
forall a b. a -> (a -> b) -> b
& (CausalHashId -> Bool) -> [CausalHashId] -> [CausalHashId]
forall a. (a -> Bool) -> [a] -> [a]
filter (CausalHashId
-> Map CausalHashId (New (CausalHash, CausalHashId)) -> Bool
forall k a. Ord k => k -> Map k a -> Bool
`Map.notMember` Map CausalHashId (New (CausalHash, CausalHashId))
migratedCausals)
          [CausalHashId] -> ([CausalHashId] -> [Entity]) -> [Entity]
forall a b. a -> (a -> b) -> b
& (CausalHashId -> Entity) -> [CausalHashId] -> [Entity]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap CausalHashId -> Entity
CausalE
  let unmigratedEntities :: [Entity]
unmigratedEntities = [Entity]
unmigratedBranch [Entity] -> [Entity] -> [Entity]
forall a. Semigroup a => a -> a -> a
<> [Entity]
unmigratedParents
  Bool
-> ExceptT
     (TrySyncResult Entity) (StateT MigrationState Transaction) ()
-> ExceptT
     (TrySyncResult Entity) (StateT MigrationState Transaction) ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Bool -> Bool
not (Bool -> Bool) -> ([Entity] -> Bool) -> [Entity] -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Entity] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null ([Entity] -> Bool) -> [Entity] -> Bool
forall a b. (a -> b) -> a -> b
$ [Entity]
unmigratedParents [Entity] -> [Entity] -> [Entity]
forall a. Semigroup a => a -> a -> a
<> [Entity]
unmigratedBranch) (TrySyncResult Entity
-> ExceptT
     (TrySyncResult Entity) (StateT MigrationState Transaction) ()
forall (m :: * -> *) e a. Monad m => e -> ExceptT e m a
throwE (TrySyncResult Entity
 -> ExceptT
      (TrySyncResult Entity) (StateT MigrationState Transaction) ())
-> TrySyncResult Entity
-> ExceptT
     (TrySyncResult Entity) (StateT MigrationState Transaction) ()
forall a b. (a -> b) -> a -> b
$ [Entity] -> TrySyncResult Entity
forall entity. [entity] -> TrySyncResult entity
Sync.Missing [Entity]
unmigratedEntities)

  (BranchHashId
newBranchHashId, BranchHash
newBranchHash) <- case Maybe ObjectId
maybeOldBranchObjId of
    -- Some codebases are corrupted, likely due to interrupted save operations.
    -- It's unfortunate, but rather than fail the whole migration we'll just replace them
    -- with an empty branch.
    Maybe ObjectId
Nothing -> Getting
  (BranchHashId, BranchHash)
  MigrationState
  (BranchHashId, BranchHash)
-> ExceptT
     (TrySyncResult Entity)
     (StateT MigrationState Transaction)
     (BranchHashId, BranchHash)
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use (forall (field :: Symbol) s t a b.
HasField field s t a b =>
Lens s t a b
field @"v2EmptyBranchHashInfo")
    Just ObjectId
branchObjId -> do
      let (ObjectId
_, HashId
newBranchHashId, New Hash
newBranchHash, New Hash
_) = Map ObjectId (ObjectId, HashId, New Hash, New Hash)
migratedObjIds Map ObjectId (ObjectId, HashId, New Hash, New Hash)
-> Getting
     (Endo (ObjectId, HashId, New Hash, New Hash))
     (Map ObjectId (ObjectId, HashId, New Hash, New Hash))
     (ObjectId, HashId, New Hash, New Hash)
-> (ObjectId, HashId, New Hash, New Hash)
forall s a. HasCallStack => s -> Getting (Endo a) s a -> a
^?! Index (Map ObjectId (ObjectId, HashId, New Hash, New Hash))
-> Traversal'
     (Map ObjectId (ObjectId, HashId, New Hash, New Hash))
     (IxValue (Map ObjectId (ObjectId, HashId, New Hash, New Hash)))
forall m. Ixed m => Index m -> Traversal' m (IxValue m)
ix Index (Map ObjectId (ObjectId, HashId, New Hash, New Hash))
ObjectId
branchObjId
      (BranchHashId, BranchHash)
-> ExceptT
     (TrySyncResult Entity)
     (StateT MigrationState Transaction)
     (BranchHashId, BranchHash)
forall a.
a
-> ExceptT
     (TrySyncResult Entity) (StateT MigrationState Transaction) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (HashId -> BranchHashId
BranchHashId HashId
newBranchHashId, New Hash -> BranchHash
BranchHash New Hash
newBranchHash)

  let (Set (New Hash)
newParentHashes, Set CausalHashId
newParentHashIds) =
        [CausalHashId]
oldCausalParentHashIds
          [CausalHashId]
-> ([CausalHashId] -> [New (CausalHash, CausalHashId)])
-> [New (CausalHash, CausalHashId)]
forall a b. a -> (a -> b) -> b
& (CausalHashId -> New (CausalHash, CausalHashId))
-> [CausalHashId] -> [New (CausalHash, CausalHashId)]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\CausalHashId
oldParentHashId -> Map CausalHashId (New (CausalHash, CausalHashId))
migratedCausals Map CausalHashId (New (CausalHash, CausalHashId))
-> Getting
     (Endo (New (CausalHash, CausalHashId)))
     (Map CausalHashId (New (CausalHash, CausalHashId)))
     (New (CausalHash, CausalHashId))
-> New (CausalHash, CausalHashId)
forall s a. HasCallStack => s -> Getting (Endo a) s a -> a
^?! Index (Map CausalHashId (New (CausalHash, CausalHashId)))
-> Traversal'
     (Map CausalHashId (New (CausalHash, CausalHashId)))
     (IxValue (Map CausalHashId (New (CausalHash, CausalHashId))))
forall m. Ixed m => Index m -> Traversal' m (IxValue m)
ix Index (Map CausalHashId (New (CausalHash, CausalHashId)))
CausalHashId
oldParentHashId)
          [New (CausalHash, CausalHashId)]
-> ([New (CausalHash, CausalHashId)]
    -> ([CausalHash], [CausalHashId]))
-> ([CausalHash], [CausalHashId])
forall a b. a -> (a -> b) -> b
& [New (CausalHash, CausalHashId)] -> ([CausalHash], [CausalHashId])
forall a b. [(a, b)] -> ([a], [b])
unzip
          ([CausalHash], [CausalHashId])
-> (([CausalHash], [CausalHashId])
    -> (Set (New Hash), Set CausalHashId))
-> (Set (New Hash), Set CausalHashId)
forall a b. a -> (a -> b) -> b
& ([CausalHash] -> Set (New Hash))
-> ([CausalHashId] -> Set CausalHashId)
-> ([CausalHash], [CausalHashId])
-> (Set (New Hash), Set CausalHashId)
forall a b c d. (a -> b) -> (c -> d) -> (a, c) -> (b, d)
forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap ([New Hash] -> Set (New Hash)
forall a. Ord a => [a] -> Set a
Set.fromList ([New Hash] -> Set (New Hash))
-> ([CausalHash] -> [New Hash]) -> [CausalHash] -> Set (New Hash)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (CausalHash -> New Hash) -> [CausalHash] -> [New Hash]
forall a b. (a -> b) -> [a] -> [b]
map CausalHash -> New Hash
unCausalHash) [CausalHashId] -> Set CausalHashId
forall a. Ord a => [a] -> Set a
Set.fromList

  let newCausalHash :: CausalHash
      newCausalHash :: CausalHash
newCausalHash =
        New Hash -> CausalHash
CausalHash (New Hash -> CausalHash) -> New Hash -> CausalHash
forall a b. (a -> b) -> a -> b
$
          Causal -> New Hash
forall a. ContentAddressable a => a -> New Hash
Hashing.contentHash
            Hashing.Causal
              { branchHash :: New Hash
branchHash = BranchHash -> New Hash
unBranchHash BranchHash
newBranchHash,
                parents :: Set (New Hash)
parents = Set (New Hash)
newParentHashes
              }
  CausalHashId
newCausalHashId <- StateT MigrationState Transaction CausalHashId
-> ExceptT
     (TrySyncResult Entity)
     (StateT MigrationState Transaction)
     CausalHashId
forall (m :: * -> *) a.
Monad m =>
m a -> ExceptT (TrySyncResult Entity) m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (StateT MigrationState Transaction CausalHashId
 -> ExceptT
      (TrySyncResult Entity)
      (StateT MigrationState Transaction)
      CausalHashId)
-> (Transaction CausalHashId
    -> StateT MigrationState Transaction CausalHashId)
-> Transaction CausalHashId
-> ExceptT
     (TrySyncResult Entity)
     (StateT MigrationState Transaction)
     CausalHashId
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Transaction CausalHashId
-> StateT MigrationState Transaction CausalHashId
forall (m :: * -> *) a. Monad m => m a -> StateT MigrationState m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (Transaction CausalHashId
 -> ExceptT
      (TrySyncResult Entity)
      (StateT MigrationState Transaction)
      CausalHashId)
-> Transaction CausalHashId
-> ExceptT
     (TrySyncResult Entity)
     (StateT MigrationState Transaction)
     CausalHashId
forall a b. (a -> b) -> a -> b
$ CausalHash -> Transaction CausalHashId
Q.saveCausalHash CausalHash
newCausalHash
  let newCausal :: GDbCausal CausalHashId BranchHashId
newCausal =
        DbCausal
          { $sel:selfHash:DbCausal :: CausalHashId
selfHash = CausalHashId
newCausalHashId,
            $sel:valueHash:DbCausal :: BranchHashId
valueHash = BranchHashId
newBranchHashId,
            $sel:parents:DbCausal :: Set CausalHashId
parents = Set CausalHashId
newParentHashIds
          }
  (StateT MigrationState Transaction ()
-> ExceptT
     (TrySyncResult Entity) (StateT MigrationState Transaction) ()
forall (m :: * -> *) a.
Monad m =>
m a -> ExceptT (TrySyncResult Entity) m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (StateT MigrationState Transaction ()
 -> ExceptT
      (TrySyncResult Entity) (StateT MigrationState Transaction) ())
-> (Transaction () -> StateT MigrationState Transaction ())
-> Transaction ()
-> ExceptT
     (TrySyncResult Entity) (StateT MigrationState Transaction) ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Transaction () -> StateT MigrationState Transaction ()
forall (m :: * -> *) a. Monad m => m a -> StateT MigrationState m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift) do
    HashHandle
-> CausalHashId -> BranchHashId -> [CausalHashId] -> Transaction ()
Q.saveCausal
      HashHandle
v2HashHandle
      (GDbCausal CausalHashId BranchHashId -> CausalHashId
forall causalHash valueHash.
GDbCausal causalHash valueHash -> causalHash
SC.DbCausal.selfHash GDbCausal CausalHashId BranchHashId
newCausal)
      (GDbCausal CausalHashId BranchHashId -> BranchHashId
forall causalHash valueHash.
GDbCausal causalHash valueHash -> valueHash
SC.DbCausal.valueHash GDbCausal CausalHashId BranchHashId
newCausal)
      (Set CausalHashId -> [CausalHashId]
forall a. Set a -> [a]
Set.toList (Set CausalHashId -> [CausalHashId])
-> Set CausalHashId -> [CausalHashId]
forall a b. (a -> b) -> a -> b
$ GDbCausal CausalHashId BranchHashId -> Set CausalHashId
forall causalHash valueHash.
GDbCausal causalHash valueHash -> Set causalHash
SC.DbCausal.parents GDbCausal CausalHashId BranchHashId
newCausal)

  forall (field :: Symbol) s t a b.
HasField field s t a b =>
Lens s t a b
field @"causalMapping" ((Map CausalHashId (New (CausalHash, CausalHashId))
  -> Identity (Map CausalHashId (New (CausalHash, CausalHashId))))
 -> MigrationState -> Identity MigrationState)
-> (Map CausalHashId (New (CausalHash, CausalHashId))
    -> Map CausalHashId (New (CausalHash, CausalHashId)))
-> ExceptT
     (TrySyncResult Entity) (StateT MigrationState Transaction) ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
%= CausalHashId
-> New (CausalHash, CausalHashId)
-> Map CausalHashId (New (CausalHash, CausalHashId))
-> Map CausalHashId (New (CausalHash, CausalHashId))
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert CausalHashId
oldCausalHashId (CausalHash
newCausalHash, CausalHashId
newCausalHashId)

  pure TrySyncResult Entity
forall entity. TrySyncResult entity
Sync.Done

migrateBranch :: ObjectId -> StateT MigrationState Sqlite.Transaction (Sync.TrySyncResult Entity)
migrateBranch :: ObjectId
-> StateT MigrationState Transaction (TrySyncResult Entity)
migrateBranch ObjectId
oldObjectId = (Either (TrySyncResult Entity) (TrySyncResult Entity)
 -> TrySyncResult Entity)
-> StateT
     MigrationState
     Transaction
     (Either (TrySyncResult Entity) (TrySyncResult Entity))
-> StateT MigrationState Transaction (TrySyncResult Entity)
forall a b.
(a -> b)
-> StateT MigrationState Transaction a
-> StateT MigrationState Transaction b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((TrySyncResult Entity -> TrySyncResult Entity)
-> (TrySyncResult Entity -> TrySyncResult Entity)
-> Either (TrySyncResult Entity) (TrySyncResult Entity)
-> TrySyncResult Entity
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either TrySyncResult Entity -> TrySyncResult Entity
forall a. a -> a
id TrySyncResult Entity -> TrySyncResult Entity
forall a. a -> a
id) (StateT
   MigrationState
   Transaction
   (Either (TrySyncResult Entity) (TrySyncResult Entity))
 -> StateT MigrationState Transaction (TrySyncResult Entity))
-> (ExceptT
      (TrySyncResult Entity)
      (StateT MigrationState Transaction)
      (TrySyncResult Entity)
    -> StateT
         MigrationState
         Transaction
         (Either (TrySyncResult Entity) (TrySyncResult Entity)))
-> ExceptT
     (TrySyncResult Entity)
     (StateT MigrationState Transaction)
     (TrySyncResult Entity)
-> StateT MigrationState Transaction (TrySyncResult Entity)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ExceptT
  (TrySyncResult Entity)
  (StateT MigrationState Transaction)
  (TrySyncResult Entity)
-> StateT
     MigrationState
     Transaction
     (Either (TrySyncResult Entity) (TrySyncResult Entity))
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT (ExceptT
   (TrySyncResult Entity)
   (StateT MigrationState Transaction)
   (TrySyncResult Entity)
 -> StateT MigrationState Transaction (TrySyncResult Entity))
-> ExceptT
     (TrySyncResult Entity)
     (StateT MigrationState Transaction)
     (TrySyncResult Entity)
-> StateT MigrationState Transaction (TrySyncResult Entity)
forall a b. (a -> b) -> a -> b
$ do
  ExceptT
  (TrySyncResult Entity) (StateT MigrationState Transaction) Bool
-> ExceptT
     (TrySyncResult Entity) (StateT MigrationState Transaction) ()
-> ExceptT
     (TrySyncResult Entity) (StateT MigrationState Transaction) ()
forall (m :: * -> *). Monad m => m Bool -> m () -> m ()
whenM (ObjectId
-> Map ObjectId (ObjectId, HashId, New Hash, New Hash) -> Bool
forall k a. Ord k => k -> Map k a -> Bool
Map.member ObjectId
oldObjectId (Map ObjectId (ObjectId, HashId, New Hash, New Hash) -> Bool)
-> ExceptT
     (TrySyncResult Entity)
     (StateT MigrationState Transaction)
     (Map ObjectId (ObjectId, HashId, New Hash, New Hash))
-> ExceptT
     (TrySyncResult Entity) (StateT MigrationState Transaction) Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Getting
  (Map ObjectId (ObjectId, HashId, New Hash, New Hash))
  MigrationState
  (Map ObjectId (ObjectId, HashId, New Hash, New Hash))
-> ExceptT
     (TrySyncResult Entity)
     (StateT MigrationState Transaction)
     (Map ObjectId (ObjectId, HashId, New Hash, New Hash))
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use (forall (field :: Symbol) s t a b.
HasField field s t a b =>
Lens s t a b
field @"objLookup")) (TrySyncResult Entity
-> ExceptT
     (TrySyncResult Entity) (StateT MigrationState Transaction) ()
forall (m :: * -> *) e a. Monad m => e -> ExceptT e m a
throwE TrySyncResult Entity
forall entity. TrySyncResult entity
Sync.PreviouslyDone)

  DbBranch
oldBranch <- StateT MigrationState Transaction DbBranch
-> ExceptT
     (TrySyncResult Entity) (StateT MigrationState Transaction) DbBranch
forall (m :: * -> *) a.
Monad m =>
m a -> ExceptT (TrySyncResult Entity) m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (StateT MigrationState Transaction DbBranch
 -> ExceptT
      (TrySyncResult Entity)
      (StateT MigrationState Transaction)
      DbBranch)
-> (Transaction DbBranch
    -> StateT MigrationState Transaction DbBranch)
-> Transaction DbBranch
-> ExceptT
     (TrySyncResult Entity) (StateT MigrationState Transaction) DbBranch
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Transaction DbBranch -> StateT MigrationState Transaction DbBranch
forall (m :: * -> *) a. Monad m => m a -> StateT MigrationState m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (Transaction DbBranch
 -> ExceptT
      (TrySyncResult Entity)
      (StateT MigrationState Transaction)
      DbBranch)
-> Transaction DbBranch
-> ExceptT
     (TrySyncResult Entity) (StateT MigrationState Transaction) DbBranch
forall a b. (a -> b) -> a -> b
$ BranchObjectId -> Transaction DbBranch
Ops.expectDbBranch (ObjectId -> BranchObjectId
BranchObjectId ObjectId
oldObjectId)
  New Hash
oldHash <- StateT MigrationState Transaction (New Hash)
-> ExceptT
     (TrySyncResult Entity)
     (StateT MigrationState Transaction)
     (New Hash)
forall (m :: * -> *) a.
Monad m =>
m a -> ExceptT (TrySyncResult Entity) m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (StateT MigrationState Transaction (New Hash)
 -> ExceptT
      (TrySyncResult Entity)
      (StateT MigrationState Transaction)
      (New Hash))
-> (Transaction (New Hash)
    -> StateT MigrationState Transaction (New Hash))
-> Transaction (New Hash)
-> ExceptT
     (TrySyncResult Entity)
     (StateT MigrationState Transaction)
     (New Hash)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Transaction (New Hash)
-> StateT MigrationState Transaction (New Hash)
forall (m :: * -> *) a. Monad m => m a -> StateT MigrationState m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (Transaction (New Hash)
 -> ExceptT
      (TrySyncResult Entity)
      (StateT MigrationState Transaction)
      (New Hash))
-> Transaction (New Hash)
-> ExceptT
     (TrySyncResult Entity)
     (StateT MigrationState Transaction)
     (New Hash)
forall a b. (a -> b) -> a -> b
$ ObjectId -> Transaction (New Hash)
Q.expectPrimaryHashByObjectId ObjectId
oldObjectId
  Branch'
  TextId (New Hash) PatchObjectId (BranchObjectId, CausalHashId)
oldBranchWithHashes <- StateT
  MigrationState
  Transaction
  (Branch'
     TextId (New Hash) PatchObjectId (BranchObjectId, CausalHashId))
-> ExceptT
     (TrySyncResult Entity)
     (StateT MigrationState Transaction)
     (Branch'
        TextId (New Hash) PatchObjectId (BranchObjectId, CausalHashId))
forall (m :: * -> *) a.
Monad m =>
m a -> ExceptT (TrySyncResult Entity) m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (StateT
   MigrationState
   Transaction
   (Branch'
      TextId (New Hash) PatchObjectId (BranchObjectId, CausalHashId))
 -> ExceptT
      (TrySyncResult Entity)
      (StateT MigrationState Transaction)
      (Branch'
         TextId (New Hash) PatchObjectId (BranchObjectId, CausalHashId)))
-> (Transaction
      (Branch'
         TextId (New Hash) PatchObjectId (BranchObjectId, CausalHashId))
    -> StateT
         MigrationState
         Transaction
         (Branch'
            TextId (New Hash) PatchObjectId (BranchObjectId, CausalHashId)))
-> Transaction
     (Branch'
        TextId (New Hash) PatchObjectId (BranchObjectId, CausalHashId))
-> ExceptT
     (TrySyncResult Entity)
     (StateT MigrationState Transaction)
     (Branch'
        TextId (New Hash) PatchObjectId (BranchObjectId, CausalHashId))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Transaction
  (Branch'
     TextId (New Hash) PatchObjectId (BranchObjectId, CausalHashId))
-> StateT
     MigrationState
     Transaction
     (Branch'
        TextId (New Hash) PatchObjectId (BranchObjectId, CausalHashId))
forall (m :: * -> *) a. Monad m => m a -> StateT MigrationState m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (Transaction
   (Branch'
      TextId (New Hash) PatchObjectId (BranchObjectId, CausalHashId))
 -> ExceptT
      (TrySyncResult Entity)
      (StateT MigrationState Transaction)
      (Branch'
         TextId (New Hash) PatchObjectId (BranchObjectId, CausalHashId)))
-> Transaction
     (Branch'
        TextId (New Hash) PatchObjectId (BranchObjectId, CausalHashId))
-> ExceptT
     (TrySyncResult Entity)
     (StateT MigrationState Transaction)
     (Branch'
        TextId (New Hash) PatchObjectId (BranchObjectId, CausalHashId))
forall a b. (a -> b) -> a -> b
$ LensLike
  Transaction
  DbBranch
  (Branch'
     TextId (New Hash) PatchObjectId (BranchObjectId, CausalHashId))
  ObjectId
  (New Hash)
-> LensLike
     Transaction
     DbBranch
     (Branch'
        TextId (New Hash) PatchObjectId (BranchObjectId, CausalHashId))
     ObjectId
     (New Hash)
forall (f :: * -> *) s t a b.
LensLike f s t a b -> LensLike f s t a b
traverseOf LensLike
  Transaction
  DbBranch
  (Branch'
     TextId (New Hash) PatchObjectId (BranchObjectId, CausalHashId))
  ObjectId
  (New Hash)
forall h' t h p c.
(Ord h', Ord t, Ord h) =>
Traversal (Branch' t h p c) (Branch' t h' p c) h h'
Traversal
  DbBranch
  (Branch'
     TextId (New Hash) PatchObjectId (BranchObjectId, CausalHashId))
  ObjectId
  (New Hash)
S.branchHashes_ ObjectId -> Transaction (New Hash)
Q.expectPrimaryHashByObjectId DbBranch
oldBranch
  Map SomeReferenceId SomeReferenceId
migratedRefs <- (MigrationState -> Map SomeReferenceId SomeReferenceId)
-> ExceptT
     (TrySyncResult Entity)
     (StateT MigrationState Transaction)
     (Map SomeReferenceId SomeReferenceId)
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets MigrationState -> Map SomeReferenceId SomeReferenceId
referenceMapping
  Map ObjectId (ObjectId, HashId, New Hash, New Hash)
migratedObjects <- (MigrationState
 -> Map ObjectId (ObjectId, HashId, New Hash, New Hash))
-> ExceptT
     (TrySyncResult Entity)
     (StateT MigrationState Transaction)
     (Map ObjectId (ObjectId, HashId, New Hash, New Hash))
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets MigrationState
-> Map ObjectId (ObjectId, HashId, New Hash, New Hash)
objLookup
  Map CausalHashId (New (CausalHash, CausalHashId))
migratedCausals <- (MigrationState
 -> Map CausalHashId (New (CausalHash, CausalHashId)))
-> ExceptT
     (TrySyncResult Entity)
     (StateT MigrationState Transaction)
     (Map CausalHashId (New (CausalHash, CausalHashId)))
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets MigrationState -> Map CausalHashId (New (CausalHash, CausalHashId))
causalMapping
  let allMissingTypesAndTerms :: [Entity]
      allMissingTypesAndTerms :: [Entity]
allMissingTypesAndTerms =
        Branch'
  TextId (New Hash) PatchObjectId (BranchObjectId, CausalHashId)
oldBranchWithHashes
          Branch'
  TextId (New Hash) PatchObjectId (BranchObjectId, CausalHashId)
-> Getting
     (Endo [Entity])
     (Branch'
        TextId (New Hash) PatchObjectId (BranchObjectId, CausalHashId))
     Entity
-> [Entity]
forall s a. s -> Getting (Endo [a]) s a -> [a]
^.. (SomeReferenceId -> Const (Endo [Entity]) SomeReferenceId)
-> Branch'
     TextId (New Hash) PatchObjectId (BranchObjectId, CausalHashId)
-> Const
     (Endo [Entity])
     (Branch'
        TextId (New Hash) PatchObjectId (BranchObjectId, CausalHashId))
forall t h p c.
(Ord t, Ord h) =>
Traversal' (Branch' t h p c) (SomeReference (Id' h))
Traversal'
  (Branch'
     TextId (New Hash) PatchObjectId (BranchObjectId, CausalHashId))
  SomeReferenceId
branchSomeRefs_
            ((SomeReferenceId -> Const (Endo [Entity]) SomeReferenceId)
 -> Branch'
      TextId (New Hash) PatchObjectId (BranchObjectId, CausalHashId)
 -> Const
      (Endo [Entity])
      (Branch'
         TextId (New Hash) PatchObjectId (BranchObjectId, CausalHashId)))
-> ((Entity -> Const (Endo [Entity]) Entity)
    -> SomeReferenceId -> Const (Endo [Entity]) SomeReferenceId)
-> Getting
     (Endo [Entity])
     (Branch'
        TextId (New Hash) PatchObjectId (BranchObjectId, CausalHashId))
     Entity
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (SomeReferenceId -> Const (Endo [Entity]) SomeReferenceId)
-> SomeReferenceId -> Const (Endo [Entity]) SomeReferenceId
Iso' SomeReferenceId SomeReferenceId
uRefIdAsRefId_
            ((SomeReferenceId -> Const (Endo [Entity]) SomeReferenceId)
 -> SomeReferenceId -> Const (Endo [Entity]) SomeReferenceId)
-> ((Entity -> Const (Endo [Entity]) Entity)
    -> SomeReferenceId -> Const (Endo [Entity]) SomeReferenceId)
-> (Entity -> Const (Endo [Entity]) Entity)
-> SomeReferenceId
-> Const (Endo [Entity]) SomeReferenceId
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (SomeReferenceId -> Bool)
-> (SomeReferenceId -> Const (Endo [Entity]) SomeReferenceId)
-> SomeReferenceId
-> Const (Endo [Entity]) SomeReferenceId
forall (p :: * -> * -> *) (f :: * -> *) a.
(Choice p, Applicative f) =>
(a -> Bool) -> Optic' p f a a
filtered (SomeReferenceId -> Map SomeReferenceId SomeReferenceId -> Bool
forall k a. Ord k => k -> Map k a -> Bool
`Map.notMember` Map SomeReferenceId SomeReferenceId
migratedRefs)
            ((SomeReferenceId -> Const (Endo [Entity]) SomeReferenceId)
 -> SomeReferenceId -> Const (Endo [Entity]) SomeReferenceId)
-> ((Entity -> Const (Endo [Entity]) Entity)
    -> SomeReferenceId -> Const (Endo [Entity]) SomeReferenceId)
-> (Entity -> Const (Endo [Entity]) Entity)
-> SomeReferenceId
-> Const (Endo [Entity]) SomeReferenceId
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (SomeReferenceId -> Entity)
-> (Entity -> Const (Endo [Entity]) Entity)
-> SomeReferenceId
-> Const (Endo [Entity]) SomeReferenceId
forall (p :: * -> * -> *) (f :: * -> *) s a.
(Profunctor p, Contravariant f) =>
(s -> a) -> Optic' p f s a
to SomeReferenceId -> Entity
someReferenceIdToEntity

  let [Entity]
allMissingPatches :: [Entity] =
        DbBranch
oldBranch
          DbBranch -> Getting (Endo [Entity]) DbBranch Entity -> [Entity]
forall s a. s -> Getting (Endo [a]) s a -> [a]
^.. (PatchObjectId -> Const (Endo [Entity]) PatchObjectId)
-> DbBranch -> Const (Endo [Entity]) DbBranch
forall t h p c p' (f :: * -> *).
Applicative f =>
(p -> f p') -> Branch' t h p c -> f (Branch' t h p' c)
S.patches_
            ((PatchObjectId -> Const (Endo [Entity]) PatchObjectId)
 -> DbBranch -> Const (Endo [Entity]) DbBranch)
-> ((Entity -> Const (Endo [Entity]) Entity)
    -> PatchObjectId -> Const (Endo [Entity]) PatchObjectId)
-> Getting (Endo [Entity]) DbBranch Entity
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (PatchObjectId -> ObjectId)
-> (ObjectId -> Const (Endo [Entity]) ObjectId)
-> PatchObjectId
-> Const (Endo [Entity]) PatchObjectId
forall (p :: * -> * -> *) (f :: * -> *) s a.
(Profunctor p, Contravariant f) =>
(s -> a) -> Optic' p f s a
to PatchObjectId -> ObjectId
unPatchObjectId
            ((ObjectId -> Const (Endo [Entity]) ObjectId)
 -> PatchObjectId -> Const (Endo [Entity]) PatchObjectId)
-> ((Entity -> Const (Endo [Entity]) Entity)
    -> ObjectId -> Const (Endo [Entity]) ObjectId)
-> (Entity -> Const (Endo [Entity]) Entity)
-> PatchObjectId
-> Const (Endo [Entity]) PatchObjectId
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ObjectId -> Bool)
-> Optic' (->) (Const (Endo [Entity])) ObjectId ObjectId
forall (p :: * -> * -> *) (f :: * -> *) a.
(Choice p, Applicative f) =>
(a -> Bool) -> Optic' p f a a
filtered (ObjectId
-> Map ObjectId (ObjectId, HashId, New Hash, New Hash) -> Bool
forall k a. Ord k => k -> Map k a -> Bool
`Map.notMember` Map ObjectId (ObjectId, HashId, New Hash, New Hash)
migratedObjects)
            Optic' (->) (Const (Endo [Entity])) ObjectId ObjectId
-> ((Entity -> Const (Endo [Entity]) Entity)
    -> ObjectId -> Const (Endo [Entity]) ObjectId)
-> (Entity -> Const (Endo [Entity]) Entity)
-> ObjectId
-> Const (Endo [Entity]) ObjectId
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ObjectId -> Entity)
-> (Entity -> Const (Endo [Entity]) Entity)
-> ObjectId
-> Const (Endo [Entity]) ObjectId
forall (p :: * -> * -> *) (f :: * -> *) s a.
(Profunctor p, Contravariant f) =>
(s -> a) -> Optic' p f s a
to ObjectId -> Entity
PatchE

  let [Entity]
allMissingChildBranches :: [Entity] =
        DbBranch
oldBranch
          DbBranch -> Getting (Endo [Entity]) DbBranch Entity -> [Entity]
forall s a. s -> Getting (Endo [a]) s a -> [a]
^.. ((BranchObjectId, CausalHashId)
 -> Const (Endo [Entity]) (BranchObjectId, CausalHashId))
-> DbBranch -> Const (Endo [Entity]) DbBranch
forall t h p c c' (f :: * -> *).
Applicative f =>
(c -> f c') -> Branch' t h p c -> f (Branch' t h p c')
S.childrenHashes_
            (((BranchObjectId, CausalHashId)
  -> Const (Endo [Entity]) (BranchObjectId, CausalHashId))
 -> DbBranch -> Const (Endo [Entity]) DbBranch)
-> ((Entity -> Const (Endo [Entity]) Entity)
    -> (BranchObjectId, CausalHashId)
    -> Const (Endo [Entity]) (BranchObjectId, CausalHashId))
-> Getting (Endo [Entity]) DbBranch Entity
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (BranchObjectId -> Const (Endo [Entity]) BranchObjectId)
-> (BranchObjectId, CausalHashId)
-> Const (Endo [Entity]) (BranchObjectId, CausalHashId)
forall s t a b. Field1 s t a b => Lens s t a b
Lens
  (BranchObjectId, CausalHashId)
  (BranchObjectId, CausalHashId)
  BranchObjectId
  BranchObjectId
_1
            ((BranchObjectId -> Const (Endo [Entity]) BranchObjectId)
 -> (BranchObjectId, CausalHashId)
 -> Const (Endo [Entity]) (BranchObjectId, CausalHashId))
-> ((Entity -> Const (Endo [Entity]) Entity)
    -> BranchObjectId -> Const (Endo [Entity]) BranchObjectId)
-> (Entity -> Const (Endo [Entity]) Entity)
-> (BranchObjectId, CausalHashId)
-> Const (Endo [Entity]) (BranchObjectId, CausalHashId)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (BranchObjectId -> ObjectId)
-> (ObjectId -> Const (Endo [Entity]) ObjectId)
-> BranchObjectId
-> Const (Endo [Entity]) BranchObjectId
forall (p :: * -> * -> *) (f :: * -> *) s a.
(Profunctor p, Contravariant f) =>
(s -> a) -> Optic' p f s a
to BranchObjectId -> ObjectId
unBranchObjectId
            ((ObjectId -> Const (Endo [Entity]) ObjectId)
 -> BranchObjectId -> Const (Endo [Entity]) BranchObjectId)
-> ((Entity -> Const (Endo [Entity]) Entity)
    -> ObjectId -> Const (Endo [Entity]) ObjectId)
-> (Entity -> Const (Endo [Entity]) Entity)
-> BranchObjectId
-> Const (Endo [Entity]) BranchObjectId
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ObjectId -> Bool)
-> Optic' (->) (Const (Endo [Entity])) ObjectId ObjectId
forall (p :: * -> * -> *) (f :: * -> *) a.
(Choice p, Applicative f) =>
(a -> Bool) -> Optic' p f a a
filtered (ObjectId
-> Map ObjectId (ObjectId, HashId, New Hash, New Hash) -> Bool
forall k a. Ord k => k -> Map k a -> Bool
`Map.notMember` Map ObjectId (ObjectId, HashId, New Hash, New Hash)
migratedObjects)
            Optic' (->) (Const (Endo [Entity])) ObjectId ObjectId
-> ((Entity -> Const (Endo [Entity]) Entity)
    -> ObjectId -> Const (Endo [Entity]) ObjectId)
-> (Entity -> Const (Endo [Entity]) Entity)
-> ObjectId
-> Const (Endo [Entity]) ObjectId
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ObjectId -> Entity)
-> (Entity -> Const (Endo [Entity]) Entity)
-> ObjectId
-> Const (Endo [Entity]) ObjectId
forall (p :: * -> * -> *) (f :: * -> *) s a.
(Profunctor p, Contravariant f) =>
(s -> a) -> Optic' p f s a
to ObjectId -> Entity
BranchE

  let [Entity]
allMissingChildCausals :: [Entity] =
        DbBranch
oldBranch
          DbBranch -> Getting (Endo [Entity]) DbBranch Entity -> [Entity]
forall s a. s -> Getting (Endo [a]) s a -> [a]
^.. ((BranchObjectId, CausalHashId)
 -> Const (Endo [Entity]) (BranchObjectId, CausalHashId))
-> DbBranch -> Const (Endo [Entity]) DbBranch
forall t h p c c' (f :: * -> *).
Applicative f =>
(c -> f c') -> Branch' t h p c -> f (Branch' t h p c')
S.childrenHashes_
            (((BranchObjectId, CausalHashId)
  -> Const (Endo [Entity]) (BranchObjectId, CausalHashId))
 -> DbBranch -> Const (Endo [Entity]) DbBranch)
-> ((Entity -> Const (Endo [Entity]) Entity)
    -> (BranchObjectId, CausalHashId)
    -> Const (Endo [Entity]) (BranchObjectId, CausalHashId))
-> Getting (Endo [Entity]) DbBranch Entity
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (CausalHashId -> Const (Endo [Entity]) CausalHashId)
-> (BranchObjectId, CausalHashId)
-> Const (Endo [Entity]) (BranchObjectId, CausalHashId)
forall s t a b. Field2 s t a b => Lens s t a b
Lens
  (BranchObjectId, CausalHashId)
  (BranchObjectId, CausalHashId)
  CausalHashId
  CausalHashId
_2
            ((CausalHashId -> Const (Endo [Entity]) CausalHashId)
 -> (BranchObjectId, CausalHashId)
 -> Const (Endo [Entity]) (BranchObjectId, CausalHashId))
-> ((Entity -> Const (Endo [Entity]) Entity)
    -> CausalHashId -> Const (Endo [Entity]) CausalHashId)
-> (Entity -> Const (Endo [Entity]) Entity)
-> (BranchObjectId, CausalHashId)
-> Const (Endo [Entity]) (BranchObjectId, CausalHashId)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (CausalHashId -> Bool)
-> (CausalHashId -> Const (Endo [Entity]) CausalHashId)
-> CausalHashId
-> Const (Endo [Entity]) CausalHashId
forall (p :: * -> * -> *) (f :: * -> *) a.
(Choice p, Applicative f) =>
(a -> Bool) -> Optic' p f a a
filtered (CausalHashId
-> Map CausalHashId (New (CausalHash, CausalHashId)) -> Bool
forall k a. Ord k => k -> Map k a -> Bool
`Map.notMember` Map CausalHashId (New (CausalHash, CausalHashId))
migratedCausals)
            ((CausalHashId -> Const (Endo [Entity]) CausalHashId)
 -> CausalHashId -> Const (Endo [Entity]) CausalHashId)
-> ((Entity -> Const (Endo [Entity]) Entity)
    -> CausalHashId -> Const (Endo [Entity]) CausalHashId)
-> (Entity -> Const (Endo [Entity]) Entity)
-> CausalHashId
-> Const (Endo [Entity]) CausalHashId
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (CausalHashId -> Entity)
-> (Entity -> Const (Endo [Entity]) Entity)
-> CausalHashId
-> Const (Endo [Entity]) CausalHashId
forall (p :: * -> * -> *) (f :: * -> *) s a.
(Profunctor p, Contravariant f) =>
(s -> a) -> Optic' p f s a
to CausalHashId -> Entity
CausalE

  -- Identify dependencies and bail out if they aren't all built
  let allMissingReferences :: [Entity]
      allMissingReferences :: [Entity]
allMissingReferences =
        [Entity]
allMissingTypesAndTerms
          [Entity] -> [Entity] -> [Entity]
forall a. [a] -> [a] -> [a]
++ [Entity]
allMissingPatches
          [Entity] -> [Entity] -> [Entity]
forall a. [a] -> [a] -> [a]
++ [Entity]
allMissingChildBranches
          [Entity] -> [Entity] -> [Entity]
forall a. [a] -> [a] -> [a]
++ [Entity]
allMissingChildCausals

  Bool
-> ExceptT
     (TrySyncResult Entity) (StateT MigrationState Transaction) ()
-> ExceptT
     (TrySyncResult Entity) (StateT MigrationState Transaction) ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Bool -> Bool
not (Bool -> Bool) -> ([Entity] -> Bool) -> [Entity] -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Entity] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null ([Entity] -> Bool) -> [Entity] -> Bool
forall a b. (a -> b) -> a -> b
$ [Entity]
allMissingReferences) (ExceptT
   (TrySyncResult Entity) (StateT MigrationState Transaction) ()
 -> ExceptT
      (TrySyncResult Entity) (StateT MigrationState Transaction) ())
-> ExceptT
     (TrySyncResult Entity) (StateT MigrationState Transaction) ()
-> ExceptT
     (TrySyncResult Entity) (StateT MigrationState Transaction) ()
forall a b. (a -> b) -> a -> b
$
    TrySyncResult Entity
-> ExceptT
     (TrySyncResult Entity) (StateT MigrationState Transaction) ()
forall (m :: * -> *) e a. Monad m => e -> ExceptT e m a
throwE (TrySyncResult Entity
 -> ExceptT
      (TrySyncResult Entity) (StateT MigrationState Transaction) ())
-> TrySyncResult Entity
-> ExceptT
     (TrySyncResult Entity) (StateT MigrationState Transaction) ()
forall a b. (a -> b) -> a -> b
$
      [Entity] -> TrySyncResult Entity
forall entity. [entity] -> TrySyncResult entity
Sync.Missing [Entity]
allMissingReferences

  let remapPatchObjectId :: PatchObjectId -> PatchObjectId
remapPatchObjectId PatchObjectId
patchObjId = case ObjectId
-> Map ObjectId (ObjectId, HashId, New Hash, New Hash)
-> Maybe (ObjectId, HashId, New Hash, New Hash)
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup (PatchObjectId -> ObjectId
unPatchObjectId PatchObjectId
patchObjId) Map ObjectId (ObjectId, HashId, New Hash, New Hash)
migratedObjects of
        Maybe (ObjectId, HashId, New Hash, New Hash)
Nothing -> [Char] -> PatchObjectId
forall a. HasCallStack => [Char] -> a
error ([Char] -> PatchObjectId) -> [Char] -> PatchObjectId
forall a b. (a -> b) -> a -> b
$ [Char]
"Expected patch: " [Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<> PatchObjectId -> [Char]
forall a. Show a => a -> [Char]
show PatchObjectId
patchObjId [Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<> [Char]
" to be migrated"
        Just (ObjectId
newPatchObjId, HashId
_, New Hash
_, New Hash
_) -> ObjectId -> PatchObjectId
PatchObjectId ObjectId
newPatchObjId
  let remapCausalHashId :: CausalHashId -> CausalHashId
remapCausalHashId CausalHashId
causalHashId = case CausalHashId
-> Map CausalHashId (New (CausalHash, CausalHashId))
-> Maybe (New (CausalHash, CausalHashId))
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup CausalHashId
causalHashId Map CausalHashId (New (CausalHash, CausalHashId))
migratedCausals of
        Maybe (New (CausalHash, CausalHashId))
Nothing -> [Char] -> CausalHashId
forall a. HasCallStack => [Char] -> a
error ([Char] -> CausalHashId) -> [Char] -> CausalHashId
forall a b. (a -> b) -> a -> b
$ [Char]
"Expected causal hash id: " [Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<> CausalHashId -> [Char]
forall a. Show a => a -> [Char]
show CausalHashId
causalHashId [Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<> [Char]
" to be migrated"
        Just (CausalHash
_, CausalHashId
newCausalHashId) -> CausalHashId
newCausalHashId
  let remapBranchObjectId :: BranchObjectId -> BranchObjectId
remapBranchObjectId BranchObjectId
objId = case ObjectId
-> Map ObjectId (ObjectId, HashId, New Hash, New Hash)
-> Maybe (ObjectId, HashId, New Hash, New Hash)
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup (BranchObjectId -> ObjectId
unBranchObjectId BranchObjectId
objId) Map ObjectId (ObjectId, HashId, New Hash, New Hash)
migratedObjects of
        Maybe (ObjectId, HashId, New Hash, New Hash)
Nothing -> [Char] -> BranchObjectId
forall a. HasCallStack => [Char] -> a
error ([Char] -> BranchObjectId) -> [Char] -> BranchObjectId
forall a b. (a -> b) -> a -> b
$ [Char]
"Expected object: " [Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<> BranchObjectId -> [Char]
forall a. Show a => a -> [Char]
show BranchObjectId
objId [Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<> [Char]
" to be migrated"
        Just (ObjectId
newBranchObjId, HashId
_, New Hash
_, New Hash
_) -> ObjectId -> BranchObjectId
BranchObjectId ObjectId
newBranchObjId

  let newBranch :: S.DbBranch
      newBranch :: DbBranch
newBranch =
        DbBranch
oldBranch
          DbBranch -> (DbBranch -> DbBranch) -> DbBranch
forall a b. a -> (a -> b) -> b
& (SomeReference (Id' ObjectId)
 -> Identity (SomeReference (Id' ObjectId)))
-> DbBranch -> Identity DbBranch
forall t h p c.
(Ord t, Ord h) =>
Traversal' (Branch' t h p c) (SomeReference (Id' h))
Traversal' DbBranch (SomeReference (Id' ObjectId))
branchSomeRefs_ ((SomeReference (Id' ObjectId)
  -> Identity (SomeReference (Id' ObjectId)))
 -> DbBranch -> Identity DbBranch)
-> (SomeReference (Id' ObjectId) -> SomeReference (Id' ObjectId))
-> DbBranch
-> DbBranch
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ Map ObjectId (ObjectId, HashId, New Hash, New Hash)
-> Map SomeReferenceId SomeReferenceId
-> SomeReference (Id' ObjectId)
-> SomeReference (Id' ObjectId)
remapObjIdRefs Map ObjectId (ObjectId, HashId, New Hash, New Hash)
migratedObjects Map SomeReferenceId SomeReferenceId
migratedRefs
          DbBranch -> (DbBranch -> DbBranch) -> DbBranch
forall a b. a -> (a -> b) -> b
& (PatchObjectId -> Identity PatchObjectId)
-> DbBranch -> Identity DbBranch
forall t h p c p' (f :: * -> *).
Applicative f =>
(p -> f p') -> Branch' t h p c -> f (Branch' t h p' c)
S.patches_ ((PatchObjectId -> Identity PatchObjectId)
 -> DbBranch -> Identity DbBranch)
-> (PatchObjectId -> PatchObjectId) -> DbBranch -> DbBranch
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ PatchObjectId -> PatchObjectId
remapPatchObjectId
          DbBranch -> (DbBranch -> DbBranch) -> DbBranch
forall a b. a -> (a -> b) -> b
& ((BranchObjectId, CausalHashId)
 -> Identity (BranchObjectId, CausalHashId))
-> DbBranch -> Identity DbBranch
forall t h p c c' (f :: * -> *).
Applicative f =>
(c -> f c') -> Branch' t h p c -> f (Branch' t h p c')
S.childrenHashes_ (((BranchObjectId, CausalHashId)
  -> Identity (BranchObjectId, CausalHashId))
 -> DbBranch -> Identity DbBranch)
-> ((BranchObjectId, CausalHashId)
    -> (BranchObjectId, CausalHashId))
-> DbBranch
-> DbBranch
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ (BranchObjectId -> BranchObjectId
remapBranchObjectId (BranchObjectId -> BranchObjectId)
-> (CausalHashId -> CausalHashId)
-> (BranchObjectId, CausalHashId)
-> (BranchObjectId, CausalHashId)
forall a b c d. (a -> b) -> (c -> d) -> (a, c) -> (b, d)
*** CausalHashId -> CausalHashId
remapCausalHashId)

  BranchHash
newHash <- StateT MigrationState Transaction BranchHash
-> ExceptT
     (TrySyncResult Entity)
     (StateT MigrationState Transaction)
     BranchHash
forall (m :: * -> *) a.
Monad m =>
m a -> ExceptT (TrySyncResult Entity) m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (StateT MigrationState Transaction BranchHash
 -> ExceptT
      (TrySyncResult Entity)
      (StateT MigrationState Transaction)
      BranchHash)
-> (Transaction BranchHash
    -> StateT MigrationState Transaction BranchHash)
-> Transaction BranchHash
-> ExceptT
     (TrySyncResult Entity)
     (StateT MigrationState Transaction)
     BranchHash
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Transaction BranchHash
-> StateT MigrationState Transaction BranchHash
forall (m :: * -> *) a. Monad m => m a -> StateT MigrationState m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (Transaction BranchHash
 -> ExceptT
      (TrySyncResult Entity)
      (StateT MigrationState Transaction)
      BranchHash)
-> Transaction BranchHash
-> ExceptT
     (TrySyncResult Entity)
     (StateT MigrationState Transaction)
     BranchHash
forall a b. (a -> b) -> a -> b
$ DbBranch -> Transaction BranchHash
Hashing.dbBranchHash DbBranch
newBranch
  BranchHashId
newHashId <- StateT MigrationState Transaction BranchHashId
-> ExceptT
     (TrySyncResult Entity)
     (StateT MigrationState Transaction)
     BranchHashId
forall (m :: * -> *) a.
Monad m =>
m a -> ExceptT (TrySyncResult Entity) m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (StateT MigrationState Transaction BranchHashId
 -> ExceptT
      (TrySyncResult Entity)
      (StateT MigrationState Transaction)
      BranchHashId)
-> (Transaction BranchHashId
    -> StateT MigrationState Transaction BranchHashId)
-> Transaction BranchHashId
-> ExceptT
     (TrySyncResult Entity)
     (StateT MigrationState Transaction)
     BranchHashId
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Transaction BranchHashId
-> StateT MigrationState Transaction BranchHashId
forall (m :: * -> *) a. Monad m => m a -> StateT MigrationState m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (Transaction BranchHashId
 -> ExceptT
      (TrySyncResult Entity)
      (StateT MigrationState Transaction)
      BranchHashId)
-> Transaction BranchHashId
-> ExceptT
     (TrySyncResult Entity)
     (StateT MigrationState Transaction)
     BranchHashId
forall a b. (a -> b) -> a -> b
$ BranchHash -> Transaction BranchHashId
Q.saveBranchHash BranchHash
newHash
  NamespaceStats
stats <- StateT MigrationState Transaction NamespaceStats
-> ExceptT
     (TrySyncResult Entity)
     (StateT MigrationState Transaction)
     NamespaceStats
forall (m :: * -> *) a.
Monad m =>
m a -> ExceptT (TrySyncResult Entity) m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (StateT MigrationState Transaction NamespaceStats
 -> ExceptT
      (TrySyncResult Entity)
      (StateT MigrationState Transaction)
      NamespaceStats)
-> (Transaction NamespaceStats
    -> StateT MigrationState Transaction NamespaceStats)
-> Transaction NamespaceStats
-> ExceptT
     (TrySyncResult Entity)
     (StateT MigrationState Transaction)
     NamespaceStats
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Transaction NamespaceStats
-> StateT MigrationState Transaction NamespaceStats
forall (m :: * -> *) a. Monad m => m a -> StateT MigrationState m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (Transaction NamespaceStats
 -> ExceptT
      (TrySyncResult Entity)
      (StateT MigrationState Transaction)
      NamespaceStats)
-> Transaction NamespaceStats
-> ExceptT
     (TrySyncResult Entity)
     (StateT MigrationState Transaction)
     NamespaceStats
forall a b. (a -> b) -> a -> b
$ DbBranchV -> Transaction NamespaceStats
Ops.namespaceStatsForDbBranch (DbBranch -> DbBranchV
Ops.DbBranchV2 DbBranch
newBranch)
  BranchObjectId
newObjectId <- StateT MigrationState Transaction BranchObjectId
-> ExceptT
     (TrySyncResult Entity)
     (StateT MigrationState Transaction)
     BranchObjectId
forall (m :: * -> *) a.
Monad m =>
m a -> ExceptT (TrySyncResult Entity) m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (StateT MigrationState Transaction BranchObjectId
 -> ExceptT
      (TrySyncResult Entity)
      (StateT MigrationState Transaction)
      BranchObjectId)
-> (Transaction BranchObjectId
    -> StateT MigrationState Transaction BranchObjectId)
-> Transaction BranchObjectId
-> ExceptT
     (TrySyncResult Entity)
     (StateT MigrationState Transaction)
     BranchObjectId
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Transaction BranchObjectId
-> StateT MigrationState Transaction BranchObjectId
forall (m :: * -> *) a. Monad m => m a -> StateT MigrationState m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (Transaction BranchObjectId
 -> ExceptT
      (TrySyncResult Entity)
      (StateT MigrationState Transaction)
      BranchObjectId)
-> Transaction BranchObjectId
-> ExceptT
     (TrySyncResult Entity)
     (StateT MigrationState Transaction)
     BranchObjectId
forall a b. (a -> b) -> a -> b
$ HashHandle
-> BranchHashId
-> NamespaceStats
-> DbBranchV
-> Transaction BranchObjectId
Ops.saveDbBranchUnderHashId HashHandle
v2HashHandle BranchHashId
newHashId NamespaceStats
stats (DbBranch -> DbBranchV
Ops.DbBranchV2 DbBranch
newBranch)
  forall (field :: Symbol) s t a b.
HasField field s t a b =>
Lens s t a b
field @"objLookup"
    ((Map ObjectId (ObjectId, HashId, New Hash, New Hash)
  -> Identity (Map ObjectId (ObjectId, HashId, New Hash, New Hash)))
 -> MigrationState -> Identity MigrationState)
-> (Map ObjectId (ObjectId, HashId, New Hash, New Hash)
    -> Map ObjectId (ObjectId, HashId, New Hash, New Hash))
-> ExceptT
     (TrySyncResult Entity) (StateT MigrationState Transaction) ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
%= ObjectId
-> (ObjectId, HashId, New Hash, New Hash)
-> Map ObjectId (ObjectId, HashId, New Hash, New Hash)
-> Map ObjectId (ObjectId, HashId, New Hash, New Hash)
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert
      ObjectId
oldObjectId
      ( BranchObjectId -> ObjectId
unBranchObjectId BranchObjectId
newObjectId,
        BranchHashId -> HashId
unBranchHashId BranchHashId
newHashId,
        BranchHash -> New Hash
unBranchHash BranchHash
newHash,
        New Hash
oldHash
      )
  pure TrySyncResult Entity
forall entity. TrySyncResult entity
Sync.Done

migratePatch :: Old PatchObjectId -> StateT MigrationState Sqlite.Transaction (Sync.TrySyncResult Entity)
migratePatch :: PatchObjectId
-> StateT MigrationState Transaction (TrySyncResult Entity)
migratePatch PatchObjectId
oldObjectId = (Either (TrySyncResult Entity) (TrySyncResult Entity)
 -> TrySyncResult Entity)
-> StateT
     MigrationState
     Transaction
     (Either (TrySyncResult Entity) (TrySyncResult Entity))
-> StateT MigrationState Transaction (TrySyncResult Entity)
forall a b.
(a -> b)
-> StateT MigrationState Transaction a
-> StateT MigrationState Transaction b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((TrySyncResult Entity -> TrySyncResult Entity)
-> (TrySyncResult Entity -> TrySyncResult Entity)
-> Either (TrySyncResult Entity) (TrySyncResult Entity)
-> TrySyncResult Entity
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either TrySyncResult Entity -> TrySyncResult Entity
forall a. a -> a
id TrySyncResult Entity -> TrySyncResult Entity
forall a. a -> a
id) (StateT
   MigrationState
   Transaction
   (Either (TrySyncResult Entity) (TrySyncResult Entity))
 -> StateT MigrationState Transaction (TrySyncResult Entity))
-> (ExceptT
      (TrySyncResult Entity)
      (StateT MigrationState Transaction)
      (TrySyncResult Entity)
    -> StateT
         MigrationState
         Transaction
         (Either (TrySyncResult Entity) (TrySyncResult Entity)))
-> ExceptT
     (TrySyncResult Entity)
     (StateT MigrationState Transaction)
     (TrySyncResult Entity)
-> StateT MigrationState Transaction (TrySyncResult Entity)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ExceptT
  (TrySyncResult Entity)
  (StateT MigrationState Transaction)
  (TrySyncResult Entity)
-> StateT
     MigrationState
     Transaction
     (Either (TrySyncResult Entity) (TrySyncResult Entity))
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT (ExceptT
   (TrySyncResult Entity)
   (StateT MigrationState Transaction)
   (TrySyncResult Entity)
 -> StateT MigrationState Transaction (TrySyncResult Entity))
-> ExceptT
     (TrySyncResult Entity)
     (StateT MigrationState Transaction)
     (TrySyncResult Entity)
-> StateT MigrationState Transaction (TrySyncResult Entity)
forall a b. (a -> b) -> a -> b
$ do
  ExceptT
  (TrySyncResult Entity) (StateT MigrationState Transaction) Bool
-> ExceptT
     (TrySyncResult Entity) (StateT MigrationState Transaction) ()
-> ExceptT
     (TrySyncResult Entity) (StateT MigrationState Transaction) ()
forall (m :: * -> *). Monad m => m Bool -> m () -> m ()
whenM (ObjectId
-> Map ObjectId (ObjectId, HashId, New Hash, New Hash) -> Bool
forall k a. Ord k => k -> Map k a -> Bool
Map.member (PatchObjectId -> ObjectId
unPatchObjectId PatchObjectId
oldObjectId) (Map ObjectId (ObjectId, HashId, New Hash, New Hash) -> Bool)
-> ExceptT
     (TrySyncResult Entity)
     (StateT MigrationState Transaction)
     (Map ObjectId (ObjectId, HashId, New Hash, New Hash))
-> ExceptT
     (TrySyncResult Entity) (StateT MigrationState Transaction) Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Getting
  (Map ObjectId (ObjectId, HashId, New Hash, New Hash))
  MigrationState
  (Map ObjectId (ObjectId, HashId, New Hash, New Hash))
-> ExceptT
     (TrySyncResult Entity)
     (StateT MigrationState Transaction)
     (Map ObjectId (ObjectId, HashId, New Hash, New Hash))
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use (forall (field :: Symbol) s t a b.
HasField field s t a b =>
Lens s t a b
field @"objLookup")) (TrySyncResult Entity
-> ExceptT
     (TrySyncResult Entity) (StateT MigrationState Transaction) ()
forall (m :: * -> *) e a. Monad m => e -> ExceptT e m a
throwE TrySyncResult Entity
forall entity. TrySyncResult entity
Sync.PreviouslyDone)

  New Hash
oldHash <- StateT MigrationState Transaction (New Hash)
-> ExceptT
     (TrySyncResult Entity)
     (StateT MigrationState Transaction)
     (New Hash)
forall (m :: * -> *) a.
Monad m =>
m a -> ExceptT (TrySyncResult Entity) m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (StateT MigrationState Transaction (New Hash)
 -> ExceptT
      (TrySyncResult Entity)
      (StateT MigrationState Transaction)
      (New Hash))
-> (Transaction (New Hash)
    -> StateT MigrationState Transaction (New Hash))
-> Transaction (New Hash)
-> ExceptT
     (TrySyncResult Entity)
     (StateT MigrationState Transaction)
     (New Hash)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Transaction (New Hash)
-> StateT MigrationState Transaction (New Hash)
forall (m :: * -> *) a. Monad m => m a -> StateT MigrationState m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (Transaction (New Hash)
 -> ExceptT
      (TrySyncResult Entity)
      (StateT MigrationState Transaction)
      (New Hash))
-> Transaction (New Hash)
-> ExceptT
     (TrySyncResult Entity)
     (StateT MigrationState Transaction)
     (New Hash)
forall a b. (a -> b) -> a -> b
$ ObjectId -> Transaction (New Hash)
Q.expectPrimaryHashByObjectId (PatchObjectId -> ObjectId
unPatchObjectId PatchObjectId
oldObjectId)
  Patch
oldPatch <- StateT MigrationState Transaction Patch
-> ExceptT
     (TrySyncResult Entity) (StateT MigrationState Transaction) Patch
forall (m :: * -> *) a.
Monad m =>
m a -> ExceptT (TrySyncResult Entity) m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (StateT MigrationState Transaction Patch
 -> ExceptT
      (TrySyncResult Entity) (StateT MigrationState Transaction) Patch)
-> (Transaction Patch -> StateT MigrationState Transaction Patch)
-> Transaction Patch
-> ExceptT
     (TrySyncResult Entity) (StateT MigrationState Transaction) Patch
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Transaction Patch -> StateT MigrationState Transaction Patch
forall (m :: * -> *) a. Monad m => m a -> StateT MigrationState m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (Transaction Patch
 -> ExceptT
      (TrySyncResult Entity) (StateT MigrationState Transaction) Patch)
-> Transaction Patch
-> ExceptT
     (TrySyncResult Entity) (StateT MigrationState Transaction) Patch
forall a b. (a -> b) -> a -> b
$ PatchObjectId -> Transaction Patch
Ops.expectDbPatch PatchObjectId
oldObjectId

  Patch' TextId (New Hash) (New Hash)
oldPatchWithHashes :: S.Patch' TextId Hash Hash <-
    StateT
  MigrationState Transaction (Patch' TextId (New Hash) (New Hash))
-> ExceptT
     (TrySyncResult Entity)
     (StateT MigrationState Transaction)
     (Patch' TextId (New Hash) (New Hash))
forall (m :: * -> *) a.
Monad m =>
m a -> ExceptT (TrySyncResult Entity) m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (StateT
   MigrationState Transaction (Patch' TextId (New Hash) (New Hash))
 -> ExceptT
      (TrySyncResult Entity)
      (StateT MigrationState Transaction)
      (Patch' TextId (New Hash) (New Hash)))
-> (Transaction (Patch' TextId (New Hash) (New Hash))
    -> StateT
         MigrationState Transaction (Patch' TextId (New Hash) (New Hash)))
-> Transaction (Patch' TextId (New Hash) (New Hash))
-> ExceptT
     (TrySyncResult Entity)
     (StateT MigrationState Transaction)
     (Patch' TextId (New Hash) (New Hash))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Transaction (Patch' TextId (New Hash) (New Hash))
-> StateT
     MigrationState Transaction (Patch' TextId (New Hash) (New Hash))
forall (m :: * -> *) a. Monad m => m a -> StateT MigrationState m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (Transaction (Patch' TextId (New Hash) (New Hash))
 -> ExceptT
      (TrySyncResult Entity)
      (StateT MigrationState Transaction)
      (Patch' TextId (New Hash) (New Hash)))
-> Transaction (Patch' TextId (New Hash) (New Hash))
-> ExceptT
     (TrySyncResult Entity)
     (StateT MigrationState Transaction)
     (Patch' TextId (New Hash) (New Hash))
forall a b. (a -> b) -> a -> b
$
      (Patch
oldPatch Patch
-> (Patch -> Transaction (Patch' TextId (New Hash) ObjectId))
-> Transaction (Patch' TextId (New Hash) ObjectId)
forall a b. a -> (a -> b) -> b
& (HashId -> Transaction (New Hash))
-> Patch -> Transaction (Patch' TextId (New Hash) ObjectId)
forall t h' h o.
(Ord t, Ord h') =>
Traversal (Patch' t h o) (Patch' t h' o) h h'
Traversal
  Patch (Patch' TextId (New Hash) ObjectId) HashId (New Hash)
S.patchH_ ((HashId -> Transaction (New Hash))
 -> Patch -> Transaction (Patch' TextId (New Hash) ObjectId))
-> (HashId -> Transaction (New Hash))
-> Patch
-> Transaction (Patch' TextId (New Hash) ObjectId)
forall {k} (f :: k -> *) s (t :: k) a (b :: k).
LensLike f s t a b -> LensLike f s t a b
%%~ HashId -> Transaction (New Hash)
Q.expectHash)
        Transaction (Patch' TextId (New Hash) ObjectId)
-> (Patch' TextId (New Hash) ObjectId
    -> Transaction (Patch' TextId (New Hash) (New Hash)))
-> Transaction (Patch' TextId (New Hash) (New Hash))
forall a b. Transaction a -> (a -> Transaction b) -> Transaction b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= ((ObjectId -> Transaction (New Hash))
-> Patch' TextId (New Hash) ObjectId
-> Transaction (Patch' TextId (New Hash) (New Hash))
forall t o' h o.
(Ord t, Ord o') =>
Traversal (Patch' t h o) (Patch' t h o') o o'
Traversal
  (Patch' TextId (New Hash) ObjectId)
  (Patch' TextId (New Hash) (New Hash))
  ObjectId
  (New Hash)
S.patchO_ ((ObjectId -> Transaction (New Hash))
 -> Patch' TextId (New Hash) ObjectId
 -> Transaction (Patch' TextId (New Hash) (New Hash)))
-> (ObjectId -> Transaction (New Hash))
-> Patch' TextId (New Hash) ObjectId
-> Transaction (Patch' TextId (New Hash) (New Hash))
forall {k} (f :: k -> *) s (t :: k) a (b :: k).
LensLike f s t a b -> LensLike f s t a b
%%~ ObjectId -> Transaction (New Hash)
Q.expectPrimaryHashByObjectId)

  Map SomeReferenceId SomeReferenceId
migratedRefs <- (MigrationState -> Map SomeReferenceId SomeReferenceId)
-> ExceptT
     (TrySyncResult Entity)
     (StateT MigrationState Transaction)
     (Map SomeReferenceId SomeReferenceId)
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets MigrationState -> Map SomeReferenceId SomeReferenceId
referenceMapping
  let isUnmigratedRef :: SomeReferenceId -> Bool
isUnmigratedRef SomeReferenceId
ref = SomeReferenceId -> Map SomeReferenceId SomeReferenceId -> Bool
forall k a. Ord k => k -> Map k a -> Bool
Map.notMember SomeReferenceId
ref Map SomeReferenceId SomeReferenceId
migratedRefs
  -- 2. Determine whether all things the patch refers to are built.
  let unmigratedDependencies :: [Entity]
      unmigratedDependencies :: [Entity]
unmigratedDependencies =
        Patch' TextId (New Hash) (New Hash)
oldPatchWithHashes Patch' TextId (New Hash) (New Hash)
-> Getting
     (Endo [Entity]) (Patch' TextId (New Hash) (New Hash)) Entity
-> [Entity]
forall s a. s -> Getting (Endo [a]) s a -> [a]
^.. (SomeReferenceId -> Const (Endo [Entity]) SomeReferenceId)
-> Patch' TextId (New Hash) (New Hash)
-> Const (Endo [Entity]) (Patch' TextId (New Hash) (New Hash))
forall t h o.
(Ord t, Ord h) =>
Traversal
  (Patch' t h o)
  (Patch' t h o)
  (SomeReference (Id' h))
  (SomeReference (Id' h))
Traversal
  (Patch' TextId (New Hash) (New Hash))
  (Patch' TextId (New Hash) (New Hash))
  SomeReferenceId
  SomeReferenceId
patchSomeRefsH_ ((SomeReferenceId -> Const (Endo [Entity]) SomeReferenceId)
 -> Patch' TextId (New Hash) (New Hash)
 -> Const (Endo [Entity]) (Patch' TextId (New Hash) (New Hash)))
-> ((Entity -> Const (Endo [Entity]) Entity)
    -> SomeReferenceId -> Const (Endo [Entity]) SomeReferenceId)
-> Getting
     (Endo [Entity]) (Patch' TextId (New Hash) (New Hash)) Entity
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (SomeReferenceId -> Const (Endo [Entity]) SomeReferenceId)
-> SomeReferenceId -> Const (Endo [Entity]) SomeReferenceId
Iso' SomeReferenceId SomeReferenceId
uRefIdAsRefId_ ((SomeReferenceId -> Const (Endo [Entity]) SomeReferenceId)
 -> SomeReferenceId -> Const (Endo [Entity]) SomeReferenceId)
-> ((Entity -> Const (Endo [Entity]) Entity)
    -> SomeReferenceId -> Const (Endo [Entity]) SomeReferenceId)
-> (Entity -> Const (Endo [Entity]) Entity)
-> SomeReferenceId
-> Const (Endo [Entity]) SomeReferenceId
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (SomeReferenceId -> Bool)
-> (SomeReferenceId -> Const (Endo [Entity]) SomeReferenceId)
-> SomeReferenceId
-> Const (Endo [Entity]) SomeReferenceId
forall (p :: * -> * -> *) (f :: * -> *) a.
(Choice p, Applicative f) =>
(a -> Bool) -> Optic' p f a a
filtered SomeReferenceId -> Bool
isUnmigratedRef ((SomeReferenceId -> Const (Endo [Entity]) SomeReferenceId)
 -> SomeReferenceId -> Const (Endo [Entity]) SomeReferenceId)
-> ((Entity -> Const (Endo [Entity]) Entity)
    -> SomeReferenceId -> Const (Endo [Entity]) SomeReferenceId)
-> (Entity -> Const (Endo [Entity]) Entity)
-> SomeReferenceId
-> Const (Endo [Entity]) SomeReferenceId
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (SomeReferenceId -> Entity)
-> (Entity -> Const (Endo [Entity]) Entity)
-> SomeReferenceId
-> Const (Endo [Entity]) SomeReferenceId
forall (p :: * -> * -> *) (f :: * -> *) s a.
(Profunctor p, Contravariant f) =>
(s -> a) -> Optic' p f s a
to SomeReferenceId -> Entity
someReferenceIdToEntity
          [Entity] -> [Entity] -> [Entity]
forall a. Semigroup a => a -> a -> a
<> Patch' TextId (New Hash) (New Hash)
oldPatchWithHashes Patch' TextId (New Hash) (New Hash)
-> Getting
     (Endo [Entity]) (Patch' TextId (New Hash) (New Hash)) Entity
-> [Entity]
forall s a. s -> Getting (Endo [a]) s a -> [a]
^.. (SomeReferenceId -> Const (Endo [Entity]) SomeReferenceId)
-> Patch' TextId (New Hash) (New Hash)
-> Const (Endo [Entity]) (Patch' TextId (New Hash) (New Hash))
forall t h o.
(Ord t, Ord h, Ord o) =>
Traversal' (Patch' t h o) (SomeReference (Id' o))
Traversal
  (Patch' TextId (New Hash) (New Hash))
  (Patch' TextId (New Hash) (New Hash))
  SomeReferenceId
  SomeReferenceId
patchSomeRefsO_ ((SomeReferenceId -> Const (Endo [Entity]) SomeReferenceId)
 -> Patch' TextId (New Hash) (New Hash)
 -> Const (Endo [Entity]) (Patch' TextId (New Hash) (New Hash)))
-> ((Entity -> Const (Endo [Entity]) Entity)
    -> SomeReferenceId -> Const (Endo [Entity]) SomeReferenceId)
-> Getting
     (Endo [Entity]) (Patch' TextId (New Hash) (New Hash)) Entity
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (SomeReferenceId -> Const (Endo [Entity]) SomeReferenceId)
-> SomeReferenceId -> Const (Endo [Entity]) SomeReferenceId
Iso' SomeReferenceId SomeReferenceId
uRefIdAsRefId_ ((SomeReferenceId -> Const (Endo [Entity]) SomeReferenceId)
 -> SomeReferenceId -> Const (Endo [Entity]) SomeReferenceId)
-> ((Entity -> Const (Endo [Entity]) Entity)
    -> SomeReferenceId -> Const (Endo [Entity]) SomeReferenceId)
-> (Entity -> Const (Endo [Entity]) Entity)
-> SomeReferenceId
-> Const (Endo [Entity]) SomeReferenceId
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (SomeReferenceId -> Bool)
-> (SomeReferenceId -> Const (Endo [Entity]) SomeReferenceId)
-> SomeReferenceId
-> Const (Endo [Entity]) SomeReferenceId
forall (p :: * -> * -> *) (f :: * -> *) a.
(Choice p, Applicative f) =>
(a -> Bool) -> Optic' p f a a
filtered SomeReferenceId -> Bool
isUnmigratedRef ((SomeReferenceId -> Const (Endo [Entity]) SomeReferenceId)
 -> SomeReferenceId -> Const (Endo [Entity]) SomeReferenceId)
-> ((Entity -> Const (Endo [Entity]) Entity)
    -> SomeReferenceId -> Const (Endo [Entity]) SomeReferenceId)
-> (Entity -> Const (Endo [Entity]) Entity)
-> SomeReferenceId
-> Const (Endo [Entity]) SomeReferenceId
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (SomeReferenceId -> Entity)
-> (Entity -> Const (Endo [Entity]) Entity)
-> SomeReferenceId
-> Const (Endo [Entity]) SomeReferenceId
forall (p :: * -> * -> *) (f :: * -> *) s a.
(Profunctor p, Contravariant f) =>
(s -> a) -> Optic' p f s a
to SomeReferenceId -> Entity
someReferenceIdToEntity
  Bool
-> ExceptT
     (TrySyncResult Entity) (StateT MigrationState Transaction) ()
-> ExceptT
     (TrySyncResult Entity) (StateT MigrationState Transaction) ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Bool -> Bool
not (Bool -> Bool) -> ([Entity] -> Bool) -> [Entity] -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Entity] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null ([Entity] -> Bool) -> [Entity] -> Bool
forall a b. (a -> b) -> a -> b
$ [Entity]
unmigratedDependencies) (TrySyncResult Entity
-> ExceptT
     (TrySyncResult Entity) (StateT MigrationState Transaction) ()
forall (m :: * -> *) e a. Monad m => e -> ExceptT e m a
throwE ([Entity] -> TrySyncResult Entity
forall entity. [entity] -> TrySyncResult entity
Sync.Missing [Entity]
unmigratedDependencies))

  let hashToHashId :: Hash -> Sqlite.Transaction HashId
      hashToHashId :: New Hash -> Transaction HashId
hashToHashId New Hash
h =
        HashId -> Maybe HashId -> HashId
forall a. a -> Maybe a -> a
fromMaybe ([Char] -> HashId
forall a. HasCallStack => [Char] -> a
error ([Char] -> HashId) -> [Char] -> HashId
forall a b. (a -> b) -> a -> b
$ [Char]
"expected hashId for hash: " [Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<> New Hash -> [Char]
forall a. Show a => a -> [Char]
show New Hash
h) (Maybe HashId -> HashId)
-> Transaction (Maybe HashId) -> Transaction HashId
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> New Hash -> Transaction (Maybe HashId)
Q.loadHashIdByHash New Hash
h
  let hashToObjectId :: Hash -> Sqlite.Transaction ObjectId
      hashToObjectId :: New Hash -> Transaction ObjectId
hashToObjectId = New Hash -> Transaction HashId
hashToHashId (New Hash -> Transaction HashId)
-> (HashId -> Transaction ObjectId)
-> New Hash
-> Transaction ObjectId
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> HashId -> Transaction ObjectId
Q.expectObjectIdForPrimaryHashId

  Map SomeReferenceId SomeReferenceId
migratedReferences <- (MigrationState -> Map SomeReferenceId SomeReferenceId)
-> ExceptT
     (TrySyncResult Entity)
     (StateT MigrationState Transaction)
     (Map SomeReferenceId SomeReferenceId)
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets MigrationState -> Map SomeReferenceId SomeReferenceId
referenceMapping
  let remapRef :: SomeReferenceId -> SomeReferenceId
      remapRef :: SomeReferenceId -> SomeReferenceId
remapRef SomeReferenceId
ref = SomeReferenceId
-> SomeReferenceId
-> Map SomeReferenceId SomeReferenceId
-> SomeReferenceId
forall k a. Ord k => a -> k -> Map k a -> a
Map.findWithDefault SomeReferenceId
ref SomeReferenceId
ref Map SomeReferenceId SomeReferenceId
migratedReferences

  let newPatch :: Patch' TextId (New Hash) (New Hash)
newPatch =
        Patch' TextId (New Hash) (New Hash)
oldPatchWithHashes
          Patch' TextId (New Hash) (New Hash)
-> (Patch' TextId (New Hash) (New Hash)
    -> Patch' TextId (New Hash) (New Hash))
-> Patch' TextId (New Hash) (New Hash)
forall a b. a -> (a -> b) -> b
& (SomeReferenceId -> Identity SomeReferenceId)
-> Patch' TextId (New Hash) (New Hash)
-> Identity (Patch' TextId (New Hash) (New Hash))
forall t h o.
(Ord t, Ord h) =>
Traversal
  (Patch' t h o)
  (Patch' t h o)
  (SomeReference (Id' h))
  (SomeReference (Id' h))
Traversal
  (Patch' TextId (New Hash) (New Hash))
  (Patch' TextId (New Hash) (New Hash))
  SomeReferenceId
  SomeReferenceId
patchSomeRefsH_ ((SomeReferenceId -> Identity SomeReferenceId)
 -> Patch' TextId (New Hash) (New Hash)
 -> Identity (Patch' TextId (New Hash) (New Hash)))
-> ((SomeReferenceId -> Identity SomeReferenceId)
    -> SomeReferenceId -> Identity SomeReferenceId)
-> (SomeReferenceId -> Identity SomeReferenceId)
-> Patch' TextId (New Hash) (New Hash)
-> Identity (Patch' TextId (New Hash) (New Hash))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (SomeReferenceId -> Identity SomeReferenceId)
-> SomeReferenceId -> Identity SomeReferenceId
Iso' SomeReferenceId SomeReferenceId
uRefIdAsRefId_ ((SomeReferenceId -> Identity SomeReferenceId)
 -> Patch' TextId (New Hash) (New Hash)
 -> Identity (Patch' TextId (New Hash) (New Hash)))
-> (SomeReferenceId -> SomeReferenceId)
-> Patch' TextId (New Hash) (New Hash)
-> Patch' TextId (New Hash) (New Hash)
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ SomeReferenceId -> SomeReferenceId
remapRef
          Patch' TextId (New Hash) (New Hash)
-> (Patch' TextId (New Hash) (New Hash)
    -> Patch' TextId (New Hash) (New Hash))
-> Patch' TextId (New Hash) (New Hash)
forall a b. a -> (a -> b) -> b
& (SomeReferenceId -> Identity SomeReferenceId)
-> Patch' TextId (New Hash) (New Hash)
-> Identity (Patch' TextId (New Hash) (New Hash))
forall t h o.
(Ord t, Ord h, Ord o) =>
Traversal' (Patch' t h o) (SomeReference (Id' o))
Traversal
  (Patch' TextId (New Hash) (New Hash))
  (Patch' TextId (New Hash) (New Hash))
  SomeReferenceId
  SomeReferenceId
patchSomeRefsO_ ((SomeReferenceId -> Identity SomeReferenceId)
 -> Patch' TextId (New Hash) (New Hash)
 -> Identity (Patch' TextId (New Hash) (New Hash)))
-> ((SomeReferenceId -> Identity SomeReferenceId)
    -> SomeReferenceId -> Identity SomeReferenceId)
-> (SomeReferenceId -> Identity SomeReferenceId)
-> Patch' TextId (New Hash) (New Hash)
-> Identity (Patch' TextId (New Hash) (New Hash))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (SomeReferenceId -> Identity SomeReferenceId)
-> SomeReferenceId -> Identity SomeReferenceId
Iso' SomeReferenceId SomeReferenceId
uRefIdAsRefId_ ((SomeReferenceId -> Identity SomeReferenceId)
 -> Patch' TextId (New Hash) (New Hash)
 -> Identity (Patch' TextId (New Hash) (New Hash)))
-> (SomeReferenceId -> SomeReferenceId)
-> Patch' TextId (New Hash) (New Hash)
-> Patch' TextId (New Hash) (New Hash)
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ SomeReferenceId -> SomeReferenceId
remapRef

  Patch
newPatchWithIds :: S.Patch <-
    StateT MigrationState Transaction Patch
-> ExceptT
     (TrySyncResult Entity) (StateT MigrationState Transaction) Patch
forall (m :: * -> *) a.
Monad m =>
m a -> ExceptT (TrySyncResult Entity) m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (StateT MigrationState Transaction Patch
 -> ExceptT
      (TrySyncResult Entity) (StateT MigrationState Transaction) Patch)
-> (Transaction Patch -> StateT MigrationState Transaction Patch)
-> Transaction Patch
-> ExceptT
     (TrySyncResult Entity) (StateT MigrationState Transaction) Patch
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Transaction Patch -> StateT MigrationState Transaction Patch
forall (m :: * -> *) a. Monad m => m a -> StateT MigrationState m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (Transaction Patch
 -> ExceptT
      (TrySyncResult Entity) (StateT MigrationState Transaction) Patch)
-> Transaction Patch
-> ExceptT
     (TrySyncResult Entity) (StateT MigrationState Transaction) Patch
forall a b. (a -> b) -> a -> b
$
      (Patch' TextId (New Hash) (New Hash)
newPatch Patch' TextId (New Hash) (New Hash)
-> (Patch' TextId (New Hash) (New Hash)
    -> Transaction (Patch' TextId HashId (New Hash)))
-> Transaction (Patch' TextId HashId (New Hash))
forall a b. a -> (a -> b) -> b
& (New Hash -> Transaction HashId)
-> Patch' TextId (New Hash) (New Hash)
-> Transaction (Patch' TextId HashId (New Hash))
forall t h' h o.
(Ord t, Ord h') =>
Traversal (Patch' t h o) (Patch' t h' o) h h'
Traversal
  (Patch' TextId (New Hash) (New Hash))
  (Patch' TextId HashId (New Hash))
  (New Hash)
  HashId
S.patchH_ ((New Hash -> Transaction HashId)
 -> Patch' TextId (New Hash) (New Hash)
 -> Transaction (Patch' TextId HashId (New Hash)))
-> (New Hash -> Transaction HashId)
-> Patch' TextId (New Hash) (New Hash)
-> Transaction (Patch' TextId HashId (New Hash))
forall {k} (f :: k -> *) s (t :: k) a (b :: k).
LensLike f s t a b -> LensLike f s t a b
%%~ New Hash -> Transaction HashId
hashToHashId)
        Transaction (Patch' TextId HashId (New Hash))
-> (Patch' TextId HashId (New Hash) -> Transaction Patch)
-> Transaction Patch
forall a b. Transaction a -> (a -> Transaction b) -> Transaction b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= ((New Hash -> Transaction ObjectId)
-> Patch' TextId HashId (New Hash) -> Transaction Patch
forall t o' h o.
(Ord t, Ord o') =>
Traversal (Patch' t h o) (Patch' t h o') o o'
Traversal
  (Patch' TextId HashId (New Hash)) Patch (New Hash) ObjectId
S.patchO_ ((New Hash -> Transaction ObjectId)
 -> Patch' TextId HashId (New Hash) -> Transaction Patch)
-> (New Hash -> Transaction ObjectId)
-> Patch' TextId HashId (New Hash)
-> Transaction Patch
forall {k} (f :: k -> *) s (t :: k) a (b :: k).
LensLike f s t a b -> LensLike f s t a b
%%~ New Hash -> Transaction ObjectId
hashToObjectId)

  let (PatchLocalIds
localPatchIds, LocalPatch
localPatch) = Patch -> (PatchLocalIds, LocalPatch)
S.LocalizeObject.localizePatch Patch
newPatchWithIds
  PatchHash
newHash <- StateT MigrationState Transaction PatchHash
-> ExceptT
     (TrySyncResult Entity)
     (StateT MigrationState Transaction)
     PatchHash
forall (m :: * -> *) a.
Monad m =>
m a -> ExceptT (TrySyncResult Entity) m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (StateT MigrationState Transaction PatchHash
 -> ExceptT
      (TrySyncResult Entity)
      (StateT MigrationState Transaction)
      PatchHash)
-> (Transaction PatchHash
    -> StateT MigrationState Transaction PatchHash)
-> Transaction PatchHash
-> ExceptT
     (TrySyncResult Entity)
     (StateT MigrationState Transaction)
     PatchHash
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Transaction PatchHash
-> StateT MigrationState Transaction PatchHash
forall (m :: * -> *) a. Monad m => m a -> StateT MigrationState m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (Transaction PatchHash
 -> ExceptT
      (TrySyncResult Entity)
      (StateT MigrationState Transaction)
      PatchHash)
-> Transaction PatchHash
-> ExceptT
     (TrySyncResult Entity)
     (StateT MigrationState Transaction)
     PatchHash
forall a b. (a -> b) -> a -> b
$ Patch -> Transaction PatchHash
Hashing.dbPatchHash Patch
newPatchWithIds
  PatchObjectId
newObjectId <-
    StateT MigrationState Transaction PatchObjectId
-> ExceptT
     (TrySyncResult Entity)
     (StateT MigrationState Transaction)
     PatchObjectId
forall (m :: * -> *) a.
Monad m =>
m a -> ExceptT (TrySyncResult Entity) m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (StateT MigrationState Transaction PatchObjectId
 -> ExceptT
      (TrySyncResult Entity)
      (StateT MigrationState Transaction)
      PatchObjectId)
-> (Transaction PatchObjectId
    -> StateT MigrationState Transaction PatchObjectId)
-> Transaction PatchObjectId
-> ExceptT
     (TrySyncResult Entity)
     (StateT MigrationState Transaction)
     PatchObjectId
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Transaction PatchObjectId
-> StateT MigrationState Transaction PatchObjectId
forall (m :: * -> *) a. Monad m => m a -> StateT MigrationState m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (Transaction PatchObjectId
 -> ExceptT
      (TrySyncResult Entity)
      (StateT MigrationState Transaction)
      PatchObjectId)
-> Transaction PatchObjectId
-> ExceptT
     (TrySyncResult Entity)
     (StateT MigrationState Transaction)
     PatchObjectId
forall a b. (a -> b) -> a -> b
$
      HashHandle -> PatchHash -> PatchFormat -> Transaction PatchObjectId
Ops.saveDbPatch
        HashHandle
v2HashHandle
        PatchHash
newHash
        (PatchLocalIds -> LocalPatch -> PatchFormat
S.Patch.Format.Full PatchLocalIds
localPatchIds LocalPatch
localPatch)
  HashId
newHashId <- StateT MigrationState Transaction HashId
-> ExceptT
     (TrySyncResult Entity) (StateT MigrationState Transaction) HashId
forall (m :: * -> *) a.
Monad m =>
m a -> ExceptT (TrySyncResult Entity) m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (StateT MigrationState Transaction HashId
 -> ExceptT
      (TrySyncResult Entity) (StateT MigrationState Transaction) HashId)
-> (Transaction HashId -> StateT MigrationState Transaction HashId)
-> Transaction HashId
-> ExceptT
     (TrySyncResult Entity) (StateT MigrationState Transaction) HashId
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Transaction HashId -> StateT MigrationState Transaction HashId
forall (m :: * -> *) a. Monad m => m a -> StateT MigrationState m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (Transaction HashId
 -> ExceptT
      (TrySyncResult Entity) (StateT MigrationState Transaction) HashId)
-> Transaction HashId
-> ExceptT
     (TrySyncResult Entity) (StateT MigrationState Transaction) HashId
forall a b. (a -> b) -> a -> b
$ New Hash -> Transaction HashId
Q.expectHashIdByHash (PatchHash -> New Hash
unPatchHash PatchHash
newHash)
  forall (field :: Symbol) s t a b.
HasField field s t a b =>
Lens s t a b
field @"objLookup"
    ((Map ObjectId (ObjectId, HashId, New Hash, New Hash)
  -> Identity (Map ObjectId (ObjectId, HashId, New Hash, New Hash)))
 -> MigrationState -> Identity MigrationState)
-> (Map ObjectId (ObjectId, HashId, New Hash, New Hash)
    -> Map ObjectId (ObjectId, HashId, New Hash, New Hash))
-> ExceptT
     (TrySyncResult Entity) (StateT MigrationState Transaction) ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
%= ObjectId
-> (ObjectId, HashId, New Hash, New Hash)
-> Map ObjectId (ObjectId, HashId, New Hash, New Hash)
-> Map ObjectId (ObjectId, HashId, New Hash, New Hash)
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert
      (PatchObjectId -> ObjectId
unPatchObjectId PatchObjectId
oldObjectId)
      ( PatchObjectId -> ObjectId
unPatchObjectId PatchObjectId
newObjectId,
        HashId
newHashId,
        PatchHash -> New Hash
unPatchHash PatchHash
newHash,
        New Hash
oldHash
      )
  pure TrySyncResult Entity
forall entity. TrySyncResult entity
Sync.Done

-- | PLAN
-- *
-- NOTE: this implementation assumes that watches will be migrated AFTER everything else is finished.
-- This is because it's difficult for us to know otherwise whether a reference refers to something which doesn't exist, or just
-- something that hasn't been migrated yet. If we do it last, we know that missing references are indeed just missing from the codebase.
migrateWatch ::
  -- | A 'getDeclType'-like lookup, possibly backed by a cache.
  (C.Reference.Reference -> Sqlite.Transaction CT.ConstructorType) ->
  WatchKind ->
  Reference.Id ->
  StateT MigrationState Sqlite.Transaction (Sync.TrySyncResult Entity)
migrateWatch :: (Reference -> Transaction ConstructorType)
-> WatchKind
-> Old Id
-> StateT MigrationState Transaction (TrySyncResult Entity)
migrateWatch Reference -> Transaction ConstructorType
getDeclType WatchKind
watchKind Old Id
oldWatchId = (Either (TrySyncResult Entity) (TrySyncResult Entity)
 -> TrySyncResult Entity)
-> StateT
     MigrationState
     Transaction
     (Either (TrySyncResult Entity) (TrySyncResult Entity))
-> StateT MigrationState Transaction (TrySyncResult Entity)
forall a b.
(a -> b)
-> StateT MigrationState Transaction a
-> StateT MigrationState Transaction b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((TrySyncResult Entity -> TrySyncResult Entity)
-> (TrySyncResult Entity -> TrySyncResult Entity)
-> Either (TrySyncResult Entity) (TrySyncResult Entity)
-> TrySyncResult Entity
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either TrySyncResult Entity -> TrySyncResult Entity
forall a. a -> a
id TrySyncResult Entity -> TrySyncResult Entity
forall a. a -> a
id) (StateT
   MigrationState
   Transaction
   (Either (TrySyncResult Entity) (TrySyncResult Entity))
 -> StateT MigrationState Transaction (TrySyncResult Entity))
-> (ExceptT
      (TrySyncResult Entity)
      (StateT MigrationState Transaction)
      (TrySyncResult Entity)
    -> StateT
         MigrationState
         Transaction
         (Either (TrySyncResult Entity) (TrySyncResult Entity)))
-> ExceptT
     (TrySyncResult Entity)
     (StateT MigrationState Transaction)
     (TrySyncResult Entity)
-> StateT MigrationState Transaction (TrySyncResult Entity)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ExceptT
  (TrySyncResult Entity)
  (StateT MigrationState Transaction)
  (TrySyncResult Entity)
-> StateT
     MigrationState
     Transaction
     (Either (TrySyncResult Entity) (TrySyncResult Entity))
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT (ExceptT
   (TrySyncResult Entity)
   (StateT MigrationState Transaction)
   (TrySyncResult Entity)
 -> StateT MigrationState Transaction (TrySyncResult Entity))
-> ExceptT
     (TrySyncResult Entity)
     (StateT MigrationState Transaction)
     (TrySyncResult Entity)
-> StateT MigrationState Transaction (TrySyncResult Entity)
forall a b. (a -> b) -> a -> b
$ do
  let watchKindV1 :: [Char]
watchKindV1 = WatchKind -> [Char]
Cv.watchKind2to1 WatchKind
watchKind
  Term (DeclName Symbol) Ann
watchResultTerm <-
    (StateT
  MigrationState Transaction (Maybe (Term (DeclName Symbol) Ann))
-> ExceptT
     (TrySyncResult Entity)
     (StateT MigrationState Transaction)
     (Maybe (Term (DeclName Symbol) Ann))
forall (m :: * -> *) a.
Monad m =>
m a -> ExceptT (TrySyncResult Entity) m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (StateT
   MigrationState Transaction (Maybe (Term (DeclName Symbol) Ann))
 -> ExceptT
      (TrySyncResult Entity)
      (StateT MigrationState Transaction)
      (Maybe (Term (DeclName Symbol) Ann)))
-> (Transaction (Maybe (Term (DeclName Symbol) Ann))
    -> StateT
         MigrationState Transaction (Maybe (Term (DeclName Symbol) Ann)))
-> Transaction (Maybe (Term (DeclName Symbol) Ann))
-> ExceptT
     (TrySyncResult Entity)
     (StateT MigrationState Transaction)
     (Maybe (Term (DeclName Symbol) Ann))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Transaction (Maybe (Term (DeclName Symbol) Ann))
-> StateT
     MigrationState Transaction (Maybe (Term (DeclName Symbol) Ann))
forall (m :: * -> *) a. Monad m => m a -> StateT MigrationState m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift) ((Reference -> Transaction ConstructorType)
-> [Char]
-> Old Id
-> Transaction (Maybe (Term (DeclName Symbol) Ann))
CodebaseOps.getWatch Reference -> Transaction ConstructorType
getDeclType [Char]
watchKindV1 Old Id
oldWatchId) ExceptT
  (TrySyncResult Entity)
  (StateT MigrationState Transaction)
  (Maybe (Term (DeclName Symbol) Ann))
-> (Maybe (Term (DeclName Symbol) Ann)
    -> ExceptT
         (TrySyncResult Entity)
         (StateT MigrationState Transaction)
         (Term (DeclName Symbol) Ann))
-> ExceptT
     (TrySyncResult Entity)
     (StateT MigrationState Transaction)
     (Term (DeclName Symbol) Ann)
forall a b.
ExceptT
  (TrySyncResult Entity) (StateT MigrationState Transaction) a
-> (a
    -> ExceptT
         (TrySyncResult Entity) (StateT MigrationState Transaction) b)
-> ExceptT
     (TrySyncResult Entity) (StateT MigrationState Transaction) b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
      -- The hash which we're watching doesn't exist in the codebase, throw out this watch.
      Maybe (Term (DeclName Symbol) Ann)
Nothing -> TrySyncResult Entity
-> ExceptT
     (TrySyncResult Entity)
     (StateT MigrationState Transaction)
     (Term (DeclName Symbol) Ann)
forall (m :: * -> *) e a. Monad m => e -> ExceptT e m a
throwE TrySyncResult Entity
forall entity. TrySyncResult entity
Sync.Done
      Just Term (DeclName Symbol) Ann
term -> Term (DeclName Symbol) Ann
-> ExceptT
     (TrySyncResult Entity)
     (StateT MigrationState Transaction)
     (Term (DeclName Symbol) Ann)
forall a.
a
-> ExceptT
     (TrySyncResult Entity) (StateT MigrationState Transaction) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Term (DeclName Symbol) Ann
term
  Map SomeReferenceId SomeReferenceId
migratedReferences <- (MigrationState -> Map SomeReferenceId SomeReferenceId)
-> ExceptT
     (TrySyncResult Entity)
     (StateT MigrationState Transaction)
     (Map SomeReferenceId SomeReferenceId)
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets MigrationState -> Map SomeReferenceId SomeReferenceId
referenceMapping
  Old Id
newWatchId <- case SomeReferenceId
-> Map SomeReferenceId SomeReferenceId -> Maybe SomeReferenceId
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup (Old Id -> SomeReferenceId
forall ref. ref -> SomeReference ref
TermReference Old Id
oldWatchId) Map SomeReferenceId SomeReferenceId
migratedReferences of
    (Just (TermReference Old Id
newRef)) -> Old Id
-> ExceptT
     (TrySyncResult Entity) (StateT MigrationState Transaction) (Old Id)
forall a.
a
-> ExceptT
     (TrySyncResult Entity) (StateT MigrationState Transaction) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Old Id
newRef
    Maybe SomeReferenceId
_ -> TrySyncResult Entity
-> ExceptT
     (TrySyncResult Entity) (StateT MigrationState Transaction) (Old Id)
forall (m :: * -> *) e a. Monad m => e -> ExceptT e m a
throwE TrySyncResult Entity
forall entity. TrySyncResult entity
Sync.NonFatalError
  let maybeRemappedTerm :: Maybe (Term.Term Symbol Ann)
      maybeRemappedTerm :: Maybe (Term (DeclName Symbol) Ann)
maybeRemappedTerm =
        Term (DeclName Symbol) Ann
watchResultTerm
          Term (DeclName Symbol) Ann
-> (Term (DeclName Symbol) Ann
    -> Maybe (Term (DeclName Symbol) Ann))
-> Maybe (Term (DeclName Symbol) Ann)
forall a b. a -> (a -> b) -> b
& LensLike' Maybe (Term (DeclName Symbol) Ann) SomeReferenceId
forall (m :: * -> *) v a.
(Monad m, Ord v) =>
LensLike' m (Term v a) SomeReferenceId
termReferences_ LensLike' Maybe (Term (DeclName Symbol) Ann) SomeReferenceId
-> LensLike' Maybe (Term (DeclName Symbol) Ann) SomeReferenceId
forall {k} (f :: k -> *) s (t :: k) a (b :: k).
LensLike f s t a b -> LensLike f s t a b
%%~ \SomeReferenceId
someRef -> SomeReferenceId
-> Map SomeReferenceId SomeReferenceId -> Maybe SomeReferenceId
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup SomeReferenceId
someRef Map SomeReferenceId SomeReferenceId
migratedReferences
  case Maybe (Term (DeclName Symbol) Ann)
maybeRemappedTerm of
    -- One or more references in the result didn't exist in our codebase.
    Maybe (Term (DeclName Symbol) Ann)
Nothing -> TrySyncResult Entity
-> ExceptT
     (TrySyncResult Entity)
     (StateT MigrationState Transaction)
     (TrySyncResult Entity)
forall a.
a
-> ExceptT
     (TrySyncResult Entity) (StateT MigrationState Transaction) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure TrySyncResult Entity
forall entity. TrySyncResult entity
Sync.NonFatalError
    Just Term (DeclName Symbol) Ann
remappedTerm -> do
      StateT MigrationState Transaction ()
-> ExceptT
     (TrySyncResult Entity) (StateT MigrationState Transaction) ()
forall (m :: * -> *) a.
Monad m =>
m a -> ExceptT (TrySyncResult Entity) m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (StateT MigrationState Transaction ()
 -> ExceptT
      (TrySyncResult Entity) (StateT MigrationState Transaction) ())
-> (Transaction () -> StateT MigrationState Transaction ())
-> Transaction ()
-> ExceptT
     (TrySyncResult Entity) (StateT MigrationState Transaction) ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Transaction () -> StateT MigrationState Transaction ()
forall (m :: * -> *) a. Monad m => m a -> StateT MigrationState m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (Transaction ()
 -> ExceptT
      (TrySyncResult Entity) (StateT MigrationState Transaction) ())
-> Transaction ()
-> ExceptT
     (TrySyncResult Entity) (StateT MigrationState Transaction) ()
forall a b. (a -> b) -> a -> b
$ [Char] -> Old Id -> Term (DeclName Symbol) Ann -> Transaction ()
CodebaseOps.putWatch [Char]
watchKindV1 Old Id
newWatchId Term (DeclName Symbol) Ann
remappedTerm
      pure TrySyncResult Entity
forall entity. TrySyncResult entity
Sync.Done

uRefIdAsRefId_ :: Iso' (SomeReference (UReference.Id' Hash)) SomeReferenceId
uRefIdAsRefId_ :: Iso' SomeReferenceId SomeReferenceId
uRefIdAsRefId_ = AnIso (Old Id) (Old Id) (Old Id) (Old Id)
-> Iso' SomeReferenceId SomeReferenceId
forall (f :: * -> *) (g :: * -> *) s t a b.
(Functor f, Functor g) =>
AnIso s t a b -> Iso (f s) (g t) (f a) (g b)
mapping AnIso (Old Id) (Old Id) (Old Id) (Old Id)
Iso' (Old Id) (Old Id)
uRefAsRef_

uRefAsRef_ :: Iso' (UReference.Id' Hash) Reference.Id
uRefAsRef_ :: Iso' (Old Id) (Old Id)
uRefAsRef_ = (Old Id -> Old Id) -> (Old Id -> Old Id) -> Iso' (Old Id) (Old Id)
forall s a b t. (s -> a) -> (b -> t) -> Iso s t a b
iso Old Id -> Old Id
forall {h}. Id' h -> Id' h
intoRef Old Id -> Old Id
forall {h}. Id' h -> Id' h
intoURef
  where
    intoRef :: Id' h -> Id' h
intoRef (UReference.Id h
hash Old ConstructorId
pos) = h -> Old ConstructorId -> Id' h
forall h. h -> Old ConstructorId -> Id' h
Reference.Id h
hash Old ConstructorId
pos
    intoURef :: Id' h -> Id' h
intoURef (Reference.Id h
hash Old ConstructorId
pos) = h -> Old ConstructorId -> Id' h
forall h. h -> Old ConstructorId -> Id' h
UReference.Id h
hash Old ConstructorId
pos

-- Project an S.Referent'' into its SomeReferenceObjId's
someReferent_ ::
  forall t h.
  (forall ref. Traversal' ref (SomeReference ref)) ->
  Traversal' (S.Branch.Full.Referent'' t h) (SomeReference (UReference.Id' h))
someReferent_ :: forall t h.
(forall ref (f :: * -> *).
 Applicative f =>
 (SomeReference ref -> f (SomeReference ref)) -> ref -> f ref)
-> Traversal' (Referent'' t h) (SomeReference (Id' h))
someReferent_ forall ref (f :: * -> *).
Applicative f =>
(SomeReference ref -> f (SomeReference ref)) -> ref -> f ref
typeOrTermTraversal_ =
  ((TermReference' t h
 -> BazaarT
      (->)
      f
      (SomeReference (Id' h))
      (SomeReference (Id' h))
      (TermReference' t h))
-> Referent'' t h
-> BazaarT
     (->)
     f
     (SomeReference (Id' h))
     (SomeReference (Id' h))
     (Referent'' t h)
forall tmr tyr tmr' (p :: * -> * -> *) (f :: * -> *).
(Choice p, Applicative f) =>
p tmr (f tmr') -> p (Referent' tmr tyr) (f (Referent' tmr' tyr))
UReferent._Ref ((TermReference' t h
  -> BazaarT
       (->)
       f
       (SomeReference (Id' h))
       (SomeReference (Id' h))
       (TermReference' t h))
 -> Referent'' t h
 -> BazaarT
      (->)
      f
      (SomeReference (Id' h))
      (SomeReference (Id' h))
      (Referent'' t h))
-> ((SomeReference (Id' h)
     -> BazaarT
          (->)
          f
          (SomeReference (Id' h))
          (SomeReference (Id' h))
          (SomeReference (Id' h)))
    -> TermReference' t h
    -> BazaarT
         (->)
         f
         (SomeReference (Id' h))
         (SomeReference (Id' h))
         (TermReference' t h))
-> (SomeReference (Id' h)
    -> BazaarT
         (->)
         f
         (SomeReference (Id' h))
         (SomeReference (Id' h))
         (SomeReference (Id' h)))
-> Referent'' t h
-> BazaarT
     (->)
     f
     (SomeReference (Id' h))
     (SomeReference (Id' h))
     (Referent'' t h)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall ref (f :: * -> *).
 Applicative f =>
 (SomeReference ref -> f (SomeReference ref)) -> ref -> f ref)
-> Traversal' (TermReference' t h) (SomeReference (Id' h))
forall t h.
(forall ref (f :: * -> *).
 Applicative f =>
 (SomeReference ref -> f (SomeReference ref)) -> ref -> f ref)
-> Traversal' (Reference' t h) (SomeReference (Id' h))
someReference_ (SomeReference ref -> f (SomeReference ref)) -> ref -> f ref
forall ref (f :: * -> *).
Applicative f =>
(SomeReference ref -> f (SomeReference ref)) -> ref -> f ref
typeOrTermTraversal_)
    ((SomeReference (Id' h)
  -> BazaarT
       (->)
       f
       (SomeReference (Id' h))
       (SomeReference (Id' h))
       (SomeReference (Id' h)))
 -> Referent'' t h
 -> BazaarT
      (->)
      f
      (SomeReference (Id' h))
      (SomeReference (Id' h))
      (Referent'' t h))
-> ((SomeReference (Id' h) -> f (SomeReference (Id' h)))
    -> Referent'' t h -> f (Referent'' t h))
-> (SomeReference (Id' h) -> f (SomeReference (Id' h)))
-> Referent'' t h
-> f (Referent'' t h)
forall (p :: * -> * -> *) (f :: * -> *) s t a b.
(Conjoined p, Applicative f) =>
Traversing p f s t a b -> Over p f s t a b -> Over p f s t a b
`failing` ( ((TermReference' t h, Old ConstructorId)
 -> f (TermReference' t h, Old ConstructorId))
-> Referent'' t h -> f (Referent'' t h)
forall tmr tyr tyr' (p :: * -> * -> *) (f :: * -> *).
(Choice p, Applicative f) =>
p (tyr, Old ConstructorId) (f (tyr', Old ConstructorId))
-> p (Referent' tmr tyr) (f (Referent' tmr tyr'))
UReferent._Con
                  (((TermReference' t h, Old ConstructorId)
  -> f (TermReference' t h, Old ConstructorId))
 -> Referent'' t h -> f (Referent'' t h))
-> ((SomeReference (Id' h) -> f (SomeReference (Id' h)))
    -> (TermReference' t h, Old ConstructorId)
    -> f (TermReference' t h, Old ConstructorId))
-> (SomeReference (Id' h) -> f (SomeReference (Id' h)))
-> Referent'' t h
-> f (Referent'' t h)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (GConstructorReference (Id' h)
 -> f (GConstructorReference (Id' h)))
-> (TermReference' t h, Old ConstructorId)
-> f (TermReference' t h, Old ConstructorId)
forall {f :: * -> *} {b} {h} {h} {t}.
(Integral b, Applicative f) =>
(GConstructorReference (Id' h)
 -> f (GConstructorReference (Id' h)))
-> (Reference' t h, b) -> f (Reference' t h, b)
asPair_ -- Need to unpack the embedded reference AND remap between mismatched Constructor ID types.
                  ((GConstructorReference (Id' h)
  -> f (GConstructorReference (Id' h)))
 -> (TermReference' t h, Old ConstructorId)
 -> f (TermReference' t h, Old ConstructorId))
-> ((SomeReference (Id' h) -> f (SomeReference (Id' h)))
    -> GConstructorReference (Id' h)
    -> f (GConstructorReference (Id' h)))
-> (SomeReference (Id' h) -> f (SomeReference (Id' h)))
-> (TermReference' t h, Old ConstructorId)
-> f (TermReference' t h, Old ConstructorId)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (SomeReference (Id' h) -> f (SomeReference (Id' h)))
-> GConstructorReference (Id' h)
-> f (GConstructorReference (Id' h))
forall ref (f :: * -> *).
Applicative f =>
(SomeReference ref -> f (SomeReference ref))
-> GConstructorReference ref -> f (GConstructorReference ref)
asConstructorReference_
              )
  where
    asPair_ :: (GConstructorReference (Id' h)
 -> f (GConstructorReference (Id' h)))
-> (Reference' t h, b) -> f (Reference' t h, b)
asPair_ GConstructorReference (Id' h) -> f (GConstructorReference (Id' h))
f (UReference.ReferenceDerived Id' h
id', b
conId) =
      GConstructorReference (Id' h) -> f (GConstructorReference (Id' h))
f (Id' h -> Old ConstructorId -> GConstructorReference (Id' h)
forall r. r -> Old ConstructorId -> GConstructorReference r
ConstructorReference.ConstructorReference Id' h
id' (b -> Old ConstructorId
forall a b. (Integral a, Num b) => a -> b
fromIntegral b
conId))
        f (GConstructorReference (Id' h))
-> (GConstructorReference (Id' h) -> (Reference' t h, b))
-> f (Reference' t h, b)
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \(ConstructorReference.ConstructorReference Id' h
newId Old ConstructorId
newConId) ->
          (Id' h -> Reference' t h
forall t h. Id' h -> Reference' t h
UReference.ReferenceDerived Id' h
newId, Old ConstructorId -> b
forall a b. (Integral a, Num b) => a -> b
fromIntegral Old ConstructorId
newConId)
    asPair_ GConstructorReference (Id' h) -> f (GConstructorReference (Id' h))
_ (UReference.ReferenceBuiltin t
x, b
conId) = (Reference' t h, b) -> f (Reference' t h, b)
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (t -> Reference' t h
forall t h. t -> Reference' t h
UReference.ReferenceBuiltin t
x, b
conId)

someReference_ ::
  (forall ref. Traversal' ref (SomeReference ref)) ->
  Traversal' (UReference.Reference' t h) (SomeReference (UReference.Id' h))
someReference_ :: forall t h.
(forall ref (f :: * -> *).
 Applicative f =>
 (SomeReference ref -> f (SomeReference ref)) -> ref -> f ref)
-> Traversal' (Reference' t h) (SomeReference (Id' h))
someReference_ forall ref (f :: * -> *).
Applicative f =>
(SomeReference ref -> f (SomeReference ref)) -> ref -> f ref
typeOrTermTraversal_ = (Id' h -> f (Id' h)) -> Reference' t h -> f (Reference' t h)
forall t h h' (p :: * -> * -> *) (f :: * -> *).
(Choice p, Applicative f) =>
p (Id' h) (f (Id' h')) -> p (Reference' t h) (f (Reference' t h'))
UReference._ReferenceDerived ((Id' h -> f (Id' h)) -> Reference' t h -> f (Reference' t h))
-> ((SomeReference (Id' h) -> f (SomeReference (Id' h)))
    -> Id' h -> f (Id' h))
-> (SomeReference (Id' h) -> f (SomeReference (Id' h)))
-> Reference' t h
-> f (Reference' t h)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (SomeReference (Id' h) -> f (SomeReference (Id' h)))
-> Id' h -> f (Id' h)
forall ref (f :: * -> *).
Applicative f =>
(SomeReference ref -> f (SomeReference ref)) -> ref -> f ref
typeOrTermTraversal_

someMetadataSetFormat_ ::
  (Ord t, Ord h) =>
  (forall ref. Traversal' ref (SomeReference ref)) ->
  Traversal' (S.Branch.Full.MetadataSetFormat' t h) (SomeReference (UReference.Id' h))
someMetadataSetFormat_ :: forall t h.
(Ord t, Ord h) =>
(forall ref (f :: * -> *).
 Applicative f =>
 (SomeReference ref -> f (SomeReference ref)) -> ref -> f ref)
-> Traversal' (MetadataSetFormat' t h) (SomeReference (Id' h))
someMetadataSetFormat_ forall ref (f :: * -> *).
Applicative f =>
(SomeReference ref -> f (SomeReference ref)) -> ref -> f ref
typeOrTermTraversal_ =
  (Reference' t h -> f (Reference' t h))
-> MetadataSetFormat' t h -> f (MetadataSetFormat' t h)
forall t h h'.
(Ord t, Ord h, Ord h') =>
Traversal
  (MetadataSetFormat' t h)
  (MetadataSetFormat' t h')
  (Reference' t h)
  (Reference' t h')
Traversal
  (MetadataSetFormat' t h)
  (MetadataSetFormat' t h)
  (Reference' t h)
  (Reference' t h)
S.Branch.Full.metadataSetFormatReferences_ ((Reference' t h -> f (Reference' t h))
 -> MetadataSetFormat' t h -> f (MetadataSetFormat' t h))
-> ((SomeReference (Id' h) -> f (SomeReference (Id' h)))
    -> Reference' t h -> f (Reference' t h))
-> (SomeReference (Id' h) -> f (SomeReference (Id' h)))
-> MetadataSetFormat' t h
-> f (MetadataSetFormat' t h)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall ref (f :: * -> *).
 Applicative f =>
 (SomeReference ref -> f (SomeReference ref)) -> ref -> f ref)
-> Traversal' (Reference' t h) (SomeReference (Id' h))
forall t h.
(forall ref (f :: * -> *).
 Applicative f =>
 (SomeReference ref -> f (SomeReference ref)) -> ref -> f ref)
-> Traversal' (Reference' t h) (SomeReference (Id' h))
someReference_ (SomeReference ref -> f (SomeReference ref)) -> ref -> f ref
forall ref (f :: * -> *).
Applicative f =>
(SomeReference ref -> f (SomeReference ref)) -> ref -> f ref
typeOrTermTraversal_

someReferenceMetadata_ ::
  (Ord k, Ord t, Ord h) =>
  Traversal' k (SomeReference (UReference.Id' h)) ->
  Traversal'
    (Map k (S.Branch.Full.MetadataSetFormat' t h))
    (SomeReference (UReference.Id' h))
someReferenceMetadata_ :: forall k t h.
(Ord k, Ord t, Ord h) =>
Traversal' k (SomeReference (Id' h))
-> Traversal'
     (Map k (MetadataSetFormat' t h)) (SomeReference (Id' h))
someReferenceMetadata_ Traversal' k (SomeReference (Id' h))
keyTraversal_ SomeReference (Id' h) -> f (SomeReference (Id' h))
f Map k (MetadataSetFormat' t h)
m =
  Map k (MetadataSetFormat' t h) -> [(k, MetadataSetFormat' t h)]
forall k a. Map k a -> [(k, a)]
Map.toList Map k (MetadataSetFormat' t h)
m
    [(k, MetadataSetFormat' t h)]
-> ([(k, MetadataSetFormat' t h)]
    -> f [(k, MetadataSetFormat' t h)])
-> f [(k, MetadataSetFormat' t h)]
forall a b. a -> (a -> b) -> b
& ((k, MetadataSetFormat' t h) -> f (k, MetadataSetFormat' t h))
-> [(k, MetadataSetFormat' t h)] -> f [(k, MetadataSetFormat' t h)]
forall (f :: * -> *) a b.
Traversable f =>
IndexedTraversal Int (f a) (f b) a b
IndexedTraversal
  Int
  [(k, MetadataSetFormat' t h)]
  [(k, MetadataSetFormat' t h)]
  (k, MetadataSetFormat' t h)
  (k, MetadataSetFormat' t h)
traversed (((k, MetadataSetFormat' t h) -> f (k, MetadataSetFormat' t h))
 -> [(k, MetadataSetFormat' t h)]
 -> f [(k, MetadataSetFormat' t h)])
-> ((SomeReference (Id' h) -> f (SomeReference (Id' h)))
    -> (k, MetadataSetFormat' t h) -> f (k, MetadataSetFormat' t h))
-> (SomeReference (Id' h) -> f (SomeReference (Id' h)))
-> [(k, MetadataSetFormat' t h)]
-> f [(k, MetadataSetFormat' t h)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Optical
  (->) (->) f k k (SomeReference (Id' h)) (SomeReference (Id' h))
-> Optical
     (->)
     (->)
     f
     (MetadataSetFormat' t h)
     (MetadataSetFormat' t h)
     (SomeReference (Id' h))
     (SomeReference (Id' h))
-> (SomeReference (Id' h) -> f (SomeReference (Id' h)))
-> (k, MetadataSetFormat' t h)
-> f (k, MetadataSetFormat' t h)
forall (q :: * -> * -> *) (f :: * -> *) (r :: * -> * -> *)
       (p :: * -> * -> *) s t a b s' t'.
(Representable q, Applicative (Rep q), Applicative f,
 Bitraversable r) =>
Optical p q f s t a b
-> Optical p q f s' t' a b -> Optical p q f (r s s') (r t t') a b
beside Optical
  (->) (->) f k k (SomeReference (Id' h)) (SomeReference (Id' h))
Traversal' k (SomeReference (Id' h))
keyTraversal_ ((forall ref (f :: * -> *).
 Applicative f =>
 (SomeReference ref -> f (SomeReference ref)) -> ref -> f ref)
-> Traversal' (MetadataSetFormat' t h) (SomeReference (Id' h))
forall t h.
(Ord t, Ord h) =>
(forall ref (f :: * -> *).
 Applicative f =>
 (SomeReference ref -> f (SomeReference ref)) -> ref -> f ref)
-> Traversal' (MetadataSetFormat' t h) (SomeReference (Id' h))
someMetadataSetFormat_ (SomeReference ref -> f (SomeReference ref)) -> ref -> f ref
forall ref (f :: * -> *).
Applicative f =>
(SomeReference ref -> f (SomeReference ref)) -> ref -> f ref
asTermReference_) ((SomeReference (Id' h) -> f (SomeReference (Id' h)))
 -> [(k, MetadataSetFormat' t h)]
 -> f [(k, MetadataSetFormat' t h)])
-> (SomeReference (Id' h) -> f (SomeReference (Id' h)))
-> [(k, MetadataSetFormat' t h)]
-> f [(k, MetadataSetFormat' t h)]
forall {k} (f :: k -> *) s (t :: k) a (b :: k).
LensLike f s t a b -> LensLike f s t a b
%%~ SomeReference (Id' h) -> f (SomeReference (Id' h))
f
    f [(k, MetadataSetFormat' t h)]
-> ([(k, MetadataSetFormat' t h)]
    -> Map k (MetadataSetFormat' t h))
-> f (Map k (MetadataSetFormat' t h))
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> [(k, MetadataSetFormat' t h)] -> Map k (MetadataSetFormat' t h)
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList

branchSomeRefs_ :: (Ord t, Ord h) => Traversal' (S.Branch' t h p c) (SomeReference (UReference.Id' h))
branchSomeRefs_ :: forall t h p c.
(Ord t, Ord h) =>
Traversal' (Branch' t h p c) (SomeReference (Id' h))
branchSomeRefs_ SomeReference (Id' h) -> f (SomeReference (Id' h))
f S.Branch.Full.Branch {Map t c
children :: Map t c
$sel:children:Branch :: forall t h p c. Branch' t h p c -> Map t c
children, Map t p
patches :: Map t p
$sel:patches:Branch :: forall t h p c. Branch' t h p c -> Map t p
patches, Map t (Map (Referent'' t h) (MetadataSetFormat' t h))
terms :: Map t (Map (Referent'' t h) (MetadataSetFormat' t h))
$sel:terms:Branch :: forall t h p c.
Branch' t h p c
-> Map t (Map (Referent'' t h) (MetadataSetFormat' t h))
terms, Map t (Map (TypeReference' t h) (MetadataSetFormat' t h))
types :: Map t (Map (TypeReference' t h) (MetadataSetFormat' t h))
$sel:types:Branch :: forall t h p c.
Branch' t h p c
-> Map t (Map (TypeReference' t h) (MetadataSetFormat' t h))
types} = do
  let newTypesMap :: f (Map t (Map (TypeReference' t h) (MetadataSetFormat' t h)))
newTypesMap = Map t (Map (TypeReference' t h) (MetadataSetFormat' t h))
types Map t (Map (TypeReference' t h) (MetadataSetFormat' t h))
-> (Map t (Map (TypeReference' t h) (MetadataSetFormat' t h))
    -> f (Map t (Map (TypeReference' t h) (MetadataSetFormat' t h))))
-> f (Map t (Map (TypeReference' t h) (MetadataSetFormat' t h)))
forall a b. a -> (a -> b) -> b
& (Map (TypeReference' t h) (MetadataSetFormat' t h)
 -> f (Map (TypeReference' t h) (MetadataSetFormat' t h)))
-> Map t (Map (TypeReference' t h) (MetadataSetFormat' t h))
-> f (Map t (Map (TypeReference' t h) (MetadataSetFormat' t h)))
forall (f :: * -> *) a b.
Traversable f =>
IndexedTraversal Int (f a) (f b) a b
IndexedTraversal
  Int
  (Map t (Map (TypeReference' t h) (MetadataSetFormat' t h)))
  (Map t (Map (TypeReference' t h) (MetadataSetFormat' t h)))
  (Map (TypeReference' t h) (MetadataSetFormat' t h))
  (Map (TypeReference' t h) (MetadataSetFormat' t h))
traversed ((Map (TypeReference' t h) (MetadataSetFormat' t h)
  -> f (Map (TypeReference' t h) (MetadataSetFormat' t h)))
 -> Map t (Map (TypeReference' t h) (MetadataSetFormat' t h))
 -> f (Map t (Map (TypeReference' t h) (MetadataSetFormat' t h))))
-> ((SomeReference (Id' h) -> f (SomeReference (Id' h)))
    -> Map (TypeReference' t h) (MetadataSetFormat' t h)
    -> f (Map (TypeReference' t h) (MetadataSetFormat' t h)))
-> (SomeReference (Id' h) -> f (SomeReference (Id' h)))
-> Map t (Map (TypeReference' t h) (MetadataSetFormat' t h))
-> f (Map t (Map (TypeReference' t h) (MetadataSetFormat' t h)))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Traversal' (TypeReference' t h) (SomeReference (Id' h))
-> Traversal'
     (Map (TypeReference' t h) (MetadataSetFormat' t h))
     (SomeReference (Id' h))
forall k t h.
(Ord k, Ord t, Ord h) =>
Traversal' k (SomeReference (Id' h))
-> Traversal'
     (Map k (MetadataSetFormat' t h)) (SomeReference (Id' h))
someReferenceMetadata_ ((forall ref (f :: * -> *).
 Applicative f =>
 (SomeReference ref -> f (SomeReference ref)) -> ref -> f ref)
-> Traversal' (TypeReference' t h) (SomeReference (Id' h))
forall t h.
(forall ref (f :: * -> *).
 Applicative f =>
 (SomeReference ref -> f (SomeReference ref)) -> ref -> f ref)
-> Traversal' (Reference' t h) (SomeReference (Id' h))
someReference_ (SomeReference ref -> f (SomeReference ref)) -> ref -> f ref
forall ref (f :: * -> *).
Applicative f =>
(SomeReference ref -> f (SomeReference ref)) -> ref -> f ref
asTypeReference_) ((SomeReference (Id' h) -> f (SomeReference (Id' h)))
 -> Map t (Map (TypeReference' t h) (MetadataSetFormat' t h))
 -> f (Map t (Map (TypeReference' t h) (MetadataSetFormat' t h))))
-> (SomeReference (Id' h) -> f (SomeReference (Id' h)))
-> Map t (Map (TypeReference' t h) (MetadataSetFormat' t h))
-> f (Map t (Map (TypeReference' t h) (MetadataSetFormat' t h)))
forall {k} (f :: k -> *) s (t :: k) a (b :: k).
LensLike f s t a b -> LensLike f s t a b
%%~ SomeReference (Id' h) -> f (SomeReference (Id' h))
f
  let newTermsMap :: f (Map t (Map (Referent'' t h) (MetadataSetFormat' t h)))
newTermsMap = Map t (Map (Referent'' t h) (MetadataSetFormat' t h))
terms Map t (Map (Referent'' t h) (MetadataSetFormat' t h))
-> (Map t (Map (Referent'' t h) (MetadataSetFormat' t h))
    -> f (Map t (Map (Referent'' t h) (MetadataSetFormat' t h))))
-> f (Map t (Map (Referent'' t h) (MetadataSetFormat' t h)))
forall a b. a -> (a -> b) -> b
& (Map (Referent'' t h) (MetadataSetFormat' t h)
 -> f (Map (Referent'' t h) (MetadataSetFormat' t h)))
-> Map t (Map (Referent'' t h) (MetadataSetFormat' t h))
-> f (Map t (Map (Referent'' t h) (MetadataSetFormat' t h)))
forall (f :: * -> *) a b.
Traversable f =>
IndexedTraversal Int (f a) (f b) a b
IndexedTraversal
  Int
  (Map t (Map (Referent'' t h) (MetadataSetFormat' t h)))
  (Map t (Map (Referent'' t h) (MetadataSetFormat' t h)))
  (Map (Referent'' t h) (MetadataSetFormat' t h))
  (Map (Referent'' t h) (MetadataSetFormat' t h))
traversed ((Map (Referent'' t h) (MetadataSetFormat' t h)
  -> f (Map (Referent'' t h) (MetadataSetFormat' t h)))
 -> Map t (Map (Referent'' t h) (MetadataSetFormat' t h))
 -> f (Map t (Map (Referent'' t h) (MetadataSetFormat' t h))))
-> ((SomeReference (Id' h) -> f (SomeReference (Id' h)))
    -> Map (Referent'' t h) (MetadataSetFormat' t h)
    -> f (Map (Referent'' t h) (MetadataSetFormat' t h)))
-> (SomeReference (Id' h) -> f (SomeReference (Id' h)))
-> Map t (Map (Referent'' t h) (MetadataSetFormat' t h))
-> f (Map t (Map (Referent'' t h) (MetadataSetFormat' t h)))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Traversal' (Referent'' t h) (SomeReference (Id' h))
-> Traversal'
     (Map (Referent'' t h) (MetadataSetFormat' t h))
     (SomeReference (Id' h))
forall k t h.
(Ord k, Ord t, Ord h) =>
Traversal' k (SomeReference (Id' h))
-> Traversal'
     (Map k (MetadataSetFormat' t h)) (SomeReference (Id' h))
someReferenceMetadata_ ((forall ref (f :: * -> *).
 Applicative f =>
 (SomeReference ref -> f (SomeReference ref)) -> ref -> f ref)
-> Traversal' (Referent'' t h) (SomeReference (Id' h))
forall t h.
(forall ref (f :: * -> *).
 Applicative f =>
 (SomeReference ref -> f (SomeReference ref)) -> ref -> f ref)
-> Traversal' (Referent'' t h) (SomeReference (Id' h))
someReferent_ (SomeReference ref -> f (SomeReference ref)) -> ref -> f ref
forall ref (f :: * -> *).
Applicative f =>
(SomeReference ref -> f (SomeReference ref)) -> ref -> f ref
asTermReference_) ((SomeReference (Id' h) -> f (SomeReference (Id' h)))
 -> Map t (Map (Referent'' t h) (MetadataSetFormat' t h))
 -> f (Map t (Map (Referent'' t h) (MetadataSetFormat' t h))))
-> (SomeReference (Id' h) -> f (SomeReference (Id' h)))
-> Map t (Map (Referent'' t h) (MetadataSetFormat' t h))
-> f (Map t (Map (Referent'' t h) (MetadataSetFormat' t h)))
forall {k} (f :: k -> *) s (t :: k) a (b :: k).
LensLike f s t a b -> LensLike f s t a b
%%~ SomeReference (Id' h) -> f (SomeReference (Id' h))
f
  Map t (Map (Referent'' t h) (MetadataSetFormat' t h))
-> Map t (Map (TypeReference' t h) (MetadataSetFormat' t h))
-> Map t p
-> Map t c
-> Branch' t h p c
forall t h p c.
Map t (Map (Referent'' t h) (MetadataSetFormat' t h))
-> Map t (Map (TypeReference' t h) (MetadataSetFormat' t h))
-> Map t p
-> Map t c
-> Branch' t h p c
S.Branch.Full.Branch (Map t (Map (Referent'' t h) (MetadataSetFormat' t h))
 -> Map t (Map (TypeReference' t h) (MetadataSetFormat' t h))
 -> Map t p
 -> Map t c
 -> Branch' t h p c)
-> f (Map t (Map (Referent'' t h) (MetadataSetFormat' t h)))
-> f (Map t (Map (TypeReference' t h) (MetadataSetFormat' t h))
      -> Map t p -> Map t c -> Branch' t h p c)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> f (Map t (Map (Referent'' t h) (MetadataSetFormat' t h)))
newTermsMap f (Map t (Map (TypeReference' t h) (MetadataSetFormat' t h))
   -> Map t p -> Map t c -> Branch' t h p c)
-> f (Map t (Map (TypeReference' t h) (MetadataSetFormat' t h)))
-> f (Map t p -> Map t c -> Branch' t h p c)
forall a b. f (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> f (Map t (Map (TypeReference' t h) (MetadataSetFormat' t h)))
newTypesMap f (Map t p -> Map t c -> Branch' t h p c)
-> f (Map t p) -> f (Map t c -> Branch' t h p c)
forall a b. f (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Map t p -> f (Map t p)
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Map t p
patches f (Map t c -> Branch' t h p c)
-> f (Map t c) -> f (Branch' t h p c)
forall a b. f (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Map t c -> f (Map t c)
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Map t c
children

patchSomeRefsH_ :: (Ord t, Ord h) => Traversal (S.Patch' t h o) (S.Patch' t h o) (SomeReference (UReference.Id' h)) (SomeReference (UReference.Id' h))
patchSomeRefsH_ :: forall t h o.
(Ord t, Ord h) =>
Traversal
  (Patch' t h o)
  (Patch' t h o)
  (SomeReference (Id' h))
  (SomeReference (Id' h))
patchSomeRefsH_ SomeReference (Id' h) -> f (SomeReference (Id' h))
f S.Patch {Map (Referent'' t h) (Set (TermEdit' t o))
termEdits :: Map (Referent'' t h) (Set (TermEdit' t o))
$sel:termEdits:Patch :: forall t h o.
Patch' t h o -> Map (Referent'' t h) (Set (TermEdit' t o))
termEdits, Map (Reference' t h) (Set (TypeEdit' t o))
typeEdits :: Map (Reference' t h) (Set (TypeEdit' t o))
$sel:typeEdits:Patch :: forall t h o.
Patch' t h o -> Map (Reference' t h) (Set (TypeEdit' t o))
typeEdits} = do
  Map (Referent'' t h) (Set (TermEdit' t o))
newTermEdits <- [(Referent'' t h, Set (TermEdit' t o))]
-> Map (Referent'' t h) (Set (TermEdit' t o))
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList ([(Referent'' t h, Set (TermEdit' t o))]
 -> Map (Referent'' t h) (Set (TermEdit' t o)))
-> f [(Referent'' t h, Set (TermEdit' t o))]
-> f (Map (Referent'' t h) (Set (TermEdit' t o)))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Map (Referent'' t h) (Set (TermEdit' t o))
-> [(Referent'' t h, Set (TermEdit' t o))]
forall k a. Map k a -> [(k, a)]
Map.toList Map (Referent'' t h) (Set (TermEdit' t o))
termEdits [(Referent'' t h, Set (TermEdit' t o))]
-> ([(Referent'' t h, Set (TermEdit' t o))]
    -> f [(Referent'' t h, Set (TermEdit' t o))])
-> f [(Referent'' t h, Set (TermEdit' t o))]
forall a b. a -> (a -> b) -> b
& ((Referent'' t h, Set (TermEdit' t o))
 -> f (Referent'' t h, Set (TermEdit' t o)))
-> [(Referent'' t h, Set (TermEdit' t o))]
-> f [(Referent'' t h, Set (TermEdit' t o))]
forall (f :: * -> *) a b.
Traversable f =>
IndexedTraversal Int (f a) (f b) a b
IndexedTraversal
  Int
  [(Referent'' t h, Set (TermEdit' t o))]
  [(Referent'' t h, Set (TermEdit' t o))]
  (Referent'' t h, Set (TermEdit' t o))
  (Referent'' t h, Set (TermEdit' t o))
traversed (((Referent'' t h, Set (TermEdit' t o))
  -> f (Referent'' t h, Set (TermEdit' t o)))
 -> [(Referent'' t h, Set (TermEdit' t o))]
 -> f [(Referent'' t h, Set (TermEdit' t o))])
-> ((SomeReference (Id' h) -> f (SomeReference (Id' h)))
    -> (Referent'' t h, Set (TermEdit' t o))
    -> f (Referent'' t h, Set (TermEdit' t o)))
-> (SomeReference (Id' h) -> f (SomeReference (Id' h)))
-> [(Referent'' t h, Set (TermEdit' t o))]
-> f [(Referent'' t h, Set (TermEdit' t o))]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Referent'' t h -> f (Referent'' t h))
-> (Referent'' t h, Set (TermEdit' t o))
-> f (Referent'' t h, Set (TermEdit' t o))
forall s t a b. Field1 s t a b => Lens s t a b
Lens
  (Referent'' t h, Set (TermEdit' t o))
  (Referent'' t h, Set (TermEdit' t o))
  (Referent'' t h)
  (Referent'' t h)
_1 ((Referent'' t h -> f (Referent'' t h))
 -> (Referent'' t h, Set (TermEdit' t o))
 -> f (Referent'' t h, Set (TermEdit' t o)))
-> ((SomeReference (Id' h) -> f (SomeReference (Id' h)))
    -> Referent'' t h -> f (Referent'' t h))
-> (SomeReference (Id' h) -> f (SomeReference (Id' h)))
-> (Referent'' t h, Set (TermEdit' t o))
-> f (Referent'' t h, Set (TermEdit' t o))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((forall ref (f :: * -> *).
 Applicative f =>
 (SomeReference ref -> f (SomeReference ref)) -> ref -> f ref)
-> Traversal' (Referent'' t h) (SomeReference (Id' h))
forall t h.
(forall ref (f :: * -> *).
 Applicative f =>
 (SomeReference ref -> f (SomeReference ref)) -> ref -> f ref)
-> Traversal' (Referent'' t h) (SomeReference (Id' h))
someReferent_ (SomeReference ref -> f (SomeReference ref)) -> ref -> f ref
forall ref (f :: * -> *).
Applicative f =>
(SomeReference ref -> f (SomeReference ref)) -> ref -> f ref
asTermReference_) ((SomeReference (Id' h) -> f (SomeReference (Id' h)))
 -> [(Referent'' t h, Set (TermEdit' t o))]
 -> f [(Referent'' t h, Set (TermEdit' t o))])
-> (SomeReference (Id' h) -> f (SomeReference (Id' h)))
-> [(Referent'' t h, Set (TermEdit' t o))]
-> f [(Referent'' t h, Set (TermEdit' t o))]
forall {k} (f :: k -> *) s (t :: k) a (b :: k).
LensLike f s t a b -> LensLike f s t a b
%%~ SomeReference (Id' h) -> f (SomeReference (Id' h))
f)
  Map (Reference' t h) (Set (TypeEdit' t o))
newTypeEdits <- [(Reference' t h, Set (TypeEdit' t o))]
-> Map (Reference' t h) (Set (TypeEdit' t o))
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList ([(Reference' t h, Set (TypeEdit' t o))]
 -> Map (Reference' t h) (Set (TypeEdit' t o)))
-> f [(Reference' t h, Set (TypeEdit' t o))]
-> f (Map (Reference' t h) (Set (TypeEdit' t o)))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Map (Reference' t h) (Set (TypeEdit' t o))
-> [(Reference' t h, Set (TypeEdit' t o))]
forall k a. Map k a -> [(k, a)]
Map.toList Map (Reference' t h) (Set (TypeEdit' t o))
typeEdits [(Reference' t h, Set (TypeEdit' t o))]
-> ([(Reference' t h, Set (TypeEdit' t o))]
    -> f [(Reference' t h, Set (TypeEdit' t o))])
-> f [(Reference' t h, Set (TypeEdit' t o))]
forall a b. a -> (a -> b) -> b
& ((Reference' t h, Set (TypeEdit' t o))
 -> f (Reference' t h, Set (TypeEdit' t o)))
-> [(Reference' t h, Set (TypeEdit' t o))]
-> f [(Reference' t h, Set (TypeEdit' t o))]
forall (f :: * -> *) a b.
Traversable f =>
IndexedTraversal Int (f a) (f b) a b
IndexedTraversal
  Int
  [(Reference' t h, Set (TypeEdit' t o))]
  [(Reference' t h, Set (TypeEdit' t o))]
  (Reference' t h, Set (TypeEdit' t o))
  (Reference' t h, Set (TypeEdit' t o))
traversed (((Reference' t h, Set (TypeEdit' t o))
  -> f (Reference' t h, Set (TypeEdit' t o)))
 -> [(Reference' t h, Set (TypeEdit' t o))]
 -> f [(Reference' t h, Set (TypeEdit' t o))])
-> ((SomeReference (Id' h) -> f (SomeReference (Id' h)))
    -> (Reference' t h, Set (TypeEdit' t o))
    -> f (Reference' t h, Set (TypeEdit' t o)))
-> (SomeReference (Id' h) -> f (SomeReference (Id' h)))
-> [(Reference' t h, Set (TypeEdit' t o))]
-> f [(Reference' t h, Set (TypeEdit' t o))]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Reference' t h -> f (Reference' t h))
-> (Reference' t h, Set (TypeEdit' t o))
-> f (Reference' t h, Set (TypeEdit' t o))
forall s t a b. Field1 s t a b => Lens s t a b
Lens
  (Reference' t h, Set (TypeEdit' t o))
  (Reference' t h, Set (TypeEdit' t o))
  (Reference' t h)
  (Reference' t h)
_1 ((Reference' t h -> f (Reference' t h))
 -> (Reference' t h, Set (TypeEdit' t o))
 -> f (Reference' t h, Set (TypeEdit' t o)))
-> ((SomeReference (Id' h) -> f (SomeReference (Id' h)))
    -> Reference' t h -> f (Reference' t h))
-> (SomeReference (Id' h) -> f (SomeReference (Id' h)))
-> (Reference' t h, Set (TypeEdit' t o))
-> f (Reference' t h, Set (TypeEdit' t o))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((forall ref (f :: * -> *).
 Applicative f =>
 (SomeReference ref -> f (SomeReference ref)) -> ref -> f ref)
-> Traversal' (Reference' t h) (SomeReference (Id' h))
forall t h.
(forall ref (f :: * -> *).
 Applicative f =>
 (SomeReference ref -> f (SomeReference ref)) -> ref -> f ref)
-> Traversal' (Reference' t h) (SomeReference (Id' h))
someReference_ (SomeReference ref -> f (SomeReference ref)) -> ref -> f ref
forall ref (f :: * -> *).
Applicative f =>
(SomeReference ref -> f (SomeReference ref)) -> ref -> f ref
asTypeReference_) ((SomeReference (Id' h) -> f (SomeReference (Id' h)))
 -> [(Reference' t h, Set (TypeEdit' t o))]
 -> f [(Reference' t h, Set (TypeEdit' t o))])
-> (SomeReference (Id' h) -> f (SomeReference (Id' h)))
-> [(Reference' t h, Set (TypeEdit' t o))]
-> f [(Reference' t h, Set (TypeEdit' t o))]
forall {k} (f :: k -> *) s (t :: k) a (b :: k).
LensLike f s t a b -> LensLike f s t a b
%%~ SomeReference (Id' h) -> f (SomeReference (Id' h))
f)
  pure S.Patch {$sel:termEdits:Patch :: Map (Referent'' t h) (Set (TermEdit' t o))
termEdits = Map (Referent'' t h) (Set (TermEdit' t o))
newTermEdits, $sel:typeEdits:Patch :: Map (Reference' t h) (Set (TypeEdit' t o))
typeEdits = Map (Reference' t h) (Set (TypeEdit' t o))
newTypeEdits}

patchSomeRefsO_ :: (Ord t, Ord h, Ord o) => Traversal' (S.Patch' t h o) (SomeReference (UReference.Id' o))
patchSomeRefsO_ :: forall t h o.
(Ord t, Ord h, Ord o) =>
Traversal' (Patch' t h o) (SomeReference (Id' o))
patchSomeRefsO_ SomeReference (Id' o) -> f (SomeReference (Id' o))
f S.Patch {Map (Referent'' t h) (Set (TermEdit' t o))
$sel:termEdits:Patch :: forall t h o.
Patch' t h o -> Map (Referent'' t h) (Set (TermEdit' t o))
termEdits :: Map (Referent'' t h) (Set (TermEdit' t o))
termEdits, Map (Reference' t h) (Set (TypeEdit' t o))
$sel:typeEdits:Patch :: forall t h o.
Patch' t h o -> Map (Reference' t h) (Set (TypeEdit' t o))
typeEdits :: Map (Reference' t h) (Set (TypeEdit' t o))
typeEdits} = do
  Map (Referent'' t h) (Set (TermEdit' t o))
newTermEdits <- (Map (Referent'' t h) (Set (TermEdit' t o))
termEdits Map (Referent'' t h) (Set (TermEdit' t o))
-> (Map (Referent'' t h) (Set (TermEdit' t o))
    -> f (Map (Referent'' t h) (Set (TermEdit' t o))))
-> f (Map (Referent'' t h) (Set (TermEdit' t o)))
forall a b. a -> (a -> b) -> b
& (Set (TermEdit' t o) -> f (Set (TermEdit' t o)))
-> Map (Referent'' t h) (Set (TermEdit' t o))
-> f (Map (Referent'' t h) (Set (TermEdit' t o)))
forall (f :: * -> *) a b.
Traversable f =>
IndexedTraversal Int (f a) (f b) a b
IndexedTraversal
  Int
  (Map (Referent'' t h) (Set (TermEdit' t o)))
  (Map (Referent'' t h) (Set (TermEdit' t o)))
  (Set (TermEdit' t o))
  (Set (TermEdit' t o))
traversed ((Set (TermEdit' t o) -> f (Set (TermEdit' t o)))
 -> Map (Referent'' t h) (Set (TermEdit' t o))
 -> f (Map (Referent'' t h) (Set (TermEdit' t o))))
-> ((SomeReference (Id' o) -> f (SomeReference (Id' o)))
    -> Set (TermEdit' t o) -> f (Set (TermEdit' t o)))
-> (SomeReference (Id' o) -> f (SomeReference (Id' o)))
-> Map (Referent'' t h) (Set (TermEdit' t o))
-> f (Map (Referent'' t h) (Set (TermEdit' t o)))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (TermEdit' t o -> f (TermEdit' t o))
-> Set (TermEdit' t o) -> f (Set (TermEdit' t o))
forall (f :: * -> *) b a.
(Applicative f, Ord b) =>
(a -> f b) -> Set a -> f (Set b)
Set.traverse ((TermEdit' t o -> f (TermEdit' t o))
 -> Set (TermEdit' t o) -> f (Set (TermEdit' t o)))
-> ((SomeReference (Id' o) -> f (SomeReference (Id' o)))
    -> TermEdit' t o -> f (TermEdit' t o))
-> (SomeReference (Id' o) -> f (SomeReference (Id' o)))
-> Set (TermEdit' t o)
-> f (Set (TermEdit' t o))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (SomeReference (Id' o) -> f (SomeReference (Id' o)))
-> TermEdit' t o -> f (TermEdit' t o)
forall t h (f :: * -> *).
Applicative f =>
(SomeReference (Id' h) -> f (SomeReference (Id' h)))
-> TermEdit' t h -> f (TermEdit' t h)
termEditRefs_ ((SomeReference (Id' o) -> f (SomeReference (Id' o)))
 -> Map (Referent'' t h) (Set (TermEdit' t o))
 -> f (Map (Referent'' t h) (Set (TermEdit' t o))))
-> (SomeReference (Id' o) -> f (SomeReference (Id' o)))
-> Map (Referent'' t h) (Set (TermEdit' t o))
-> f (Map (Referent'' t h) (Set (TermEdit' t o)))
forall {k} (f :: k -> *) s (t :: k) a (b :: k).
LensLike f s t a b -> LensLike f s t a b
%%~ SomeReference (Id' o) -> f (SomeReference (Id' o))
f)
  Map (Reference' t h) (Set (TypeEdit' t o))
newTypeEdits <- (Map (Reference' t h) (Set (TypeEdit' t o))
typeEdits Map (Reference' t h) (Set (TypeEdit' t o))
-> (Map (Reference' t h) (Set (TypeEdit' t o))
    -> f (Map (Reference' t h) (Set (TypeEdit' t o))))
-> f (Map (Reference' t h) (Set (TypeEdit' t o)))
forall a b. a -> (a -> b) -> b
& (Set (TypeEdit' t o) -> f (Set (TypeEdit' t o)))
-> Map (Reference' t h) (Set (TypeEdit' t o))
-> f (Map (Reference' t h) (Set (TypeEdit' t o)))
forall (f :: * -> *) a b.
Traversable f =>
IndexedTraversal Int (f a) (f b) a b
IndexedTraversal
  Int
  (Map (Reference' t h) (Set (TypeEdit' t o)))
  (Map (Reference' t h) (Set (TypeEdit' t o)))
  (Set (TypeEdit' t o))
  (Set (TypeEdit' t o))
traversed ((Set (TypeEdit' t o) -> f (Set (TypeEdit' t o)))
 -> Map (Reference' t h) (Set (TypeEdit' t o))
 -> f (Map (Reference' t h) (Set (TypeEdit' t o))))
-> ((SomeReference (Id' o) -> f (SomeReference (Id' o)))
    -> Set (TypeEdit' t o) -> f (Set (TypeEdit' t o)))
-> (SomeReference (Id' o) -> f (SomeReference (Id' o)))
-> Map (Reference' t h) (Set (TypeEdit' t o))
-> f (Map (Reference' t h) (Set (TypeEdit' t o)))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (TypeEdit' t o -> f (TypeEdit' t o))
-> Set (TypeEdit' t o) -> f (Set (TypeEdit' t o))
forall (f :: * -> *) b a.
(Applicative f, Ord b) =>
(a -> f b) -> Set a -> f (Set b)
Set.traverse ((TypeEdit' t o -> f (TypeEdit' t o))
 -> Set (TypeEdit' t o) -> f (Set (TypeEdit' t o)))
-> ((SomeReference (Id' o) -> f (SomeReference (Id' o)))
    -> TypeEdit' t o -> f (TypeEdit' t o))
-> (SomeReference (Id' o) -> f (SomeReference (Id' o)))
-> Set (TypeEdit' t o)
-> f (Set (TypeEdit' t o))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (SomeReference (Id' o) -> f (SomeReference (Id' o)))
-> TypeEdit' t o -> f (TypeEdit' t o)
forall t h (f :: * -> *).
Applicative f =>
(SomeReference (Id' h) -> f (SomeReference (Id' h)))
-> TypeEdit' t h -> f (TypeEdit' t h)
typeEditRefs_ ((SomeReference (Id' o) -> f (SomeReference (Id' o)))
 -> Map (Reference' t h) (Set (TypeEdit' t o))
 -> f (Map (Reference' t h) (Set (TypeEdit' t o))))
-> (SomeReference (Id' o) -> f (SomeReference (Id' o)))
-> Map (Reference' t h) (Set (TypeEdit' t o))
-> f (Map (Reference' t h) (Set (TypeEdit' t o)))
forall {k} (f :: k -> *) s (t :: k) a (b :: k).
LensLike f s t a b -> LensLike f s t a b
%%~ SomeReference (Id' o) -> f (SomeReference (Id' o))
f)
  pure (S.Patch {$sel:termEdits:Patch :: Map (Referent'' t h) (Set (TermEdit' t o))
termEdits = Map (Referent'' t h) (Set (TermEdit' t o))
newTermEdits, $sel:typeEdits:Patch :: Map (Reference' t h) (Set (TypeEdit' t o))
typeEdits = Map (Reference' t h) (Set (TypeEdit' t o))
newTypeEdits})

termEditRefs_ :: Traversal' (TermEdit.TermEdit' t h) (SomeReference (UReference.Id' h))
termEditRefs_ :: forall t h (f :: * -> *).
Applicative f =>
(SomeReference (Id' h) -> f (SomeReference (Id' h)))
-> TermEdit' t h -> f (TermEdit' t h)
termEditRefs_ SomeReference (Id' h) -> f (SomeReference (Id' h))
f (TermEdit.Replace Referent' t h
ref Typing
typing) =
  Referent' t h -> Typing -> TermEdit' t h
forall t h. Referent' t h -> Typing -> TermEdit' t h
TermEdit.Replace (Referent' t h -> Typing -> TermEdit' t h)
-> f (Referent' t h) -> f (Typing -> TermEdit' t h)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Referent' t h
ref Referent' t h
-> (Referent' t h -> f (Referent' t h)) -> f (Referent' t h)
forall a b. a -> (a -> b) -> b
& (forall ref (f :: * -> *).
 Applicative f =>
 (SomeReference ref -> f (SomeReference ref)) -> ref -> f ref)
-> Traversal' (Referent' t h) (SomeReference (Id' h))
forall t h.
(forall ref (f :: * -> *).
 Applicative f =>
 (SomeReference ref -> f (SomeReference ref)) -> ref -> f ref)
-> Traversal' (Referent'' t h) (SomeReference (Id' h))
someReferent_ (SomeReference ref -> f (SomeReference ref)) -> ref -> f ref
forall ref (f :: * -> *).
Applicative f =>
(SomeReference ref -> f (SomeReference ref)) -> ref -> f ref
asTermReference_ ((SomeReference (Id' h) -> f (SomeReference (Id' h)))
 -> Referent' t h -> f (Referent' t h))
-> (SomeReference (Id' h) -> f (SomeReference (Id' h)))
-> Referent' t h
-> f (Referent' t h)
forall {k} (f :: k -> *) s (t :: k) a (b :: k).
LensLike f s t a b -> LensLike f s t a b
%%~ SomeReference (Id' h) -> f (SomeReference (Id' h))
f) f (Typing -> TermEdit' t h) -> f Typing -> f (TermEdit' t h)
forall a b. f (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Typing -> f Typing
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Typing
typing
termEditRefs_ SomeReference (Id' h) -> f (SomeReference (Id' h))
_f (TermEdit' t h
TermEdit.Deprecate) = TermEdit' t h -> f (TermEdit' t h)
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure TermEdit' t h
forall t h. TermEdit' t h
TermEdit.Deprecate

typeEditRefs_ :: Traversal' (TypeEdit.TypeEdit' t h) (SomeReference (UReference.Id' h))
typeEditRefs_ :: forall t h (f :: * -> *).
Applicative f =>
(SomeReference (Id' h) -> f (SomeReference (Id' h)))
-> TypeEdit' t h -> f (TypeEdit' t h)
typeEditRefs_ SomeReference (Id' h) -> f (SomeReference (Id' h))
f (TypeEdit.Replace Reference' t h
ref) =
  Reference' t h -> TypeEdit' t h
forall t h. Reference' t h -> TypeEdit' t h
TypeEdit.Replace (Reference' t h -> TypeEdit' t h)
-> f (Reference' t h) -> f (TypeEdit' t h)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Reference' t h
ref Reference' t h
-> (Reference' t h -> f (Reference' t h)) -> f (Reference' t h)
forall a b. a -> (a -> b) -> b
& (forall ref (f :: * -> *).
 Applicative f =>
 (SomeReference ref -> f (SomeReference ref)) -> ref -> f ref)
-> Traversal' (Reference' t h) (SomeReference (Id' h))
forall t h.
(forall ref (f :: * -> *).
 Applicative f =>
 (SomeReference ref -> f (SomeReference ref)) -> ref -> f ref)
-> Traversal' (Reference' t h) (SomeReference (Id' h))
someReference_ (SomeReference ref -> f (SomeReference ref)) -> ref -> f ref
forall ref (f :: * -> *).
Applicative f =>
(SomeReference ref -> f (SomeReference ref)) -> ref -> f ref
asTypeReference_ ((SomeReference (Id' h) -> f (SomeReference (Id' h)))
 -> Reference' t h -> f (Reference' t h))
-> (SomeReference (Id' h) -> f (SomeReference (Id' h)))
-> Reference' t h
-> f (Reference' t h)
forall {k} (f :: k -> *) s (t :: k) a (b :: k).
LensLike f s t a b -> LensLike f s t a b
%%~ SomeReference (Id' h) -> f (SomeReference (Id' h))
f)
typeEditRefs_ SomeReference (Id' h) -> f (SomeReference (Id' h))
_f (TypeEdit' t h
TypeEdit.Deprecate) = TypeEdit' t h -> f (TypeEdit' t h)
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure TypeEdit' t h
forall t h. TypeEdit' t h
TypeEdit.Deprecate

migrateTermComponent ::
  -- | A 'getDeclType'-like lookup, possibly backed by a cache.
  (C.Reference.Reference -> Sqlite.Transaction CT.ConstructorType) ->
  TVar (Map Hash CodebaseOps.TermBufferEntry) ->
  TVar (Map Hash CodebaseOps.DeclBufferEntry) ->
  Unison.Hash ->
  StateT MigrationState Sqlite.Transaction (Sync.TrySyncResult Entity)
migrateTermComponent :: (Reference -> Transaction ConstructorType)
-> TVar (Map (New Hash) TermBufferEntry)
-> TVar (Map (New Hash) DeclBufferEntry)
-> New Hash
-> StateT MigrationState Transaction (TrySyncResult Entity)
migrateTermComponent Reference -> Transaction ConstructorType
getDeclType TVar (Map (New Hash) TermBufferEntry)
termBuffer TVar (Map (New Hash) DeclBufferEntry)
declBuffer New Hash
oldHash = (Either (TrySyncResult Entity) (TrySyncResult Entity)
 -> TrySyncResult Entity)
-> StateT
     MigrationState
     Transaction
     (Either (TrySyncResult Entity) (TrySyncResult Entity))
-> StateT MigrationState Transaction (TrySyncResult Entity)
forall a b.
(a -> b)
-> StateT MigrationState Transaction a
-> StateT MigrationState Transaction b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((TrySyncResult Entity -> TrySyncResult Entity)
-> (TrySyncResult Entity -> TrySyncResult Entity)
-> Either (TrySyncResult Entity) (TrySyncResult Entity)
-> TrySyncResult Entity
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either TrySyncResult Entity -> TrySyncResult Entity
forall a. a -> a
id TrySyncResult Entity -> TrySyncResult Entity
forall a. a -> a
id) (StateT
   MigrationState
   Transaction
   (Either (TrySyncResult Entity) (TrySyncResult Entity))
 -> StateT MigrationState Transaction (TrySyncResult Entity))
-> (ExceptT
      (TrySyncResult Entity)
      (StateT MigrationState Transaction)
      (TrySyncResult Entity)
    -> StateT
         MigrationState
         Transaction
         (Either (TrySyncResult Entity) (TrySyncResult Entity)))
-> ExceptT
     (TrySyncResult Entity)
     (StateT MigrationState Transaction)
     (TrySyncResult Entity)
-> StateT MigrationState Transaction (TrySyncResult Entity)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ExceptT
  (TrySyncResult Entity)
  (StateT MigrationState Transaction)
  (TrySyncResult Entity)
-> StateT
     MigrationState
     Transaction
     (Either (TrySyncResult Entity) (TrySyncResult Entity))
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT (ExceptT
   (TrySyncResult Entity)
   (StateT MigrationState Transaction)
   (TrySyncResult Entity)
 -> StateT MigrationState Transaction (TrySyncResult Entity))
-> ExceptT
     (TrySyncResult Entity)
     (StateT MigrationState Transaction)
     (TrySyncResult Entity)
-> StateT MigrationState Transaction (TrySyncResult Entity)
forall a b. (a -> b) -> a -> b
$ do
  ExceptT
  (TrySyncResult Entity) (StateT MigrationState Transaction) Bool
-> ExceptT
     (TrySyncResult Entity) (StateT MigrationState Transaction) ()
-> ExceptT
     (TrySyncResult Entity) (StateT MigrationState Transaction) ()
forall (m :: * -> *). Monad m => m Bool -> m () -> m ()
whenM (New Hash -> Set (New Hash) -> Bool
forall a. Ord a => a -> Set a -> Bool
Set.member New Hash
oldHash (Set (New Hash) -> Bool)
-> ExceptT
     (TrySyncResult Entity)
     (StateT MigrationState Transaction)
     (Set (New Hash))
-> ExceptT
     (TrySyncResult Entity) (StateT MigrationState Transaction) Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Getting (Set (New Hash)) MigrationState (Set (New Hash))
-> ExceptT
     (TrySyncResult Entity)
     (StateT MigrationState Transaction)
     (Set (New Hash))
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use (forall (field :: Symbol) s t a b.
HasField field s t a b =>
Lens s t a b
field @"migratedDefnHashes")) (TrySyncResult Entity
-> ExceptT
     (TrySyncResult Entity) (StateT MigrationState Transaction) ()
forall (m :: * -> *) e a. Monad m => e -> ExceptT e m a
throwE TrySyncResult Entity
forall entity. TrySyncResult entity
Sync.PreviouslyDone)

  [(Term (DeclName Symbol) Ann, Type (DeclName Symbol) Ann)]
oldComponent <-
    (StateT
  MigrationState
  Transaction
  (Maybe [(Term (DeclName Symbol) Ann, Type (DeclName Symbol) Ann)])
-> ExceptT
     (TrySyncResult Entity)
     (StateT MigrationState Transaction)
     (Maybe [(Term (DeclName Symbol) Ann, Type (DeclName Symbol) Ann)])
forall (m :: * -> *) a.
Monad m =>
m a -> ExceptT (TrySyncResult Entity) m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (StateT
   MigrationState
   Transaction
   (Maybe [(Term (DeclName Symbol) Ann, Type (DeclName Symbol) Ann)])
 -> ExceptT
      (TrySyncResult Entity)
      (StateT MigrationState Transaction)
      (Maybe [(Term (DeclName Symbol) Ann, Type (DeclName Symbol) Ann)]))
-> (Transaction
      (Maybe [(Term (DeclName Symbol) Ann, Type (DeclName Symbol) Ann)])
    -> StateT
         MigrationState
         Transaction
         (Maybe [(Term (DeclName Symbol) Ann, Type (DeclName Symbol) Ann)]))
-> Transaction
     (Maybe [(Term (DeclName Symbol) Ann, Type (DeclName Symbol) Ann)])
-> ExceptT
     (TrySyncResult Entity)
     (StateT MigrationState Transaction)
     (Maybe [(Term (DeclName Symbol) Ann, Type (DeclName Symbol) Ann)])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Transaction
  (Maybe [(Term (DeclName Symbol) Ann, Type (DeclName Symbol) Ann)])
-> StateT
     MigrationState
     Transaction
     (Maybe [(Term (DeclName Symbol) Ann, Type (DeclName Symbol) Ann)])
forall (m :: * -> *) a. Monad m => m a -> StateT MigrationState m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (Transaction
   (Maybe [(Term (DeclName Symbol) Ann, Type (DeclName Symbol) Ann)])
 -> ExceptT
      (TrySyncResult Entity)
      (StateT MigrationState Transaction)
      (Maybe [(Term (DeclName Symbol) Ann, Type (DeclName Symbol) Ann)]))
-> Transaction
     (Maybe [(Term (DeclName Symbol) Ann, Type (DeclName Symbol) Ann)])
-> ExceptT
     (TrySyncResult Entity)
     (StateT MigrationState Transaction)
     (Maybe [(Term (DeclName Symbol) Ann, Type (DeclName Symbol) Ann)])
forall a b. (a -> b) -> a -> b
$ (Reference -> Transaction ConstructorType)
-> New Hash
-> Transaction
     (Maybe [(Term (DeclName Symbol) Ann, Type (DeclName Symbol) Ann)])
CodebaseOps.getTermComponentWithTypes Reference -> Transaction ConstructorType
getDeclType New Hash
oldHash) ExceptT
  (TrySyncResult Entity)
  (StateT MigrationState Transaction)
  (Maybe [(Term (DeclName Symbol) Ann, Type (DeclName Symbol) Ann)])
-> (Maybe
      [(Term (DeclName Symbol) Ann, Type (DeclName Symbol) Ann)]
    -> ExceptT
         (TrySyncResult Entity)
         (StateT MigrationState Transaction)
         [(Term (DeclName Symbol) Ann, Type (DeclName Symbol) Ann)])
-> ExceptT
     (TrySyncResult Entity)
     (StateT MigrationState Transaction)
     [(Term (DeclName Symbol) Ann, Type (DeclName Symbol) Ann)]
forall a b.
ExceptT
  (TrySyncResult Entity) (StateT MigrationState Transaction) a
-> (a
    -> ExceptT
         (TrySyncResult Entity) (StateT MigrationState Transaction) b)
-> ExceptT
     (TrySyncResult Entity) (StateT MigrationState Transaction) b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
      Maybe [(Term (DeclName Symbol) Ann, Type (DeclName Symbol) Ann)]
Nothing -> [Char]
-> ExceptT
     (TrySyncResult Entity)
     (StateT MigrationState Transaction)
     [(Term (DeclName Symbol) Ann, Type (DeclName Symbol) Ann)]
forall a. HasCallStack => [Char] -> a
error ([Char]
 -> ExceptT
      (TrySyncResult Entity)
      (StateT MigrationState Transaction)
      [(Term (DeclName Symbol) Ann, Type (DeclName Symbol) Ann)])
-> [Char]
-> ExceptT
     (TrySyncResult Entity)
     (StateT MigrationState Transaction)
     [(Term (DeclName Symbol) Ann, Type (DeclName Symbol) Ann)]
forall a b. (a -> b) -> a -> b
$ [Char]
"Hash was missing from codebase: " [Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<> New Hash -> [Char]
forall a. Show a => a -> [Char]
show New Hash
oldHash
      Just [(Term (DeclName Symbol) Ann, Type (DeclName Symbol) Ann)]
c -> [(Term (DeclName Symbol) Ann, Type (DeclName Symbol) Ann)]
-> ExceptT
     (TrySyncResult Entity)
     (StateT MigrationState Transaction)
     [(Term (DeclName Symbol) Ann, Type (DeclName Symbol) Ann)]
forall a.
a
-> ExceptT
     (TrySyncResult Entity) (StateT MigrationState Transaction) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure [(Term (DeclName Symbol) Ann, Type (DeclName Symbol) Ann)]
c

  let componentIDMap :: Map (Old Reference.Id) (Term.Term Symbol Ann, Type Symbol Ann)
      componentIDMap :: Map
  (Old Id) (Term (DeclName Symbol) Ann, Type (DeclName Symbol) Ann)
componentIDMap = [(Old Id,
  (Term (DeclName Symbol) Ann, Type (DeclName Symbol) Ann))]
-> Map
     (Old Id) (Term (DeclName Symbol) Ann, Type (DeclName Symbol) Ann)
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList ([(Old Id,
   (Term (DeclName Symbol) Ann, Type (DeclName Symbol) Ann))]
 -> Map
      (Old Id) (Term (DeclName Symbol) Ann, Type (DeclName Symbol) Ann))
-> [(Old Id,
     (Term (DeclName Symbol) Ann, Type (DeclName Symbol) Ann))]
-> Map
     (Old Id) (Term (DeclName Symbol) Ann, Type (DeclName Symbol) Ann)
forall a b. (a -> b) -> a -> b
$ New Hash
-> [(Term (DeclName Symbol) Ann, Type (DeclName Symbol) Ann)]
-> [(Old Id,
     (Term (DeclName Symbol) Ann, Type (DeclName Symbol) Ann))]
forall a. New Hash -> [a] -> [(Old Id, a)]
Reference.componentFor New Hash
oldHash [(Term (DeclName Symbol) Ann, Type (DeclName Symbol) Ann)]
oldComponent
  let unhashed :: Map (Old Reference.Id) (Symbol, Term.Term Symbol Ann)
      unhashed :: Map (Old Id) (DeclName Symbol, Term (DeclName Symbol) Ann)
unhashed = Map (Old Id) (Term (DeclName Symbol) Ann)
-> Map (Old Id) (DeclName Symbol, Term (DeclName Symbol) Ann)
forall v a.
Var v =>
Map (Old Id) (Term v a) -> Map (Old Id) (v, Term v a)
Term.unhashComponent ((Term (DeclName Symbol) Ann, Type (DeclName Symbol) Ann)
-> Term (DeclName Symbol) Ann
forall a b. (a, b) -> a
fst ((Term (DeclName Symbol) Ann, Type (DeclName Symbol) Ann)
 -> Term (DeclName Symbol) Ann)
-> Map
     (Old Id) (Term (DeclName Symbol) Ann, Type (DeclName Symbol) Ann)
-> Map (Old Id) (Term (DeclName Symbol) Ann)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Map
  (Old Id) (Term (DeclName Symbol) Ann, Type (DeclName Symbol) Ann)
componentIDMap)
  let vToOldReferenceMapping :: Map Symbol (Old Reference.Id)
      vToOldReferenceMapping :: Map (DeclName Symbol) (Old Id)
vToOldReferenceMapping =
        Map (Old Id) (DeclName Symbol, Term (DeclName Symbol) Ann)
unhashed
          Map (Old Id) (DeclName Symbol, Term (DeclName Symbol) Ann)
-> (Map (Old Id) (DeclName Symbol, Term (DeclName Symbol) Ann)
    -> [(Old Id, (DeclName Symbol, Term (DeclName Symbol) Ann))])
-> [(Old Id, (DeclName Symbol, Term (DeclName Symbol) Ann))]
forall a b. a -> (a -> b) -> b
& Map (Old Id) (DeclName Symbol, Term (DeclName Symbol) Ann)
-> [(Old Id, (DeclName Symbol, Term (DeclName Symbol) Ann))]
forall k a. Map k a -> [(k, a)]
Map.toList
          [(Old Id, (DeclName Symbol, Term (DeclName Symbol) Ann))]
-> ([(Old Id, (DeclName Symbol, Term (DeclName Symbol) Ann))]
    -> [(DeclName Symbol, Old Id)])
-> [(DeclName Symbol, Old Id)]
forall a b. a -> (a -> b) -> b
& ((Old Id, (DeclName Symbol, Term (DeclName Symbol) Ann))
 -> (DeclName Symbol, Old Id))
-> [(Old Id, (DeclName Symbol, Term (DeclName Symbol) Ann))]
-> [(DeclName Symbol, Old Id)]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\(Old Id
refId, (DeclName Symbol
v, Term (DeclName Symbol) Ann
_trm)) -> (DeclName Symbol
v, Old Id
refId))
          [(DeclName Symbol, Old Id)]
-> ([(DeclName Symbol, Old Id)] -> Map (DeclName Symbol) (Old Id))
-> Map (DeclName Symbol) (Old Id)
forall a b. a -> (a -> b) -> b
& [(DeclName Symbol, Old Id)] -> Map (DeclName Symbol) (Old Id)
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList

  Map SomeReferenceId SomeReferenceId
referencesMap <- (MigrationState -> Map SomeReferenceId SomeReferenceId)
-> ExceptT
     (TrySyncResult Entity)
     (StateT MigrationState Transaction)
     (Map SomeReferenceId SomeReferenceId)
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets MigrationState -> Map SomeReferenceId SomeReferenceId
referenceMapping

  let allMissingReferences :: [Old SomeReferenceId]
      allMissingReferences :: [SomeReferenceId]
allMissingReferences =
        let missingTermRefs :: [SomeReferenceId]
missingTermRefs =
              Map (Old Id) (DeclName Symbol, Term (DeclName Symbol) Ann)
unhashed Map (Old Id) (DeclName Symbol, Term (DeclName Symbol) Ann)
-> (Map (Old Id) (DeclName Symbol, Term (DeclName Symbol) Ann)
    -> [SomeReferenceId])
-> [SomeReferenceId]
forall a b. a -> (a -> b) -> b
& LensLike
  (WriterT [SomeReferenceId] Identity)
  (Map (Old Id) (DeclName Symbol, Term (DeclName Symbol) Ann))
  (Map (Old Id) (DeclName Symbol, Term (DeclName Symbol) Ann))
  SomeReferenceId
  SomeReferenceId
-> Map (Old Id) (DeclName Symbol, Term (DeclName Symbol) Ann)
-> [SomeReferenceId]
forall a s t. LensLike (Writer [a]) s t a a -> s -> [a]
foldSetter (((DeclName Symbol, Term (DeclName Symbol) Ann)
 -> WriterT
      [SomeReferenceId]
      Identity
      (DeclName Symbol, Term (DeclName Symbol) Ann))
-> Map (Old Id) (DeclName Symbol, Term (DeclName Symbol) Ann)
-> WriterT
     [SomeReferenceId]
     Identity
     (Map (Old Id) (DeclName Symbol, Term (DeclName Symbol) Ann))
forall (f :: * -> *) a b.
Traversable f =>
IndexedTraversal Int (f a) (f b) a b
IndexedTraversal
  Int
  (Map (Old Id) (DeclName Symbol, Term (DeclName Symbol) Ann))
  (Map (Old Id) (DeclName Symbol, Term (DeclName Symbol) Ann))
  (DeclName Symbol, Term (DeclName Symbol) Ann)
  (DeclName Symbol, Term (DeclName Symbol) Ann)
traversed (((DeclName Symbol, Term (DeclName Symbol) Ann)
  -> WriterT
       [SomeReferenceId]
       Identity
       (DeclName Symbol, Term (DeclName Symbol) Ann))
 -> Map (Old Id) (DeclName Symbol, Term (DeclName Symbol) Ann)
 -> WriterT
      [SomeReferenceId]
      Identity
      (Map (Old Id) (DeclName Symbol, Term (DeclName Symbol) Ann)))
-> ((SomeReferenceId -> Writer [SomeReferenceId] SomeReferenceId)
    -> (DeclName Symbol, Term (DeclName Symbol) Ann)
    -> WriterT
         [SomeReferenceId]
         Identity
         (DeclName Symbol, Term (DeclName Symbol) Ann))
-> LensLike
     (WriterT [SomeReferenceId] Identity)
     (Map (Old Id) (DeclName Symbol, Term (DeclName Symbol) Ann))
     (Map (Old Id) (DeclName Symbol, Term (DeclName Symbol) Ann))
     SomeReferenceId
     SomeReferenceId
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Term (DeclName Symbol) Ann
 -> WriterT [SomeReferenceId] Identity (Term (DeclName Symbol) Ann))
-> (DeclName Symbol, Term (DeclName Symbol) Ann)
-> WriterT
     [SomeReferenceId]
     Identity
     (DeclName Symbol, Term (DeclName Symbol) Ann)
forall s t a b. Field2 s t a b => Lens s t a b
Lens
  (DeclName Symbol, Term (DeclName Symbol) Ann)
  (DeclName Symbol, Term (DeclName Symbol) Ann)
  (Term (DeclName Symbol) Ann)
  (Term (DeclName Symbol) Ann)
_2 ((Term (DeclName Symbol) Ann
  -> WriterT [SomeReferenceId] Identity (Term (DeclName Symbol) Ann))
 -> (DeclName Symbol, Term (DeclName Symbol) Ann)
 -> WriterT
      [SomeReferenceId]
      Identity
      (DeclName Symbol, Term (DeclName Symbol) Ann))
-> ((SomeReferenceId -> Writer [SomeReferenceId] SomeReferenceId)
    -> Term (DeclName Symbol) Ann
    -> WriterT [SomeReferenceId] Identity (Term (DeclName Symbol) Ann))
-> (SomeReferenceId -> Writer [SomeReferenceId] SomeReferenceId)
-> (DeclName Symbol, Term (DeclName Symbol) Ann)
-> WriterT
     [SomeReferenceId]
     Identity
     (DeclName Symbol, Term (DeclName Symbol) Ann)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (SomeReferenceId -> Writer [SomeReferenceId] SomeReferenceId)
-> Term (DeclName Symbol) Ann
-> WriterT [SomeReferenceId] Identity (Term (DeclName Symbol) Ann)
forall (m :: * -> *) v a.
(Monad m, Ord v) =>
LensLike' m (Term v a) SomeReferenceId
termReferences_)
            missingTypeRefs :: [SomeReferenceId]
missingTypeRefs =
              Map
  (Old Id) (Term (DeclName Symbol) Ann, Type (DeclName Symbol) Ann)
componentIDMap
                Map
  (Old Id) (Term (DeclName Symbol) Ann, Type (DeclName Symbol) Ann)
-> (Map
      (Old Id) (Term (DeclName Symbol) Ann, Type (DeclName Symbol) Ann)
    -> [SomeReferenceId])
-> [SomeReferenceId]
forall a b. a -> (a -> b) -> b
& LensLike
  (WriterT [SomeReferenceId] Identity)
  (Map
     (Old Id) (Term (DeclName Symbol) Ann, Type (DeclName Symbol) Ann))
  (Map
     (Old Id) (Term (DeclName Symbol) Ann, Type (DeclName Symbol) Ann))
  SomeReferenceId
  SomeReferenceId
-> Map
     (Old Id) (Term (DeclName Symbol) Ann, Type (DeclName Symbol) Ann)
-> [SomeReferenceId]
forall a s t. LensLike (Writer [a]) s t a a -> s -> [a]
foldSetter (((Term (DeclName Symbol) Ann, Type (DeclName Symbol) Ann)
 -> WriterT
      [SomeReferenceId]
      Identity
      (Term (DeclName Symbol) Ann, Type (DeclName Symbol) Ann))
-> Map
     (Old Id) (Term (DeclName Symbol) Ann, Type (DeclName Symbol) Ann)
-> WriterT
     [SomeReferenceId]
     Identity
     (Map
        (Old Id) (Term (DeclName Symbol) Ann, Type (DeclName Symbol) Ann))
forall (f :: * -> *) a b.
Traversable f =>
IndexedTraversal Int (f a) (f b) a b
IndexedTraversal
  Int
  (Map
     (Old Id) (Term (DeclName Symbol) Ann, Type (DeclName Symbol) Ann))
  (Map
     (Old Id) (Term (DeclName Symbol) Ann, Type (DeclName Symbol) Ann))
  (Term (DeclName Symbol) Ann, Type (DeclName Symbol) Ann)
  (Term (DeclName Symbol) Ann, Type (DeclName Symbol) Ann)
traversed (((Term (DeclName Symbol) Ann, Type (DeclName Symbol) Ann)
  -> WriterT
       [SomeReferenceId]
       Identity
       (Term (DeclName Symbol) Ann, Type (DeclName Symbol) Ann))
 -> Map
      (Old Id) (Term (DeclName Symbol) Ann, Type (DeclName Symbol) Ann)
 -> WriterT
      [SomeReferenceId]
      Identity
      (Map
         (Old Id) (Term (DeclName Symbol) Ann, Type (DeclName Symbol) Ann)))
-> ((SomeReferenceId -> Writer [SomeReferenceId] SomeReferenceId)
    -> (Term (DeclName Symbol) Ann, Type (DeclName Symbol) Ann)
    -> WriterT
         [SomeReferenceId]
         Identity
         (Term (DeclName Symbol) Ann, Type (DeclName Symbol) Ann))
-> LensLike
     (WriterT [SomeReferenceId] Identity)
     (Map
        (Old Id) (Term (DeclName Symbol) Ann, Type (DeclName Symbol) Ann))
     (Map
        (Old Id) (Term (DeclName Symbol) Ann, Type (DeclName Symbol) Ann))
     SomeReferenceId
     SomeReferenceId
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Type (DeclName Symbol) Ann
 -> WriterT [SomeReferenceId] Identity (Type (DeclName Symbol) Ann))
-> (Term (DeclName Symbol) Ann, Type (DeclName Symbol) Ann)
-> WriterT
     [SomeReferenceId]
     Identity
     (Term (DeclName Symbol) Ann, Type (DeclName Symbol) Ann)
forall s t a b. Field2 s t a b => Lens s t a b
Lens
  (Term (DeclName Symbol) Ann, Type (DeclName Symbol) Ann)
  (Term (DeclName Symbol) Ann, Type (DeclName Symbol) Ann)
  (Type (DeclName Symbol) Ann)
  (Type (DeclName Symbol) Ann)
_2 ((Type (DeclName Symbol) Ann
  -> WriterT [SomeReferenceId] Identity (Type (DeclName Symbol) Ann))
 -> (Term (DeclName Symbol) Ann, Type (DeclName Symbol) Ann)
 -> WriterT
      [SomeReferenceId]
      Identity
      (Term (DeclName Symbol) Ann, Type (DeclName Symbol) Ann))
-> ((SomeReferenceId -> Writer [SomeReferenceId] SomeReferenceId)
    -> Type (DeclName Symbol) Ann
    -> WriterT [SomeReferenceId] Identity (Type (DeclName Symbol) Ann))
-> (SomeReferenceId -> Writer [SomeReferenceId] SomeReferenceId)
-> (Term (DeclName Symbol) Ann, Type (DeclName Symbol) Ann)
-> WriterT
     [SomeReferenceId]
     Identity
     (Term (DeclName Symbol) Ann, Type (DeclName Symbol) Ann)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (SomeReferenceId -> Writer [SomeReferenceId] SomeReferenceId)
-> Type (DeclName Symbol) Ann
-> WriterT [SomeReferenceId] Identity (Type (DeclName Symbol) Ann)
forall (m :: * -> *) v a.
(Monad m, Ord v) =>
LensLike' m (Type v a) SomeReferenceId
typeReferences_)
         in (SomeReferenceId -> Bool) -> [SomeReferenceId] -> [SomeReferenceId]
forall a. (a -> Bool) -> [a] -> [a]
filter (SomeReferenceId -> Map SomeReferenceId SomeReferenceId -> Bool
forall k a. Ord k => k -> Map k a -> Bool
`Map.notMember` Map SomeReferenceId SomeReferenceId
referencesMap) ([SomeReferenceId]
missingTermRefs [SomeReferenceId] -> [SomeReferenceId] -> [SomeReferenceId]
forall a. Semigroup a => a -> a -> a
<> [SomeReferenceId]
missingTypeRefs)

  Bool
-> ExceptT
     (TrySyncResult Entity) (StateT MigrationState Transaction) ()
-> ExceptT
     (TrySyncResult Entity) (StateT MigrationState Transaction) ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Bool -> Bool
not (Bool -> Bool)
-> ([SomeReferenceId] -> Bool) -> [SomeReferenceId] -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [SomeReferenceId] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null ([SomeReferenceId] -> Bool) -> [SomeReferenceId] -> Bool
forall a b. (a -> b) -> a -> b
$ [SomeReferenceId]
allMissingReferences) (ExceptT
   (TrySyncResult Entity) (StateT MigrationState Transaction) ()
 -> ExceptT
      (TrySyncResult Entity) (StateT MigrationState Transaction) ())
-> ExceptT
     (TrySyncResult Entity) (StateT MigrationState Transaction) ()
-> ExceptT
     (TrySyncResult Entity) (StateT MigrationState Transaction) ()
forall a b. (a -> b) -> a -> b
$
    TrySyncResult Entity
-> ExceptT
     (TrySyncResult Entity) (StateT MigrationState Transaction) ()
forall (m :: * -> *) e a. Monad m => e -> ExceptT e m a
throwE (TrySyncResult Entity
 -> ExceptT
      (TrySyncResult Entity) (StateT MigrationState Transaction) ())
-> TrySyncResult Entity
-> ExceptT
     (TrySyncResult Entity) (StateT MigrationState Transaction) ()
forall a b. (a -> b) -> a -> b
$
      [Entity] -> TrySyncResult Entity
forall entity. [entity] -> TrySyncResult entity
Sync.Missing ([Entity] -> TrySyncResult Entity)
-> ([Entity] -> [Entity]) -> [Entity] -> TrySyncResult Entity
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Entity] -> [Entity]
forall a. Ord a => [a] -> [a]
nubOrd ([Entity] -> TrySyncResult Entity)
-> [Entity] -> TrySyncResult Entity
forall a b. (a -> b) -> a -> b
$
        (SomeReferenceId -> Entity
someReferenceIdToEntity (SomeReferenceId -> Entity) -> [SomeReferenceId] -> [Entity]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [SomeReferenceId]
allMissingReferences)

  let getMigratedReference :: Old SomeReferenceId -> New SomeReferenceId
      getMigratedReference :: SomeReferenceId -> SomeReferenceId
getMigratedReference SomeReferenceId
ref =
        SomeReferenceId
-> SomeReferenceId
-> Map SomeReferenceId SomeReferenceId
-> SomeReferenceId
forall k a. Ord k => a -> k -> Map k a -> a
Map.findWithDefault ([Char] -> SomeReferenceId
forall a. HasCallStack => [Char] -> a
error ([Char] -> SomeReferenceId) -> [Char] -> SomeReferenceId
forall a b. (a -> b) -> a -> b
$ [Char]
"unmigrated reference" [Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<> SomeReferenceId -> [Char]
forall a. Show a => a -> [Char]
show SomeReferenceId
ref) SomeReferenceId
ref Map SomeReferenceId SomeReferenceId
referencesMap

  let Map
  (Old Id)
  (DeclName Symbol, Term (DeclName Symbol) Ann,
   Type (DeclName Symbol) Ann)
remappedReferences :: Map (Old Reference.Id) (Symbol, Term.Term Symbol Ann, Type Symbol Ann) =
        ((DeclName Symbol, Term (DeclName Symbol) Ann)
 -> (Term (DeclName Symbol) Ann, Type (DeclName Symbol) Ann)
 -> (DeclName Symbol, Term (DeclName Symbol) Ann,
     Type (DeclName Symbol) Ann))
-> Map (Old Id) (DeclName Symbol, Term (DeclName Symbol) Ann)
-> Map
     (Old Id) (Term (DeclName Symbol) Ann, Type (DeclName Symbol) Ann)
-> Map
     (Old Id)
     (DeclName Symbol, Term (DeclName Symbol) Ann,
      Type (DeclName Symbol) Ann)
forall a b c.
(a -> b -> c) -> Map (Old Id) a -> Map (Old Id) b -> Map (Old Id) c
forall (f :: * -> *) a b c.
Zip f =>
(a -> b -> c) -> f a -> f b -> f c
Zip.zipWith
          ( \(DeclName Symbol
v, Term (DeclName Symbol) Ann
trm) (Term (DeclName Symbol) Ann
_, Type (DeclName Symbol) Ann
typ) ->
              ( DeclName Symbol
v,
                Term (DeclName Symbol) Ann
trm Term (DeclName Symbol) Ann
-> (Term (DeclName Symbol) Ann -> Term (DeclName Symbol) Ann)
-> Term (DeclName Symbol) Ann
forall a b. a -> (a -> b) -> b
& LensLike' Identity (Term (DeclName Symbol) Ann) SomeReferenceId
forall (m :: * -> *) v a.
(Monad m, Ord v) =>
LensLike' m (Term v a) SomeReferenceId
termReferences_ LensLike' Identity (Term (DeclName Symbol) Ann) SomeReferenceId
-> (SomeReferenceId -> SomeReferenceId)
-> Term (DeclName Symbol) Ann
-> Term (DeclName Symbol) Ann
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ SomeReferenceId -> SomeReferenceId
getMigratedReference,
                Type (DeclName Symbol) Ann
typ Type (DeclName Symbol) Ann
-> (Type (DeclName Symbol) Ann -> Type (DeclName Symbol) Ann)
-> Type (DeclName Symbol) Ann
forall a b. a -> (a -> b) -> b
& LensLike' Identity (Type (DeclName Symbol) Ann) SomeReferenceId
forall (m :: * -> *) v a.
(Monad m, Ord v) =>
LensLike' m (Type v a) SomeReferenceId
typeReferences_ LensLike' Identity (Type (DeclName Symbol) Ann) SomeReferenceId
-> (SomeReferenceId -> SomeReferenceId)
-> Type (DeclName Symbol) Ann
-> Type (DeclName Symbol) Ann
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ SomeReferenceId -> SomeReferenceId
getMigratedReference
              )
          )
          Map (Old Id) (DeclName Symbol, Term (DeclName Symbol) Ann)
unhashed
          Map
  (Old Id) (Term (DeclName Symbol) Ann, Type (DeclName Symbol) Ann)
componentIDMap

  let newTermComponents :: Map Symbol (New Reference.Id, Term.Term Symbol Ann, Type Symbol Ann)
      newTermComponents :: Map
  (DeclName Symbol)
  (Old Id, Term (DeclName Symbol) Ann, Type (DeclName Symbol) Ann)
newTermComponents =
        Map
  (Old Id)
  (DeclName Symbol, Term (DeclName Symbol) Ann,
   Type (DeclName Symbol) Ann)
remappedReferences
          Map
  (Old Id)
  (DeclName Symbol, Term (DeclName Symbol) Ann,
   Type (DeclName Symbol) Ann)
-> (Map
      (Old Id)
      (DeclName Symbol, Term (DeclName Symbol) Ann,
       Type (DeclName Symbol) Ann)
    -> [(DeclName Symbol, Term (DeclName Symbol) Ann,
         Type (DeclName Symbol) Ann)])
-> [(DeclName Symbol, Term (DeclName Symbol) Ann,
     Type (DeclName Symbol) Ann)]
forall a b. a -> (a -> b) -> b
& Map
  (Old Id)
  (DeclName Symbol, Term (DeclName Symbol) Ann,
   Type (DeclName Symbol) Ann)
-> [(DeclName Symbol, Term (DeclName Symbol) Ann,
     Type (DeclName Symbol) Ann)]
forall k a. Map k a -> [a]
Map.elems
          [(DeclName Symbol, Term (DeclName Symbol) Ann,
  Type (DeclName Symbol) Ann)]
-> ([(DeclName Symbol, Term (DeclName Symbol) Ann,
      Type (DeclName Symbol) Ann)]
    -> [(DeclName Symbol,
         (Term (DeclName Symbol) Ann, Type (DeclName Symbol) Ann, ()))])
-> [(DeclName Symbol,
     (Term (DeclName Symbol) Ann, Type (DeclName Symbol) Ann, ()))]
forall a b. a -> (a -> b) -> b
& ((DeclName Symbol, Term (DeclName Symbol) Ann,
  Type (DeclName Symbol) Ann)
 -> (DeclName Symbol,
     (Term (DeclName Symbol) Ann, Type (DeclName Symbol) Ann, ())))
-> [(DeclName Symbol, Term (DeclName Symbol) Ann,
     Type (DeclName Symbol) Ann)]
-> [(DeclName Symbol,
     (Term (DeclName Symbol) Ann, Type (DeclName Symbol) Ann, ()))]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\(DeclName Symbol
v, Term (DeclName Symbol) Ann
trm, Type (DeclName Symbol) Ann
typ) -> (DeclName Symbol
v, (Term (DeclName Symbol) Ann
trm, Type (DeclName Symbol) Ann
typ, ())))
          [(DeclName Symbol,
  (Term (DeclName Symbol) Ann, Type (DeclName Symbol) Ann, ()))]
-> ([(DeclName Symbol,
      (Term (DeclName Symbol) Ann, Type (DeclName Symbol) Ann, ()))]
    -> Map
         (DeclName Symbol)
         (Term (DeclName Symbol) Ann, Type (DeclName Symbol) Ann, ()))
-> Map
     (DeclName Symbol)
     (Term (DeclName Symbol) Ann, Type (DeclName Symbol) Ann, ())
forall a b. a -> (a -> b) -> b
& [(DeclName Symbol,
  (Term (DeclName Symbol) Ann, Type (DeclName Symbol) Ann, ()))]
-> Map
     (DeclName Symbol)
     (Term (DeclName Symbol) Ann, Type (DeclName Symbol) Ann, ())
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList
          Map
  (DeclName Symbol)
  (Term (DeclName Symbol) Ann, Type (DeclName Symbol) Ann, ())
-> (Map
      (DeclName Symbol)
      (Term (DeclName Symbol) Ann, Type (DeclName Symbol) Ann, ())
    -> Map
         (DeclName Symbol)
         (Old Id, Term (DeclName Symbol) Ann, Type (DeclName Symbol) Ann,
          ()))
-> Map
     (DeclName Symbol)
     (Old Id, Term (DeclName Symbol) Ann, Type (DeclName Symbol) Ann,
      ())
forall a b. a -> (a -> b) -> b
& Map
  (DeclName Symbol)
  (Term (DeclName Symbol) Ann, Type (DeclName Symbol) Ann, ())
-> Map
     (DeclName Symbol)
     (Old Id, Term (DeclName Symbol) Ann, Type (DeclName Symbol) Ann,
      ())
forall v a extra.
Var v =>
Map v (Term v a, Type v a, extra)
-> Map v (Old Id, Term v a, Type v a, extra)
Convert.hashTermComponents
          Map
  (DeclName Symbol)
  (Old Id, Term (DeclName Symbol) Ann, Type (DeclName Symbol) Ann,
   ())
-> (Map
      (DeclName Symbol)
      (Old Id, Term (DeclName Symbol) Ann, Type (DeclName Symbol) Ann,
       ())
    -> Map
         (DeclName Symbol)
         (Old Id, Term (DeclName Symbol) Ann, Type (DeclName Symbol) Ann))
-> Map
     (DeclName Symbol)
     (Old Id, Term (DeclName Symbol) Ann, Type (DeclName Symbol) Ann)
forall a b. a -> (a -> b) -> b
& ((Old Id, Term (DeclName Symbol) Ann, Type (DeclName Symbol) Ann,
  ())
 -> (Old Id, Term (DeclName Symbol) Ann,
     Type (DeclName Symbol) Ann))
-> Map
     (DeclName Symbol)
     (Old Id, Term (DeclName Symbol) Ann, Type (DeclName Symbol) Ann,
      ())
-> Map
     (DeclName Symbol)
     (Old Id, Term (DeclName Symbol) Ann, Type (DeclName Symbol) Ann)
forall a b.
(a -> b) -> Map (DeclName Symbol) a -> Map (DeclName Symbol) b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\(Old Id
ref, Term (DeclName Symbol) Ann
trm, Type (DeclName Symbol) Ann
typ, ()
_) -> (Old Id
ref, Term (DeclName Symbol) Ann
trm, Type (DeclName Symbol) Ann
typ))

  Map
  (DeclName Symbol)
  (Old Id, Term (DeclName Symbol) Ann, Type (DeclName Symbol) Ann)
-> (DeclName Symbol
    -> (Old Id, Term (DeclName Symbol) Ann, Type (DeclName Symbol) Ann)
    -> ExceptT
         (TrySyncResult Entity) (StateT MigrationState Transaction) ())
-> ExceptT
     (TrySyncResult Entity)
     (StateT MigrationState Transaction)
     (Map (DeclName Symbol) ())
forall i (t :: * -> *) (f :: * -> *) a b.
(TraversableWithIndex i t, Applicative f) =>
t a -> (i -> a -> f b) -> f (t b)
ifor Map
  (DeclName Symbol)
  (Old Id, Term (DeclName Symbol) Ann, Type (DeclName Symbol) Ann)
newTermComponents ((DeclName Symbol
  -> (Old Id, Term (DeclName Symbol) Ann, Type (DeclName Symbol) Ann)
  -> ExceptT
       (TrySyncResult Entity) (StateT MigrationState Transaction) ())
 -> ExceptT
      (TrySyncResult Entity)
      (StateT MigrationState Transaction)
      (Map (DeclName Symbol) ()))
-> (DeclName Symbol
    -> (Old Id, Term (DeclName Symbol) Ann, Type (DeclName Symbol) Ann)
    -> ExceptT
         (TrySyncResult Entity) (StateT MigrationState Transaction) ())
-> ExceptT
     (TrySyncResult Entity)
     (StateT MigrationState Transaction)
     (Map (DeclName Symbol) ())
forall a b. (a -> b) -> a -> b
$ \DeclName Symbol
v (Old Id
newReferenceId, Term (DeclName Symbol) Ann
trm, Type (DeclName Symbol) Ann
typ) -> do
    let oldReferenceId :: Old Id
oldReferenceId = Map (DeclName Symbol) (Old Id)
vToOldReferenceMapping Map (DeclName Symbol) (Old Id)
-> Getting
     (Endo (Old Id)) (Map (DeclName Symbol) (Old Id)) (Old Id)
-> Old Id
forall s a. HasCallStack => s -> Getting (Endo a) s a -> a
^?! Index (Map (DeclName Symbol) (Old Id))
-> Traversal'
     (Map (DeclName Symbol) (Old Id))
     (IxValue (Map (DeclName Symbol) (Old Id)))
forall m. Ixed m => Index m -> Traversal' m (IxValue m)
ix Index (Map (DeclName Symbol) (Old Id))
DeclName Symbol
v
    forall (field :: Symbol) s t a b.
HasField field s t a b =>
Lens s t a b
field @"referenceMapping" ((Map SomeReferenceId SomeReferenceId
  -> Identity (Map SomeReferenceId SomeReferenceId))
 -> MigrationState -> Identity MigrationState)
-> (Map SomeReferenceId SomeReferenceId
    -> Map SomeReferenceId SomeReferenceId)
-> ExceptT
     (TrySyncResult Entity) (StateT MigrationState Transaction) ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
%= SomeReferenceId
-> SomeReferenceId
-> Map SomeReferenceId SomeReferenceId
-> Map SomeReferenceId SomeReferenceId
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert (Old Id -> SomeReferenceId
forall ref. ref -> SomeReference ref
TermReference Old Id
oldReferenceId) (Old Id -> SomeReferenceId
forall ref. ref -> SomeReference ref
TermReference Old Id
newReferenceId)
    StateT MigrationState Transaction ()
-> ExceptT
     (TrySyncResult Entity) (StateT MigrationState Transaction) ()
forall (m :: * -> *) a.
Monad m =>
m a -> ExceptT (TrySyncResult Entity) m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (StateT MigrationState Transaction ()
 -> ExceptT
      (TrySyncResult Entity) (StateT MigrationState Transaction) ())
-> (Transaction () -> StateT MigrationState Transaction ())
-> Transaction ()
-> ExceptT
     (TrySyncResult Entity) (StateT MigrationState Transaction) ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Transaction () -> StateT MigrationState Transaction ()
forall (m :: * -> *) a. Monad m => m a -> StateT MigrationState m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (Transaction ()
 -> ExceptT
      (TrySyncResult Entity) (StateT MigrationState Transaction) ())
-> Transaction ()
-> ExceptT
     (TrySyncResult Entity) (StateT MigrationState Transaction) ()
forall a b. (a -> b) -> a -> b
$ TVar (Map (New Hash) TermBufferEntry)
-> TVar (Map (New Hash) DeclBufferEntry)
-> Old Id
-> Term (DeclName Symbol) Ann
-> Type (DeclName Symbol) Ann
-> Transaction ()
CodebaseOps.putTerm TVar (Map (New Hash) TermBufferEntry)
termBuffer TVar (Map (New Hash) DeclBufferEntry)
declBuffer Old Id
newReferenceId Term (DeclName Symbol) Ann
trm Type (DeclName Symbol) Ann
typ

  -- Need to get one of the new references to grab its hash, doesn't matter which one since
  -- all hashes in the component are the same.
  case Map
  (DeclName Symbol)
  (Old Id, Term (DeclName Symbol) Ann, Type (DeclName Symbol) Ann)
newTermComponents Map
  (DeclName Symbol)
  (Old Id, Term (DeclName Symbol) Ann, Type (DeclName Symbol) Ann)
-> Getting
     (First (New Hash))
     (Map
        (DeclName Symbol)
        (Old Id, Term (DeclName Symbol) Ann, Type (DeclName Symbol) Ann))
     (New Hash)
-> Maybe (New Hash)
forall s a. s -> Getting (First a) s a -> Maybe a
^? ((Old Id, Term (DeclName Symbol) Ann, Type (DeclName Symbol) Ann)
 -> Const
      (First (New Hash))
      (Old Id, Term (DeclName Symbol) Ann, Type (DeclName Symbol) Ann))
-> Map
     (DeclName Symbol)
     (Old Id, Term (DeclName Symbol) Ann, Type (DeclName Symbol) Ann)
-> Const
     (First (New Hash))
     (Map
        (DeclName Symbol)
        (Old Id, Term (DeclName Symbol) Ann, Type (DeclName Symbol) Ann))
forall (f :: * -> *) a b.
Traversable f =>
IndexedTraversal Int (f a) (f b) a b
IndexedTraversal
  Int
  (Map
     (DeclName Symbol)
     (Old Id, Term (DeclName Symbol) Ann, Type (DeclName Symbol) Ann))
  (Map
     (DeclName Symbol)
     (Old Id, Term (DeclName Symbol) Ann, Type (DeclName Symbol) Ann))
  (Old Id, Term (DeclName Symbol) Ann, Type (DeclName Symbol) Ann)
  (Old Id, Term (DeclName Symbol) Ann, Type (DeclName Symbol) Ann)
traversed (((Old Id, Term (DeclName Symbol) Ann, Type (DeclName Symbol) Ann)
  -> Const
       (First (New Hash))
       (Old Id, Term (DeclName Symbol) Ann, Type (DeclName Symbol) Ann))
 -> Map
      (DeclName Symbol)
      (Old Id, Term (DeclName Symbol) Ann, Type (DeclName Symbol) Ann)
 -> Const
      (First (New Hash))
      (Map
         (DeclName Symbol)
         (Old Id, Term (DeclName Symbol) Ann, Type (DeclName Symbol) Ann)))
-> ((New Hash -> Const (First (New Hash)) (New Hash))
    -> (Old Id, Term (DeclName Symbol) Ann, Type (DeclName Symbol) Ann)
    -> Const
         (First (New Hash))
         (Old Id, Term (DeclName Symbol) Ann, Type (DeclName Symbol) Ann))
-> Getting
     (First (New Hash))
     (Map
        (DeclName Symbol)
        (Old Id, Term (DeclName Symbol) Ann, Type (DeclName Symbol) Ann))
     (New Hash)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Old Id -> Const (First (New Hash)) (Old Id))
-> (Old Id, Term (DeclName Symbol) Ann, Type (DeclName Symbol) Ann)
-> Const
     (First (New Hash))
     (Old Id, Term (DeclName Symbol) Ann, Type (DeclName Symbol) Ann)
forall s t a b. Field1 s t a b => Lens s t a b
Lens
  (Old Id, Term (DeclName Symbol) Ann, Type (DeclName Symbol) Ann)
  (Old Id, Term (DeclName Symbol) Ann, Type (DeclName Symbol) Ann)
  (Old Id)
  (Old Id)
_1 ((Old Id -> Const (First (New Hash)) (Old Id))
 -> (Old Id, Term (DeclName Symbol) Ann, Type (DeclName Symbol) Ann)
 -> Const
      (First (New Hash))
      (Old Id, Term (DeclName Symbol) Ann, Type (DeclName Symbol) Ann))
-> ((New Hash -> Const (First (New Hash)) (New Hash))
    -> Old Id -> Const (First (New Hash)) (Old Id))
-> (New Hash -> Const (First (New Hash)) (New Hash))
-> (Old Id, Term (DeclName Symbol) Ann, Type (DeclName Symbol) Ann)
-> Const
     (First (New Hash))
     (Old Id, Term (DeclName Symbol) Ann, Type (DeclName Symbol) Ann)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Old Id -> New Hash)
-> (New Hash -> Const (First (New Hash)) (New Hash))
-> Old Id
-> Const (First (New Hash)) (Old Id)
forall (p :: * -> * -> *) (f :: * -> *) s a.
(Profunctor p, Contravariant f) =>
(s -> a) -> Optic' p f s a
to Old Id -> New Hash
Reference.idToHash of
    Maybe (New Hash)
Nothing -> ()
-> ExceptT
     (TrySyncResult Entity) (StateT MigrationState Transaction) ()
forall a.
a
-> ExceptT
     (TrySyncResult Entity) (StateT MigrationState Transaction) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
    Just New Hash
newHash -> StateT MigrationState Transaction ()
-> ExceptT
     (TrySyncResult Entity) (StateT MigrationState Transaction) ()
forall (m :: * -> *) a.
Monad m =>
m a -> ExceptT (TrySyncResult Entity) m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (New Hash -> New Hash -> StateT MigrationState Transaction ()
insertObjectMappingForHash New Hash
oldHash New Hash
newHash)

  forall (field :: Symbol) s t a b.
HasField field s t a b =>
Lens s t a b
field @"migratedDefnHashes" ((Set (New Hash) -> Identity (Set (New Hash)))
 -> MigrationState -> Identity MigrationState)
-> (Set (New Hash) -> Set (New Hash))
-> ExceptT
     (TrySyncResult Entity) (StateT MigrationState Transaction) ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
%= New Hash -> Set (New Hash) -> Set (New Hash)
forall a. Ord a => a -> Set a -> Set a
Set.insert New Hash
oldHash
  pure TrySyncResult Entity
forall entity. TrySyncResult entity
Sync.Done

migrateDeclComponent ::
  TVar (Map Hash CodebaseOps.TermBufferEntry) ->
  TVar (Map Hash CodebaseOps.DeclBufferEntry) ->
  Unison.Hash ->
  StateT MigrationState Sqlite.Transaction (Sync.TrySyncResult Entity)
migrateDeclComponent :: TVar (Map (New Hash) TermBufferEntry)
-> TVar (Map (New Hash) DeclBufferEntry)
-> New Hash
-> StateT MigrationState Transaction (TrySyncResult Entity)
migrateDeclComponent TVar (Map (New Hash) TermBufferEntry)
termBuffer TVar (Map (New Hash) DeclBufferEntry)
declBuffer New Hash
oldHash = (Either (TrySyncResult Entity) (TrySyncResult Entity)
 -> TrySyncResult Entity)
-> StateT
     MigrationState
     Transaction
     (Either (TrySyncResult Entity) (TrySyncResult Entity))
-> StateT MigrationState Transaction (TrySyncResult Entity)
forall a b.
(a -> b)
-> StateT MigrationState Transaction a
-> StateT MigrationState Transaction b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((TrySyncResult Entity -> TrySyncResult Entity)
-> (TrySyncResult Entity -> TrySyncResult Entity)
-> Either (TrySyncResult Entity) (TrySyncResult Entity)
-> TrySyncResult Entity
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either TrySyncResult Entity -> TrySyncResult Entity
forall a. a -> a
id TrySyncResult Entity -> TrySyncResult Entity
forall a. a -> a
id) (StateT
   MigrationState
   Transaction
   (Either (TrySyncResult Entity) (TrySyncResult Entity))
 -> StateT MigrationState Transaction (TrySyncResult Entity))
-> (ExceptT
      (TrySyncResult Entity)
      (StateT MigrationState Transaction)
      (TrySyncResult Entity)
    -> StateT
         MigrationState
         Transaction
         (Either (TrySyncResult Entity) (TrySyncResult Entity)))
-> ExceptT
     (TrySyncResult Entity)
     (StateT MigrationState Transaction)
     (TrySyncResult Entity)
-> StateT MigrationState Transaction (TrySyncResult Entity)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ExceptT
  (TrySyncResult Entity)
  (StateT MigrationState Transaction)
  (TrySyncResult Entity)
-> StateT
     MigrationState
     Transaction
     (Either (TrySyncResult Entity) (TrySyncResult Entity))
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT (ExceptT
   (TrySyncResult Entity)
   (StateT MigrationState Transaction)
   (TrySyncResult Entity)
 -> StateT MigrationState Transaction (TrySyncResult Entity))
-> ExceptT
     (TrySyncResult Entity)
     (StateT MigrationState Transaction)
     (TrySyncResult Entity)
-> StateT MigrationState Transaction (TrySyncResult Entity)
forall a b. (a -> b) -> a -> b
$ do
  ExceptT
  (TrySyncResult Entity) (StateT MigrationState Transaction) Bool
-> ExceptT
     (TrySyncResult Entity) (StateT MigrationState Transaction) ()
-> ExceptT
     (TrySyncResult Entity) (StateT MigrationState Transaction) ()
forall (m :: * -> *). Monad m => m Bool -> m () -> m ()
whenM (New Hash -> Set (New Hash) -> Bool
forall a. Ord a => a -> Set a -> Bool
Set.member New Hash
oldHash (Set (New Hash) -> Bool)
-> ExceptT
     (TrySyncResult Entity)
     (StateT MigrationState Transaction)
     (Set (New Hash))
-> ExceptT
     (TrySyncResult Entity) (StateT MigrationState Transaction) Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Getting (Set (New Hash)) MigrationState (Set (New Hash))
-> ExceptT
     (TrySyncResult Entity)
     (StateT MigrationState Transaction)
     (Set (New Hash))
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use (forall (field :: Symbol) s t a b.
HasField field s t a b =>
Lens s t a b
field @"migratedDefnHashes")) (TrySyncResult Entity
-> ExceptT
     (TrySyncResult Entity) (StateT MigrationState Transaction) ()
forall (m :: * -> *) e a. Monad m => e -> ExceptT e m a
throwE TrySyncResult Entity
forall entity. TrySyncResult entity
Sync.PreviouslyDone)

  [Decl (DeclName Symbol) Ann]
declComponent :: [DD.Decl v a] <-
    (StateT
  MigrationState Transaction (Maybe [Decl (DeclName Symbol) Ann])
-> ExceptT
     (TrySyncResult Entity)
     (StateT MigrationState Transaction)
     (Maybe [Decl (DeclName Symbol) Ann])
forall (m :: * -> *) a.
Monad m =>
m a -> ExceptT (TrySyncResult Entity) m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (StateT
   MigrationState Transaction (Maybe [Decl (DeclName Symbol) Ann])
 -> ExceptT
      (TrySyncResult Entity)
      (StateT MigrationState Transaction)
      (Maybe [Decl (DeclName Symbol) Ann]))
-> (Transaction (Maybe [Decl (DeclName Symbol) Ann])
    -> StateT
         MigrationState Transaction (Maybe [Decl (DeclName Symbol) Ann]))
-> Transaction (Maybe [Decl (DeclName Symbol) Ann])
-> ExceptT
     (TrySyncResult Entity)
     (StateT MigrationState Transaction)
     (Maybe [Decl (DeclName Symbol) Ann])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Transaction (Maybe [Decl (DeclName Symbol) Ann])
-> StateT
     MigrationState Transaction (Maybe [Decl (DeclName Symbol) Ann])
forall (m :: * -> *) a. Monad m => m a -> StateT MigrationState m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (Transaction (Maybe [Decl (DeclName Symbol) Ann])
 -> ExceptT
      (TrySyncResult Entity)
      (StateT MigrationState Transaction)
      (Maybe [Decl (DeclName Symbol) Ann]))
-> Transaction (Maybe [Decl (DeclName Symbol) Ann])
-> ExceptT
     (TrySyncResult Entity)
     (StateT MigrationState Transaction)
     (Maybe [Decl (DeclName Symbol) Ann])
forall a b. (a -> b) -> a -> b
$ New Hash -> Transaction (Maybe [Decl (DeclName Symbol) Ann])
CodebaseOps.getDeclComponent New Hash
oldHash) ExceptT
  (TrySyncResult Entity)
  (StateT MigrationState Transaction)
  (Maybe [Decl (DeclName Symbol) Ann])
-> (Maybe [Decl (DeclName Symbol) Ann]
    -> ExceptT
         (TrySyncResult Entity)
         (StateT MigrationState Transaction)
         [Decl (DeclName Symbol) Ann])
-> ExceptT
     (TrySyncResult Entity)
     (StateT MigrationState Transaction)
     [Decl (DeclName Symbol) Ann]
forall a b.
ExceptT
  (TrySyncResult Entity) (StateT MigrationState Transaction) a
-> (a
    -> ExceptT
         (TrySyncResult Entity) (StateT MigrationState Transaction) b)
-> ExceptT
     (TrySyncResult Entity) (StateT MigrationState Transaction) b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
      Maybe [Decl (DeclName Symbol) Ann]
Nothing -> [Char]
-> ExceptT
     (TrySyncResult Entity)
     (StateT MigrationState Transaction)
     [Decl (DeclName Symbol) Ann]
forall a. HasCallStack => [Char] -> a
error ([Char]
 -> ExceptT
      (TrySyncResult Entity)
      (StateT MigrationState Transaction)
      [Decl (DeclName Symbol) Ann])
-> [Char]
-> ExceptT
     (TrySyncResult Entity)
     (StateT MigrationState Transaction)
     [Decl (DeclName Symbol) Ann]
forall a b. (a -> b) -> a -> b
$ [Char]
"Expected decl component for hash:" [Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<> New Hash -> [Char]
forall a. Show a => a -> [Char]
show New Hash
oldHash
      Just [Decl (DeclName Symbol) Ann]
dc -> [Decl (DeclName Symbol) Ann]
-> ExceptT
     (TrySyncResult Entity)
     (StateT MigrationState Transaction)
     [Decl (DeclName Symbol) Ann]
forall a.
a
-> ExceptT
     (TrySyncResult Entity) (StateT MigrationState Transaction) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure [Decl (DeclName Symbol) Ann]
dc

  let componentIDMap :: Map (Old Reference.Id) (DD.Decl v a)
      componentIDMap :: Map (Old Id) (Decl (DeclName Symbol) Ann)
componentIDMap = [(Old Id, Decl (DeclName Symbol) Ann)]
-> Map (Old Id) (Decl (DeclName Symbol) Ann)
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList ([(Old Id, Decl (DeclName Symbol) Ann)]
 -> Map (Old Id) (Decl (DeclName Symbol) Ann))
-> [(Old Id, Decl (DeclName Symbol) Ann)]
-> Map (Old Id) (Decl (DeclName Symbol) Ann)
forall a b. (a -> b) -> a -> b
$ New Hash
-> [Decl (DeclName Symbol) Ann]
-> [(Old Id, Decl (DeclName Symbol) Ann)]
forall a. New Hash -> [a] -> [(Old Id, a)]
Reference.componentFor New Hash
oldHash [Decl (DeclName Symbol) Ann]
declComponent

  let unhashed :: Map (Old Reference.Id) (DeclName v, DD.Decl v a)
      unhashed :: Map (Old Id) (DeclName Symbol, Decl (DeclName Symbol) Ann)
unhashed = Map (Old Id) (Decl (DeclName Symbol) Ann)
-> Map (Old Id) (DeclName Symbol, Decl (DeclName Symbol) Ann)
forall v a.
Var v =>
Map (Old Id) (Decl v a) -> Map (Old Id) (v, Decl v a)
DD.unhashComponent Map (Old Id) (Decl (DeclName Symbol) Ann)
componentIDMap

  let allTypes :: [Type v a]
      allTypes :: [Type (DeclName Symbol) Ann]
allTypes =
        Map (Old Id) (DeclName Symbol, Decl (DeclName Symbol) Ann)
unhashed
          Map (Old Id) (DeclName Symbol, Decl (DeclName Symbol) Ann)
-> Getting
     (Endo [Type (DeclName Symbol) Ann])
     (Map (Old Id) (DeclName Symbol, Decl (DeclName Symbol) Ann))
     (Type (DeclName Symbol) Ann)
-> [Type (DeclName Symbol) Ann]
forall s a. s -> Getting (Endo [a]) s a -> [a]
^.. ((DeclName Symbol, Decl (DeclName Symbol) Ann)
 -> Const
      (Endo [Type (DeclName Symbol) Ann])
      (DeclName Symbol, Decl (DeclName Symbol) Ann))
-> Map (Old Id) (DeclName Symbol, Decl (DeclName Symbol) Ann)
-> Const
     (Endo [Type (DeclName Symbol) Ann])
     (Map (Old Id) (DeclName Symbol, Decl (DeclName Symbol) Ann))
forall (f :: * -> *) a b.
Traversable f =>
IndexedTraversal Int (f a) (f b) a b
IndexedTraversal
  Int
  (Map (Old Id) (DeclName Symbol, Decl (DeclName Symbol) Ann))
  (Map (Old Id) (DeclName Symbol, Decl (DeclName Symbol) Ann))
  (DeclName Symbol, Decl (DeclName Symbol) Ann)
  (DeclName Symbol, Decl (DeclName Symbol) Ann)
traversed
            (((DeclName Symbol, Decl (DeclName Symbol) Ann)
  -> Const
       (Endo [Type (DeclName Symbol) Ann])
       (DeclName Symbol, Decl (DeclName Symbol) Ann))
 -> Map (Old Id) (DeclName Symbol, Decl (DeclName Symbol) Ann)
 -> Const
      (Endo [Type (DeclName Symbol) Ann])
      (Map (Old Id) (DeclName Symbol, Decl (DeclName Symbol) Ann)))
-> ((Type (DeclName Symbol) Ann
     -> Const
          (Endo [Type (DeclName Symbol) Ann]) (Type (DeclName Symbol) Ann))
    -> (DeclName Symbol, Decl (DeclName Symbol) Ann)
    -> Const
         (Endo [Type (DeclName Symbol) Ann])
         (DeclName Symbol, Decl (DeclName Symbol) Ann))
-> Getting
     (Endo [Type (DeclName Symbol) Ann])
     (Map (Old Id) (DeclName Symbol, Decl (DeclName Symbol) Ann))
     (Type (DeclName Symbol) Ann)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Decl (DeclName Symbol) Ann
 -> Const
      (Endo [Type (DeclName Symbol) Ann]) (Decl (DeclName Symbol) Ann))
-> (DeclName Symbol, Decl (DeclName Symbol) Ann)
-> Const
     (Endo [Type (DeclName Symbol) Ann])
     (DeclName Symbol, Decl (DeclName Symbol) Ann)
forall s t a b. Field2 s t a b => Lens s t a b
Lens
  (DeclName Symbol, Decl (DeclName Symbol) Ann)
  (DeclName Symbol, Decl (DeclName Symbol) Ann)
  (Decl (DeclName Symbol) Ann)
  (Decl (DeclName Symbol) Ann)
_2
            ((Decl (DeclName Symbol) Ann
  -> Const
       (Endo [Type (DeclName Symbol) Ann]) (Decl (DeclName Symbol) Ann))
 -> (DeclName Symbol, Decl (DeclName Symbol) Ann)
 -> Const
      (Endo [Type (DeclName Symbol) Ann])
      (DeclName Symbol, Decl (DeclName Symbol) Ann))
-> ((Type (DeclName Symbol) Ann
     -> Const
          (Endo [Type (DeclName Symbol) Ann]) (Type (DeclName Symbol) Ann))
    -> Decl (DeclName Symbol) Ann
    -> Const
         (Endo [Type (DeclName Symbol) Ann]) (Decl (DeclName Symbol) Ann))
-> (Type (DeclName Symbol) Ann
    -> Const
         (Endo [Type (DeclName Symbol) Ann]) (Type (DeclName Symbol) Ann))
-> (DeclName Symbol, Decl (DeclName Symbol) Ann)
-> Const
     (Endo [Type (DeclName Symbol) Ann])
     (DeclName Symbol, Decl (DeclName Symbol) Ann)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Optical
  (->)
  (->)
  (Const (Endo [Type (DeclName Symbol) Ann]))
  (EffectDeclaration (DeclName Symbol) Ann)
  (EffectDeclaration (DeclName Symbol) Ann)
  (DataDeclaration (DeclName Symbol) Ann)
  (DataDeclaration (DeclName Symbol) Ann)
-> Optical
     (->)
     (->)
     (Const (Endo [Type (DeclName Symbol) Ann]))
     (DataDeclaration (DeclName Symbol) Ann)
     (DataDeclaration (DeclName Symbol) Ann)
     (DataDeclaration (DeclName Symbol) Ann)
     (DataDeclaration (DeclName Symbol) Ann)
-> (DataDeclaration (DeclName Symbol) Ann
    -> Const
         (Endo [Type (DeclName Symbol) Ann])
         (DataDeclaration (DeclName Symbol) Ann))
-> Decl (DeclName Symbol) Ann
-> Const
     (Endo [Type (DeclName Symbol) Ann]) (Decl (DeclName Symbol) Ann)
forall (q :: * -> * -> *) (f :: * -> *) (r :: * -> * -> *)
       (p :: * -> * -> *) s t a b s' t'.
(Representable q, Applicative (Rep q), Applicative f,
 Bitraversable r) =>
Optical p q f s t a b
-> Optical p q f s' t' a b -> Optical p q f (r s s') (r t t') a b
beside Optical
  (->)
  (->)
  (Const (Endo [Type (DeclName Symbol) Ann]))
  (EffectDeclaration (DeclName Symbol) Ann)
  (EffectDeclaration (DeclName Symbol) Ann)
  (DataDeclaration (DeclName Symbol) Ann)
  (DataDeclaration (DeclName Symbol) Ann)
forall v a (p :: * -> * -> *) (f :: * -> *).
(Profunctor p, Functor f) =>
p (DataDeclaration v a) (f (DataDeclaration v a))
-> p (EffectDeclaration v a) (f (EffectDeclaration v a))
DD.asDataDecl_ Optical
  (->)
  (->)
  (Const (Endo [Type (DeclName Symbol) Ann]))
  (DataDeclaration (DeclName Symbol) Ann)
  (DataDeclaration (DeclName Symbol) Ann)
  (DataDeclaration (DeclName Symbol) Ann)
  (DataDeclaration (DeclName Symbol) Ann)
forall a. a -> a
id
            ((DataDeclaration (DeclName Symbol) Ann
  -> Const
       (Endo [Type (DeclName Symbol) Ann])
       (DataDeclaration (DeclName Symbol) Ann))
 -> Decl (DeclName Symbol) Ann
 -> Const
      (Endo [Type (DeclName Symbol) Ann]) (Decl (DeclName Symbol) Ann))
-> ((Type (DeclName Symbol) Ann
     -> Const
          (Endo [Type (DeclName Symbol) Ann]) (Type (DeclName Symbol) Ann))
    -> DataDeclaration (DeclName Symbol) Ann
    -> Const
         (Endo [Type (DeclName Symbol) Ann])
         (DataDeclaration (DeclName Symbol) Ann))
-> (Type (DeclName Symbol) Ann
    -> Const
         (Endo [Type (DeclName Symbol) Ann]) (Type (DeclName Symbol) Ann))
-> Decl (DeclName Symbol) Ann
-> Const
     (Endo [Type (DeclName Symbol) Ann]) (Decl (DeclName Symbol) Ann)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (DataDeclaration (DeclName Symbol) Ann
 -> [(Ann, DeclName Symbol, Type (DeclName Symbol) Ann)])
-> Optic'
     (->)
     (Const (Endo [Type (DeclName Symbol) Ann]))
     (DataDeclaration (DeclName Symbol) Ann)
     [(Ann, DeclName Symbol, Type (DeclName Symbol) Ann)]
forall (p :: * -> * -> *) (f :: * -> *) s a.
(Profunctor p, Contravariant f) =>
(s -> a) -> Optic' p f s a
to DataDeclaration (DeclName Symbol) Ann
-> [(Ann, DeclName Symbol, Type (DeclName Symbol) Ann)]
forall v a. DataDeclaration v a -> [(a, v, Type v a)]
DD.constructors'
            Optic'
  (->)
  (Const (Endo [Type (DeclName Symbol) Ann]))
  (DataDeclaration (DeclName Symbol) Ann)
  [(Ann, DeclName Symbol, Type (DeclName Symbol) Ann)]
-> ((Type (DeclName Symbol) Ann
     -> Const
          (Endo [Type (DeclName Symbol) Ann]) (Type (DeclName Symbol) Ann))
    -> [(Ann, DeclName Symbol, Type (DeclName Symbol) Ann)]
    -> Const
         (Endo [Type (DeclName Symbol) Ann])
         [(Ann, DeclName Symbol, Type (DeclName Symbol) Ann)])
-> (Type (DeclName Symbol) Ann
    -> Const
         (Endo [Type (DeclName Symbol) Ann]) (Type (DeclName Symbol) Ann))
-> DataDeclaration (DeclName Symbol) Ann
-> Const
     (Endo [Type (DeclName Symbol) Ann])
     (DataDeclaration (DeclName Symbol) Ann)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Ann, DeclName Symbol, Type (DeclName Symbol) Ann)
 -> Const
      (Endo [Type (DeclName Symbol) Ann])
      (Ann, DeclName Symbol, Type (DeclName Symbol) Ann))
-> [(Ann, DeclName Symbol, Type (DeclName Symbol) Ann)]
-> Const
     (Endo [Type (DeclName Symbol) Ann])
     [(Ann, DeclName Symbol, Type (DeclName Symbol) Ann)]
forall (f :: * -> *) a b.
Traversable f =>
IndexedTraversal Int (f a) (f b) a b
IndexedTraversal
  Int
  [(Ann, DeclName Symbol, Type (DeclName Symbol) Ann)]
  [(Ann, DeclName Symbol, Type (DeclName Symbol) Ann)]
  (Ann, DeclName Symbol, Type (DeclName Symbol) Ann)
  (Ann, DeclName Symbol, Type (DeclName Symbol) Ann)
traversed
            (((Ann, DeclName Symbol, Type (DeclName Symbol) Ann)
  -> Const
       (Endo [Type (DeclName Symbol) Ann])
       (Ann, DeclName Symbol, Type (DeclName Symbol) Ann))
 -> [(Ann, DeclName Symbol, Type (DeclName Symbol) Ann)]
 -> Const
      (Endo [Type (DeclName Symbol) Ann])
      [(Ann, DeclName Symbol, Type (DeclName Symbol) Ann)])
-> ((Type (DeclName Symbol) Ann
     -> Const
          (Endo [Type (DeclName Symbol) Ann]) (Type (DeclName Symbol) Ann))
    -> (Ann, DeclName Symbol, Type (DeclName Symbol) Ann)
    -> Const
         (Endo [Type (DeclName Symbol) Ann])
         (Ann, DeclName Symbol, Type (DeclName Symbol) Ann))
-> (Type (DeclName Symbol) Ann
    -> Const
         (Endo [Type (DeclName Symbol) Ann]) (Type (DeclName Symbol) Ann))
-> [(Ann, DeclName Symbol, Type (DeclName Symbol) Ann)]
-> Const
     (Endo [Type (DeclName Symbol) Ann])
     [(Ann, DeclName Symbol, Type (DeclName Symbol) Ann)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Type (DeclName Symbol) Ann
 -> Const
      (Endo [Type (DeclName Symbol) Ann]) (Type (DeclName Symbol) Ann))
-> (Ann, DeclName Symbol, Type (DeclName Symbol) Ann)
-> Const
     (Endo [Type (DeclName Symbol) Ann])
     (Ann, DeclName Symbol, Type (DeclName Symbol) Ann)
forall s t a b. Field3 s t a b => Lens s t a b
Lens
  (Ann, DeclName Symbol, Type (DeclName Symbol) Ann)
  (Ann, DeclName Symbol, Type (DeclName Symbol) Ann)
  (Type (DeclName Symbol) Ann)
  (Type (DeclName Symbol) Ann)
_3

  Map SomeReferenceId SomeReferenceId
migratedReferences <- (MigrationState -> Map SomeReferenceId SomeReferenceId)
-> ExceptT
     (TrySyncResult Entity)
     (StateT MigrationState Transaction)
     (Map SomeReferenceId SomeReferenceId)
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets MigrationState -> Map SomeReferenceId SomeReferenceId
referenceMapping
  let unmigratedRefIds :: [SomeReferenceId]
      unmigratedRefIds :: [SomeReferenceId]
unmigratedRefIds =
        [Type (DeclName Symbol) Ann]
allTypes
          [Type (DeclName Symbol) Ann]
-> ([Type (DeclName Symbol) Ann] -> [SomeReferenceId])
-> [SomeReferenceId]
forall a b. a -> (a -> b) -> b
& LensLike
  (WriterT [SomeReferenceId] Identity)
  [Type (DeclName Symbol) Ann]
  [Type (DeclName Symbol) Ann]
  SomeReferenceId
  SomeReferenceId
-> [Type (DeclName Symbol) Ann] -> [SomeReferenceId]
forall a s t. LensLike (Writer [a]) s t a a -> s -> [a]
foldSetter
            ( (Type (DeclName Symbol) Ann
 -> WriterT [SomeReferenceId] Identity (Type (DeclName Symbol) Ann))
-> [Type (DeclName Symbol) Ann]
-> WriterT [SomeReferenceId] Identity [Type (DeclName Symbol) Ann]
forall (f :: * -> *) a b.
Traversable f =>
IndexedTraversal Int (f a) (f b) a b
IndexedTraversal
  Int
  [Type (DeclName Symbol) Ann]
  [Type (DeclName Symbol) Ann]
  (Type (DeclName Symbol) Ann)
  (Type (DeclName Symbol) Ann)
traversed -- Every type in the list
                ((Type (DeclName Symbol) Ann
  -> WriterT [SomeReferenceId] Identity (Type (DeclName Symbol) Ann))
 -> [Type (DeclName Symbol) Ann]
 -> WriterT [SomeReferenceId] Identity [Type (DeclName Symbol) Ann])
-> ((SomeReferenceId -> Writer [SomeReferenceId] SomeReferenceId)
    -> Type (DeclName Symbol) Ann
    -> WriterT [SomeReferenceId] Identity (Type (DeclName Symbol) Ann))
-> LensLike
     (WriterT [SomeReferenceId] Identity)
     [Type (DeclName Symbol) Ann]
     [Type (DeclName Symbol) Ann]
     SomeReferenceId
     SomeReferenceId
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (SomeReferenceId -> Writer [SomeReferenceId] SomeReferenceId)
-> Type (DeclName Symbol) Ann
-> WriterT [SomeReferenceId] Identity (Type (DeclName Symbol) Ann)
forall (m :: * -> *) v a.
(Monad m, Ord v) =>
LensLike' m (Type v a) SomeReferenceId
typeReferences_
                ((SomeReferenceId -> Writer [SomeReferenceId] SomeReferenceId)
 -> Type (DeclName Symbol) Ann
 -> WriterT [SomeReferenceId] Identity (Type (DeclName Symbol) Ann))
-> ((SomeReferenceId -> Writer [SomeReferenceId] SomeReferenceId)
    -> SomeReferenceId -> Writer [SomeReferenceId] SomeReferenceId)
-> (SomeReferenceId -> Writer [SomeReferenceId] SomeReferenceId)
-> Type (DeclName Symbol) Ann
-> WriterT [SomeReferenceId] Identity (Type (DeclName Symbol) Ann)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (SomeReferenceId -> Bool)
-> (SomeReferenceId -> Writer [SomeReferenceId] SomeReferenceId)
-> SomeReferenceId
-> Writer [SomeReferenceId] SomeReferenceId
forall (p :: * -> * -> *) (f :: * -> *) a.
(Choice p, Applicative f) =>
(a -> Bool) -> Optic' p f a a
filtered (SomeReferenceId -> Map SomeReferenceId SomeReferenceId -> Bool
forall k a. Ord k => k -> Map k a -> Bool
`Map.notMember` Map SomeReferenceId SomeReferenceId
migratedReferences)
            )

  Bool
-> ExceptT
     (TrySyncResult Entity) (StateT MigrationState Transaction) ()
-> ExceptT
     (TrySyncResult Entity) (StateT MigrationState Transaction) ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Bool -> Bool
not (Bool -> Bool)
-> ([SomeReferenceId] -> Bool) -> [SomeReferenceId] -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [SomeReferenceId] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null ([SomeReferenceId] -> Bool) -> [SomeReferenceId] -> Bool
forall a b. (a -> b) -> a -> b
$ [SomeReferenceId]
unmigratedRefIds) do
    TrySyncResult Entity
-> ExceptT
     (TrySyncResult Entity) (StateT MigrationState Transaction) ()
forall (m :: * -> *) e a. Monad m => e -> ExceptT e m a
throwE ([Entity] -> TrySyncResult Entity
forall entity. [entity] -> TrySyncResult entity
Sync.Missing ([Entity] -> [Entity]
forall a. Ord a => [a] -> [a]
nubOrd ([Entity] -> [Entity])
-> ([SomeReferenceId] -> [Entity]) -> [SomeReferenceId] -> [Entity]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (SomeReferenceId -> Entity) -> [SomeReferenceId] -> [Entity]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap SomeReferenceId -> Entity
someReferenceIdToEntity ([SomeReferenceId] -> [Entity]) -> [SomeReferenceId] -> [Entity]
forall a b. (a -> b) -> a -> b
$ [SomeReferenceId]
unmigratedRefIds))

  -- At this point we know we have all the required mappings from old references  to new ones.
  let remapTerm :: Type v a -> Type v a
      remapTerm :: Type (DeclName Symbol) Ann -> Type (DeclName Symbol) Ann
remapTerm = LensLike' Identity (Type (DeclName Symbol) Ann) SomeReferenceId
forall (m :: * -> *) v a.
(Monad m, Ord v) =>
LensLike' m (Type v a) SomeReferenceId
typeReferences_ LensLike' Identity (Type (DeclName Symbol) Ann) SomeReferenceId
-> (SomeReferenceId -> SomeReferenceId)
-> Type (DeclName Symbol) Ann
-> Type (DeclName Symbol) Ann
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ \SomeReferenceId
ref -> SomeReferenceId
-> SomeReferenceId
-> Map SomeReferenceId SomeReferenceId
-> SomeReferenceId
forall k a. Ord k => a -> k -> Map k a -> a
Map.findWithDefault ([Char] -> SomeReferenceId
forall a. HasCallStack => [Char] -> a
error [Char]
"unmigrated reference") SomeReferenceId
ref Map SomeReferenceId SomeReferenceId
migratedReferences

  let remappedReferences :: Map (Old Reference.Id) (DeclName v, DD.Decl v a)
      remappedReferences :: Map (Old Id) (DeclName Symbol, Decl (DeclName Symbol) Ann)
remappedReferences =
        Map (Old Id) (DeclName Symbol, Decl (DeclName Symbol) Ann)
unhashed
          Map (Old Id) (DeclName Symbol, Decl (DeclName Symbol) Ann)
-> (Map (Old Id) (DeclName Symbol, Decl (DeclName Symbol) Ann)
    -> Map (Old Id) (DeclName Symbol, Decl (DeclName Symbol) Ann))
-> Map (Old Id) (DeclName Symbol, Decl (DeclName Symbol) Ann)
forall a b. a -> (a -> b) -> b
& ((DeclName Symbol, Decl (DeclName Symbol) Ann)
 -> Identity (DeclName Symbol, Decl (DeclName Symbol) Ann))
-> Map (Old Id) (DeclName Symbol, Decl (DeclName Symbol) Ann)
-> Identity
     (Map (Old Id) (DeclName Symbol, Decl (DeclName Symbol) Ann))
forall (f :: * -> *) a b.
Traversable f =>
IndexedTraversal Int (f a) (f b) a b
IndexedTraversal
  Int
  (Map (Old Id) (DeclName Symbol, Decl (DeclName Symbol) Ann))
  (Map (Old Id) (DeclName Symbol, Decl (DeclName Symbol) Ann))
  (DeclName Symbol, Decl (DeclName Symbol) Ann)
  (DeclName Symbol, Decl (DeclName Symbol) Ann)
traversed -- Traverse map of reference IDs
            (((DeclName Symbol, Decl (DeclName Symbol) Ann)
  -> Identity (DeclName Symbol, Decl (DeclName Symbol) Ann))
 -> Map (Old Id) (DeclName Symbol, Decl (DeclName Symbol) Ann)
 -> Identity
      (Map (Old Id) (DeclName Symbol, Decl (DeclName Symbol) Ann)))
-> ((Type (DeclName Symbol) Ann
     -> Identity (Type (DeclName Symbol) Ann))
    -> (DeclName Symbol, Decl (DeclName Symbol) Ann)
    -> Identity (DeclName Symbol, Decl (DeclName Symbol) Ann))
-> (Type (DeclName Symbol) Ann
    -> Identity (Type (DeclName Symbol) Ann))
-> Map (Old Id) (DeclName Symbol, Decl (DeclName Symbol) Ann)
-> Identity
     (Map (Old Id) (DeclName Symbol, Decl (DeclName Symbol) Ann))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Decl (DeclName Symbol) Ann
 -> Identity (Decl (DeclName Symbol) Ann))
-> (DeclName Symbol, Decl (DeclName Symbol) Ann)
-> Identity (DeclName Symbol, Decl (DeclName Symbol) Ann)
forall s t a b. Field2 s t a b => Lens s t a b
Lens
  (DeclName Symbol, Decl (DeclName Symbol) Ann)
  (DeclName Symbol, Decl (DeclName Symbol) Ann)
  (Decl (DeclName Symbol) Ann)
  (Decl (DeclName Symbol) Ann)
_2 -- Select the DataDeclaration
            ((Decl (DeclName Symbol) Ann
  -> Identity (Decl (DeclName Symbol) Ann))
 -> (DeclName Symbol, Decl (DeclName Symbol) Ann)
 -> Identity (DeclName Symbol, Decl (DeclName Symbol) Ann))
-> ((Type (DeclName Symbol) Ann
     -> Identity (Type (DeclName Symbol) Ann))
    -> Decl (DeclName Symbol) Ann
    -> Identity (Decl (DeclName Symbol) Ann))
-> (Type (DeclName Symbol) Ann
    -> Identity (Type (DeclName Symbol) Ann))
-> (DeclName Symbol, Decl (DeclName Symbol) Ann)
-> Identity (DeclName Symbol, Decl (DeclName Symbol) Ann)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Optical
  (->)
  (->)
  Identity
  (EffectDeclaration (DeclName Symbol) Ann)
  (EffectDeclaration (DeclName Symbol) Ann)
  (DataDeclaration (DeclName Symbol) Ann)
  (DataDeclaration (DeclName Symbol) Ann)
-> Optical
     (->)
     (->)
     Identity
     (DataDeclaration (DeclName Symbol) Ann)
     (DataDeclaration (DeclName Symbol) Ann)
     (DataDeclaration (DeclName Symbol) Ann)
     (DataDeclaration (DeclName Symbol) Ann)
-> (DataDeclaration (DeclName Symbol) Ann
    -> Identity (DataDeclaration (DeclName Symbol) Ann))
-> Decl (DeclName Symbol) Ann
-> Identity (Decl (DeclName Symbol) Ann)
forall (q :: * -> * -> *) (f :: * -> *) (r :: * -> * -> *)
       (p :: * -> * -> *) s t a b s' t'.
(Representable q, Applicative (Rep q), Applicative f,
 Bitraversable r) =>
Optical p q f s t a b
-> Optical p q f s' t' a b -> Optical p q f (r s s') (r t t') a b
beside Optical
  (->)
  (->)
  Identity
  (EffectDeclaration (DeclName Symbol) Ann)
  (EffectDeclaration (DeclName Symbol) Ann)
  (DataDeclaration (DeclName Symbol) Ann)
  (DataDeclaration (DeclName Symbol) Ann)
forall v a (p :: * -> * -> *) (f :: * -> *).
(Profunctor p, Functor f) =>
p (DataDeclaration v a) (f (DataDeclaration v a))
-> p (EffectDeclaration v a) (f (EffectDeclaration v a))
DD.asDataDecl_ Optical
  (->)
  (->)
  Identity
  (DataDeclaration (DeclName Symbol) Ann)
  (DataDeclaration (DeclName Symbol) Ann)
  (DataDeclaration (DeclName Symbol) Ann)
  (DataDeclaration (DeclName Symbol) Ann)
forall a. a -> a
id -- Unpack effect decls
            ((DataDeclaration (DeclName Symbol) Ann
  -> Identity (DataDeclaration (DeclName Symbol) Ann))
 -> Decl (DeclName Symbol) Ann
 -> Identity (Decl (DeclName Symbol) Ann))
-> ((Type (DeclName Symbol) Ann
     -> Identity (Type (DeclName Symbol) Ann))
    -> DataDeclaration (DeclName Symbol) Ann
    -> Identity (DataDeclaration (DeclName Symbol) Ann))
-> (Type (DeclName Symbol) Ann
    -> Identity (Type (DeclName Symbol) Ann))
-> Decl (DeclName Symbol) Ann
-> Identity (Decl (DeclName Symbol) Ann)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([(Ann, DeclName Symbol, Type (DeclName Symbol) Ann)]
 -> Identity [(Ann, DeclName Symbol, Type (DeclName Symbol) Ann)])
-> DataDeclaration (DeclName Symbol) Ann
-> Identity (DataDeclaration (DeclName Symbol) Ann)
forall v a (f :: * -> *).
Functor f =>
([(a, v, Type v a)] -> f [(a, v, Type v a)])
-> DataDeclaration v a -> f (DataDeclaration v a)
DD.constructors_ -- Get the data constructors
            (([(Ann, DeclName Symbol, Type (DeclName Symbol) Ann)]
  -> Identity [(Ann, DeclName Symbol, Type (DeclName Symbol) Ann)])
 -> DataDeclaration (DeclName Symbol) Ann
 -> Identity (DataDeclaration (DeclName Symbol) Ann))
-> ((Type (DeclName Symbol) Ann
     -> Identity (Type (DeclName Symbol) Ann))
    -> [(Ann, DeclName Symbol, Type (DeclName Symbol) Ann)]
    -> Identity [(Ann, DeclName Symbol, Type (DeclName Symbol) Ann)])
-> (Type (DeclName Symbol) Ann
    -> Identity (Type (DeclName Symbol) Ann))
-> DataDeclaration (DeclName Symbol) Ann
-> Identity (DataDeclaration (DeclName Symbol) Ann)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Ann, DeclName Symbol, Type (DeclName Symbol) Ann)
 -> Identity (Ann, DeclName Symbol, Type (DeclName Symbol) Ann))
-> [(Ann, DeclName Symbol, Type (DeclName Symbol) Ann)]
-> Identity [(Ann, DeclName Symbol, Type (DeclName Symbol) Ann)]
forall (f :: * -> *) a b.
Traversable f =>
IndexedTraversal Int (f a) (f b) a b
IndexedTraversal
  Int
  [(Ann, DeclName Symbol, Type (DeclName Symbol) Ann)]
  [(Ann, DeclName Symbol, Type (DeclName Symbol) Ann)]
  (Ann, DeclName Symbol, Type (DeclName Symbol) Ann)
  (Ann, DeclName Symbol, Type (DeclName Symbol) Ann)
traversed -- traverse the list of them
            (((Ann, DeclName Symbol, Type (DeclName Symbol) Ann)
  -> Identity (Ann, DeclName Symbol, Type (DeclName Symbol) Ann))
 -> [(Ann, DeclName Symbol, Type (DeclName Symbol) Ann)]
 -> Identity [(Ann, DeclName Symbol, Type (DeclName Symbol) Ann)])
-> ((Type (DeclName Symbol) Ann
     -> Identity (Type (DeclName Symbol) Ann))
    -> (Ann, DeclName Symbol, Type (DeclName Symbol) Ann)
    -> Identity (Ann, DeclName Symbol, Type (DeclName Symbol) Ann))
-> (Type (DeclName Symbol) Ann
    -> Identity (Type (DeclName Symbol) Ann))
-> [(Ann, DeclName Symbol, Type (DeclName Symbol) Ann)]
-> Identity [(Ann, DeclName Symbol, Type (DeclName Symbol) Ann)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Type (DeclName Symbol) Ann
 -> Identity (Type (DeclName Symbol) Ann))
-> (Ann, DeclName Symbol, Type (DeclName Symbol) Ann)
-> Identity (Ann, DeclName Symbol, Type (DeclName Symbol) Ann)
forall s t a b. Field3 s t a b => Lens s t a b
Lens
  (Ann, DeclName Symbol, Type (DeclName Symbol) Ann)
  (Ann, DeclName Symbol, Type (DeclName Symbol) Ann)
  (Type (DeclName Symbol) Ann)
  (Type (DeclName Symbol) Ann)
_3 -- Select the Type term.
            ((Type (DeclName Symbol) Ann
  -> Identity (Type (DeclName Symbol) Ann))
 -> Map (Old Id) (DeclName Symbol, Decl (DeclName Symbol) Ann)
 -> Identity
      (Map (Old Id) (DeclName Symbol, Decl (DeclName Symbol) Ann)))
-> (Type (DeclName Symbol) Ann -> Type (DeclName Symbol) Ann)
-> Map (Old Id) (DeclName Symbol, Decl (DeclName Symbol) Ann)
-> Map (Old Id) (DeclName Symbol, Decl (DeclName Symbol) Ann)
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ Type (DeclName Symbol) Ann -> Type (DeclName Symbol) Ann
remapTerm

  let declNameToOldReference :: Map (DeclName v) (Old Reference.Id)
      declNameToOldReference :: Map (DeclName Symbol) (Old Id)
declNameToOldReference = [(DeclName Symbol, Old Id)] -> Map (DeclName Symbol) (Old Id)
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList ([(DeclName Symbol, Old Id)] -> Map (DeclName Symbol) (Old Id))
-> (Map (Old Id) (DeclName Symbol, Decl (DeclName Symbol) Ann)
    -> [(DeclName Symbol, Old Id)])
-> Map (Old Id) (DeclName Symbol, Decl (DeclName Symbol) Ann)
-> Map (DeclName Symbol) (Old Id)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Old Id, DeclName Symbol) -> (DeclName Symbol, Old Id))
-> [(Old Id, DeclName Symbol)] -> [(DeclName Symbol, Old Id)]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Old Id, DeclName Symbol) -> (DeclName Symbol, Old Id)
forall a b. (a, b) -> (b, a)
swap ([(Old Id, DeclName Symbol)] -> [(DeclName Symbol, Old Id)])
-> (Map (Old Id) (DeclName Symbol, Decl (DeclName Symbol) Ann)
    -> [(Old Id, DeclName Symbol)])
-> Map (Old Id) (DeclName Symbol, Decl (DeclName Symbol) Ann)
-> [(DeclName Symbol, Old Id)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Map (Old Id) (DeclName Symbol) -> [(Old Id, DeclName Symbol)]
forall k a. Map k a -> [(k, a)]
Map.toList (Map (Old Id) (DeclName Symbol) -> [(Old Id, DeclName Symbol)])
-> (Map (Old Id) (DeclName Symbol, Decl (DeclName Symbol) Ann)
    -> Map (Old Id) (DeclName Symbol))
-> Map (Old Id) (DeclName Symbol, Decl (DeclName Symbol) Ann)
-> [(Old Id, DeclName Symbol)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((DeclName Symbol, Decl (DeclName Symbol) Ann) -> DeclName Symbol)
-> Map (Old Id) (DeclName Symbol, Decl (DeclName Symbol) Ann)
-> Map (Old Id) (DeclName Symbol)
forall a b. (a -> b) -> Map (Old Id) a -> Map (Old Id) b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (DeclName Symbol, Decl (DeclName Symbol) Ann) -> DeclName Symbol
forall a b. (a, b) -> a
fst (Map (Old Id) (DeclName Symbol, Decl (DeclName Symbol) Ann)
 -> Map (DeclName Symbol) (Old Id))
-> Map (Old Id) (DeclName Symbol, Decl (DeclName Symbol) Ann)
-> Map (DeclName Symbol) (Old Id)
forall a b. (a -> b) -> a -> b
$ Map (Old Id) (DeclName Symbol, Decl (DeclName Symbol) Ann)
remappedReferences

  let newComponent :: [(DeclName v, Reference.Id, DD.Decl v a)]
      newComponent :: [(DeclName Symbol, Old Id, Decl (DeclName Symbol) Ann)]
newComponent =
        Map (Old Id) (DeclName Symbol, Decl (DeclName Symbol) Ann)
remappedReferences
          Map (Old Id) (DeclName Symbol, Decl (DeclName Symbol) Ann)
-> (Map (Old Id) (DeclName Symbol, Decl (DeclName Symbol) Ann)
    -> [(DeclName Symbol, Decl (DeclName Symbol) Ann)])
-> [(DeclName Symbol, Decl (DeclName Symbol) Ann)]
forall a b. a -> (a -> b) -> b
& Map (Old Id) (DeclName Symbol, Decl (DeclName Symbol) Ann)
-> [(DeclName Symbol, Decl (DeclName Symbol) Ann)]
forall k a. Map k a -> [a]
Map.elems
          [(DeclName Symbol, Decl (DeclName Symbol) Ann)]
-> ([(DeclName Symbol, Decl (DeclName Symbol) Ann)]
    -> Map (DeclName Symbol) (Decl (DeclName Symbol) Ann))
-> Map (DeclName Symbol) (Decl (DeclName Symbol) Ann)
forall a b. a -> (a -> b) -> b
& [(DeclName Symbol, Decl (DeclName Symbol) Ann)]
-> Map (DeclName Symbol) (Decl (DeclName Symbol) Ann)
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList
          Map (DeclName Symbol) (Decl (DeclName Symbol) Ann)
-> (Map (DeclName Symbol) (Decl (DeclName Symbol) Ann)
    -> ResolutionResult
         Ann [(DeclName Symbol, Old Id, Decl (DeclName Symbol) Ann)])
-> ResolutionResult
     Ann [(DeclName Symbol, Old Id, Decl (DeclName Symbol) Ann)]
forall a b. a -> (a -> b) -> b
& Map (DeclName Symbol) (Decl (DeclName Symbol) Ann)
-> ResolutionResult
     Ann [(DeclName Symbol, Old Id, Decl (DeclName Symbol) Ann)]
forall v a.
Var v =>
Map v (Decl v a) -> ResolutionResult a [(v, Old Id, Decl v a)]
Convert.hashDecls
          ResolutionResult
  Ann [(DeclName Symbol, Old Id, Decl (DeclName Symbol) Ann)]
-> (ResolutionResult
      Ann [(DeclName Symbol, Old Id, Decl (DeclName Symbol) Ann)]
    -> [(DeclName Symbol, Old Id, Decl (DeclName Symbol) Ann)])
-> [(DeclName Symbol, Old Id, Decl (DeclName Symbol) Ann)]
forall a b. a -> (a -> b) -> b
& [(DeclName Symbol, Old Id, Decl (DeclName Symbol) Ann)]
-> ResolutionResult
     Ann [(DeclName Symbol, Old Id, Decl (DeclName Symbol) Ann)]
-> [(DeclName Symbol, Old Id, Decl (DeclName Symbol) Ann)]
forall b a. b -> Either a b -> b
fromRight ([Char] -> [(DeclName Symbol, Old Id, Decl (DeclName Symbol) Ann)]
forall a. HasCallStack => [Char] -> a
error [Char]
"unexpected resolution error")

  [(DeclName Symbol, Old Id, Decl (DeclName Symbol) Ann)]
-> ((DeclName Symbol, Old Id, Decl (DeclName Symbol) Ann)
    -> ExceptT
         (TrySyncResult Entity) (StateT MigrationState Transaction) ())
-> ExceptT
     (TrySyncResult Entity) (StateT MigrationState Transaction) ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ [(DeclName Symbol, Old Id, Decl (DeclName Symbol) Ann)]
newComponent (((DeclName Symbol, Old Id, Decl (DeclName Symbol) Ann)
  -> ExceptT
       (TrySyncResult Entity) (StateT MigrationState Transaction) ())
 -> ExceptT
      (TrySyncResult Entity) (StateT MigrationState Transaction) ())
-> ((DeclName Symbol, Old Id, Decl (DeclName Symbol) Ann)
    -> ExceptT
         (TrySyncResult Entity) (StateT MigrationState Transaction) ())
-> ExceptT
     (TrySyncResult Entity) (StateT MigrationState Transaction) ()
forall a b. (a -> b) -> a -> b
$ \(DeclName Symbol
declName, Old Id
newReferenceId, Decl (DeclName Symbol) Ann
dd) -> do
    let oldReferenceId :: Old Id
oldReferenceId = Map (DeclName Symbol) (Old Id)
declNameToOldReference Map (DeclName Symbol) (Old Id)
-> Getting
     (Endo (Old Id)) (Map (DeclName Symbol) (Old Id)) (Old Id)
-> Old Id
forall s a. HasCallStack => s -> Getting (Endo a) s a -> a
^?! Index (Map (DeclName Symbol) (Old Id))
-> Traversal'
     (Map (DeclName Symbol) (Old Id))
     (IxValue (Map (DeclName Symbol) (Old Id)))
forall m. Ixed m => Index m -> Traversal' m (IxValue m)
ix Index (Map (DeclName Symbol) (Old Id))
DeclName Symbol
declName
    forall (field :: Symbol) s t a b.
HasField field s t a b =>
Lens s t a b
field @"referenceMapping" ((Map SomeReferenceId SomeReferenceId
  -> Identity (Map SomeReferenceId SomeReferenceId))
 -> MigrationState -> Identity MigrationState)
-> (Map SomeReferenceId SomeReferenceId
    -> Map SomeReferenceId SomeReferenceId)
-> ExceptT
     (TrySyncResult Entity) (StateT MigrationState Transaction) ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
%= SomeReferenceId
-> SomeReferenceId
-> Map SomeReferenceId SomeReferenceId
-> Map SomeReferenceId SomeReferenceId
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert (Old Id -> SomeReferenceId
forall ref. ref -> SomeReference ref
TypeReference Old Id
oldReferenceId) (Old Id -> SomeReferenceId
forall ref. ref -> SomeReference ref
TypeReference Old Id
newReferenceId)

    let oldConstructorIds :: Map (ConstructorName v) (Old ConstructorId)
        oldConstructorIds :: Map (DeclName Symbol) (Old ConstructorId)
oldConstructorIds =
          (Map (Old Id) (Decl (DeclName Symbol) Ann)
componentIDMap Map (Old Id) (Decl (DeclName Symbol) Ann)
-> Getting
     (Endo (Decl (DeclName Symbol) Ann))
     (Map (Old Id) (Decl (DeclName Symbol) Ann))
     (Decl (DeclName Symbol) Ann)
-> Decl (DeclName Symbol) Ann
forall s a. HasCallStack => s -> Getting (Endo a) s a -> a
^?! Index (Map (Old Id) (Decl (DeclName Symbol) Ann))
-> Traversal'
     (Map (Old Id) (Decl (DeclName Symbol) Ann))
     (IxValue (Map (Old Id) (Decl (DeclName Symbol) Ann)))
forall m. Ixed m => Index m -> Traversal' m (IxValue m)
ix Index (Map (Old Id) (Decl (DeclName Symbol) Ann))
Old Id
oldReferenceId)
            Decl (DeclName Symbol) Ann
-> (Decl (DeclName Symbol) Ann
    -> DataDeclaration (DeclName Symbol) Ann)
-> DataDeclaration (DeclName Symbol) Ann
forall a b. a -> (a -> b) -> b
& Decl (DeclName Symbol) Ann -> DataDeclaration (DeclName Symbol) Ann
forall v a. Decl v a -> DataDeclaration v a
DD.asDataDecl
            DataDeclaration (DeclName Symbol) Ann
-> (DataDeclaration (DeclName Symbol) Ann
    -> [(Ann, DeclName Symbol, Type (DeclName Symbol) Ann)])
-> [(Ann, DeclName Symbol, Type (DeclName Symbol) Ann)]
forall a b. a -> (a -> b) -> b
& DataDeclaration (DeclName Symbol) Ann
-> [(Ann, DeclName Symbol, Type (DeclName Symbol) Ann)]
forall v a. DataDeclaration v a -> [(a, v, Type v a)]
DD.constructors'
            [(Ann, DeclName Symbol, Type (DeclName Symbol) Ann)]
-> ([(Ann, DeclName Symbol, Type (DeclName Symbol) Ann)]
    -> [(DeclName Symbol, Old ConstructorId)])
-> [(DeclName Symbol, Old ConstructorId)]
forall a b. a -> (a -> b) -> b
& (Int
 -> (Ann, DeclName Symbol, Type (DeclName Symbol) Ann)
 -> (DeclName Symbol, Old ConstructorId))
-> [(Ann, DeclName Symbol, Type (DeclName Symbol) Ann)]
-> [(DeclName Symbol, Old ConstructorId)]
forall a b. (Int -> a -> b) -> [a] -> [b]
forall i (f :: * -> *) a b.
FunctorWithIndex i f =>
(i -> a -> b) -> f a -> f b
imap (\Int
constructorId (Ann
_ann, DeclName Symbol
constructorName, Type (DeclName Symbol) Ann
_type) -> (DeclName Symbol
constructorName, Int -> Old ConstructorId
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
constructorId))
            [(DeclName Symbol, Old ConstructorId)]
-> ([(DeclName Symbol, Old ConstructorId)]
    -> Map (DeclName Symbol) (Old ConstructorId))
-> Map (DeclName Symbol) (Old ConstructorId)
forall a b. a -> (a -> b) -> b
& [(DeclName Symbol, Old ConstructorId)]
-> Map (DeclName Symbol) (Old ConstructorId)
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList

    [(Ann, DeclName Symbol, Type (DeclName Symbol) Ann)]
-> (Int
    -> (Ann, DeclName Symbol, Type (DeclName Symbol) Ann)
    -> ExceptT
         (TrySyncResult Entity) (StateT MigrationState Transaction) ())
-> ExceptT
     (TrySyncResult Entity) (StateT MigrationState Transaction) ()
forall i (t :: * -> *) (f :: * -> *) a b.
(FoldableWithIndex i t, Applicative f) =>
t a -> (i -> a -> f b) -> f ()
ifor_ (DataDeclaration (DeclName Symbol) Ann
-> [(Ann, DeclName Symbol, Type (DeclName Symbol) Ann)]
forall v a. DataDeclaration v a -> [(a, v, Type v a)]
DD.constructors' (Decl (DeclName Symbol) Ann -> DataDeclaration (DeclName Symbol) Ann
forall v a. Decl v a -> DataDeclaration v a
DD.asDataDecl Decl (DeclName Symbol) Ann
dd)) \(Int -> Old ConstructorId
forall a b. (Integral a, Num b) => a -> b
fromIntegral -> Old ConstructorId
newConstructorId) (Ann
_ann, DeclName Symbol
constructorName, Type (DeclName Symbol) Ann
_type) -> do
      forall (field :: Symbol) s t a b.
HasField field s t a b =>
Lens s t a b
field @"referenceMapping"
        ((Map SomeReferenceId SomeReferenceId
  -> Identity (Map SomeReferenceId SomeReferenceId))
 -> MigrationState -> Identity MigrationState)
-> (Map SomeReferenceId SomeReferenceId
    -> Map SomeReferenceId SomeReferenceId)
-> ExceptT
     (TrySyncResult Entity) (StateT MigrationState Transaction) ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
%= SomeReferenceId
-> SomeReferenceId
-> Map SomeReferenceId SomeReferenceId
-> Map SomeReferenceId SomeReferenceId
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert
          (Old Id -> Old ConstructorId -> SomeReferenceId
forall ref. ref -> Old ConstructorId -> SomeReference ref
ConstructorReference Old Id
oldReferenceId (Map (DeclName Symbol) (Old ConstructorId)
oldConstructorIds Map (DeclName Symbol) (Old ConstructorId)
-> Getting
     (Endo (Old ConstructorId))
     (Map (DeclName Symbol) (Old ConstructorId))
     (Old ConstructorId)
-> Old ConstructorId
forall s a. HasCallStack => s -> Getting (Endo a) s a -> a
^?! Index (Map (DeclName Symbol) (Old ConstructorId))
-> Traversal'
     (Map (DeclName Symbol) (Old ConstructorId))
     (IxValue (Map (DeclName Symbol) (Old ConstructorId)))
forall m. Ixed m => Index m -> Traversal' m (IxValue m)
ix Index (Map (DeclName Symbol) (Old ConstructorId))
DeclName Symbol
constructorName))
          (Old Id -> Old ConstructorId -> SomeReferenceId
forall ref. ref -> Old ConstructorId -> SomeReference ref
ConstructorReference Old Id
newReferenceId Old ConstructorId
newConstructorId)

    StateT MigrationState Transaction ()
-> ExceptT
     (TrySyncResult Entity) (StateT MigrationState Transaction) ()
forall (m :: * -> *) a.
Monad m =>
m a -> ExceptT (TrySyncResult Entity) m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (StateT MigrationState Transaction ()
 -> ExceptT
      (TrySyncResult Entity) (StateT MigrationState Transaction) ())
-> (Transaction () -> StateT MigrationState Transaction ())
-> Transaction ()
-> ExceptT
     (TrySyncResult Entity) (StateT MigrationState Transaction) ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Transaction () -> StateT MigrationState Transaction ()
forall (m :: * -> *) a. Monad m => m a -> StateT MigrationState m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (Transaction ()
 -> ExceptT
      (TrySyncResult Entity) (StateT MigrationState Transaction) ())
-> Transaction ()
-> ExceptT
     (TrySyncResult Entity) (StateT MigrationState Transaction) ()
forall a b. (a -> b) -> a -> b
$ TVar (Map (New Hash) TermBufferEntry)
-> TVar (Map (New Hash) DeclBufferEntry)
-> Old Id
-> Decl (DeclName Symbol) Ann
-> Transaction ()
CodebaseOps.putTypeDeclaration TVar (Map (New Hash) TermBufferEntry)
termBuffer TVar (Map (New Hash) DeclBufferEntry)
declBuffer Old Id
newReferenceId Decl (DeclName Symbol) Ann
dd

  -- Need to get one of the new references to grab its hash, doesn't matter which one since
  -- all hashes in the component are the same.
  case [(DeclName Symbol, Old Id, Decl (DeclName Symbol) Ann)]
newComponent [(DeclName Symbol, Old Id, Decl (DeclName Symbol) Ann)]
-> Getting
     (First (New Hash))
     [(DeclName Symbol, Old Id, Decl (DeclName Symbol) Ann)]
     (New Hash)
-> Maybe (New Hash)
forall s a. s -> Getting (First a) s a -> Maybe a
^? ((DeclName Symbol, Old Id, Decl (DeclName Symbol) Ann)
 -> Const
      (First (New Hash))
      (DeclName Symbol, Old Id, Decl (DeclName Symbol) Ann))
-> [(DeclName Symbol, Old Id, Decl (DeclName Symbol) Ann)]
-> Const
     (First (New Hash))
     [(DeclName Symbol, Old Id, Decl (DeclName Symbol) Ann)]
forall (f :: * -> *) a b.
Traversable f =>
IndexedTraversal Int (f a) (f b) a b
IndexedTraversal
  Int
  [(DeclName Symbol, Old Id, Decl (DeclName Symbol) Ann)]
  [(DeclName Symbol, Old Id, Decl (DeclName Symbol) Ann)]
  (DeclName Symbol, Old Id, Decl (DeclName Symbol) Ann)
  (DeclName Symbol, Old Id, Decl (DeclName Symbol) Ann)
traversed (((DeclName Symbol, Old Id, Decl (DeclName Symbol) Ann)
  -> Const
       (First (New Hash))
       (DeclName Symbol, Old Id, Decl (DeclName Symbol) Ann))
 -> [(DeclName Symbol, Old Id, Decl (DeclName Symbol) Ann)]
 -> Const
      (First (New Hash))
      [(DeclName Symbol, Old Id, Decl (DeclName Symbol) Ann)])
-> ((New Hash -> Const (First (New Hash)) (New Hash))
    -> (DeclName Symbol, Old Id, Decl (DeclName Symbol) Ann)
    -> Const
         (First (New Hash))
         (DeclName Symbol, Old Id, Decl (DeclName Symbol) Ann))
-> Getting
     (First (New Hash))
     [(DeclName Symbol, Old Id, Decl (DeclName Symbol) Ann)]
     (New Hash)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Old Id -> Const (First (New Hash)) (Old Id))
-> (DeclName Symbol, Old Id, Decl (DeclName Symbol) Ann)
-> Const
     (First (New Hash))
     (DeclName Symbol, Old Id, Decl (DeclName Symbol) Ann)
forall s t a b. Field2 s t a b => Lens s t a b
Lens
  (DeclName Symbol, Old Id, Decl (DeclName Symbol) Ann)
  (DeclName Symbol, Old Id, Decl (DeclName Symbol) Ann)
  (Old Id)
  (Old Id)
_2 ((Old Id -> Const (First (New Hash)) (Old Id))
 -> (DeclName Symbol, Old Id, Decl (DeclName Symbol) Ann)
 -> Const
      (First (New Hash))
      (DeclName Symbol, Old Id, Decl (DeclName Symbol) Ann))
-> ((New Hash -> Const (First (New Hash)) (New Hash))
    -> Old Id -> Const (First (New Hash)) (Old Id))
-> (New Hash -> Const (First (New Hash)) (New Hash))
-> (DeclName Symbol, Old Id, Decl (DeclName Symbol) Ann)
-> Const
     (First (New Hash))
     (DeclName Symbol, Old Id, Decl (DeclName Symbol) Ann)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Old Id -> New Hash)
-> (New Hash -> Const (First (New Hash)) (New Hash))
-> Old Id
-> Const (First (New Hash)) (Old Id)
forall (p :: * -> * -> *) (f :: * -> *) s a.
(Profunctor p, Contravariant f) =>
(s -> a) -> Optic' p f s a
to Old Id -> New Hash
Reference.idToHash of
    Maybe (New Hash)
Nothing -> ()
-> ExceptT
     (TrySyncResult Entity) (StateT MigrationState Transaction) ()
forall a.
a
-> ExceptT
     (TrySyncResult Entity) (StateT MigrationState Transaction) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
    Just New Hash
newHash -> StateT MigrationState Transaction ()
-> ExceptT
     (TrySyncResult Entity) (StateT MigrationState Transaction) ()
forall (m :: * -> *) a.
Monad m =>
m a -> ExceptT (TrySyncResult Entity) m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (New Hash -> New Hash -> StateT MigrationState Transaction ()
insertObjectMappingForHash New Hash
oldHash New Hash
newHash)
  forall (field :: Symbol) s t a b.
HasField field s t a b =>
Lens s t a b
field @"migratedDefnHashes" ((Set (New Hash) -> Identity (Set (New Hash)))
 -> MigrationState -> Identity MigrationState)
-> (Set (New Hash) -> Set (New Hash))
-> ExceptT
     (TrySyncResult Entity) (StateT MigrationState Transaction) ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
%= New Hash -> Set (New Hash) -> Set (New Hash)
forall a. Ord a => a -> Set a -> Set a
Set.insert New Hash
oldHash

  pure TrySyncResult Entity
forall entity. TrySyncResult entity
Sync.Done

insertObjectMappingForHash :: Old Hash -> New Hash -> StateT MigrationState Sqlite.Transaction ()
insertObjectMappingForHash :: New Hash -> New Hash -> StateT MigrationState Transaction ()
insertObjectMappingForHash New Hash
oldHash New Hash
newHash = do
  (ObjectId
oldObjectId, HashId
newHashId, ObjectId
newObjectId) <- Transaction (ObjectId, HashId, ObjectId)
-> StateT MigrationState Transaction (ObjectId, HashId, ObjectId)
forall (m :: * -> *) a. Monad m => m a -> StateT MigrationState m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift do
    HashId
oldHashId <- New Hash -> Transaction HashId
Q.expectHashIdByHash New Hash
oldHash
    ObjectId
oldObjectId <- HashId -> Transaction ObjectId
Q.expectObjectIdForPrimaryHashId HashId
oldHashId
    HashId
newHashId <- New Hash -> Transaction HashId
Q.expectHashIdByHash New Hash
newHash
    ObjectId
newObjectId <- HashId -> Transaction ObjectId
Q.expectObjectIdForPrimaryHashId HashId
newHashId
    pure (ObjectId
oldObjectId, HashId
newHashId, ObjectId
newObjectId)
  forall (field :: Symbol) s t a b.
HasField field s t a b =>
Lens s t a b
field @"objLookup" ((Map ObjectId (ObjectId, HashId, New Hash, New Hash)
  -> Identity (Map ObjectId (ObjectId, HashId, New Hash, New Hash)))
 -> MigrationState -> Identity MigrationState)
-> (Map ObjectId (ObjectId, HashId, New Hash, New Hash)
    -> Map ObjectId (ObjectId, HashId, New Hash, New Hash))
-> StateT MigrationState Transaction ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
%= ObjectId
-> (ObjectId, HashId, New Hash, New Hash)
-> Map ObjectId (ObjectId, HashId, New Hash, New Hash)
-> Map ObjectId (ObjectId, HashId, New Hash, New Hash)
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert ObjectId
oldObjectId (ObjectId
newObjectId, HashId
newHashId, New Hash
newHash, New Hash
oldHash)

typeReferences_ :: (Monad m, Ord v) => LensLike' m (Type v a) SomeReferenceId
typeReferences_ :: forall (m :: * -> *) v a.
(Monad m, Ord v) =>
LensLike' m (Type v a) SomeReferenceId
typeReferences_ =
  (Term F v a -> m (Term F v a)) -> Term F v a -> m (Term F v a)
forall (f :: * -> *) (m :: * -> *) v a.
(Traversable f, Monad m, Ord v) =>
(Term f v a -> m (Term f v a)) -> Term f v a -> m (Term f v a)
ABT.rewriteDown_ -- Focus all terms
    ((Term F v a -> m (Term F v a)) -> Term F v a -> m (Term F v a))
-> ((SomeReferenceId -> m SomeReferenceId)
    -> Term F v a -> m (Term F v a))
-> (SomeReferenceId -> m SomeReferenceId)
-> Term F v a
-> m (Term F v a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (F (Term F v a) -> m (F (Term F v a)))
-> Term F v a -> m (Term F v a)
forall (m :: * -> *) (f :: * -> *) v a.
Applicative m =>
(f (Term f v a) -> m (f (Term f v a)))
-> Term f v a -> m (Term f v a)
ABT.baseFunctor_ -- Focus Type.F
    ((F (Term F v a) -> m (F (Term F v a)))
 -> Term F v a -> m (Term F v a))
-> ((SomeReferenceId -> m SomeReferenceId)
    -> F (Term F v a) -> m (F (Term F v a)))
-> (SomeReferenceId -> m SomeReferenceId)
-> Term F v a
-> m (Term F v a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Reference -> m Reference) -> F (Term F v a) -> m (F (Term F v a))
forall a (p :: * -> * -> *) (f :: * -> *).
(Choice p, Applicative f) =>
p Reference (f Reference) -> p (F a) (f (F a))
Type._Ref -- Only the Ref constructor has references
    ((Reference -> m Reference)
 -> F (Term F v a) -> m (F (Term F v a)))
-> ((SomeReferenceId -> m SomeReferenceId)
    -> Reference -> m Reference)
-> (SomeReferenceId -> m SomeReferenceId)
-> F (Term F v a)
-> m (F (Term F v a))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Old Id -> m (Old Id)) -> Reference -> m Reference
Prism' Reference (Old Id)
Reference._DerivedId
    ((Old Id -> m (Old Id)) -> Reference -> m Reference)
-> ((SomeReferenceId -> m SomeReferenceId) -> Old Id -> m (Old Id))
-> (SomeReferenceId -> m SomeReferenceId)
-> Reference
-> m Reference
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (SomeReferenceId -> m SomeReferenceId) -> Old Id -> m (Old Id)
forall ref (f :: * -> *).
Applicative f =>
(SomeReference ref -> f (SomeReference ref)) -> ref -> f ref
asTypeReference_

termReferences_ :: (Monad m, Ord v) => LensLike' m (Term.Term v a) SomeReferenceId
termReferences_ :: forall (m :: * -> *) v a.
(Monad m, Ord v) =>
LensLike' m (Term v a) SomeReferenceId
termReferences_ =
  (Term (F v a a) v a -> m (Term (F v a a) v a))
-> Term (F v a a) v a -> m (Term (F v a a) v a)
forall (f :: * -> *) (m :: * -> *) v a.
(Traversable f, Monad m, Ord v) =>
(Term f v a -> m (Term f v a)) -> Term f v a -> m (Term f v a)
ABT.rewriteDown_ -- Focus all terms
    ((Term (F v a a) v a -> m (Term (F v a a) v a))
 -> Term (F v a a) v a -> m (Term (F v a a) v a))
-> ((SomeReferenceId -> m SomeReferenceId)
    -> Term (F v a a) v a -> m (Term (F v a a) v a))
-> (SomeReferenceId -> m SomeReferenceId)
-> Term (F v a a) v a
-> m (Term (F v a a) v a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (F v a a (Term (F v a a) v a) -> m (F v a a (Term (F v a a) v a)))
-> Term (F v a a) v a -> m (Term (F v a a) v a)
forall (m :: * -> *) (f :: * -> *) v a.
Applicative m =>
(f (Term f v a) -> m (f (Term f v a)))
-> Term f v a -> m (Term f v a)
ABT.baseFunctor_ -- Focus Term.F
    ((F v a a (Term (F v a a) v a) -> m (F v a a (Term (F v a a) v a)))
 -> Term (F v a a) v a -> m (Term (F v a a) v a))
-> ((SomeReferenceId -> m SomeReferenceId)
    -> F v a a (Term (F v a a) v a)
    -> m (F v a a (Term (F v a a) v a)))
-> (SomeReferenceId -> m SomeReferenceId)
-> Term (F v a a) v a
-> m (Term (F v a a) v a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (SomeReferenceId -> m SomeReferenceId)
-> F v a a (Term (F v a a) v a) -> m (F v a a (Term (F v a a) v a))
forall tv (m :: * -> *) ta pa a.
(Ord tv, Monad m) =>
LensLike' m (F tv ta pa a) SomeReferenceId
termFReferences_

termFReferences_ :: (Ord tv, Monad m) => LensLike' m (Term.F tv ta pa a) SomeReferenceId
termFReferences_ :: forall tv (m :: * -> *) ta pa a.
(Ord tv, Monad m) =>
LensLike' m (F tv ta pa a) SomeReferenceId
termFReferences_ SomeReferenceId -> m SomeReferenceId
f F tv ta pa a
t =
  (F tv ta pa a
t F tv ta pa a
-> (F tv ta pa a -> m (F tv ta pa a)) -> m (F tv ta pa a)
forall a b. a -> (a -> b) -> b
& (Reference -> m Reference) -> F tv ta pa a -> m (F tv ta pa a)
forall tv ta pa a (p :: * -> * -> *) (f :: * -> *).
(Choice p, Applicative f) =>
p Reference (f Reference) -> p (F tv ta pa a) (f (F tv ta pa a))
Term._Ref ((Reference -> m Reference) -> F tv ta pa a -> m (F tv ta pa a))
-> ((SomeReferenceId -> m SomeReferenceId)
    -> Reference -> m Reference)
-> (SomeReferenceId -> m SomeReferenceId)
-> F tv ta pa a
-> m (F tv ta pa a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Old Id -> m (Old Id)) -> Reference -> m Reference
Prism' Reference (Old Id)
Reference._DerivedId ((Old Id -> m (Old Id)) -> Reference -> m Reference)
-> ((SomeReferenceId -> m SomeReferenceId) -> Old Id -> m (Old Id))
-> (SomeReferenceId -> m SomeReferenceId)
-> Reference
-> m Reference
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (SomeReferenceId -> m SomeReferenceId) -> Old Id -> m (Old Id)
forall ref (f :: * -> *).
Applicative f =>
(SomeReference ref -> f (SomeReference ref)) -> ref -> f ref
asTermReference_ ((SomeReferenceId -> m SomeReferenceId)
 -> F tv ta pa a -> m (F tv ta pa a))
-> (SomeReferenceId -> m SomeReferenceId)
-> F tv ta pa a
-> m (F tv ta pa a)
forall {k} (f :: k -> *) s (t :: k) a (b :: k).
LensLike f s t a b -> LensLike f s t a b
%%~ SomeReferenceId -> m SomeReferenceId
f)
    m (F tv ta pa a)
-> (F tv ta pa a -> m (F tv ta pa a)) -> m (F tv ta pa a)
forall a b. m a -> (a -> m b) -> m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (ConstructorReference -> m ConstructorReference)
-> F tv ta pa a -> m (F tv ta pa a)
forall tv ta pa a (p :: * -> * -> *) (f :: * -> *).
(Choice p, Applicative f) =>
p ConstructorReference (f ConstructorReference)
-> p (F tv ta pa a) (f (F tv ta pa a))
Term._Constructor ((ConstructorReference -> m ConstructorReference)
 -> F tv ta pa a -> m (F tv ta pa a))
-> ((SomeReferenceId -> m SomeReferenceId)
    -> ConstructorReference -> m ConstructorReference)
-> (SomeReferenceId -> m SomeReferenceId)
-> F tv ta pa a
-> m (F tv ta pa a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (SomeReferenceId -> m SomeReferenceId)
-> ConstructorReference -> m ConstructorReference
Traversal' ConstructorReference SomeReferenceId
someRefCon_ ((SomeReferenceId -> m SomeReferenceId)
 -> F tv ta pa a -> m (F tv ta pa a))
-> (SomeReferenceId -> m SomeReferenceId)
-> F tv ta pa a
-> m (F tv ta pa a)
forall {k} (f :: k -> *) s (t :: k) a (b :: k).
LensLike f s t a b -> LensLike f s t a b
%%~ SomeReferenceId -> m SomeReferenceId
f
    m (F tv ta pa a)
-> (F tv ta pa a -> m (F tv ta pa a)) -> m (F tv ta pa a)
forall a b. m a -> (a -> m b) -> m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (ConstructorReference -> m ConstructorReference)
-> F tv ta pa a -> m (F tv ta pa a)
forall tv ta pa a (p :: * -> * -> *) (f :: * -> *).
(Choice p, Applicative f) =>
p ConstructorReference (f ConstructorReference)
-> p (F tv ta pa a) (f (F tv ta pa a))
Term._Request ((ConstructorReference -> m ConstructorReference)
 -> F tv ta pa a -> m (F tv ta pa a))
-> ((SomeReferenceId -> m SomeReferenceId)
    -> ConstructorReference -> m ConstructorReference)
-> (SomeReferenceId -> m SomeReferenceId)
-> F tv ta pa a
-> m (F tv ta pa a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (SomeReferenceId -> m SomeReferenceId)
-> ConstructorReference -> m ConstructorReference
Traversal' ConstructorReference SomeReferenceId
someRefCon_ ((SomeReferenceId -> m SomeReferenceId)
 -> F tv ta pa a -> m (F tv ta pa a))
-> (SomeReferenceId -> m SomeReferenceId)
-> F tv ta pa a
-> m (F tv ta pa a)
forall {k} (f :: k -> *) s (t :: k) a (b :: k).
LensLike f s t a b -> LensLike f s t a b
%%~ SomeReferenceId -> m SomeReferenceId
f
    m (F tv ta pa a)
-> (F tv ta pa a -> m (F tv ta pa a)) -> m (F tv ta pa a)
forall a b. m a -> (a -> m b) -> m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= ((a, Term F tv ta) -> m (a, Term F tv ta))
-> F tv ta pa a -> m (F tv ta pa a)
forall tv ta pa a (p :: * -> * -> *) (f :: * -> *).
(Choice p, Applicative f) =>
p (a, Term F tv ta) (f (a, Term F tv ta))
-> p (F tv ta pa a) (f (F tv ta pa a))
Term._Ann (((a, Term F tv ta) -> m (a, Term F tv ta))
 -> F tv ta pa a -> m (F tv ta pa a))
-> ((SomeReferenceId -> m SomeReferenceId)
    -> (a, Term F tv ta) -> m (a, Term F tv ta))
-> (SomeReferenceId -> m SomeReferenceId)
-> F tv ta pa a
-> m (F tv ta pa a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Term F tv ta -> m (Term F tv ta))
-> (a, Term F tv ta) -> m (a, Term F tv ta)
forall s t a b. Field2 s t a b => Lens s t a b
Lens
  (a, Term F tv ta) (a, Term F tv ta) (Term F tv ta) (Term F tv ta)
_2 ((Term F tv ta -> m (Term F tv ta))
 -> (a, Term F tv ta) -> m (a, Term F tv ta))
-> ((SomeReferenceId -> m SomeReferenceId)
    -> Term F tv ta -> m (Term F tv ta))
-> (SomeReferenceId -> m SomeReferenceId)
-> (a, Term F tv ta)
-> m (a, Term F tv ta)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (SomeReferenceId -> m SomeReferenceId)
-> Term F tv ta -> m (Term F tv ta)
forall (m :: * -> *) v a.
(Monad m, Ord v) =>
LensLike' m (Type v a) SomeReferenceId
typeReferences_ ((SomeReferenceId -> m SomeReferenceId)
 -> F tv ta pa a -> m (F tv ta pa a))
-> (SomeReferenceId -> m SomeReferenceId)
-> F tv ta pa a
-> m (F tv ta pa a)
forall {k} (f :: k -> *) s (t :: k) a (b :: k).
LensLike f s t a b -> LensLike f s t a b
%%~ SomeReferenceId -> m SomeReferenceId
f
    m (F tv ta pa a)
-> (F tv ta pa a -> m (F tv ta pa a)) -> m (F tv ta pa a)
forall a b. m a -> (a -> m b) -> m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= ((a, [MatchCase pa a]) -> m (a, [MatchCase pa a]))
-> F tv ta pa a -> m (F tv ta pa a)
forall tv ta pa a (p :: * -> * -> *) (f :: * -> *).
(Choice p, Applicative f) =>
p (a, [MatchCase pa a]) (f (a, [MatchCase pa a]))
-> p (F tv ta pa a) (f (F tv ta pa a))
Term._Match (((a, [MatchCase pa a]) -> m (a, [MatchCase pa a]))
 -> F tv ta pa a -> m (F tv ta pa a))
-> ((SomeReferenceId -> m SomeReferenceId)
    -> (a, [MatchCase pa a]) -> m (a, [MatchCase pa a]))
-> (SomeReferenceId -> m SomeReferenceId)
-> F tv ta pa a
-> m (F tv ta pa a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([MatchCase pa a] -> m [MatchCase pa a])
-> (a, [MatchCase pa a]) -> m (a, [MatchCase pa a])
forall s t a b. Field2 s t a b => Lens s t a b
Lens
  (a, [MatchCase pa a])
  (a, [MatchCase pa a])
  [MatchCase pa a]
  [MatchCase pa a]
_2 (([MatchCase pa a] -> m [MatchCase pa a])
 -> (a, [MatchCase pa a]) -> m (a, [MatchCase pa a]))
-> ((SomeReferenceId -> m SomeReferenceId)
    -> [MatchCase pa a] -> m [MatchCase pa a])
-> (SomeReferenceId -> m SomeReferenceId)
-> (a, [MatchCase pa a])
-> m (a, [MatchCase pa a])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (MatchCase pa a -> m (MatchCase pa a))
-> [MatchCase pa a] -> m [MatchCase pa a]
forall (f :: * -> *) a b.
Traversable f =>
IndexedTraversal Int (f a) (f b) a b
IndexedTraversal
  Int
  [MatchCase pa a]
  [MatchCase pa a]
  (MatchCase pa a)
  (MatchCase pa a)
traversed ((MatchCase pa a -> m (MatchCase pa a))
 -> [MatchCase pa a] -> m [MatchCase pa a])
-> ((SomeReferenceId -> m SomeReferenceId)
    -> MatchCase pa a -> m (MatchCase pa a))
-> (SomeReferenceId -> m SomeReferenceId)
-> [MatchCase pa a]
-> m [MatchCase pa a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Pattern pa -> m (Pattern pa))
-> MatchCase pa a -> m (MatchCase pa a)
forall loc a (f :: * -> *).
Functor f =>
(Pattern loc -> f (Pattern loc))
-> MatchCase loc a -> f (MatchCase loc a)
Term.matchPattern_ ((Pattern pa -> m (Pattern pa))
 -> MatchCase pa a -> m (MatchCase pa a))
-> ((SomeReferenceId -> m SomeReferenceId)
    -> Pattern pa -> m (Pattern pa))
-> (SomeReferenceId -> m SomeReferenceId)
-> MatchCase pa a
-> m (MatchCase pa a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (SomeReferenceId -> m SomeReferenceId)
-> Pattern pa -> m (Pattern pa)
forall loc (f :: * -> *).
Applicative f =>
(SomeReferenceId -> f SomeReferenceId)
-> Pattern loc -> f (Pattern loc)
patternReferences_ ((SomeReferenceId -> m SomeReferenceId)
 -> F tv ta pa a -> m (F tv ta pa a))
-> (SomeReferenceId -> m SomeReferenceId)
-> F tv ta pa a
-> m (F tv ta pa a)
forall {k} (f :: k -> *) s (t :: k) a (b :: k).
LensLike f s t a b -> LensLike f s t a b
%%~ SomeReferenceId -> m SomeReferenceId
f
    m (F tv ta pa a)
-> (F tv ta pa a -> m (F tv ta pa a)) -> m (F tv ta pa a)
forall a b. m a -> (a -> m b) -> m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Referent -> m Referent) -> F tv ta pa a -> m (F tv ta pa a)
forall tv ta pa a (p :: * -> * -> *) (f :: * -> *).
(Choice p, Applicative f) =>
p Referent (f Referent) -> p (F tv ta pa a) (f (F tv ta pa a))
Term._TermLink ((Referent -> m Referent) -> F tv ta pa a -> m (F tv ta pa a))
-> ((SomeReferenceId -> m SomeReferenceId)
    -> Referent -> m Referent)
-> (SomeReferenceId -> m SomeReferenceId)
-> F tv ta pa a
-> m (F tv ta pa a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (SomeReferenceId -> m SomeReferenceId) -> Referent -> m Referent
Traversal' Referent SomeReferenceId
referentAsSomeTermReference_ ((SomeReferenceId -> m SomeReferenceId)
 -> F tv ta pa a -> m (F tv ta pa a))
-> (SomeReferenceId -> m SomeReferenceId)
-> F tv ta pa a
-> m (F tv ta pa a)
forall {k} (f :: k -> *) s (t :: k) a (b :: k).
LensLike f s t a b -> LensLike f s t a b
%%~ SomeReferenceId -> m SomeReferenceId
f
    m (F tv ta pa a)
-> (F tv ta pa a -> m (F tv ta pa a)) -> m (F tv ta pa a)
forall a b. m a -> (a -> m b) -> m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Reference -> m Reference) -> F tv ta pa a -> m (F tv ta pa a)
forall tv ta pa a (p :: * -> * -> *) (f :: * -> *).
(Choice p, Applicative f) =>
p Reference (f Reference) -> p (F tv ta pa a) (f (F tv ta pa a))
Term._TypeLink ((Reference -> m Reference) -> F tv ta pa a -> m (F tv ta pa a))
-> ((SomeReferenceId -> m SomeReferenceId)
    -> Reference -> m Reference)
-> (SomeReferenceId -> m SomeReferenceId)
-> F tv ta pa a
-> m (F tv ta pa a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Old Id -> m (Old Id)) -> Reference -> m Reference
Prism' Reference (Old Id)
Reference._DerivedId ((Old Id -> m (Old Id)) -> Reference -> m Reference)
-> ((SomeReferenceId -> m SomeReferenceId) -> Old Id -> m (Old Id))
-> (SomeReferenceId -> m SomeReferenceId)
-> Reference
-> m Reference
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (SomeReferenceId -> m SomeReferenceId) -> Old Id -> m (Old Id)
forall ref (f :: * -> *).
Applicative f =>
(SomeReference ref -> f (SomeReference ref)) -> ref -> f ref
asTypeReference_ ((SomeReferenceId -> m SomeReferenceId)
 -> F tv ta pa a -> m (F tv ta pa a))
-> (SomeReferenceId -> m SomeReferenceId)
-> F tv ta pa a
-> m (F tv ta pa a)
forall {k} (f :: k -> *) s (t :: k) a (b :: k).
LensLike f s t a b -> LensLike f s t a b
%%~ SomeReferenceId -> m SomeReferenceId
f

-- | Build a SomeConstructorReference
someRefCon_ :: Traversal' ConstructorReference.ConstructorReference SomeReferenceId
someRefCon_ :: Traversal' ConstructorReference SomeReferenceId
someRefCon_ = (ConstructorReferenceId -> f ConstructorReferenceId)
-> ConstructorReference -> f ConstructorReference
Traversal' ConstructorReference ConstructorReferenceId
refConPair_ ((ConstructorReferenceId -> f ConstructorReferenceId)
 -> ConstructorReference -> f ConstructorReference)
-> ((SomeReferenceId -> f SomeReferenceId)
    -> ConstructorReferenceId -> f ConstructorReferenceId)
-> (SomeReferenceId -> f SomeReferenceId)
-> ConstructorReference
-> f ConstructorReference
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (SomeReferenceId -> f SomeReferenceId)
-> ConstructorReferenceId -> f ConstructorReferenceId
forall ref (f :: * -> *).
Applicative f =>
(SomeReference ref -> f (SomeReference ref))
-> GConstructorReference ref -> f (GConstructorReference ref)
asConstructorReference_
  where
    refConPair_ :: Traversal' ConstructorReference.ConstructorReference ConstructorReference.ConstructorReferenceId
    refConPair_ :: Traversal' ConstructorReference ConstructorReferenceId
refConPair_ ConstructorReferenceId -> f ConstructorReferenceId
f ConstructorReference
s =
      case ConstructorReference
s of
        ConstructorReference.ConstructorReference (Reference.Builtin Text
_) Old ConstructorId
_ -> ConstructorReference -> f ConstructorReference
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ConstructorReference
s
        ConstructorReference.ConstructorReference (Reference.DerivedId Old Id
n) Old ConstructorId
c ->
          ( \(ConstructorReference.ConstructorReference Old Id
n' Old ConstructorId
c') ->
              Reference -> Old ConstructorId -> ConstructorReference
forall r. r -> Old ConstructorId -> GConstructorReference r
ConstructorReference.ConstructorReference (Old Id -> Reference
forall h t. Id' h -> Reference' t h
Reference.DerivedId Old Id
n') Old ConstructorId
c'
          )
            (ConstructorReferenceId -> ConstructorReference)
-> f ConstructorReferenceId -> f ConstructorReference
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ConstructorReferenceId -> f ConstructorReferenceId
f (Old Id -> Old ConstructorId -> ConstructorReferenceId
forall r. r -> Old ConstructorId -> GConstructorReference r
ConstructorReference.ConstructorReference Old Id
n Old ConstructorId
c)

patternReferences_ :: Traversal' (Pattern loc) SomeReferenceId
patternReferences_ :: forall loc (f :: * -> *).
Applicative f =>
(SomeReferenceId -> f SomeReferenceId)
-> Pattern loc -> f (Pattern loc)
patternReferences_ SomeReferenceId -> f SomeReferenceId
f = \case
  p :: Pattern loc
p@(Pattern.Unbound {}) -> Pattern loc -> f (Pattern loc)
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Pattern loc
p
  p :: Pattern loc
p@(Pattern.Var {}) -> Pattern loc -> f (Pattern loc)
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Pattern loc
p
  p :: Pattern loc
p@(Pattern.Boolean {}) -> Pattern loc -> f (Pattern loc)
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Pattern loc
p
  p :: Pattern loc
p@(Pattern.Int {}) -> Pattern loc -> f (Pattern loc)
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Pattern loc
p
  p :: Pattern loc
p@(Pattern.Nat {}) -> Pattern loc -> f (Pattern loc)
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Pattern loc
p
  p :: Pattern loc
p@(Pattern.Float {}) -> Pattern loc -> f (Pattern loc)
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Pattern loc
p
  p :: Pattern loc
p@(Pattern.Text {}) -> Pattern loc -> f (Pattern loc)
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Pattern loc
p
  p :: Pattern loc
p@(Pattern.Char {}) -> Pattern loc -> f (Pattern loc)
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Pattern loc
p
  (Pattern.Constructor loc
loc ConstructorReference
ref [Pattern loc]
patterns) ->
    (\ConstructorReference
newRef [Pattern loc]
newPatterns -> loc -> ConstructorReference -> [Pattern loc] -> Pattern loc
forall loc.
loc -> ConstructorReference -> [Pattern loc] -> Pattern loc
Pattern.Constructor loc
loc ConstructorReference
newRef [Pattern loc]
newPatterns)
      (ConstructorReference -> [Pattern loc] -> Pattern loc)
-> f ConstructorReference -> f ([Pattern loc] -> Pattern loc)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (ConstructorReference
ref ConstructorReference
-> (ConstructorReference -> f ConstructorReference)
-> f ConstructorReference
forall a b. a -> (a -> b) -> b
& (SomeReferenceId -> f SomeReferenceId)
-> ConstructorReference -> f ConstructorReference
Traversal' ConstructorReference SomeReferenceId
someRefCon_ ((SomeReferenceId -> f SomeReferenceId)
 -> ConstructorReference -> f ConstructorReference)
-> (SomeReferenceId -> f SomeReferenceId)
-> ConstructorReference
-> f ConstructorReference
forall {k} (f :: k -> *) s (t :: k) a (b :: k).
LensLike f s t a b -> LensLike f s t a b
%%~ SomeReferenceId -> f SomeReferenceId
f)
      f ([Pattern loc] -> Pattern loc)
-> f [Pattern loc] -> f (Pattern loc)
forall a b. f (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ([Pattern loc]
patterns [Pattern loc]
-> ([Pattern loc] -> f [Pattern loc]) -> f [Pattern loc]
forall a b. a -> (a -> b) -> b
& (Pattern loc -> f (Pattern loc))
-> [Pattern loc] -> f [Pattern loc]
forall (f :: * -> *) a b.
Traversable f =>
IndexedTraversal Int (f a) (f b) a b
IndexedTraversal
  Int [Pattern loc] [Pattern loc] (Pattern loc) (Pattern loc)
traversed ((Pattern loc -> f (Pattern loc))
 -> [Pattern loc] -> f [Pattern loc])
-> ((SomeReferenceId -> f SomeReferenceId)
    -> Pattern loc -> f (Pattern loc))
-> (SomeReferenceId -> f SomeReferenceId)
-> [Pattern loc]
-> f [Pattern loc]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (SomeReferenceId -> f SomeReferenceId)
-> Pattern loc -> f (Pattern loc)
forall loc (f :: * -> *).
Applicative f =>
(SomeReferenceId -> f SomeReferenceId)
-> Pattern loc -> f (Pattern loc)
patternReferences_ ((SomeReferenceId -> f SomeReferenceId)
 -> [Pattern loc] -> f [Pattern loc])
-> (SomeReferenceId -> f SomeReferenceId)
-> [Pattern loc]
-> f [Pattern loc]
forall {k} (f :: k -> *) s (t :: k) a (b :: k).
LensLike f s t a b -> LensLike f s t a b
%%~ SomeReferenceId -> f SomeReferenceId
f)
  (Pattern.As loc
loc Pattern loc
pat) -> loc -> Pattern loc -> Pattern loc
forall loc. loc -> Pattern loc -> Pattern loc
Pattern.As loc
loc (Pattern loc -> Pattern loc) -> f (Pattern loc) -> f (Pattern loc)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (SomeReferenceId -> f SomeReferenceId)
-> Pattern loc -> f (Pattern loc)
forall loc (f :: * -> *).
Applicative f =>
(SomeReferenceId -> f SomeReferenceId)
-> Pattern loc -> f (Pattern loc)
patternReferences_ SomeReferenceId -> f SomeReferenceId
f Pattern loc
pat
  (Pattern.EffectPure loc
loc Pattern loc
pat) -> loc -> Pattern loc -> Pattern loc
forall loc. loc -> Pattern loc -> Pattern loc
Pattern.EffectPure loc
loc (Pattern loc -> Pattern loc) -> f (Pattern loc) -> f (Pattern loc)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (SomeReferenceId -> f SomeReferenceId)
-> Pattern loc -> f (Pattern loc)
forall loc (f :: * -> *).
Applicative f =>
(SomeReferenceId -> f SomeReferenceId)
-> Pattern loc -> f (Pattern loc)
patternReferences_ SomeReferenceId -> f SomeReferenceId
f Pattern loc
pat
  (Pattern.EffectBind loc
loc ConstructorReference
ref [Pattern loc]
patterns Pattern loc
pat) ->
    do
      (\ConstructorReference
newRef [Pattern loc]
newPatterns Pattern loc
newPat -> loc
-> ConstructorReference
-> [Pattern loc]
-> Pattern loc
-> Pattern loc
forall loc.
loc
-> ConstructorReference
-> [Pattern loc]
-> Pattern loc
-> Pattern loc
Pattern.EffectBind loc
loc ConstructorReference
newRef [Pattern loc]
newPatterns Pattern loc
newPat)
      (ConstructorReference
 -> [Pattern loc] -> Pattern loc -> Pattern loc)
-> f ConstructorReference
-> f ([Pattern loc] -> Pattern loc -> Pattern loc)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (ConstructorReference
ref ConstructorReference
-> (ConstructorReference -> f ConstructorReference)
-> f ConstructorReference
forall a b. a -> (a -> b) -> b
& (SomeReferenceId -> f SomeReferenceId)
-> ConstructorReference -> f ConstructorReference
Traversal' ConstructorReference SomeReferenceId
someRefCon_ ((SomeReferenceId -> f SomeReferenceId)
 -> ConstructorReference -> f ConstructorReference)
-> (SomeReferenceId -> f SomeReferenceId)
-> ConstructorReference
-> f ConstructorReference
forall {k} (f :: k -> *) s (t :: k) a (b :: k).
LensLike f s t a b -> LensLike f s t a b
%%~ SomeReferenceId -> f SomeReferenceId
f)
      f ([Pattern loc] -> Pattern loc -> Pattern loc)
-> f [Pattern loc] -> f (Pattern loc -> Pattern loc)
forall a b. f (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ([Pattern loc]
patterns [Pattern loc]
-> ([Pattern loc] -> f [Pattern loc]) -> f [Pattern loc]
forall a b. a -> (a -> b) -> b
& (Pattern loc -> f (Pattern loc))
-> [Pattern loc] -> f [Pattern loc]
forall (f :: * -> *) a b.
Traversable f =>
IndexedTraversal Int (f a) (f b) a b
IndexedTraversal
  Int [Pattern loc] [Pattern loc] (Pattern loc) (Pattern loc)
traversed ((Pattern loc -> f (Pattern loc))
 -> [Pattern loc] -> f [Pattern loc])
-> ((SomeReferenceId -> f SomeReferenceId)
    -> Pattern loc -> f (Pattern loc))
-> (SomeReferenceId -> f SomeReferenceId)
-> [Pattern loc]
-> f [Pattern loc]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (SomeReferenceId -> f SomeReferenceId)
-> Pattern loc -> f (Pattern loc)
forall loc (f :: * -> *).
Applicative f =>
(SomeReferenceId -> f SomeReferenceId)
-> Pattern loc -> f (Pattern loc)
patternReferences_ ((SomeReferenceId -> f SomeReferenceId)
 -> [Pattern loc] -> f [Pattern loc])
-> (SomeReferenceId -> f SomeReferenceId)
-> [Pattern loc]
-> f [Pattern loc]
forall {k} (f :: k -> *) s (t :: k) a (b :: k).
LensLike f s t a b -> LensLike f s t a b
%%~ SomeReferenceId -> f SomeReferenceId
f)
      f (Pattern loc -> Pattern loc)
-> f (Pattern loc) -> f (Pattern loc)
forall a b. f (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ((SomeReferenceId -> f SomeReferenceId)
-> Pattern loc -> f (Pattern loc)
forall loc (f :: * -> *).
Applicative f =>
(SomeReferenceId -> f SomeReferenceId)
-> Pattern loc -> f (Pattern loc)
patternReferences_ SomeReferenceId -> f SomeReferenceId
f Pattern loc
pat)
  (Pattern.SequenceLiteral loc
loc [Pattern loc]
patterns) ->
    loc -> [Pattern loc] -> Pattern loc
forall loc. loc -> [Pattern loc] -> Pattern loc
Pattern.SequenceLiteral loc
loc ([Pattern loc] -> Pattern loc)
-> f [Pattern loc] -> f (Pattern loc)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ([Pattern loc]
patterns [Pattern loc]
-> ([Pattern loc] -> f [Pattern loc]) -> f [Pattern loc]
forall a b. a -> (a -> b) -> b
& (Pattern loc -> f (Pattern loc))
-> [Pattern loc] -> f [Pattern loc]
forall (f :: * -> *) a b.
Traversable f =>
IndexedTraversal Int (f a) (f b) a b
IndexedTraversal
  Int [Pattern loc] [Pattern loc] (Pattern loc) (Pattern loc)
traversed ((Pattern loc -> f (Pattern loc))
 -> [Pattern loc] -> f [Pattern loc])
-> ((SomeReferenceId -> f SomeReferenceId)
    -> Pattern loc -> f (Pattern loc))
-> (SomeReferenceId -> f SomeReferenceId)
-> [Pattern loc]
-> f [Pattern loc]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (SomeReferenceId -> f SomeReferenceId)
-> Pattern loc -> f (Pattern loc)
forall loc (f :: * -> *).
Applicative f =>
(SomeReferenceId -> f SomeReferenceId)
-> Pattern loc -> f (Pattern loc)
patternReferences_ ((SomeReferenceId -> f SomeReferenceId)
 -> [Pattern loc] -> f [Pattern loc])
-> (SomeReferenceId -> f SomeReferenceId)
-> [Pattern loc]
-> f [Pattern loc]
forall {k} (f :: k -> *) s (t :: k) a (b :: k).
LensLike f s t a b -> LensLike f s t a b
%%~ SomeReferenceId -> f SomeReferenceId
f)
  Pattern.SequenceOp loc
loc Pattern loc
pat SeqOp
seqOp Pattern loc
pat2 -> do
    loc -> Pattern loc -> SeqOp -> Pattern loc -> Pattern loc
forall loc.
loc -> Pattern loc -> SeqOp -> Pattern loc -> Pattern loc
Pattern.SequenceOp loc
loc (Pattern loc -> SeqOp -> Pattern loc -> Pattern loc)
-> f (Pattern loc) -> f (SeqOp -> Pattern loc -> Pattern loc)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (SomeReferenceId -> f SomeReferenceId)
-> Pattern loc -> f (Pattern loc)
forall loc (f :: * -> *).
Applicative f =>
(SomeReferenceId -> f SomeReferenceId)
-> Pattern loc -> f (Pattern loc)
patternReferences_ SomeReferenceId -> f SomeReferenceId
f Pattern loc
pat f (SeqOp -> Pattern loc -> Pattern loc)
-> f SeqOp -> f (Pattern loc -> Pattern loc)
forall a b. f (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> SeqOp -> f SeqOp
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure SeqOp
seqOp f (Pattern loc -> Pattern loc)
-> f (Pattern loc) -> f (Pattern loc)
forall a b. f (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (SomeReferenceId -> f SomeReferenceId)
-> Pattern loc -> f (Pattern loc)
forall loc (f :: * -> *).
Applicative f =>
(SomeReferenceId -> f SomeReferenceId)
-> Pattern loc -> f (Pattern loc)
patternReferences_ SomeReferenceId -> f SomeReferenceId
f Pattern loc
pat2

referentAsSomeTermReference_ :: Traversal' Referent.Referent SomeReferenceId
referentAsSomeTermReference_ :: Traversal' Referent SomeReferenceId
referentAsSomeTermReference_ SomeReferenceId -> f SomeReferenceId
f = \case
  (Referent'.Ref' (Reference.DerivedId Old Id
refId)) -> do
    Old Id
newRefId <- Old Id
refId Old Id -> (Old Id -> f (Old Id)) -> f (Old Id)
forall a b. a -> (a -> b) -> b
& (SomeReferenceId -> f SomeReferenceId) -> Old Id -> f (Old Id)
forall ref (f :: * -> *).
Applicative f =>
(SomeReference ref -> f (SomeReference ref)) -> ref -> f ref
asTermReference_ ((SomeReferenceId -> f SomeReferenceId) -> Old Id -> f (Old Id))
-> (SomeReferenceId -> f SomeReferenceId) -> Old Id -> f (Old Id)
forall {k} (f :: k -> *) s (t :: k) a (b :: k).
LensLike f s t a b -> LensLike f s t a b
%%~ SomeReferenceId -> f SomeReferenceId
f
    pure (Reference -> Referent
forall r. r -> Referent' r
Referent'.Ref' (Old Id -> Reference
forall h t. Id' h -> Reference' t h
Reference.DerivedId Old Id
newRefId))
  (Referent'.Con' (ConstructorReference.ConstructorReference (Reference.DerivedId Old Id
refId) Old ConstructorId
conId) ConstructorType
conType) ->
    (Old Id -> Old ConstructorId -> ConstructorReferenceId
forall r. r -> Old ConstructorId -> GConstructorReference r
ConstructorReference.ConstructorReference Old Id
refId Old ConstructorId
conId ConstructorReferenceId
-> (ConstructorReferenceId -> f ConstructorReferenceId)
-> f ConstructorReferenceId
forall a b. a -> (a -> b) -> b
& (SomeReferenceId -> f SomeReferenceId)
-> ConstructorReferenceId -> f ConstructorReferenceId
forall ref (f :: * -> *).
Applicative f =>
(SomeReference ref -> f (SomeReference ref))
-> GConstructorReference ref -> f (GConstructorReference ref)
asConstructorReference_ ((SomeReferenceId -> f SomeReferenceId)
 -> ConstructorReferenceId -> f ConstructorReferenceId)
-> (SomeReferenceId -> f SomeReferenceId)
-> ConstructorReferenceId
-> f ConstructorReferenceId
forall {k} (f :: k -> *) s (t :: k) a (b :: k).
LensLike f s t a b -> LensLike f s t a b
%%~ SomeReferenceId -> f SomeReferenceId
f)
      f ConstructorReferenceId
-> (ConstructorReferenceId -> Referent) -> f Referent
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \(ConstructorReference.ConstructorReference Old Id
newRefId Old ConstructorId
newConId) ->
        ConstructorReference -> ConstructorType -> Referent
forall r. GConstructorReference r -> ConstructorType -> Referent' r
Referent'.Con'
          (Reference -> Old ConstructorId -> ConstructorReference
forall r. r -> Old ConstructorId -> GConstructorReference r
ConstructorReference.ConstructorReference (Old Id -> Reference
forall h t. Id' h -> Reference' t h
Reference.DerivedId Old Id
newRefId) Old ConstructorId
newConId)
          ConstructorType
conType
  Referent
r -> Referent -> f Referent
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Referent
r

type SomeReferenceId = SomeReference Reference.Id

type SomeReferenceObjId = SomeReference (UReference.Id' ObjectId)

remapObjIdRefs ::
  (Map (Old ObjectId) (New ObjectId, New HashId, New Hash, Old Hash)) ->
  (Map SomeReferenceId SomeReferenceId) ->
  SomeReferenceObjId ->
  SomeReferenceObjId
remapObjIdRefs :: Map ObjectId (ObjectId, HashId, New Hash, New Hash)
-> Map SomeReferenceId SomeReferenceId
-> SomeReference (Id' ObjectId)
-> SomeReference (Id' ObjectId)
remapObjIdRefs Map ObjectId (ObjectId, HashId, New Hash, New Hash)
objMapping Map SomeReferenceId SomeReferenceId
refMapping SomeReference (Id' ObjectId)
someObjIdRef = SomeReference (Id' ObjectId)
newSomeObjId
  where
    oldObjId :: ObjectId
    oldObjId :: ObjectId
oldObjId = SomeReference (Id' ObjectId)
someObjIdRef SomeReference (Id' ObjectId)
-> Getting ObjectId (SomeReference (Id' ObjectId)) ObjectId
-> ObjectId
forall s a. s -> Getting a s a -> a
^. (Id' ObjectId -> Const ObjectId (Id' ObjectId))
-> SomeReference (Id' ObjectId)
-> Const ObjectId (SomeReference (Id' ObjectId))
forall ref ref' (f :: * -> *).
Functor f =>
(ref -> f ref') -> SomeReference ref -> f (SomeReference ref')
someRef_ ((Id' ObjectId -> Const ObjectId (Id' ObjectId))
 -> SomeReference (Id' ObjectId)
 -> Const ObjectId (SomeReference (Id' ObjectId)))
-> ((ObjectId -> Const ObjectId ObjectId)
    -> Id' ObjectId -> Const ObjectId (Id' ObjectId))
-> Getting ObjectId (SomeReference (Id' ObjectId)) ObjectId
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ObjectId -> Const ObjectId ObjectId)
-> Id' ObjectId -> Const ObjectId (Id' ObjectId)
forall h h' (f :: * -> *).
Functor f =>
(h -> f h') -> Id' h -> f (Id' h')
UReference.idH
    (ObjectId
newObjId, HashId
_, New Hash
_, New Hash
oldHash) =
      case ObjectId
-> Map ObjectId (ObjectId, HashId, New Hash, New Hash)
-> Maybe (ObjectId, HashId, New Hash, New Hash)
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup ObjectId
oldObjId Map ObjectId (ObjectId, HashId, New Hash, New Hash)
objMapping of
        Maybe (ObjectId, HashId, New Hash, New Hash)
Nothing -> [Char] -> (ObjectId, HashId, New Hash, New Hash)
forall a. HasCallStack => [Char] -> a
error ([Char] -> (ObjectId, HashId, New Hash, New Hash))
-> [Char] -> (ObjectId, HashId, New Hash, New Hash)
forall a b. (a -> b) -> a -> b
$ [Char]
"Expected object mapping for ID: " [Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<> ObjectId -> [Char]
forall a. Show a => a -> [Char]
show ObjectId
oldObjId
        Just (ObjectId, HashId, New Hash, New Hash)
found -> (ObjectId, HashId, New Hash, New Hash)
found
    oldSomeRefId :: SomeReferenceId
    oldSomeRefId :: SomeReferenceId
oldSomeRefId = (SomeReference (Id' ObjectId)
someObjIdRef SomeReference (Id' ObjectId)
-> (SomeReference (Id' ObjectId) -> SomeReferenceId)
-> SomeReferenceId
forall a b. a -> (a -> b) -> b
& (Id' ObjectId -> Identity (Old Id))
-> SomeReference (Id' ObjectId) -> Identity SomeReferenceId
forall ref ref' (f :: * -> *).
Functor f =>
(ref -> f ref') -> SomeReference ref -> f (SomeReference ref')
someRef_ ((Id' ObjectId -> Identity (Old Id))
 -> SomeReference (Id' ObjectId) -> Identity SomeReferenceId)
-> ((ObjectId -> Identity (New Hash))
    -> Id' ObjectId -> Identity (Old Id))
-> (ObjectId -> Identity (New Hash))
-> SomeReference (Id' ObjectId)
-> Identity SomeReferenceId
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ObjectId -> Identity (New Hash))
-> Id' ObjectId -> Identity (Old Id)
forall h h' (f :: * -> *).
Functor f =>
(h -> f h') -> Id' h -> f (Id' h')
UReference.idH ((ObjectId -> Identity (New Hash))
 -> SomeReference (Id' ObjectId) -> Identity SomeReferenceId)
-> New Hash -> SomeReference (Id' ObjectId) -> SomeReferenceId
forall s t a b. ASetter s t a b -> b -> s -> t
.~ New Hash
oldHash) SomeReferenceId
-> Getting SomeReferenceId SomeReferenceId SomeReferenceId
-> SomeReferenceId
forall s a. s -> Getting a s a -> a
^. Getting SomeReferenceId SomeReferenceId SomeReferenceId
Iso' SomeReferenceId SomeReferenceId
uRefIdAsRefId_
    newSomeRefId :: SomeReferenceId
    newSomeRefId :: SomeReferenceId
newSomeRefId = case SomeReferenceId
-> Map SomeReferenceId SomeReferenceId -> Maybe SomeReferenceId
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup SomeReferenceId
oldSomeRefId Map SomeReferenceId SomeReferenceId
refMapping of
      Maybe SomeReferenceId
Nothing -> [Char] -> SomeReferenceId
forall a. HasCallStack => [Char] -> a
error ([Char] -> SomeReferenceId) -> [Char] -> SomeReferenceId
forall a b. (a -> b) -> a -> b
$ [Char]
"Expected reference mapping for ID: " [Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<> SomeReferenceId -> [Char]
forall a. Show a => a -> [Char]
show SomeReferenceId
oldSomeRefId
      Just SomeReferenceId
r -> SomeReferenceId
r
    newSomeObjId :: SomeReference (UReference.Id' (New ObjectId))
    newSomeObjId :: SomeReference (Id' ObjectId)
newSomeObjId = (SomeReferenceId
newSomeRefId SomeReferenceId
-> Getting SomeReferenceId SomeReferenceId SomeReferenceId
-> SomeReferenceId
forall s a. s -> Getting a s a -> a
^. AnIso
  SomeReferenceId SomeReferenceId SomeReferenceId SomeReferenceId
-> Iso' SomeReferenceId SomeReferenceId
forall s t a b. AnIso s t a b -> Iso b a t s
Lens.from AnIso
  SomeReferenceId SomeReferenceId SomeReferenceId SomeReferenceId
Iso' SomeReferenceId SomeReferenceId
uRefIdAsRefId_) SomeReferenceId
-> (SomeReferenceId -> SomeReference (Id' ObjectId))
-> SomeReference (Id' ObjectId)
forall a b. a -> (a -> b) -> b
& (Old Id -> Identity (Id' ObjectId))
-> SomeReferenceId -> Identity (SomeReference (Id' ObjectId))
forall ref ref' (f :: * -> *).
Functor f =>
(ref -> f ref') -> SomeReference ref -> f (SomeReference ref')
someRef_ ((Old Id -> Identity (Id' ObjectId))
 -> SomeReferenceId -> Identity (SomeReference (Id' ObjectId)))
-> ((New Hash -> Identity ObjectId)
    -> Old Id -> Identity (Id' ObjectId))
-> (New Hash -> Identity ObjectId)
-> SomeReferenceId
-> Identity (SomeReference (Id' ObjectId))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (New Hash -> Identity ObjectId)
-> Old Id -> Identity (Id' ObjectId)
forall h h' (f :: * -> *).
Functor f =>
(h -> f h') -> Id' h -> f (Id' h')
UReference.idH ((New Hash -> Identity ObjectId)
 -> SomeReferenceId -> Identity (SomeReference (Id' ObjectId)))
-> ObjectId -> SomeReferenceId -> SomeReference (Id' ObjectId)
forall s t a b. ASetter s t a b -> b -> s -> t
.~ ObjectId
newObjId

data SomeReference ref
  = TermReference ref
  | TypeReference ref
  | ConstructorReference ref ConstructorId
  deriving (SomeReference ref -> SomeReference ref -> Bool
(SomeReference ref -> SomeReference ref -> Bool)
-> (SomeReference ref -> SomeReference ref -> Bool)
-> Eq (SomeReference ref)
forall ref.
Eq ref =>
SomeReference ref -> SomeReference ref -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall ref.
Eq ref =>
SomeReference ref -> SomeReference ref -> Bool
== :: SomeReference ref -> SomeReference ref -> Bool
$c/= :: forall ref.
Eq ref =>
SomeReference ref -> SomeReference ref -> Bool
/= :: SomeReference ref -> SomeReference ref -> Bool
Eq, (forall a b. (a -> b) -> SomeReference a -> SomeReference b)
-> (forall a b. a -> SomeReference b -> SomeReference a)
-> Functor SomeReference
forall a b. a -> SomeReference b -> SomeReference a
forall a b. (a -> b) -> SomeReference a -> SomeReference b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
$cfmap :: forall a b. (a -> b) -> SomeReference a -> SomeReference b
fmap :: forall a b. (a -> b) -> SomeReference a -> SomeReference b
$c<$ :: forall a b. a -> SomeReference b -> SomeReference a
<$ :: forall a b. a -> SomeReference b -> SomeReference a
Functor, (forall x. SomeReference ref -> Rep (SomeReference ref) x)
-> (forall x. Rep (SomeReference ref) x -> SomeReference ref)
-> Generic (SomeReference ref)
forall x. Rep (SomeReference ref) x -> SomeReference ref
forall x. SomeReference ref -> Rep (SomeReference ref) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall ref x. Rep (SomeReference ref) x -> SomeReference ref
forall ref x. SomeReference ref -> Rep (SomeReference ref) x
$cfrom :: forall ref x. SomeReference ref -> Rep (SomeReference ref) x
from :: forall x. SomeReference ref -> Rep (SomeReference ref) x
$cto :: forall ref x. Rep (SomeReference ref) x -> SomeReference ref
to :: forall x. Rep (SomeReference ref) x -> SomeReference ref
Generic, Eq (SomeReference ref)
Eq (SomeReference ref) =>
(SomeReference ref -> SomeReference ref -> Ordering)
-> (SomeReference ref -> SomeReference ref -> Bool)
-> (SomeReference ref -> SomeReference ref -> Bool)
-> (SomeReference ref -> SomeReference ref -> Bool)
-> (SomeReference ref -> SomeReference ref -> Bool)
-> (SomeReference ref -> SomeReference ref -> SomeReference ref)
-> (SomeReference ref -> SomeReference ref -> SomeReference ref)
-> Ord (SomeReference ref)
SomeReference ref -> SomeReference ref -> Bool
SomeReference ref -> SomeReference ref -> Ordering
SomeReference ref -> SomeReference ref -> SomeReference ref
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall ref. Ord ref => Eq (SomeReference ref)
forall ref.
Ord ref =>
SomeReference ref -> SomeReference ref -> Bool
forall ref.
Ord ref =>
SomeReference ref -> SomeReference ref -> Ordering
forall ref.
Ord ref =>
SomeReference ref -> SomeReference ref -> SomeReference ref
$ccompare :: forall ref.
Ord ref =>
SomeReference ref -> SomeReference ref -> Ordering
compare :: SomeReference ref -> SomeReference ref -> Ordering
$c< :: forall ref.
Ord ref =>
SomeReference ref -> SomeReference ref -> Bool
< :: SomeReference ref -> SomeReference ref -> Bool
$c<= :: forall ref.
Ord ref =>
SomeReference ref -> SomeReference ref -> Bool
<= :: SomeReference ref -> SomeReference ref -> Bool
$c> :: forall ref.
Ord ref =>
SomeReference ref -> SomeReference ref -> Bool
> :: SomeReference ref -> SomeReference ref -> Bool
$c>= :: forall ref.
Ord ref =>
SomeReference ref -> SomeReference ref -> Bool
>= :: SomeReference ref -> SomeReference ref -> Bool
$cmax :: forall ref.
Ord ref =>
SomeReference ref -> SomeReference ref -> SomeReference ref
max :: SomeReference ref -> SomeReference ref -> SomeReference ref
$cmin :: forall ref.
Ord ref =>
SomeReference ref -> SomeReference ref -> SomeReference ref
min :: SomeReference ref -> SomeReference ref -> SomeReference ref
Ord, Int -> SomeReference ref -> [Char] -> [Char]
[SomeReference ref] -> [Char] -> [Char]
SomeReference ref -> [Char]
(Int -> SomeReference ref -> [Char] -> [Char])
-> (SomeReference ref -> [Char])
-> ([SomeReference ref] -> [Char] -> [Char])
-> Show (SomeReference ref)
forall ref.
Show ref =>
Int -> SomeReference ref -> [Char] -> [Char]
forall ref. Show ref => [SomeReference ref] -> [Char] -> [Char]
forall ref. Show ref => SomeReference ref -> [Char]
forall a.
(Int -> a -> [Char] -> [Char])
-> (a -> [Char]) -> ([a] -> [Char] -> [Char]) -> Show a
$cshowsPrec :: forall ref.
Show ref =>
Int -> SomeReference ref -> [Char] -> [Char]
showsPrec :: Int -> SomeReference ref -> [Char] -> [Char]
$cshow :: forall ref. Show ref => SomeReference ref -> [Char]
show :: SomeReference ref -> [Char]
$cshowList :: forall ref. Show ref => [SomeReference ref] -> [Char] -> [Char]
showList :: [SomeReference ref] -> [Char] -> [Char]
Show, (forall m. Monoid m => SomeReference m -> m)
-> (forall m a. Monoid m => (a -> m) -> SomeReference a -> m)
-> (forall m a. Monoid m => (a -> m) -> SomeReference a -> m)
-> (forall a b. (a -> b -> b) -> b -> SomeReference a -> b)
-> (forall a b. (a -> b -> b) -> b -> SomeReference a -> b)
-> (forall b a. (b -> a -> b) -> b -> SomeReference a -> b)
-> (forall b a. (b -> a -> b) -> b -> SomeReference a -> b)
-> (forall a. (a -> a -> a) -> SomeReference a -> a)
-> (forall a. (a -> a -> a) -> SomeReference a -> a)
-> (forall a. SomeReference a -> [a])
-> (forall a. SomeReference a -> Bool)
-> (forall a. SomeReference a -> Int)
-> (forall a. Eq a => a -> SomeReference a -> Bool)
-> (forall a. Ord a => SomeReference a -> a)
-> (forall a. Ord a => SomeReference a -> a)
-> (forall a. Num a => SomeReference a -> a)
-> (forall a. Num a => SomeReference a -> a)
-> Foldable SomeReference
forall a. Eq a => a -> SomeReference a -> Bool
forall a. Num a => SomeReference a -> a
forall a. Ord a => SomeReference a -> a
forall m. Monoid m => SomeReference m -> m
forall a. SomeReference a -> Bool
forall a. SomeReference a -> Int
forall a. SomeReference a -> [a]
forall a. (a -> a -> a) -> SomeReference a -> a
forall m a. Monoid m => (a -> m) -> SomeReference a -> m
forall b a. (b -> a -> b) -> b -> SomeReference a -> b
forall a b. (a -> b -> b) -> b -> SomeReference a -> b
forall (t :: * -> *).
(forall m. Monoid m => t m -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. t a -> [a])
-> (forall a. t a -> Bool)
-> (forall a. t a -> Int)
-> (forall a. Eq a => a -> t a -> Bool)
-> (forall a. Ord a => t a -> a)
-> (forall a. Ord a => t a -> a)
-> (forall a. Num a => t a -> a)
-> (forall a. Num a => t a -> a)
-> Foldable t
$cfold :: forall m. Monoid m => SomeReference m -> m
fold :: forall m. Monoid m => SomeReference m -> m
$cfoldMap :: forall m a. Monoid m => (a -> m) -> SomeReference a -> m
foldMap :: forall m a. Monoid m => (a -> m) -> SomeReference a -> m
$cfoldMap' :: forall m a. Monoid m => (a -> m) -> SomeReference a -> m
foldMap' :: forall m a. Monoid m => (a -> m) -> SomeReference a -> m
$cfoldr :: forall a b. (a -> b -> b) -> b -> SomeReference a -> b
foldr :: forall a b. (a -> b -> b) -> b -> SomeReference a -> b
$cfoldr' :: forall a b. (a -> b -> b) -> b -> SomeReference a -> b
foldr' :: forall a b. (a -> b -> b) -> b -> SomeReference a -> b
$cfoldl :: forall b a. (b -> a -> b) -> b -> SomeReference a -> b
foldl :: forall b a. (b -> a -> b) -> b -> SomeReference a -> b
$cfoldl' :: forall b a. (b -> a -> b) -> b -> SomeReference a -> b
foldl' :: forall b a. (b -> a -> b) -> b -> SomeReference a -> b
$cfoldr1 :: forall a. (a -> a -> a) -> SomeReference a -> a
foldr1 :: forall a. (a -> a -> a) -> SomeReference a -> a
$cfoldl1 :: forall a. (a -> a -> a) -> SomeReference a -> a
foldl1 :: forall a. (a -> a -> a) -> SomeReference a -> a
$ctoList :: forall a. SomeReference a -> [a]
toList :: forall a. SomeReference a -> [a]
$cnull :: forall a. SomeReference a -> Bool
null :: forall a. SomeReference a -> Bool
$clength :: forall a. SomeReference a -> Int
length :: forall a. SomeReference a -> Int
$celem :: forall a. Eq a => a -> SomeReference a -> Bool
elem :: forall a. Eq a => a -> SomeReference a -> Bool
$cmaximum :: forall a. Ord a => SomeReference a -> a
maximum :: forall a. Ord a => SomeReference a -> a
$cminimum :: forall a. Ord a => SomeReference a -> a
minimum :: forall a. Ord a => SomeReference a -> a
$csum :: forall a. Num a => SomeReference a -> a
sum :: forall a. Num a => SomeReference a -> a
$cproduct :: forall a. Num a => SomeReference a -> a
product :: forall a. Num a => SomeReference a -> a
Foldable, Functor SomeReference
Foldable SomeReference
(Functor SomeReference, Foldable SomeReference) =>
(forall (f :: * -> *) a b.
 Applicative f =>
 (a -> f b) -> SomeReference a -> f (SomeReference b))
-> (forall (f :: * -> *) a.
    Applicative f =>
    SomeReference (f a) -> f (SomeReference a))
-> (forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> SomeReference a -> m (SomeReference b))
-> (forall (m :: * -> *) a.
    Monad m =>
    SomeReference (m a) -> m (SomeReference a))
-> Traversable SomeReference
forall (t :: * -> *).
(Functor t, Foldable t) =>
(forall (f :: * -> *) a b.
 Applicative f =>
 (a -> f b) -> t a -> f (t b))
-> (forall (f :: * -> *) a. Applicative f => t (f a) -> f (t a))
-> (forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> t a -> m (t b))
-> (forall (m :: * -> *) a. Monad m => t (m a) -> m (t a))
-> Traversable t
forall (m :: * -> *) a.
Monad m =>
SomeReference (m a) -> m (SomeReference a)
forall (f :: * -> *) a.
Applicative f =>
SomeReference (f a) -> f (SomeReference a)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> SomeReference a -> m (SomeReference b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> SomeReference a -> f (SomeReference b)
$ctraverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> SomeReference a -> f (SomeReference b)
traverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> SomeReference a -> f (SomeReference b)
$csequenceA :: forall (f :: * -> *) a.
Applicative f =>
SomeReference (f a) -> f (SomeReference a)
sequenceA :: forall (f :: * -> *) a.
Applicative f =>
SomeReference (f a) -> f (SomeReference a)
$cmapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> SomeReference a -> m (SomeReference b)
mapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> SomeReference a -> m (SomeReference b)
$csequence :: forall (m :: * -> *) a.
Monad m =>
SomeReference (m a) -> m (SomeReference a)
sequence :: forall (m :: * -> *) a.
Monad m =>
SomeReference (m a) -> m (SomeReference a)
Traversable)

someRef_ :: Lens (SomeReference ref) (SomeReference ref') ref ref'
someRef_ :: forall ref ref' (f :: * -> *).
Functor f =>
(ref -> f ref') -> SomeReference ref -> f (SomeReference ref')
someRef_ = (SomeReference ref -> ref)
-> (SomeReference ref -> ref' -> SomeReference ref')
-> Lens (SomeReference ref) (SomeReference ref') ref ref'
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens SomeReference ref -> ref
forall {ref}. SomeReference ref -> ref
getter SomeReference ref -> ref' -> SomeReference ref'
forall {ref} {ref}. SomeReference ref -> ref -> SomeReference ref
setter
  where
    setter :: SomeReference ref -> ref -> SomeReference ref
setter (TermReference ref
_) ref
r = ref -> SomeReference ref
forall ref. ref -> SomeReference ref
TermReference ref
r
    setter (TypeReference ref
_) ref
r = ref -> SomeReference ref
forall ref. ref -> SomeReference ref
TypeReference ref
r
    setter (ConstructorReference ref
_ Old ConstructorId
conId) ref
r = (ref -> Old ConstructorId -> SomeReference ref
forall ref. ref -> Old ConstructorId -> SomeReference ref
ConstructorReference ref
r Old ConstructorId
conId)
    getter :: SomeReference ref -> ref
getter = \case
      TermReference ref
r -> ref
r
      TypeReference ref
r -> ref
r
      ConstructorReference ref
r Old ConstructorId
_ -> ref
r

_TermReference :: Prism' (SomeReference ref) ref
_TermReference :: forall ref (p :: * -> * -> *) (f :: * -> *).
(Choice p, Applicative f) =>
p ref (f ref) -> p (SomeReference ref) (f (SomeReference ref))
_TermReference = forall (ctor :: Symbol) s t a b.
AsConstructor ctor s t a b =>
Prism s t a b
_Ctor @"TermReference"

-- | This is only safe as long as you don't change the constructor of your SomeReference
asTermReference_ :: Traversal' ref (SomeReference ref)
asTermReference_ :: forall ref (f :: * -> *).
Applicative f =>
(SomeReference ref -> f (SomeReference ref)) -> ref -> f ref
asTermReference_ SomeReference ref -> f (SomeReference ref)
f ref
ref =
  SomeReference ref -> f (SomeReference ref)
f (ref -> SomeReference ref
forall ref. ref -> SomeReference ref
TermReference ref
ref) f (SomeReference ref) -> (SomeReference ref -> ref) -> f ref
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \case
    TermReference ref
ref' -> ref
ref'
    SomeReference ref
_ -> [Char] -> ref
forall a. HasCallStack => [Char] -> a
error [Char]
"asTermReference_: SomeReferenceId constructor was changed."

-- | This is only safe as long as you don't change the constructor of your SomeReference
asTypeReference_ :: Traversal' ref (SomeReference ref)
asTypeReference_ :: forall ref (f :: * -> *).
Applicative f =>
(SomeReference ref -> f (SomeReference ref)) -> ref -> f ref
asTypeReference_ SomeReference ref -> f (SomeReference ref)
f ref
ref =
  SomeReference ref -> f (SomeReference ref)
f (ref -> SomeReference ref
forall ref. ref -> SomeReference ref
TypeReference ref
ref) f (SomeReference ref) -> (SomeReference ref -> ref) -> f ref
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \case
    TypeReference ref
ref' -> ref
ref'
    SomeReference ref
_ -> [Char] -> ref
forall a. HasCallStack => [Char] -> a
error [Char]
"asTypeReference_: SomeReferenceId constructor was changed."

-- | This is only safe as long as you don't change the constructor of your SomeReference
asConstructorReference_ :: Traversal' (ConstructorReference.GConstructorReference ref) (SomeReference ref)
asConstructorReference_ :: forall ref (f :: * -> *).
Applicative f =>
(SomeReference ref -> f (SomeReference ref))
-> GConstructorReference ref -> f (GConstructorReference ref)
asConstructorReference_ SomeReference ref -> f (SomeReference ref)
f (ConstructorReference.ConstructorReference ref
ref Old ConstructorId
cId) =
  SomeReference ref -> f (SomeReference ref)
f (ref -> Old ConstructorId -> SomeReference ref
forall ref. ref -> Old ConstructorId -> SomeReference ref
ConstructorReference ref
ref Old ConstructorId
cId) f (SomeReference ref)
-> (SomeReference ref -> GConstructorReference ref)
-> f (GConstructorReference ref)
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \case
    ConstructorReference ref
ref' Old ConstructorId
cId -> ref -> Old ConstructorId -> GConstructorReference ref
forall r. r -> Old ConstructorId -> GConstructorReference r
ConstructorReference.ConstructorReference ref
ref' Old ConstructorId
cId
    SomeReference ref
_ -> [Char] -> GConstructorReference ref
forall a. HasCallStack => [Char] -> a
error [Char]
"asConstructorReference_: SomeReferenceId constructor was changed."

someReferenceIdToEntity :: SomeReferenceId -> Entity
someReferenceIdToEntity :: SomeReferenceId -> Entity
someReferenceIdToEntity = \case
  (TermReference Old Id
ref) -> New Hash -> Entity
TermComponent (Old Id -> New Hash
Reference.idToHash Old Id
ref)
  (TypeReference Old Id
ref) -> New Hash -> Entity
DeclComponent (Old Id -> New Hash
Reference.idToHash Old Id
ref)
  -- Constructors are migrated by their decl component.
  (ConstructorReference Old Id
ref Old ConstructorId
_conId) -> New Hash -> Entity
DeclComponent (Old Id -> New Hash
Reference.idToHash Old Id
ref)

foldSetter :: LensLike (Writer [a]) s t a a -> s -> [a]
foldSetter :: forall a s t. LensLike (Writer [a]) s t a a -> s -> [a]
foldSetter LensLike (WriterT [a] Identity) s t a a
t s
s = Writer [a] t -> [a]
forall w a. Monoid w => Writer w a -> w
execWriter (s
s s -> (s -> Writer [a] t) -> Writer [a] t
forall a b. a -> (a -> b) -> b
& LensLike (WriterT [a] Identity) s t a a
t LensLike (WriterT [a] Identity) s t a a
-> LensLike (WriterT [a] Identity) s t a a
forall {k} (f :: k -> *) s (t :: k) a (b :: k).
LensLike f s t a b -> LensLike f s t a b
%%~ \a
a -> [a] -> WriterT [a] Identity ()
forall w (m :: * -> *). (Monoid w, Monad m) => w -> WriterT w m ()
tell [a
a] WriterT [a] Identity ()
-> WriterT [a] Identity a -> WriterT [a] Identity a
forall a b.
WriterT [a] Identity a
-> WriterT [a] Identity b -> WriterT [a] Identity b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> a -> WriterT [a] Identity a
forall a. a -> WriterT [a] Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
a)

-- | Save an empty branch and get its new hash to use when replacing
-- branches which are missing due to database corruption.
saveV2EmptyBranch :: Sqlite.Transaction (BranchHashId, BranchHash)
saveV2EmptyBranch :: Transaction (BranchHashId, BranchHash)
saveV2EmptyBranch = do
  let branch :: Branch' t h p c
branch = Branch' t h p c
forall t h p c. Branch' t h p c
S.emptyBranch
  BranchHash
newHash <- DbBranch -> Transaction BranchHash
Hashing.dbBranchHash DbBranch
forall t h p c. Branch' t h p c
branch
  BranchHashId
newHashId <- BranchHash -> Transaction BranchHashId
Q.saveBranchHash BranchHash
newHash
  -- Stats are empty for the empty branch.
  let emptyStats :: NamespaceStats
emptyStats = Int -> Int -> Int -> NamespaceStats
NamespaceStats Int
0 Int
0 Int
0
  BranchObjectId
_ <- HashHandle
-> BranchHashId
-> NamespaceStats
-> DbBranchV
-> Transaction BranchObjectId
Ops.saveDbBranchUnderHashId HashHandle
v2HashHandle BranchHashId
newHashId NamespaceStats
emptyStats (DbBranch -> DbBranchV
Ops.DbBranchV2 DbBranch
forall t h p c. Branch' t h p c
branch)
  pure (BranchHashId
newHashId, BranchHash
newHash)