-- | 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 ->
      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)
loadUniqueTypeGuidFromUpdateParent Name
name CausalHashId
parentCausalHashId
        Maybe CausalHashId
Nothing ->
          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
            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
            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

loadUniqueTypeGuidFromUpdateParent :: Name -> Sqlite.CausalHashId -> Sqlite.Transaction (Maybe Text)
loadUniqueTypeGuidFromUpdateParent :: Name -> CausalHashId -> Transaction (Maybe Text)
loadUniqueTypeGuidFromUpdateParent Name
name CausalHashId
causalHashId = do
  BranchHashId
namespaceHashId <- CausalHashId -> Transaction BranchHashId
Queries.expectCausalValueHashId CausalHashId
causalHashId
  BranchHashId -> Name -> Transaction (Maybe Text)
Queries.loadNamespaceUniqueTypeGuid BranchHashId
namespaceHashId Name
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
  BranchHashId
aliceNamespaceHashId <- CausalHashId -> Transaction BranchHashId
Queries.expectCausalValueHashId CausalHashId
aliceCausalHashId
  BranchHashId
bobNamespaceHashId <- CausalHashId -> Transaction BranchHashId
Queries.expectCausalValueHashId CausalHashId
bobCausalHashId

  Maybe Text
maybeAliceGuid <- BranchHashId -> Name -> Transaction (Maybe Text)
Queries.loadNamespaceUniqueTypeGuid BranchHashId
aliceNamespaceHashId Name
name
  Maybe Text
maybeBobGuid <- BranchHashId -> Name -> Transaction (Maybe Text)
Queries.loadNamespaceUniqueTypeGuid BranchHashId
bobNamespaceHashId Name
name

  case (Maybe Text
maybeAliceGuid, Maybe Text
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
          Maybe ProjectBranchId
aliceParentBranchId <- ProjectId -> ProjectBranchId -> Transaction (Maybe ProjectBranchId)
Queries.loadProjectBranchParent ProjectPath
pp.project.projectId ProjectBranchId
aliceBranchId
          if Maybe ProjectBranchId
aliceParentBranchId Maybe ProjectBranchId -> Maybe ProjectBranchId -> Bool
forall a. Eq a => a -> a -> Bool
== ProjectBranchId -> Maybe ProjectBranchId
forall a. a -> Maybe a
Just ProjectBranchId
bobBranchId
            then 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)
            else do
              Maybe ProjectBranchId
bobParentBranchId <- ProjectId -> ProjectBranchId -> Transaction (Maybe ProjectBranchId)
Queries.loadProjectBranchParent ProjectPath
pp.project.projectId ProjectBranchId
bobBranchId
              Maybe Text -> Transaction (Maybe Text)
forall a. a -> Transaction a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
                if Maybe ProjectBranchId
bobParentBranchId Maybe ProjectBranchId -> Maybe ProjectBranchId -> Bool
forall a. Eq a => a -> a -> Bool
== ProjectBranchId -> Maybe ProjectBranchId
forall a. a -> Maybe a
Just ProjectBranchId
aliceBranchId
                  then Text -> Maybe Text
forall a. a -> Maybe a
Just Text
aliceGuid
                  else Maybe Text
forall a. Maybe a
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