{-# 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 ::
(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
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
{ MigrationState -> Map SomeReferenceId SomeReferenceId
referenceMapping :: Map (Old SomeReferenceId) (New SomeReferenceId),
MigrationState -> Map CausalHashId (New (CausalHash, CausalHashId))
causalMapping :: Map (Old CausalHashId) (New (CausalHash, CausalHashId)),
MigrationState
-> Map ObjectId (ObjectId, HashId, New Hash, New Hash)
objLookup :: Map (Old ObjectId) (New ObjectId, New HashId, New Hash, Old Hash),
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 ::
(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
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
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
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
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
migrateWatch ::
(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
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
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
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_
((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 ::
(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
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
((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))
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
(((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
((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
((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_
(([(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
(((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
((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
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_
((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_
((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
((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_
((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_
((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
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"
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."
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."
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)
(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)
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
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)