-- | This module contains functionality related to computing a "unique type guid lookup" function, which resolves a
-- name to a unique type's GUID to reuse.
module Unison.Cli.UniqueTypeGuidLookup
  ( loadUniqueTypeGuid,
  )
where

import U.Codebase.Branch qualified as Codebase.Branch
import U.Codebase.Sqlite.DbId qualified as Sqlite
import U.Codebase.Sqlite.Queries qualified as Queries
import Unison.Codebase qualified as Codebase
import Unison.Codebase.Path qualified as Path
import Unison.Codebase.ProjectPath (ProjectPath)
import Unison.Codebase.ProjectPath qualified as PP
import Unison.Codebase.UniqueTypeGuidLookup qualified as Codebase
import Unison.Name (Name)
import Unison.Prelude
import Unison.Sqlite qualified as Sqlite

loadUniqueTypeGuid :: ProjectPath -> Name -> Sqlite.Transaction (Maybe Text)
loadUniqueTypeGuid :: ProjectPath -> Name -> Transaction (Maybe Text)
loadUniqueTypeGuid ProjectPath
pp Name
name = do
  let (Path
namePath, NameSegment
finalSegment) = Name -> (Path, NameSegment)
Path.splitFromName Name
name
  let fullPP :: ProjectPath
fullPP = ProjectPath
pp ProjectPath -> (ProjectPath -> ProjectPath) -> ProjectPath
forall a b. a -> (a -> b) -> b
& ASetter ProjectPath ProjectPath Path Path
-> (Path -> Path) -> ProjectPath -> ProjectPath
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over ASetter ProjectPath ProjectPath Path Path
forall p b (f :: * -> *).
Functor f =>
(Path -> f Path) -> ProjectPathG p b -> f (ProjectPathG p b)
PP.path_ (Path -> Path -> Path
forall a. Semigroup a => a -> a -> a
<> Path
namePath)

  -- Define an operation to load a branch by its full path from the root namespace.
  --
  -- This ought to probably lean somewhat on a cache (so long as the caller is aware of the cache, and discrads it at
  -- an appropriate time, such as after the current unison file finishes parsing).
  let loadBranchAtPath :: ProjectPath -> Sqlite.Transaction (Maybe (Codebase.Branch.Branch Sqlite.Transaction))
      loadBranchAtPath :: ProjectPath -> Transaction (Maybe (Branch Transaction))
loadBranchAtPath = ProjectPath -> Transaction (Maybe (Branch Transaction))
Codebase.getMaybeShallowBranchAtProjectPath

  (ProjectPath -> Transaction (Maybe (Branch Transaction)))
-> ProjectPath -> NameSegment -> Transaction (Maybe Text)
Codebase.loadUniqueTypeGuid ProjectPath -> Transaction (Maybe (Branch Transaction))
loadBranchAtPath ProjectPath
fullPP NameSegment
finalSegment Transaction (Maybe Text)
-> (Maybe Text -> Transaction (Maybe Text))
-> Transaction (Maybe Text)
forall a b. Transaction a -> (a -> Transaction b) -> Transaction b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    Just Text
guid -> Maybe Text -> Transaction (Maybe Text)
forall a. a -> Transaction a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
guid)
    Maybe Text
Nothing
      | ProjectPath
pp.branch.isUpdate ->
          ProjectId -> ProjectBranchId -> Transaction (Maybe CausalHashId)
Queries.loadUpdateBranchParentCausalHashId ProjectPath
pp.project.projectId ProjectPath
pp.branch.branchId Transaction (Maybe CausalHashId)
-> (Maybe CausalHashId -> Transaction (Maybe Text))
-> Transaction (Maybe Text)
forall a b. Transaction a -> (a -> Transaction b) -> Transaction b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
            Just CausalHashId
parentCausalHashId -> Name -> CausalHashId -> Transaction (Maybe Text)
loadUniqueTypeGuidFromParent Name
name CausalHashId
parentCausalHashId
            Maybe CausalHashId
Nothing -> Maybe Text -> Transaction (Maybe Text)
forall a. a -> Transaction a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe Text
forall a. Maybe a
Nothing
      | ProjectPath
pp.branch.isUpgrade ->
          ProjectId -> ProjectBranchId -> Transaction (Maybe CausalHashId)
Queries.loadUpgradeBranchParentCausalHashId ProjectPath
pp.project.projectId ProjectPath
pp.branch.branchId Transaction (Maybe CausalHashId)
-> (Maybe CausalHashId -> Transaction (Maybe Text))
-> Transaction (Maybe Text)
forall a b. Transaction a -> (a -> Transaction b) -> Transaction b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
            Just CausalHashId
parentCausalHashId -> Name -> CausalHashId -> Transaction (Maybe Text)
loadUniqueTypeGuidFromParent Name
name CausalHashId
parentCausalHashId
            Maybe CausalHashId
Nothing -> Maybe Text -> Transaction (Maybe Text)
forall a. a -> Transaction a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe Text
forall a. Maybe a
Nothing
      | ProjectPath
pp.branch.isMerge ->
          ProjectId
-> ProjectBranchId
-> Transaction
     (Maybe
        (Maybe ProjectBranchId, CausalHashId, Maybe ProjectBranchId,
         CausalHashId))
Queries.loadMergeBranchParents ProjectPath
pp.project.projectId ProjectPath
pp.branch.branchId Transaction
  (Maybe
     (Maybe ProjectBranchId, CausalHashId, Maybe ProjectBranchId,
      CausalHashId))
-> (Maybe
      (Maybe ProjectBranchId, CausalHashId, Maybe ProjectBranchId,
       CausalHashId)
    -> Transaction (Maybe Text))
-> Transaction (Maybe Text)
forall a b. Transaction a -> (a -> Transaction b) -> Transaction b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
            Just (Maybe ProjectBranchId
bobMaybeBranchId, CausalHashId
bobCausalHashId, Maybe ProjectBranchId
aliceMaybeBranchId, CausalHashId
aliceCausalHashId) ->
              ProjectPath
-> Name
-> Maybe ProjectBranchId
-> CausalHashId
-> Maybe ProjectBranchId
-> CausalHashId
-> Transaction (Maybe Text)
loadUniqueTypeGuidFromMergeParents
                ProjectPath
pp
                Name
name
                Maybe ProjectBranchId
bobMaybeBranchId
                CausalHashId
bobCausalHashId
                Maybe ProjectBranchId
aliceMaybeBranchId
                CausalHashId
aliceCausalHashId
            Maybe
  (Maybe ProjectBranchId, CausalHashId, Maybe ProjectBranchId,
   CausalHashId)
Nothing -> Maybe Text -> Transaction (Maybe Text)
forall a. a -> Transaction a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe Text
forall a. Maybe a
Nothing
      | Bool
otherwise -> Maybe Text -> Transaction (Maybe Text)
forall a. a -> Transaction a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe Text
forall a. Maybe a
Nothing

-- update or upgrade parent
loadUniqueTypeGuidFromParent :: Name -> Sqlite.CausalHashId -> Sqlite.Transaction (Maybe Text)
loadUniqueTypeGuidFromParent :: Name -> CausalHashId -> Transaction (Maybe Text)
loadUniqueTypeGuidFromParent Name
name CausalHashId
causalHashId = do
  namespaceHashId <- CausalHashId -> Transaction BranchHashId
Queries.expectCausalValueHashId CausalHashId
causalHashId
  Queries.loadNamespaceUniqueTypeGuid namespaceHashId name

loadUniqueTypeGuidFromMergeParents ::
  ProjectPath ->
  Name ->
  Maybe Sqlite.ProjectBranchId ->
  Sqlite.CausalHashId ->
  Maybe Sqlite.ProjectBranchId ->
  Sqlite.CausalHashId ->
  Sqlite.Transaction (Maybe Text)
loadUniqueTypeGuidFromMergeParents :: ProjectPath
-> Name
-> Maybe ProjectBranchId
-> CausalHashId
-> Maybe ProjectBranchId
-> CausalHashId
-> Transaction (Maybe Text)
loadUniqueTypeGuidFromMergeParents ProjectPath
pp Name
name Maybe ProjectBranchId
bobMaybeBranchId CausalHashId
bobCausalHashId Maybe ProjectBranchId
aliceMaybeBranchId CausalHashId
aliceCausalHashId = do
  aliceNamespaceHashId <- CausalHashId -> Transaction BranchHashId
Queries.expectCausalValueHashId CausalHashId
aliceCausalHashId
  bobNamespaceHashId <- Queries.expectCausalValueHashId bobCausalHashId

  maybeAliceGuid <- Queries.loadNamespaceUniqueTypeGuid aliceNamespaceHashId name
  maybeBobGuid <- Queries.loadNamespaceUniqueTypeGuid bobNamespaceHashId name

  case (maybeAliceGuid, maybeBobGuid) of
    -- A few simple cases – reuse a GUID if it is sensible to do so
    (Just Text
aliceGuid, Just Text
bobGuid) | Text
aliceGuid Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
bobGuid -> Maybe Text -> Transaction (Maybe Text)
forall a. a -> Transaction a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
aliceGuid)
    (Just Text
aliceGuid, Maybe Text
Nothing) -> Maybe Text -> Transaction (Maybe Text)
forall a. a -> Transaction a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
aliceGuid)
    (Maybe Text
Nothing, Just Text
bobGuid) -> Maybe Text -> Transaction (Maybe Text)
forall a. a -> Transaction a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
bobGuid)
    (Maybe Text
Nothing, Maybe Text
Nothing) -> Maybe Text -> Transaction (Maybe Text)
forall a. a -> Transaction a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe Text
forall a. Maybe a
Nothing
    -- If alice and bob have different guids, and there is a parent-child relationship between them (i.e. alice was
    -- directly branched off of bob or vice versa), then prefer the parent's GUID. Otherwise, just make up a new
    -- GUID because it's not clear whether alice's or bob's should be preferred.
    (Just Text
aliceGuid, Just Text
bobGuid) -> do
      case (Maybe ProjectBranchId
aliceMaybeBranchId, Maybe ProjectBranchId
bobMaybeBranchId) of
        (Just ProjectBranchId
aliceBranchId, Just ProjectBranchId
bobBranchId) -> do
          aliceParentBranchId <- ProjectId -> ProjectBranchId -> Transaction (Maybe ProjectBranchId)
Queries.loadProjectBranchParent ProjectPath
pp.project.projectId ProjectBranchId
aliceBranchId
          if aliceParentBranchId == Just bobBranchId
            then pure (Just bobGuid)
            else do
              bobParentBranchId <- Queries.loadProjectBranchParent pp.project.projectId bobBranchId
              pure
                if bobParentBranchId == Just aliceBranchId
                  then Just aliceGuid
                  else Nothing
        (Maybe ProjectBranchId, Maybe ProjectBranchId)
_ -> Maybe Text -> Transaction (Maybe Text)
forall a. a -> Transaction a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe Text
forall a. Maybe a
Nothing