{-# LANGUAGE DataKinds #-}
{-# LANGUAGE OverloadedLists #-}
{-# LANGUAGE QuasiQuotes #-}

module Unison.Codebase.SqliteCodebase.Migrations.MigrateSchema6To7 (migrateSchema6To7) where

import Control.Monad.State
import U.Codebase.Branch.Type (NamespaceStats)
import U.Codebase.Sqlite.DbId qualified as DB
import U.Codebase.Sqlite.DbId qualified as Db
import U.Codebase.Sqlite.Operations qualified as Ops
import U.Codebase.Sqlite.Queries qualified as Q
import U.Codebase.Sync qualified as Sync
import Unison.Debug qualified as Debug
import Unison.Sqlite qualified as Sqlite

-- | Adds a table for tracking namespace statistics
-- Adds stats for all existing namespaces, even though missing stats are computed on-demand if missing.
migrateSchema6To7 :: Sqlite.Transaction ()
migrateSchema6To7 :: Transaction ()
migrateSchema6To7 = do
  SchemaVersion -> Transaction ()
Q.expectSchemaVersion SchemaVersion
6
  Transaction ()
Q.addNamespaceStatsTables
  Transaction ()
addStatsToAllNamespaces
  SchemaVersion -> Transaction ()
Q.setSchemaVersion SchemaVersion
7

addStatsToAllNamespaces :: Sqlite.Transaction ()
addStatsToAllNamespaces :: Transaction ()
addStatsToAllNamespaces = do
  Int
totalToMigrate <-
    Sql -> Transaction Int
forall a. (FromField a, HasCallStack) => Sql -> Transaction a
Sqlite.queryOneCol
      [Sqlite.sql|
        SELECT COUNT(*)
          FROM object
          WHERE type_id = 2
      |]
  [BranchObjectId]
allBranchObjIds <-
    Sql -> Transaction [BranchObjectId]
forall a. (FromField a, HasCallStack) => Sql -> Transaction [a]
Sqlite.queryListCol
      [Sqlite.sql|
        SELECT id
          FROM object
          WHERE type_id = 2
      |]
  ((), Int)
_ <- (StateT Int Transaction () -> Int -> Transaction ((), Int))
-> Int -> StateT Int Transaction () -> Transaction ((), Int)
forall a b c. (a -> b -> c) -> b -> a -> c
flip StateT Int Transaction () -> Int -> Transaction ((), Int)
forall s (m :: * -> *) a. StateT s m a -> s -> m (a, s)
runStateT Int
0 (StateT Int Transaction () -> Transaction ((), Int))
-> StateT Int Transaction () -> Transaction ((), Int)
forall a b. (a -> b) -> a -> b
$ Sync (StateT Int Transaction) BranchObjectId
-> Progress (StateT Int Transaction) BranchObjectId
-> [BranchObjectId]
-> StateT Int Transaction ()
forall (m :: * -> *) h.
(Monad m, Show h) =>
Sync m h -> Progress m h -> [h] -> m ()
Sync.sync Sync (StateT Int Transaction) BranchObjectId
migrationSync (Int -> Progress (StateT Int Transaction) BranchObjectId
migrationProgress Int
totalToMigrate) [BranchObjectId]
allBranchObjIds
  pure ()

migrationSync :: Sync.Sync (StateT Int Sqlite.Transaction) DB.BranchObjectId
migrationSync :: Sync (StateT Int Transaction) BranchObjectId
migrationSync =
  (BranchObjectId
 -> StateT Int Transaction (TrySyncResult BranchObjectId))
-> Sync (StateT Int Transaction) BranchObjectId
forall (m :: * -> *) entity.
(entity -> m (TrySyncResult entity)) -> Sync m entity
Sync.Sync (Transaction (TrySyncResult BranchObjectId)
-> StateT Int Transaction (TrySyncResult BranchObjectId)
forall (m :: * -> *) a. Monad m => m a -> StateT Int m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (Transaction (TrySyncResult BranchObjectId)
 -> StateT Int Transaction (TrySyncResult BranchObjectId))
-> (BranchObjectId -> Transaction (TrySyncResult BranchObjectId))
-> BranchObjectId
-> StateT Int Transaction (TrySyncResult BranchObjectId)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BranchObjectId -> Transaction (TrySyncResult BranchObjectId)
addStatsForBranch)

addStatsForBranch :: DB.BranchObjectId -> Sqlite.Transaction (Sync.TrySyncResult DB.BranchObjectId)
addStatsForBranch :: BranchObjectId -> Transaction (TrySyncResult BranchObjectId)
addStatsForBranch BranchObjectId
boId = do
  BranchHashId
bhId <- HashId -> BranchHashId
Db.BranchHashId (HashId -> BranchHashId)
-> Transaction HashId -> Transaction BranchHashId
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ObjectId -> Transaction HashId
Q.expectPrimaryHashIdForObject (BranchObjectId -> ObjectId
Db.unBranchObjectId BranchObjectId
boId)
  -- "expectNamespaceStatsByHashId" computes stats if they are missing.
  NamespaceStats
_ :: NamespaceStats <- BranchHashId -> Transaction NamespaceStats
Ops.expectNamespaceStatsByHashId BranchHashId
bhId
  pure TrySyncResult BranchObjectId
forall entity. TrySyncResult entity
Sync.Done

debugLog :: String -> Sqlite.Transaction ()
debugLog :: String -> Transaction ()
debugLog = DebugFlag -> Transaction () -> Transaction ()
forall (m :: * -> *). Monad m => DebugFlag -> m () -> m ()
Debug.whenDebug DebugFlag
Debug.Migration (Transaction () -> Transaction ())
-> (String -> Transaction ()) -> String -> Transaction ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IO () -> Transaction ()
forall a. HasCallStack => IO a -> Transaction a
Sqlite.unsafeIO (IO () -> Transaction ())
-> (String -> IO ()) -> String -> Transaction ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> IO ()
putStrLn

migrationProgress :: Int -> Sync.Progress (StateT Int Sqlite.Transaction) DB.BranchObjectId
migrationProgress :: Int -> Progress (StateT Int Transaction) BranchObjectId
migrationProgress Int
totalBranches =
  Sync.Progress {BranchObjectId -> StateT Int Transaction ()
forall {t :: (* -> *) -> * -> *} {a}.
(MonadTrans t, Show a) =>
a -> t Transaction ()
need :: forall {t :: (* -> *) -> * -> *} {a}.
(MonadTrans t, Show a) =>
a -> t Transaction ()
need :: BranchObjectId -> StateT Int Transaction ()
Sync.need, BranchObjectId -> StateT Int Transaction ()
done :: BranchObjectId -> StateT Int Transaction ()
done :: BranchObjectId -> StateT Int Transaction ()
Sync.done, BranchObjectId -> StateT Int Transaction ()
forall {t :: (* -> *) -> * -> *} {a}.
(MonadTrans t, Show a) =>
a -> t Transaction ()
error :: forall {t :: (* -> *) -> * -> *} {a}.
(MonadTrans t, Show a) =>
a -> t Transaction ()
error :: BranchObjectId -> StateT Int Transaction ()
Sync.error, StateT Int Transaction ()
allDone :: StateT Int Transaction ()
allDone :: StateT Int Transaction ()
Sync.allDone}
  where
    need :: a -> t Transaction ()
need a
e = Transaction () -> t Transaction ()
forall (m :: * -> *) a. Monad m => m a -> t m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (Transaction () -> t Transaction ())
-> Transaction () -> t Transaction ()
forall a b. (a -> b) -> a -> b
$ String -> Transaction ()
debugLog (String -> Transaction ()) -> String -> Transaction ()
forall a b. (a -> b) -> a -> b
$ String
"Need " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> a -> String
forall a. Show a => a -> String
show a
e
    done :: BranchObjectId -> StateT Int Transaction ()
done BranchObjectId
_ =
      do
        (Int -> Int) -> StateT Int Transaction ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify Int -> Int
forall a. Enum a => a -> a
succ
        Int
numDone <- StateT Int Transaction Int
forall s (m :: * -> *). MonadState s m => m s
get
        Transaction () -> StateT Int Transaction ()
forall (m :: * -> *) a. Monad m => m a -> StateT Int m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (Transaction () -> StateT Int Transaction ())
-> Transaction () -> StateT Int 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
$ String -> IO ()
putStr (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String
"\r🏗  " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Int -> String
forall a. Show a => a -> String
show Int
numDone String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
" / ~" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Int -> String
forall a. Show a => a -> String
show Int
totalBranches String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
" entities migrated. 🚧"
    error :: a -> t Transaction ()
error a
e = Transaction () -> t Transaction ()
forall (m :: * -> *) a. Monad m => m a -> t m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (Transaction () -> t Transaction ())
-> (String -> Transaction ()) -> String -> t Transaction ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IO () -> Transaction ()
forall a. HasCallStack => IO a -> Transaction a
Sqlite.unsafeIO (IO () -> Transaction ())
-> (String -> IO ()) -> String -> Transaction ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> IO ()
putStrLn (String -> t Transaction ()) -> String -> t Transaction ()
forall a b. (a -> b) -> a -> b
$ String
"Error " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> a -> String
forall a. Show a => a -> String
show a
e
    allDone :: StateT Int Transaction ()
allDone = Transaction () -> StateT Int Transaction ()
forall (m :: * -> *) a. Monad m => m a -> StateT Int m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift do
      -- In some corrupted codebases we don't necessarily process every causal, or there may
      -- be unreachable causals. We'll show the final number here just so everything looks
      -- good to users. It's okay since we'll process the other branches and clean them up in
      -- a batch step.
      IO () -> Transaction ()
forall a. HasCallStack => IO a -> Transaction a
Sqlite.unsafeIO (IO () -> Transaction ()) -> IO () -> Transaction ()
forall a b. (a -> b) -> a -> b
$ String -> IO ()
putStrLn (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String
"\r🏗  " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Int -> String
forall a. Show a => a -> String
show Int
totalBranches String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
" / ~" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Int -> String
forall a. Show a => a -> String
show Int
totalBranches String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
" entities migrated. 🚧"
      IO () -> Transaction ()
forall a. HasCallStack => IO a -> Transaction a
Sqlite.unsafeIO (IO () -> Transaction ())
-> (String -> IO ()) -> String -> Transaction ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> IO ()
putStrLn (String -> Transaction ()) -> String -> Transaction ()
forall a b. (a -> b) -> a -> b
$ String
"Finished."