-- | 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.Codebase.UniqueTypeGuidLookup
  ( loadUniqueTypeGuid,
  )
where

import Data.Map.Strict qualified as Map
import U.Codebase.Branch qualified as Codebase.Branch
import U.Codebase.Decl qualified as Codebase.Decl
import U.Codebase.Reference qualified as Codebase.Reference
import U.Codebase.Sqlite.Operations qualified as Operations
import Unison.Codebase.ProjectPath (ProjectPath)
import Unison.NameSegment (NameSegment)
import Unison.Prelude
import Unison.Sqlite qualified as Sqlite
import Witherable (witherM)

-- | @loadUniqueTypeGuid loadNamespaceAtPath path name@ looks up the GUID associated with the unique type named @name@
-- at child namespace @path@ in the root namespace. If there are multiple such types, an arbitrary one is chosen.
--
-- For (potential) efficiency, this function accepts an argument that loads a namespace at a path, which may be backed
-- by a cache.
loadUniqueTypeGuid ::
  (ProjectPath -> Sqlite.Transaction (Maybe (Codebase.Branch.Branch Sqlite.Transaction))) ->
  ProjectPath ->
  NameSegment ->
  Sqlite.Transaction (Maybe Text)
loadUniqueTypeGuid :: (ProjectPath -> Transaction (Maybe (Branch Transaction)))
-> ProjectPath -> NameSegment -> Transaction (Maybe Text)
loadUniqueTypeGuid ProjectPath -> Transaction (Maybe (Branch Transaction))
loadNamespaceAtPath ProjectPath
path NameSegment
name =
  ProjectPath -> Transaction (Maybe (Branch Transaction))
loadNamespaceAtPath ProjectPath
path Transaction (Maybe (Branch Transaction))
-> (Maybe (Branch Transaction) -> 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 (Branch Transaction)
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 Branch Transaction
branch ->
      case NameSegment
-> Map NameSegment (Map Reference (Transaction MdValues))
-> Maybe (Map Reference (Transaction MdValues))
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup NameSegment
name (Branch Transaction
-> Map NameSegment (Map Reference (Transaction MdValues))
forall (m :: * -> *).
Branch m -> Map NameSegment (Map Reference (m MdValues))
Codebase.Branch.types Branch Transaction
branch) of
        Maybe (Map Reference (Transaction MdValues))
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 Map Reference (Transaction MdValues)
refs0 -> do
          [Text]
guids <-
            Map Reference (Transaction MdValues) -> [Reference]
forall k a. Map k a -> [k]
Map.keys Map Reference (Transaction MdValues)
refs0 [Reference]
-> ([Reference] -> Transaction [Text]) -> Transaction [Text]
forall a b. a -> (a -> b) -> b
& (Reference -> Transaction (Maybe Text))
-> [Reference] -> Transaction [Text]
forall (t :: * -> *) (m :: * -> *) a b.
(Witherable t, Monad m) =>
(a -> m (Maybe b)) -> t a -> m (t b)
forall (m :: * -> *) a b.
Monad m =>
(a -> m (Maybe b)) -> [a] -> m [b]
witherM \case
              Codebase.Reference.ReferenceBuiltin Text
_ -> 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
              Codebase.Reference.ReferenceDerived Id' Hash
id -> do
                Decl Symbol
decl <- Id' Hash -> Transaction (Decl Symbol)
Operations.expectDeclByReference Id' Hash
id
                pure case Decl Symbol -> Modifier
forall r v. DeclR r v -> Modifier
Codebase.Decl.modifier Decl Symbol
decl of
                  Modifier
Codebase.Decl.Structural -> Maybe Text
forall a. Maybe a
Nothing
                  Codebase.Decl.Unique Text
guid -> Text -> Maybe Text
forall a. a -> Maybe a
Just Text
guid
          pure case [Text]
guids of
            [] -> Maybe Text
forall a. Maybe a
Nothing
            Text
guid : [Text]
_ -> Text -> Maybe Text
forall a. a -> Maybe a
Just Text
guid