module Unison.Type.Names
  ( bindNames,
  )
where

import Data.Sequence qualified as Seq
import Data.Set qualified as Set
import Unison.ABT qualified as ABT
import Unison.HashQualified qualified as HQ
import Unison.Name (Name)
import Unison.Names (Names)
import Unison.Names qualified as Names
import Unison.Names.ResolutionResult qualified as Names
import Unison.Names.ResolvesTo (ResolvesTo (..), partitionResolutions)
import Unison.Prelude
import Unison.Reference (TypeReference)
import Unison.Type
import Unison.Type qualified as Type
import Unison.Util.List qualified as List
import Unison.Var (Var)

bindNames ::
  forall a v.
  (Var v) =>
  (v -> Name) ->
  (Name -> v) ->
  Set v ->
  Names ->
  Type v a ->
  Names.ResolutionResult a (Type v a)
bindNames :: forall a v.
Var v =>
(v -> Name)
-> (Name -> v)
-> Set v
-> Names
-> Type v a
-> ResolutionResult a (Type v a)
bindNames v -> Name
unsafeVarToName Name -> v
nameToVar Set v
localVars Names
namespace =
  -- type is bound here because the where-clause binds a data structure that we only want to compute once, then share
  -- across all calls to `bindNames` with different types
  \Type v a
ty ->
    let -- Identify the unresolved variables in the type: those whose names aren't an *exact* match for some locally-bound
        -- type.
        --
        -- For example:
        --
        --   type Foo.Bar = ...
        --   type Baz.Qux = ...
        --   type Whatever = Whatever Foo.Bar Qux
        --                            ^^^^^^^ ^^^
        --                               |    this variable *is* unresolved: it doesn't match any locally-bound type exactly
        --                               |
        --                            this variable is *not* unresolved: it matches locally-bound `Foo.Bar` exactly
        unresolvedVars :: [(v, a)]
        unresolvedVars :: [(v, a)]
unresolvedVars =
          Set v -> Type v a -> [(v, a)]
forall (f :: * -> *) v a.
(Traversable f, Ord v) =>
Set v -> Term f v a -> [(v, a)]
ABT.freeVarOccurrences Set v
localVars Type v a
ty

        okTy :: (v, a) -> Names.ResolutionResult a (v, ResolvesTo TypeReference)
        okTy :: (v, a) -> ResolutionResult a (v, ResolvesTo TypeReference)
okTy (v
v, a
a) =
          case Set (ResolvesTo TypeReference) -> Int
forall a. Set a -> Int
Set.size Set (ResolvesTo TypeReference)
matches of
            Int
1 -> ResolvesTo TypeReference
-> ResolutionResult a (v, ResolvesTo TypeReference)
good (Set (ResolvesTo TypeReference) -> ResolvesTo TypeReference
forall a. Set a -> a
Set.findMin Set (ResolvesTo TypeReference)
matches)
            Int
0 -> ResolutionError TypeReference
-> ResolutionResult a (v, ResolvesTo TypeReference)
bad ResolutionError TypeReference
forall ref. ResolutionError ref
Names.NotFound
            Int
_ ->
              let (Set TypeReference
namespaceMatches, Set Name
localMatches) =
                    Set (ResolvesTo TypeReference)
matches
                      Set (ResolvesTo TypeReference)
-> (Set (ResolvesTo TypeReference) -> [ResolvesTo TypeReference])
-> [ResolvesTo TypeReference]
forall a b. a -> (a -> b) -> b
& Set (ResolvesTo TypeReference) -> [ResolvesTo TypeReference]
forall a. Set a -> [a]
Set.toList
                      [ResolvesTo TypeReference]
-> ([ResolvesTo TypeReference] -> [Either TypeReference Name])
-> [Either TypeReference Name]
forall a b. a -> (a -> b) -> b
& (ResolvesTo TypeReference -> Either TypeReference Name)
-> [ResolvesTo TypeReference] -> [Either TypeReference Name]
forall a b. (a -> b) -> [a] -> [b]
map \case
                        ResolvesToNamespace TypeReference
ref -> TypeReference -> Either TypeReference Name
forall a b. a -> Either a b
Left TypeReference
ref
                        ResolvesToLocal Name
name -> Name -> Either TypeReference Name
forall a b. b -> Either a b
Right Name
name
                      [Either TypeReference Name]
-> ([Either TypeReference Name] -> ([TypeReference], [Name]))
-> ([TypeReference], [Name])
forall a b. a -> (a -> b) -> b
& [Either TypeReference Name] -> ([TypeReference], [Name])
forall a b. [Either a b] -> ([a], [b])
partitionEithers
                      ([TypeReference], [Name])
-> (([TypeReference], [Name]) -> (Set TypeReference, Set Name))
-> (Set TypeReference, Set Name)
forall a b. a -> (a -> b) -> b
& ([TypeReference] -> Set TypeReference)
-> ([Name] -> Set Name)
-> ([TypeReference], [Name])
-> (Set TypeReference, Set Name)
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 [TypeReference] -> Set TypeReference
forall a. Ord a => [a] -> Set a
Set.fromList [Name] -> Set Name
forall a. Ord a => [a] -> Set a
Set.fromList
               in ResolutionError TypeReference
-> ResolutionResult a (v, ResolvesTo TypeReference)
bad (Names
-> Set TypeReference -> Set Name -> ResolutionError TypeReference
forall ref. Names -> Set ref -> Set Name -> ResolutionError ref
Names.Ambiguous Names
namespace Set TypeReference
namespaceMatches Set Name
localMatches)
          where
            matches :: Set (ResolvesTo TypeReference)
            matches :: Set (ResolvesTo TypeReference)
matches =
              Name -> Set (ResolvesTo TypeReference)
resolveTypeName (v -> Name
unsafeVarToName v
v)

            bad :: ResolutionError TypeReference
-> ResolutionResult a (v, ResolvesTo TypeReference)
bad = Seq (ResolutionFailure a)
-> ResolutionResult a (v, ResolvesTo TypeReference)
forall a b. a -> Either a b
Left (Seq (ResolutionFailure a)
 -> ResolutionResult a (v, ResolvesTo TypeReference))
-> (ResolutionError TypeReference -> Seq (ResolutionFailure a))
-> ResolutionError TypeReference
-> ResolutionResult a (v, ResolvesTo TypeReference)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ResolutionFailure a -> Seq (ResolutionFailure a)
forall a. a -> Seq a
Seq.singleton (ResolutionFailure a -> Seq (ResolutionFailure a))
-> (ResolutionError TypeReference -> ResolutionFailure a)
-> ResolutionError TypeReference
-> Seq (ResolutionFailure a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HashQualified Name
-> a -> ResolutionError TypeReference -> ResolutionFailure a
forall annotation.
HashQualified Name
-> annotation
-> ResolutionError TypeReference
-> ResolutionFailure annotation
Names.TypeResolutionFailure (Name -> HashQualified Name
forall n. n -> HashQualified n
HQ.NameOnly (v -> Name
unsafeVarToName v
v)) a
a
            good :: ResolvesTo TypeReference
-> ResolutionResult a (v, ResolvesTo TypeReference)
good = (v, ResolvesTo TypeReference)
-> ResolutionResult a (v, ResolvesTo TypeReference)
forall a b. b -> Either a b
Right ((v, ResolvesTo TypeReference)
 -> ResolutionResult a (v, ResolvesTo TypeReference))
-> (ResolvesTo TypeReference -> (v, ResolvesTo TypeReference))
-> ResolvesTo TypeReference
-> ResolutionResult a (v, ResolvesTo TypeReference)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (v
v,)
     in ((v, a) -> ResolutionResult a (v, ResolvesTo TypeReference))
-> [(v, a)]
-> Either
     (Seq (ResolutionFailure a)) [(v, ResolvesTo TypeReference)]
forall e (f :: * -> *) a b.
(Semigroup e, Foldable f) =>
(a -> Either e b) -> f a -> Either e [b]
List.validate (v, a) -> ResolutionResult a (v, ResolvesTo TypeReference)
okTy [(v, a)]
unresolvedVars Either (Seq (ResolutionFailure a)) [(v, ResolvesTo TypeReference)]
-> ([(v, ResolvesTo TypeReference)] -> Type v a)
-> ResolutionResult a (Type v a)
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \[(v, ResolvesTo TypeReference)]
resolutions ->
          let ([(v, TypeReference)]
namespaceResolutions, [(v, Name)]
localResolutions) = [(v, ResolvesTo TypeReference)]
-> ([(v, TypeReference)], [(v, Name)])
forall v ref. [(v, ResolvesTo ref)] -> ([(v, ref)], [(v, Name)])
partitionResolutions [(v, ResolvesTo TypeReference)]
resolutions
           in Type v a
ty
                -- Apply namespace resolutions (replacing "Foo" with #Foo where "Foo" refers to namespace)
                Type v a -> (Type v a -> Type v a) -> Type v a
forall a b. a -> (a -> b) -> b
& [(v, TypeReference)] -> Type v a -> Type v a
forall v a. Var v => [(v, TypeReference)] -> Type v a -> Type v a
bindExternal [(v, TypeReference)]
namespaceResolutions
                -- Apply local resolutions (replacing "Foo" with "Full.Name.Foo" where "Full.Name.Foo" is in local vars)
                Type v a -> (Type v a -> Type v a) -> Type v a
forall a b. a -> (a -> b) -> b
& [(v, Term F v ())] -> Type v a -> Type v a
forall (f :: * -> *) v b a.
(Foldable f, Functor f, Var v) =>
[(v, Term f v b)] -> Term f v a -> Term f v a
ABT.substsInheritAnnotation [(v
v, () -> v -> Term F v ()
forall v a. Ord v => a -> v -> Type v a
Type.var () (Name -> v
nameToVar Name
name)) | (v
v, Name
name) <- [(v, Name)]
localResolutions]
                -- Clean up ability lists again – we might have something to de-dupe after resolution
                Type v a -> (Type v a -> Type v a) -> Type v a
forall a b. a -> (a -> b) -> b
& Type v a -> Type v a
forall v a. Var v => Type v a -> Type v a
Type.cleanupAbilityLists
  where
    resolveTypeName :: Name -> Set (ResolvesTo TypeReference)
    resolveTypeName :: Name -> Set (ResolvesTo TypeReference)
resolveTypeName =
      Relation Name TypeReference
-> Set Name -> Name -> Set (ResolvesTo TypeReference)
forall ref.
(Ord ref, Show ref) =>
Relation Name ref -> Set Name -> Name -> Set (ResolvesTo ref)
Names.resolveName (Names -> Relation Name TypeReference
Names.types Names
namespace) ((v -> Name) -> Set v -> Set Name
forall b a. Ord b => (a -> b) -> Set a -> Set b
Set.map v -> Name
unsafeVarToName Set v
localVars)