{-# LANGUAGE MultiWayIf #-}
{-# LANGUAGE RecordWildCards #-}

module Unison.Names
  ( Names (..),
    addTerm,
    addType,
    labeledReferences,
    conflicts,
    contains,
    difference,
    filter,
    filterByHQs,
    filterBySHs,
    filterTypes,
    fromReferenceIds,
    fromUnconflictedReferenceIds,
    map,
    makeAbsolute,
    makeRelative,
    fuzzyFind,
    hqName,
    hqTermName,
    hqTypeName,
    hqTermName',
    hqTypeName',
    _hqTermName,
    _hqTypeName,
    _hqTermAliases,
    _hqTypeAliases,
    mapNames,
    prefix0,
    restrictReferences,
    refTermsNamed,
    refTermsHQNamed,
    referenceIds,
    termReferences,
    termReferents,
    typeReferences,
    termsNamed,
    typesNamed,
    shadowing,
    namesForReference,
    namesForReferent,
    shadowTerms,
    importing,
    constructorsForType,
    expandWildcardImport,
    isEmpty,
    hashQualifyTypesRelation,
    hashQualifyTermsRelation,
    fromTermsAndTypes,
    lenientToNametree,
    resolveName,
  )
where

import Control.Lens (_2)
import Data.List qualified as List
import Data.Map qualified as Map
import Data.Semialign (alignWith)
import Data.Set qualified as Set
import Data.Text qualified as Text
import Data.These (These (..))
import Text.FuzzyFind qualified as FZF
import Unison.ConstructorReference (GConstructorReference (..))
import Unison.ConstructorType qualified as CT
import Unison.HashQualified qualified as HQ
import Unison.HashQualifiedPrime qualified as HQ'
import Unison.LabeledDependency (LabeledDependency)
import Unison.LabeledDependency qualified as LD
import Unison.Name (Name)
import Unison.Name qualified as Name
import Unison.NameSegment (NameSegment)
import Unison.Names.ResolvesTo (ResolvesTo (..))
import Unison.Prelude
import Unison.Reference (Reference, TermReference, TermReferenceId, TypeReference, TypeReferenceId)
import Unison.Reference qualified as Reference
import Unison.Referent (Referent)
import Unison.Referent qualified as Referent
import Unison.ShortHash (ShortHash)
import Unison.ShortHash qualified as SH
import Unison.Util.Defns (Defns (..), DefnsF)
import Unison.Util.Nametree (Nametree, unflattenNametree)
import Unison.Util.Relation (Relation)
import Unison.Util.Relation qualified as R
import Unison.Util.Relation qualified as Relation
import Unison.Util.Set qualified as Set (mapMaybe)
import Prelude hiding (filter, map)
import Prelude qualified

-- This will support the APIs of both PrettyPrintEnv and the old Names.
-- For pretty-printing, we need to look up names for References.
-- For parsing (both .u files and command-line args)
data Names = Names
  { Names -> Relation Name Referent
terms :: Relation Name Referent,
    Names -> Relation Name TypeReference
types :: Relation Name TypeReference
  }
  deriving (Names -> Names -> Bool
(Names -> Names -> Bool) -> (Names -> Names -> Bool) -> Eq Names
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Names -> Names -> Bool
== :: Names -> Names -> Bool
$c/= :: Names -> Names -> Bool
/= :: Names -> Names -> Bool
Eq, Eq Names
Eq Names =>
(Names -> Names -> Ordering)
-> (Names -> Names -> Bool)
-> (Names -> Names -> Bool)
-> (Names -> Names -> Bool)
-> (Names -> Names -> Bool)
-> (Names -> Names -> Names)
-> (Names -> Names -> Names)
-> Ord Names
Names -> Names -> Bool
Names -> Names -> Ordering
Names -> Names -> Names
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: Names -> Names -> Ordering
compare :: Names -> Names -> Ordering
$c< :: Names -> Names -> Bool
< :: Names -> Names -> Bool
$c<= :: Names -> Names -> Bool
<= :: Names -> Names -> Bool
$c> :: Names -> Names -> Bool
> :: Names -> Names -> Bool
$c>= :: Names -> Names -> Bool
>= :: Names -> Names -> Bool
$cmax :: Names -> Names -> Names
max :: Names -> Names -> Names
$cmin :: Names -> Names -> Names
min :: Names -> Names -> Names
Ord, Int -> Names -> ShowS
[Names] -> ShowS
Names -> String
(Int -> Names -> ShowS)
-> (Names -> String) -> ([Names] -> ShowS) -> Show Names
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Names -> ShowS
showsPrec :: Int -> Names -> ShowS
$cshow :: Names -> String
show :: Names -> String
$cshowList :: [Names] -> ShowS
showList :: [Names] -> ShowS
Show, (forall x. Names -> Rep Names x)
-> (forall x. Rep Names x -> Names) -> Generic Names
forall x. Rep Names x -> Names
forall x. Names -> Rep Names x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. Names -> Rep Names x
from :: forall x. Names -> Rep Names x
$cto :: forall x. Rep Names x -> Names
to :: forall x. Rep Names x -> Names
Generic)

instance Semigroup (Names) where
  Names Relation Name Referent
e1 Relation Name TypeReference
t1 <> :: Names -> Names -> Names
<> Names Relation Name Referent
e2 Relation Name TypeReference
t2 =
    Relation Name Referent -> Relation Name TypeReference -> Names
Names (Relation Name Referent
e1 Relation Name Referent
-> Relation Name Referent -> Relation Name Referent
forall a. Semigroup a => a -> a -> a
<> Relation Name Referent
e2) (Relation Name TypeReference
t1 Relation Name TypeReference
-> Relation Name TypeReference -> Relation Name TypeReference
forall a. Semigroup a => a -> a -> a
<> Relation Name TypeReference
t2)

instance Monoid (Names) where
  mempty :: Names
mempty = Relation Name Referent -> Relation Name TypeReference -> Names
Names Relation Name Referent
forall a. Monoid a => a
mempty Relation Name TypeReference
forall a. Monoid a => a
mempty

isEmpty :: Names -> Bool
isEmpty :: Names -> Bool
isEmpty Names
n = Relation Name Referent -> Bool
forall a b. Relation a b -> Bool
R.null Names
n.terms Bool -> Bool -> Bool
&& Relation Name TypeReference -> Bool
forall a b. Relation a b -> Bool
R.null Names
n.types

-- | Construct a 'Names' from unconflicted reference ids.
fromReferenceIds :: DefnsF (Relation Name) TermReferenceId TypeReferenceId -> Names
fromReferenceIds :: DefnsF (Relation Name) Id Id -> Names
fromReferenceIds DefnsF (Relation Name) Id Id
defns =
  Names
    { $sel:terms:Names :: Relation Name Referent
terms = (Id -> Referent) -> Relation Name Id -> Relation Name Referent
forall a b b'.
(Ord a, Ord b, Ord b') =>
(b -> b') -> Relation a b -> Relation a b'
Relation.mapRan Id -> Referent
Referent.fromTermReferenceId DefnsF (Relation Name) Id Id
defns.terms,
      $sel:types:Names :: Relation Name TypeReference
types = (Id -> TypeReference)
-> Relation Name Id -> Relation Name TypeReference
forall a b b'.
(Ord a, Ord b, Ord b') =>
(b -> b') -> Relation a b -> Relation a b'
Relation.mapRan Id -> TypeReference
Reference.fromId DefnsF (Relation Name) Id Id
defns.types
    }

-- | Construct a 'Names' from unconflicted reference ids.
fromUnconflictedReferenceIds :: DefnsF (Map Name) TermReferenceId TypeReferenceId -> Names
fromUnconflictedReferenceIds :: DefnsF (Map Name) Id Id -> Names
fromUnconflictedReferenceIds DefnsF (Map Name) Id Id
defns =
  Names
    { $sel:terms:Names :: Relation Name Referent
terms = Map Name Referent -> Relation Name Referent
forall a b. (Ord a, Ord b) => Map a b -> Relation a b
Relation.fromMap ((Id -> Referent) -> Map Name Id -> Map Name Referent
forall a b k. (a -> b) -> Map k a -> Map k b
Map.map Id -> Referent
Referent.fromTermReferenceId DefnsF (Map Name) Id Id
defns.terms),
      $sel:types:Names :: Relation Name TypeReference
types = Map Name TypeReference -> Relation Name TypeReference
forall a b. (Ord a, Ord b) => Map a b -> Relation a b
Relation.fromMap ((Id -> TypeReference) -> Map Name Id -> Map Name TypeReference
forall a b k. (a -> b) -> Map k a -> Map k b
Map.map Id -> TypeReference
Reference.fromId DefnsF (Map Name) Id Id
defns.types)
    }

map :: (Name -> Name) -> Names -> Names
map :: (Name -> Name) -> Names -> Names
map Name -> Name
f (Names {Relation Name Referent
$sel:terms:Names :: Names -> Relation Name Referent
terms :: Relation Name Referent
terms, Relation Name TypeReference
$sel:types:Names :: Names -> Relation Name TypeReference
types :: Relation Name TypeReference
types}) = Relation Name Referent -> Relation Name TypeReference -> Names
Names Relation Name Referent
terms' Relation Name TypeReference
types'
  where
    terms' :: Relation Name Referent
terms' = (Name -> Name) -> Relation Name Referent -> Relation Name Referent
forall a a' b.
(Ord a, Ord a', Ord b) =>
(a -> a') -> Relation a b -> Relation a' b
R.mapDom Name -> Name
f Relation Name Referent
terms
    types' :: Relation Name TypeReference
types' = (Name -> Name)
-> Relation Name TypeReference -> Relation Name TypeReference
forall a a' b.
(Ord a, Ord a', Ord b) =>
(a -> a') -> Relation a b -> Relation a' b
R.mapDom Name -> Name
f Relation Name TypeReference
types

makeAbsolute :: Names -> Names
makeAbsolute :: Names -> Names
makeAbsolute = (Name -> Name) -> Names -> Names
map Name -> Name
Name.makeAbsolute

makeRelative :: Names -> Names
makeRelative :: Names -> Names
makeRelative = (Name -> Name) -> Names -> Names
map Name -> Name
Name.makeRelative

-- Finds names that are supersequences of all the given strings, ordered by
-- score and grouped by name.
fuzzyFind ::
  (Name -> Text) ->
  [String] ->
  Names ->
  [(FZF.Alignment, Name, Set (Either Referent TypeReference))]
fuzzyFind :: (Name -> Text)
-> [String]
-> Names
-> [(Alignment, Name, Set (Either Referent TypeReference))]
fuzzyFind Name -> Text
nameToText [String]
query Names
names =
  ((Alignment, (Name, Set (Either Referent TypeReference)))
 -> (Alignment, Name, Set (Either Referent TypeReference)))
-> [(Alignment, (Name, Set (Either Referent TypeReference)))]
-> [(Alignment, Name, Set (Either Referent TypeReference))]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Alignment, (Name, Set (Either Referent TypeReference)))
-> (Alignment, Name, Set (Either Referent TypeReference))
forall {a} {b} {c}. (a, (b, c)) -> (a, b, c)
flatten
    ([(Alignment, (Name, Set (Either Referent TypeReference)))]
 -> [(Alignment, Name, Set (Either Referent TypeReference))])
-> (Map Name (Set (Either Referent TypeReference))
    -> [(Alignment, (Name, Set (Either Referent TypeReference)))])
-> Map Name (Set (Either Referent TypeReference))
-> [(Alignment, Name, Set (Either Referent TypeReference))]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Name, Set (Either Referent TypeReference)) -> String)
-> [String]
-> [(Name, Set (Either Referent TypeReference))]
-> [(Alignment, (Name, Set (Either Referent TypeReference)))]
forall a. (a -> String) -> [String] -> [a] -> [(Alignment, a)]
fuzzyFinds (Text -> String
Text.unpack (Text -> String)
-> ((Name, Set (Either Referent TypeReference)) -> Text)
-> (Name, Set (Either Referent TypeReference))
-> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Name -> Text
nameToText (Name -> Text)
-> ((Name, Set (Either Referent TypeReference)) -> Name)
-> (Name, Set (Either Referent TypeReference))
-> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Name, Set (Either Referent TypeReference)) -> Name
forall a b. (a, b) -> a
fst) [String]
query
    ([(Name, Set (Either Referent TypeReference))]
 -> [(Alignment, (Name, Set (Either Referent TypeReference)))])
-> (Map Name (Set (Either Referent TypeReference))
    -> [(Name, Set (Either Referent TypeReference))])
-> Map Name (Set (Either Referent TypeReference))
-> [(Alignment, (Name, Set (Either Referent TypeReference)))]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Name, Set (Either Referent TypeReference)) -> Bool)
-> [(Name, Set (Either Referent TypeReference))]
-> [(Name, Set (Either Referent TypeReference))]
forall a. (a -> Bool) -> [a] -> [a]
Prelude.filter (Name, Set (Either Referent TypeReference)) -> Bool
prefilter
    ([(Name, Set (Either Referent TypeReference))]
 -> [(Name, Set (Either Referent TypeReference))])
-> (Map Name (Set (Either Referent TypeReference))
    -> [(Name, Set (Either Referent TypeReference))])
-> Map Name (Set (Either Referent TypeReference))
-> [(Name, Set (Either Referent TypeReference))]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Map Name (Set (Either Referent TypeReference))
-> [(Name, Set (Either Referent TypeReference))]
forall k a. Map k a -> [(k, a)]
Map.toList
    -- `mapMonotonic` is safe here and saves a log n factor
    (Map Name (Set (Either Referent TypeReference))
 -> [(Alignment, Name, Set (Either Referent TypeReference))])
-> Map Name (Set (Either Referent TypeReference))
-> [(Alignment, Name, Set (Either Referent TypeReference))]
forall a b. (a -> b) -> a -> b
$ ((Referent -> Either Referent TypeReference)
-> Set Referent -> Set (Either Referent TypeReference)
forall a b. (a -> b) -> Set a -> Set b
Set.mapMonotonic Referent -> Either Referent TypeReference
forall a b. a -> Either a b
Left (Set Referent -> Set (Either Referent TypeReference))
-> Map Name (Set Referent)
-> Map Name (Set (Either Referent TypeReference))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Relation Name Referent -> Map Name (Set Referent)
forall a b. Relation a b -> Map a (Set b)
R.toMultimap Names
names.terms)
      Map Name (Set (Either Referent TypeReference))
-> Map Name (Set (Either Referent TypeReference))
-> Map Name (Set (Either Referent TypeReference))
forall a. Semigroup a => a -> a -> a
<> ((TypeReference -> Either Referent TypeReference)
-> Set TypeReference -> Set (Either Referent TypeReference)
forall a b. (a -> b) -> Set a -> Set b
Set.mapMonotonic TypeReference -> Either Referent TypeReference
forall a b. b -> Either a b
Right (Set TypeReference -> Set (Either Referent TypeReference))
-> Map Name (Set TypeReference)
-> Map Name (Set (Either Referent TypeReference))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Relation Name TypeReference -> Map Name (Set TypeReference)
forall a b. Relation a b -> Map a (Set b)
R.toMultimap Names
names.types)
  where
    lowerqueryt :: [Text]
lowerqueryt = Text -> Text
Text.toLower (Text -> Text) -> (String -> Text) -> String -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
Text.pack (String -> Text) -> [String] -> [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [String]
query
    -- For performance, case-insensitive substring matching as a pre-filter
    -- This finds fewer matches than subsequence matching, but is
    -- (currently) way faster even on large name sets.
    prefilter :: (Name, Set (Either Referent TypeReference)) -> Bool
prefilter (Name -> Text
nameToText -> Text
name, Set (Either Referent TypeReference)
_) = case [Text]
lowerqueryt of
      -- Special cases here just to help optimizer, since
      -- not sure if `all` will get sufficiently unrolled for
      -- Text fusion to work out.
      [Text
q] -> Text
q Text -> Text -> Bool
`Text.isInfixOf` Text
lowername
      [Text
q1, Text
q2] -> Text
q1 Text -> Text -> Bool
`Text.isInfixOf` Text
lowername Bool -> Bool -> Bool
&& Text
q2 Text -> Text -> Bool
`Text.isInfixOf` Text
lowername
      [Text]
query -> (Text -> Bool) -> [Text] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (Text -> Text -> Bool
`Text.isInfixOf` Text
lowername) [Text]
query
      where
        lowername :: Text
lowername = Text -> Text
Text.toLower Text
name
    flatten :: (a, (b, c)) -> (a, b, c)
flatten (a
a, (b
b, c
c)) = (a
a, b
b, c
c)
    fuzzyFinds :: (a -> String) -> [String] -> [a] -> [(FZF.Alignment, a)]
    fuzzyFinds :: forall a. (a -> String) -> [String] -> [a] -> [(Alignment, a)]
fuzzyFinds a -> String
f [String]
query [a]
d =
      [a]
d
        [a] -> (a -> [(Alignment, a)]) -> [(Alignment, a)]
forall a b. [a] -> (a -> [b]) -> [b]
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= ( \a
s ->
                Maybe (Alignment, a) -> [(Alignment, a)]
forall a. Maybe a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList (Maybe (Alignment, a) -> [(Alignment, a)])
-> Maybe (Alignment, a) -> [(Alignment, a)]
forall a b. (a -> b) -> a -> b
$
                  (,a
s)
                    (Alignment -> (Alignment, a))
-> Maybe Alignment -> Maybe (Alignment, a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Maybe Alignment -> String -> Maybe Alignment)
-> Maybe Alignment -> [String] -> Maybe Alignment
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl'
                      (\Maybe Alignment
a String
q -> Alignment -> Alignment -> Alignment
forall a. Semigroup a => a -> a -> a
(<>) (Alignment -> Alignment -> Alignment)
-> Maybe Alignment -> Maybe (Alignment -> Alignment)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Alignment
a Maybe (Alignment -> Alignment)
-> Maybe Alignment -> Maybe Alignment
forall a b. Maybe (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> String -> String -> Maybe Alignment
FZF.bestMatch String
q (a -> String
f a
s))
                      (Alignment -> Maybe Alignment
forall a. a -> Maybe a
Just Alignment
forall a. Monoid a => a
mempty)
                      [String]
query
            )

-- | Get all (untagged) term/type references ids in a @Names@.
referenceIds :: Names -> Set Reference.Id
referenceIds :: Names -> Set Id
referenceIds Names {Relation Name Referent
$sel:terms:Names :: Names -> Relation Name Referent
terms :: Relation Name Referent
terms, Relation Name TypeReference
$sel:types:Names :: Names -> Relation Name TypeReference
types :: Relation Name TypeReference
types} =
  Set Id
fromTerms Set Id -> Set Id -> Set Id
forall a. Semigroup a => a -> a -> a
<> Set Id
fromTypes
  where
    fromTerms :: Set Id
fromTerms = (Referent -> Maybe Id) -> Set Referent -> Set Id
forall b a. Ord b => (a -> Maybe b) -> Set a -> Set b
Set.mapMaybe Referent -> Maybe Id
Referent.toReferenceId (Relation Name Referent -> Set Referent
forall a b. Relation a b -> Set b
Relation.ran Relation Name Referent
terms)
    fromTypes :: Set Id
fromTypes = (TypeReference -> Maybe Id) -> Set TypeReference -> Set Id
forall b a. Ord b => (a -> Maybe b) -> Set a -> Set b
Set.mapMaybe TypeReference -> Maybe Id
Reference.toId (Relation Name TypeReference -> Set TypeReference
forall a b. Relation a b -> Set b
Relation.ran Relation Name TypeReference
types)

-- | Returns all constructor term references. Constructors are omitted.
termReferences :: Names -> Set TermReference
termReferences :: Names -> Set TypeReference
termReferences Names {Relation Name TypeReference
Relation Name Referent
$sel:terms:Names :: Names -> Relation Name Referent
$sel:types:Names :: Names -> Relation Name TypeReference
terms :: Relation Name Referent
types :: Relation Name TypeReference
..} = (Referent -> Maybe TypeReference)
-> Set Referent -> Set TypeReference
forall b a. Ord b => (a -> Maybe b) -> Set a -> Set b
Set.mapMaybe Referent -> Maybe TypeReference
forall r. Referent' r -> Maybe r
Referent.toTermReference (Set Referent -> Set TypeReference)
-> Set Referent -> Set TypeReference
forall a b. (a -> b) -> a -> b
$ Relation Name Referent -> Set Referent
forall a b. Relation a b -> Set b
R.ran Relation Name Referent
terms

typeReferences :: Names -> Set TypeReference
typeReferences :: Names -> Set TypeReference
typeReferences Names {Relation Name TypeReference
Relation Name Referent
$sel:terms:Names :: Names -> Relation Name Referent
$sel:types:Names :: Names -> Relation Name TypeReference
terms :: Relation Name Referent
types :: Relation Name TypeReference
..} = Relation Name TypeReference -> Set TypeReference
forall a b. Relation a b -> Set b
R.ran Relation Name TypeReference
types

-- | Collect all references in the given Names, tagged with their type.
labeledReferences :: Names -> Set LabeledDependency
labeledReferences :: Names -> Set LabeledDependency
labeledReferences Names {Relation Name TypeReference
Relation Name Referent
$sel:terms:Names :: Names -> Relation Name Referent
$sel:types:Names :: Names -> Relation Name TypeReference
terms :: Relation Name Referent
types :: Relation Name TypeReference
..} =
  (TypeReference -> LabeledDependency)
-> Set TypeReference -> Set LabeledDependency
forall b a. Ord b => (a -> b) -> Set a -> Set b
Set.map TypeReference -> LabeledDependency
LD.typeRef (Relation Name TypeReference -> Set TypeReference
forall a b. Relation a b -> Set b
Relation.ran Relation Name TypeReference
types)
    Set LabeledDependency
-> Set LabeledDependency -> Set LabeledDependency
forall a. Semigroup a => a -> a -> a
<> (Referent -> LabeledDependency)
-> Set Referent -> Set LabeledDependency
forall b a. Ord b => (a -> b) -> Set a -> Set b
Set.map Referent -> LabeledDependency
LD.referent (Relation Name Referent -> Set Referent
forall a b. Relation a b -> Set b
Relation.ran Relation Name Referent
terms)

termReferents :: Names -> Set Referent
termReferents :: Names -> Set Referent
termReferents Names {Relation Name TypeReference
Relation Name Referent
$sel:terms:Names :: Names -> Relation Name Referent
$sel:types:Names :: Names -> Relation Name TypeReference
terms :: Relation Name Referent
types :: Relation Name TypeReference
..} = Relation Name Referent -> Set Referent
forall a b. Relation a b -> Set b
R.ran Relation Name Referent
terms

restrictReferences :: Set Reference -> Names -> Names
restrictReferences :: Set TypeReference -> Names -> Names
restrictReferences Set TypeReference
refs Names {Relation Name TypeReference
Relation Name Referent
$sel:terms:Names :: Names -> Relation Name Referent
$sel:types:Names :: Names -> Relation Name TypeReference
terms :: Relation Name Referent
types :: Relation Name TypeReference
..} = Relation Name Referent -> Relation Name TypeReference -> Names
Names Relation Name Referent
terms' Relation Name TypeReference
types'
  where
    terms' :: Relation Name Referent
terms' = (Referent -> Bool)
-> Relation Name Referent -> Relation Name Referent
forall a b.
(Ord a, Ord b) =>
(b -> Bool) -> Relation a b -> Relation a b
R.filterRan ((TypeReference -> Set TypeReference -> Bool
forall a. Ord a => a -> Set a -> Bool
`Set.member` Set TypeReference
refs) (TypeReference -> Bool)
-> (Referent -> TypeReference) -> Referent -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Referent -> TypeReference
Referent.toReference) Relation Name Referent
terms
    types' :: Relation Name TypeReference
types' = (TypeReference -> Bool)
-> Relation Name TypeReference -> Relation Name TypeReference
forall a b.
(Ord a, Ord b) =>
(b -> Bool) -> Relation a b -> Relation a b
R.filterRan (TypeReference -> Set TypeReference -> Bool
forall a. Ord a => a -> Set a -> Bool
`Set.member` Set TypeReference
refs) Relation Name TypeReference
types

-- | Prefer names in the first argument, falling back to names in the second.
-- This can be used to shadow names in the codebase with names in a unison file for instance:
-- e.g. @shadowing scratchFileNames codebaseNames@
shadowing :: Names -> Names -> Names
shadowing :: Names -> Names -> Names
shadowing Names
a Names
b =
  Relation Name Referent -> Relation Name TypeReference -> Names
Names (Relation Name Referent
-> Relation Name Referent -> Relation Name Referent
forall a b.
(Ord a, Ord b) =>
Relation a b -> Relation a b -> Relation a b
shadowing1 Names
a.terms Names
b.terms) (Relation Name TypeReference
-> Relation Name TypeReference -> Relation Name TypeReference
forall a b.
(Ord a, Ord b) =>
Relation a b -> Relation a b -> Relation a b
shadowing1 Names
a.types Names
b.types)

shadowing1 :: (Ord a, Ord b) => Relation a b -> Relation a b -> Relation a b
shadowing1 :: forall a b.
(Ord a, Ord b) =>
Relation a b -> Relation a b -> Relation a b
shadowing1 Relation a b
xs Relation a b
ys =
  Map a (Set b) -> Relation a b
forall a b. (Ord a, Ord b) => Map a (Set b) -> Relation a b
Relation.fromMultimap ((Set b -> Set b -> Set b)
-> Map a (Set b) -> Map a (Set b) -> Map a (Set b)
forall k a. Ord k => (a -> a -> a) -> Map k a -> Map k a -> Map k a
Map.unionWith (\Set b
x Set b
_ -> Set b
x) (Relation a b -> Map a (Set b)
forall a b. Relation a b -> Map a (Set b)
Relation.domain Relation a b
xs) (Relation a b -> Map a (Set b)
forall a b. Relation a b -> Map a (Set b)
Relation.domain Relation a b
ys))

-- | TODO: get this from database. For now it's a constant.
numHashChars :: Int
numHashChars :: Int
numHashChars = Int
3

termsNamed :: Names -> Name -> Set Referent
termsNamed :: Names -> Name -> Set Referent
termsNamed = (Name -> Relation Name Referent -> Set Referent)
-> Relation Name Referent -> Name -> Set Referent
forall a b c. (a -> b -> c) -> b -> a -> c
flip Name -> Relation Name Referent -> Set Referent
forall a b. Ord a => a -> Relation a b -> Set b
R.lookupDom (Relation Name Referent -> Name -> Set Referent)
-> (Names -> Relation Name Referent)
-> Names
-> Name
-> Set Referent
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (.terms)

-- | Get all terms with a specific name.
refTermsNamed :: Names -> Name -> Set TermReference
refTermsNamed :: Names -> Name -> Set TypeReference
refTermsNamed Names
names Name
n =
  (Referent -> Maybe TypeReference)
-> Set Referent -> Set TypeReference
forall b a. Ord b => (a -> Maybe b) -> Set a -> Set b
Set.mapMaybe Referent -> Maybe TypeReference
forall r. Referent' r -> Maybe r
Referent.toTermReference (Names -> Name -> Set Referent
termsNamed Names
names Name
n)

-- | Get all terms with a specific hash-qualified name.
refTermsHQNamed :: Names -> HQ.HashQualified Name -> Set TermReference
refTermsHQNamed :: Names -> HashQualified Name -> Set TypeReference
refTermsHQNamed Names
names = \case
  HQ.NameOnly Name
name -> Names -> Name -> Set TypeReference
refTermsNamed Names
names Name
name
  HQ.HashOnly ShortHash
_hash -> Set TypeReference
forall a. Set a
Set.empty
  HQ.HashQualified Name
name ShortHash
hash ->
    let f :: Referent -> Maybe TermReference
        f :: Referent -> Maybe TypeReference
f Referent
ref0 = do
          TypeReference
ref <- Referent -> Maybe TypeReference
forall r. Referent' r -> Maybe r
Referent.toTermReference Referent
ref0
          Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (ShortHash -> TypeReference -> Bool
Reference.isPrefixOf ShortHash
hash TypeReference
ref)
          TypeReference -> Maybe TypeReference
forall a. a -> Maybe a
Just TypeReference
ref
     in (Referent -> Maybe TypeReference)
-> Set Referent -> Set TypeReference
forall b a. Ord b => (a -> Maybe b) -> Set a -> Set b
Set.mapMaybe Referent -> Maybe TypeReference
f (Names -> Name -> Set Referent
termsNamed Names
names Name
name)

typesNamed :: Names -> Name -> Set TypeReference
typesNamed :: Names -> Name -> Set TypeReference
typesNamed = (Name -> Relation Name TypeReference -> Set TypeReference)
-> Relation Name TypeReference -> Name -> Set TypeReference
forall a b c. (a -> b -> c) -> b -> a -> c
flip Name -> Relation Name TypeReference -> Set TypeReference
forall a b. Ord a => a -> Relation a b -> Set b
R.lookupDom (Relation Name TypeReference -> Name -> Set TypeReference)
-> (Names -> Relation Name TypeReference)
-> Names
-> Name
-> Set TypeReference
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (.types)

namesForReferent :: Names -> Referent -> Set Name
namesForReferent :: Names -> Referent -> Set Name
namesForReferent Names
names Referent
r = Referent -> Relation Name Referent -> Set Name
forall b a. Ord b => b -> Relation a b -> Set a
R.lookupRan Referent
r Names
names.terms

namesForReference :: Names -> TypeReference -> Set Name
namesForReference :: Names -> TypeReference -> Set Name
namesForReference Names
names TypeReference
r = TypeReference -> Relation Name TypeReference -> Set Name
forall b a. Ord b => b -> Relation a b -> Set a
R.lookupRan TypeReference
r Names
names.types

termAliases :: Names -> Name -> Referent -> Set Name
termAliases :: Names -> Name -> Referent -> Set Name
termAliases Names
names Name
n Referent
r = Name -> Set Name -> Set Name
forall a. Ord a => a -> Set a -> Set a
Set.delete Name
n (Set Name -> Set Name) -> Set Name -> Set Name
forall a b. (a -> b) -> a -> b
$ Names -> Referent -> Set Name
namesForReferent Names
names Referent
r

typeAliases :: Names -> Name -> TypeReference -> Set Name
typeAliases :: Names -> Name -> TypeReference -> Set Name
typeAliases Names
names Name
n TypeReference
r = Name -> Set Name -> Set Name
forall a. Ord a => a -> Set a -> Set a
Set.delete Name
n (Set Name -> Set Name) -> Set Name -> Set Name
forall a b. (a -> b) -> a -> b
$ Names -> TypeReference -> Set Name
namesForReference Names
names TypeReference
r

addType :: Name -> TypeReference -> Names -> Names
addType :: Name -> TypeReference -> Names -> Names
addType Name
n TypeReference
r = (Names -> Names -> Names
forall a. Semigroup a => a -> a -> a
<> [(Name, TypeReference)] -> Names
fromTypes [(Name
n, TypeReference
r)])

addTerm :: Name -> Referent -> Names -> Names
addTerm :: Name -> Referent -> Names -> Names
addTerm Name
n Referent
r = (Names -> Names -> Names
forall a. Semigroup a => a -> a -> a
<> [(Name, Referent)] -> Names
fromTerms [(Name
n, Referent
r)])

-- | Like hqTermName and hqTypeName, but considers term and type names to
-- conflict with each other (so will hash-qualify if there is e.g. both a term
-- and a type named "foo").
--
-- This is useful in contexts such as printing branch diffs. Example:
--
--     - Deletes:
--
--       foo
--       foo
--
-- We want to append the hash regardless of whether or not one is a term and the
-- other is a type.
hqName :: Names -> Name -> Either TypeReference Referent -> HQ'.HashQualified Name
hqName :: Names
-> Name -> Either TypeReference Referent -> HashQualified Name
hqName Names
b Name
n = \case
  Left TypeReference
r -> if Bool
ambiguous then Names -> Name -> TypeReference -> HashQualified Name
_hqTypeName' Names
b Name
n TypeReference
r else Name -> HashQualified Name
forall n. n -> HashQualified n
HQ'.fromName Name
n
  Right Referent
r -> if Bool
ambiguous then Names -> Name -> Referent -> HashQualified Name
_hqTermName' Names
b Name
n Referent
r else Name -> HashQualified Name
forall n. n -> HashQualified n
HQ'.fromName Name
n
  where
    ambiguous :: Bool
ambiguous = Set Referent -> Int
forall a. Set a -> Int
Set.size (Names -> Name -> Set Referent
termsNamed Names
b Name
n) Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Set TypeReference -> Int
forall a. Set a -> Int
Set.size (Names -> Name -> Set TypeReference
typesNamed Names
b Name
n) Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
1

-- Conditionally apply hash qualifier to term name.
-- Should be the same as the input name if the Names is unconflicted.
hqTermName :: Int -> Names -> Name -> Referent -> HQ'.HashQualified Name
hqTermName :: Int -> Names -> Name -> Referent -> HashQualified Name
hqTermName Int
hqLen Names
b Name
n Referent
r =
  if Set Referent -> Int
forall a. Set a -> Int
Set.size (Names -> Name -> Set Referent
termsNamed Names
b Name
n) Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
1
    then Int -> Name -> Referent -> HashQualified Name
hqTermName' Int
hqLen Name
n Referent
r
    else Name -> HashQualified Name
forall n. n -> HashQualified n
HQ'.fromName Name
n

hqTypeName :: Int -> Names -> Name -> TypeReference -> HQ'.HashQualified Name
hqTypeName :: Int -> Names -> Name -> TypeReference -> HashQualified Name
hqTypeName Int
hqLen Names
b Name
n TypeReference
r =
  if Set TypeReference -> Int
forall a. Set a -> Int
Set.size (Names -> Name -> Set TypeReference
typesNamed Names
b Name
n) Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
1
    then Int -> Name -> TypeReference -> HashQualified Name
hqTypeName' Int
hqLen Name
n TypeReference
r
    else Name -> HashQualified Name
forall n. n -> HashQualified n
HQ'.fromName Name
n

_hqTermName :: Names -> Name -> Referent -> HQ'.HashQualified Name
_hqTermName :: Names -> Name -> Referent -> HashQualified Name
_hqTermName Names
b Name
n Referent
r =
  if Set Referent -> Int
forall a. Set a -> Int
Set.size (Names -> Name -> Set Referent
termsNamed Names
b Name
n) Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
1
    then Names -> Name -> Referent -> HashQualified Name
_hqTermName' Names
b Name
n Referent
r
    else Name -> HashQualified Name
forall n. n -> HashQualified n
HQ'.fromName Name
n

_hqTypeName :: Names -> Name -> TypeReference -> HQ'.HashQualified Name
_hqTypeName :: Names -> Name -> TypeReference -> HashQualified Name
_hqTypeName Names
b Name
n TypeReference
r =
  if Set TypeReference -> Int
forall a. Set a -> Int
Set.size (Names -> Name -> Set TypeReference
typesNamed Names
b Name
n) Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
1
    then Names -> Name -> TypeReference -> HashQualified Name
_hqTypeName' Names
b Name
n TypeReference
r
    else Name -> HashQualified Name
forall n. n -> HashQualified n
HQ'.fromName Name
n

_hqTypeAliases :: Names -> Name -> TypeReference -> Set (HQ'.HashQualified Name)
_hqTypeAliases :: Names -> Name -> TypeReference -> Set (HashQualified Name)
_hqTypeAliases Names
b Name
n TypeReference
r = (Name -> HashQualified Name)
-> Set Name -> Set (HashQualified Name)
forall b a. Ord b => (a -> b) -> Set a -> Set b
Set.map ((Name -> TypeReference -> HashQualified Name)
-> TypeReference -> Name -> HashQualified Name
forall a b c. (a -> b -> c) -> b -> a -> c
flip (Names -> Name -> TypeReference -> HashQualified Name
_hqTypeName Names
b) TypeReference
r) (Names -> Name -> TypeReference -> Set Name
typeAliases Names
b Name
n TypeReference
r)

_hqTermAliases :: Names -> Name -> Referent -> Set (HQ'.HashQualified Name)
_hqTermAliases :: Names -> Name -> Referent -> Set (HashQualified Name)
_hqTermAliases Names
b Name
n Referent
r = (Name -> HashQualified Name)
-> Set Name -> Set (HashQualified Name)
forall b a. Ord b => (a -> b) -> Set a -> Set b
Set.map ((Name -> Referent -> HashQualified Name)
-> Referent -> Name -> HashQualified Name
forall a b c. (a -> b -> c) -> b -> a -> c
flip (Names -> Name -> Referent -> HashQualified Name
_hqTermName Names
b) Referent
r) (Names -> Name -> Referent -> Set Name
termAliases Names
b Name
n Referent
r)

-- Unconditionally apply hash qualifier long enough to distinguish all the
-- References in this Names.
hqTermName' :: Int -> Name -> Referent -> HQ'.HashQualified Name
hqTermName' :: Int -> Name -> Referent -> HashQualified Name
hqTermName' Int
hqLen Name
n Referent
r =
  Int -> HashQualified Name -> HashQualified Name
forall n. Int -> HashQualified n -> HashQualified n
HQ'.take Int
hqLen (HashQualified Name -> HashQualified Name)
-> HashQualified Name -> HashQualified Name
forall a b. (a -> b) -> a -> b
$ Name -> Referent -> HashQualified Name
forall n. n -> Referent -> HashQualified n
HQ'.fromNamedReferent Name
n Referent
r

hqTypeName' :: Int -> Name -> TypeReference -> HQ'.HashQualified Name
hqTypeName' :: Int -> Name -> TypeReference -> HashQualified Name
hqTypeName' Int
hqLen Name
n TypeReference
r =
  Int -> HashQualified Name -> HashQualified Name
forall n. Int -> HashQualified n -> HashQualified n
HQ'.take Int
hqLen (HashQualified Name -> HashQualified Name)
-> HashQualified Name -> HashQualified Name
forall a b. (a -> b) -> a -> b
$ Name -> TypeReference -> HashQualified Name
forall n. n -> TypeReference -> HashQualified n
HQ'.fromNamedReference Name
n TypeReference
r

_hqTermName' :: Names -> Name -> Referent -> HQ'.HashQualified Name
_hqTermName' :: Names -> Name -> Referent -> HashQualified Name
_hqTermName' Names
_b Name
n Referent
r =
  Int -> HashQualified Name -> HashQualified Name
forall n. Int -> HashQualified n -> HashQualified n
HQ'.take Int
numHashChars (HashQualified Name -> HashQualified Name)
-> HashQualified Name -> HashQualified Name
forall a b. (a -> b) -> a -> b
$ Name -> Referent -> HashQualified Name
forall n. n -> Referent -> HashQualified n
HQ'.fromNamedReferent Name
n Referent
r

_hqTypeName' :: Names -> Name -> TypeReference -> HQ'.HashQualified Name
_hqTypeName' :: Names -> Name -> TypeReference -> HashQualified Name
_hqTypeName' Names
_b Name
n TypeReference
r =
  Int -> HashQualified Name -> HashQualified Name
forall n. Int -> HashQualified n -> HashQualified n
HQ'.take Int
numHashChars (HashQualified Name -> HashQualified Name)
-> HashQualified Name -> HashQualified Name
forall a b. (a -> b) -> a -> b
$ Name -> TypeReference -> HashQualified Name
forall n. n -> TypeReference -> HashQualified n
HQ'.fromNamedReference Name
n TypeReference
r

fromTerms :: [(Name, Referent)] -> Names
fromTerms :: [(Name, Referent)] -> Names
fromTerms [(Name, Referent)]
ts = Relation Name Referent -> Relation Name TypeReference -> Names
Names ([(Name, Referent)] -> Relation Name Referent
forall a b. (Ord a, Ord b) => [(a, b)] -> Relation a b
R.fromList [(Name, Referent)]
ts) Relation Name TypeReference
forall a. Monoid a => a
mempty

fromTypes :: [(Name, TypeReference)] -> Names
fromTypes :: [(Name, TypeReference)] -> Names
fromTypes [(Name, TypeReference)]
ts = Relation Name Referent -> Relation Name TypeReference -> Names
Names Relation Name Referent
forall a. Monoid a => a
mempty ([(Name, TypeReference)] -> Relation Name TypeReference
forall a b. (Ord a, Ord b) => [(a, b)] -> Relation a b
R.fromList [(Name, TypeReference)]
ts)

fromTermsAndTypes :: [(Name, Referent)] -> [(Name, TypeReference)] -> Names
fromTermsAndTypes :: [(Name, Referent)] -> [(Name, TypeReference)] -> Names
fromTermsAndTypes [(Name, Referent)]
terms [(Name, TypeReference)]
types =
  [(Name, Referent)] -> Names
fromTerms [(Name, Referent)]
terms Names -> Names -> Names
forall a. Semigroup a => a -> a -> a
<> [(Name, TypeReference)] -> Names
fromTypes [(Name, TypeReference)]
types

-- | Map over each name in a 'Names'.
mapNames :: (Name -> Name) -> Names -> Names
mapNames :: (Name -> Name) -> Names -> Names
mapNames Name -> Name
f Names {Relation Name Referent
$sel:terms:Names :: Names -> Relation Name Referent
terms :: Relation Name Referent
terms, Relation Name TypeReference
$sel:types:Names :: Names -> Relation Name TypeReference
types :: Relation Name TypeReference
types} =
  Names
    { $sel:terms:Names :: Relation Name Referent
terms = (Name -> Name) -> Relation Name Referent -> Relation Name Referent
forall a a' b.
(Ord a, Ord a', Ord b) =>
(a -> a') -> Relation a b -> Relation a' b
R.mapDom Name -> Name
f Relation Name Referent
terms,
      $sel:types:Names :: Relation Name TypeReference
types = (Name -> Name)
-> Relation Name TypeReference -> Relation Name TypeReference
forall a a' b.
(Ord a, Ord a', Ord b) =>
(a -> a') -> Relation a b -> Relation a' b
R.mapDom Name -> Name
f Relation Name TypeReference
types
    }

-- | @prefix0 n ns@ prepends @n@ to each name in @ns@.
--
-- Precondition: every name in @ns@ is relative.
prefix0 :: Name -> Names -> Names
prefix0 :: Name -> Names -> Names
prefix0 Name
n =
  (Name -> Name) -> Names -> Names
mapNames (HasCallStack => Name -> Name -> Name
Name -> Name -> Name
Name.joinDot Name
n)

filter :: (Name -> Bool) -> Names -> Names
filter :: (Name -> Bool) -> Names -> Names
filter Name -> Bool
f (Names Relation Name Referent
terms Relation Name TypeReference
types) = Relation Name Referent -> Relation Name TypeReference -> Names
Names ((Name -> Bool) -> Relation Name Referent -> Relation Name Referent
forall a b.
(Ord a, Ord b) =>
(a -> Bool) -> Relation a b -> Relation a b
R.filterDom Name -> Bool
f Relation Name Referent
terms) ((Name -> Bool)
-> Relation Name TypeReference -> Relation Name TypeReference
forall a b.
(Ord a, Ord b) =>
(a -> Bool) -> Relation a b -> Relation a b
R.filterDom Name -> Bool
f Relation Name TypeReference
types)

-- currently used for filtering before a conditional `add`
filterByHQs :: Set (HQ'.HashQualified Name) -> Names -> Names
filterByHQs :: Set (HashQualified Name) -> Names -> Names
filterByHQs Set (HashQualified Name)
hqs Names {Relation Name TypeReference
Relation Name Referent
$sel:terms:Names :: Names -> Relation Name Referent
$sel:types:Names :: Names -> Relation Name TypeReference
terms :: Relation Name Referent
types :: Relation Name TypeReference
..} = Relation Name Referent -> Relation Name TypeReference -> Names
Names Relation Name Referent
terms' Relation Name TypeReference
types'
  where
    terms' :: Relation Name Referent
terms' = ((Name, Referent) -> Bool)
-> Relation Name Referent -> Relation Name Referent
forall a b.
(Ord a, Ord b) =>
((a, b) -> Bool) -> Relation a b -> Relation a b
R.filter (Name, Referent) -> Bool
f Relation Name Referent
terms
    types' :: Relation Name TypeReference
types' = ((Name, TypeReference) -> Bool)
-> Relation Name TypeReference -> Relation Name TypeReference
forall a b.
(Ord a, Ord b) =>
((a, b) -> Bool) -> Relation a b -> Relation a b
R.filter (Name, TypeReference) -> Bool
g Relation Name TypeReference
types
    f :: (Name, Referent) -> Bool
f (Name
n, Referent
r) = (HashQualified Name -> Bool) -> Set (HashQualified Name) -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (Name -> Referent -> HashQualified Name -> Bool
forall n. Eq n => n -> Referent -> HashQualified n -> Bool
HQ'.matchesNamedReferent Name
n Referent
r) Set (HashQualified Name)
hqs
    g :: (Name, TypeReference) -> Bool
g (Name
n, TypeReference
r) = (HashQualified Name -> Bool) -> Set (HashQualified Name) -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (Name -> TypeReference -> HashQualified Name -> Bool
forall n. Eq n => n -> TypeReference -> HashQualified n -> Bool
HQ'.matchesNamedReference Name
n TypeReference
r) Set (HashQualified Name)
hqs

filterBySHs :: Set ShortHash -> Names -> Names
filterBySHs :: Set ShortHash -> Names -> Names
filterBySHs Set ShortHash
shs Names {Relation Name TypeReference
Relation Name Referent
$sel:terms:Names :: Names -> Relation Name Referent
$sel:types:Names :: Names -> Relation Name TypeReference
terms :: Relation Name Referent
types :: Relation Name TypeReference
..} = Relation Name Referent -> Relation Name TypeReference -> Names
Names Relation Name Referent
terms' Relation Name TypeReference
types'
  where
    terms' :: Relation Name Referent
terms' = ((Name, Referent) -> Bool)
-> Relation Name Referent -> Relation Name Referent
forall a b.
(Ord a, Ord b) =>
((a, b) -> Bool) -> Relation a b -> Relation a b
R.filter (Name, Referent) -> Bool
f Relation Name Referent
terms
    types' :: Relation Name TypeReference
types' = ((Name, TypeReference) -> Bool)
-> Relation Name TypeReference -> Relation Name TypeReference
forall a b.
(Ord a, Ord b) =>
((a, b) -> Bool) -> Relation a b -> Relation a b
R.filter (Name, TypeReference) -> Bool
g Relation Name TypeReference
types
    f :: (Name, Referent) -> Bool
f (Name
_n, Referent
r) = (ShortHash -> Bool) -> Set ShortHash -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (ShortHash -> ShortHash -> Bool
`SH.isPrefixOf` Referent -> ShortHash
Referent.toShortHash Referent
r) Set ShortHash
shs
    g :: (Name, TypeReference) -> Bool
g (Name
_n, TypeReference
r) = (ShortHash -> Bool) -> Set ShortHash -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (ShortHash -> ShortHash -> Bool
`SH.isPrefixOf` TypeReference -> ShortHash
Reference.toShortHash TypeReference
r) Set ShortHash
shs

filterTypes :: (Name -> Bool) -> Names -> Names
filterTypes :: (Name -> Bool) -> Names -> Names
filterTypes Name -> Bool
f (Names Relation Name Referent
terms Relation Name TypeReference
types) = Relation Name Referent -> Relation Name TypeReference -> Names
Names Relation Name Referent
terms ((Name -> Bool)
-> Relation Name TypeReference -> Relation Name TypeReference
forall a b.
(Ord a, Ord b) =>
(a -> Bool) -> Relation a b -> Relation a b
R.filterDom Name -> Bool
f Relation Name TypeReference
types)

difference :: Names -> Names -> Names
difference :: Names -> Names -> Names
difference Names
a Names
b =
  Relation Name Referent -> Relation Name TypeReference -> Names
Names
    (Relation Name Referent
-> Relation Name Referent -> Relation Name Referent
forall a b.
(Ord a, Ord b) =>
Relation a b -> Relation a b -> Relation a b
R.difference Names
a.terms Names
b.terms)
    (Relation Name TypeReference
-> Relation Name TypeReference -> Relation Name TypeReference
forall a b.
(Ord a, Ord b) =>
Relation a b -> Relation a b -> Relation a b
R.difference Names
a.types Names
b.types)

contains :: Names -> Reference -> Bool
contains :: Names -> TypeReference -> Bool
contains Names
names =
  -- We want to compute `termsReferences` only once, if `contains` is partially applied to a `Names`, and called over
  -- and over for different references. GHC would probably float `termsReferences` out without the explicit lambda, but
  -- it's written like this just to be sure.
  \TypeReference
r -> TypeReference -> Set TypeReference -> Bool
forall a. Ord a => a -> Set a -> Bool
Set.member TypeReference
r Set TypeReference
termsReferences Bool -> Bool -> Bool
|| TypeReference -> Relation Name TypeReference -> Bool
forall b a. Ord b => b -> Relation a b -> Bool
R.memberRan TypeReference
r Names
names.types
  where
    -- this check makes `contains` O(n) instead of O(log n)
    termsReferences :: Set TermReference
    termsReferences :: Set TypeReference
termsReferences =
      (Referent -> TypeReference) -> Set Referent -> Set TypeReference
forall b a. Ord b => (a -> b) -> Set a -> Set b
Set.map Referent -> TypeReference
Referent.toReference (Relation Name Referent -> Set Referent
forall a b. Relation a b -> Set b
R.ran Names
names.terms)

-- | filters out everything from the domain except what's conflicted
conflicts :: Names -> Names
conflicts :: Names -> Names
conflicts Names {Relation Name TypeReference
Relation Name Referent
$sel:terms:Names :: Names -> Relation Name Referent
$sel:types:Names :: Names -> Relation Name TypeReference
terms :: Relation Name Referent
types :: Relation Name TypeReference
..} = Relation Name Referent -> Relation Name TypeReference -> Names
Names (Relation Name Referent -> Relation Name Referent
forall a b. (Ord a, Ord b) => Relation a b -> Relation a b
R.filterManyDom Relation Name Referent
terms) (Relation Name TypeReference -> Relation Name TypeReference
forall a b. (Ord a, Ord b) => Relation a b -> Relation a b
R.filterManyDom Relation Name TypeReference
types)

-- Deletes from the `n0 : Names` any definitions whose names
-- are in `ns`. Does so using logarithmic time lookups,
-- traversing only `ns`.
--
-- See usage in `FileParser` for handling precendence of symbol
-- resolution where local names are preferred to codebase names.
shadowTerms :: [Name] -> Names -> Names
shadowTerms :: [Name] -> Names -> Names
shadowTerms [Name]
ns Names
n0 = Relation Name Referent -> Relation Name TypeReference -> Names
Names Relation Name Referent
terms' Names
n0.types
  where
    terms' :: Relation Name Referent
terms' = (Relation Name Referent -> Name -> Relation Name Referent)
-> Relation Name Referent -> [Name] -> Relation Name Referent
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' Relation Name Referent -> Name -> Relation Name Referent
forall {a} {b}. (Ord a, Ord b) => Relation a b -> a -> Relation a b
go Names
n0.terms [Name]
ns
    go :: Relation a b -> a -> Relation a b
go Relation a b
ts a
name = a -> Relation a b -> Relation a b
forall a b. (Ord a, Ord b) => a -> Relation a b -> Relation a b
R.deleteDom a
name Relation a b
ts

-- | Given a mapping from name to qualified name, update a `Names`,
-- so for instance if the input has [(Some, Optional.Some)],
-- and `Optional.Some` is a constructor in the input `Names`,
-- the alias `Some` will map to that same constructor and shadow
-- anything else that is currently called `Some`.
importing :: [(Name, Name)] -> Names -> Names
importing :: [(Name, Name)] -> Names -> Names
importing [(Name, Name)]
shortToLongName Names
ns =
  Relation Name Referent -> Relation Name TypeReference -> Names
Names
    ((Relation Name Referent -> (Name, Name) -> Relation Name Referent)
-> Relation Name Referent
-> [(Name, Name)]
-> Relation Name Referent
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' Relation Name Referent -> (Name, Name) -> Relation Name Referent
forall r.
Ord r =>
Relation Name r -> (Name, Name) -> Relation Name r
go Names
ns.terms [(Name, Name)]
shortToLongName)
    ((Relation Name TypeReference
 -> (Name, Name) -> Relation Name TypeReference)
-> Relation Name TypeReference
-> [(Name, Name)]
-> Relation Name TypeReference
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' Relation Name TypeReference
-> (Name, Name) -> Relation Name TypeReference
forall r.
Ord r =>
Relation Name r -> (Name, Name) -> Relation Name r
go Names
ns.types [(Name, Name)]
shortToLongName)
  where
    go :: (Ord r) => Relation Name r -> (Name, Name) -> Relation Name r
    go :: forall r.
Ord r =>
Relation Name r -> (Name, Name) -> Relation Name r
go Relation Name r
m (Name
shortname, Name
qname) = case Name -> Relation Name r -> Set r
forall r. Ord r => Name -> Relation Name r -> Set r
Name.searchByRankedSuffix Name
qname Relation Name r
m of
      Set r
s
        | Set r -> Bool
forall a. Set a -> Bool
Set.null Set r
s -> Relation Name r
m
        | Bool
otherwise -> Name -> Set r -> Relation Name r -> Relation Name r
forall (f :: * -> *) a b.
(Foldable f, Ord a, Ord b) =>
a -> f b -> Relation a b -> Relation a b
R.insertManyRan Name
shortname Set r
s (Name -> Relation Name r -> Relation Name r
forall a b. (Ord a, Ord b) => a -> Relation a b -> Relation a b
R.deleteDom Name
shortname Relation Name r
m)

-- | Converts a wildcard import into a list of explicit imports, of the form
-- [(suffix, full)]. Example: if `io` contains two functions, `foo` and
-- `bar`, then `expandWildcardImport io` will produce
-- `[(foo, io.foo), (bar, io.bar)]`.
expandWildcardImport :: Name -> Names -> [(Name, Name)]
expandWildcardImport :: Name -> Names -> [(Name, Name)]
expandWildcardImport Name
prefix Names
ns =
  [(Name
suffix, Name
full) | Just (Name
suffix, Name
full) <- (Name, Referent) -> Maybe (Name, Name)
forall a. (Name, a) -> Maybe (Name, Name)
go ((Name, Referent) -> Maybe (Name, Name))
-> [(Name, Referent)] -> [Maybe (Name, Name)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Relation Name Referent -> [(Name, Referent)]
forall a b. Relation a b -> [(a, b)]
R.toList Names
ns.terms]
    [(Name, Name)] -> [(Name, Name)] -> [(Name, Name)]
forall a. Semigroup a => a -> a -> a
<> [(Name
suffix, Name
full) | Just (Name
suffix, Name
full) <- (Name, TypeReference) -> Maybe (Name, Name)
forall a. (Name, a) -> Maybe (Name, Name)
go ((Name, TypeReference) -> Maybe (Name, Name))
-> [(Name, TypeReference)] -> [Maybe (Name, Name)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Relation Name TypeReference -> [(Name, TypeReference)]
forall a b. Relation a b -> [(a, b)]
R.toList Names
ns.types]
  where
    go :: (Name, a) -> Maybe (Name, Name)
    go :: forall a. (Name, a) -> Maybe (Name, Name)
go (Name
full, a
_) = do
      -- running example:
      --   prefix = Int
      --   full = builtin.Int.negate
      Name
rem <- Name -> Name -> Maybe Name
Name.suffixFrom Name
prefix Name
full
      -- rem = Int.negate
      Name
suffix <- Name -> Name -> Maybe Name
Name.stripNamePrefix Name
prefix Name
rem
      -- suffix = negate
      (Name, Name) -> Maybe (Name, Name)
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Name
suffix, Name
full)

-- Finds all the constructors for the given type in the `Names`
constructorsForType :: TypeReference -> Names -> [(Name, Referent)]
constructorsForType :: TypeReference -> Names -> [(Name, Referent)]
constructorsForType TypeReference
r Names
ns =
  let -- rather than searching all of names, we use the known possible forms
      -- that the constructors can take
      possibleDatas :: [Referent]
possibleDatas = [ConstructorReference -> ConstructorType -> Referent
Referent.Con (TypeReference -> ConstructorId -> ConstructorReference
forall r. r -> ConstructorId -> GConstructorReference r
ConstructorReference TypeReference
r ConstructorId
cid) ConstructorType
CT.Data | ConstructorId
cid <- [ConstructorId
0 ..]]
      possibleEffects :: [Referent]
possibleEffects = [ConstructorReference -> ConstructorType -> Referent
Referent.Con (TypeReference -> ConstructorId -> ConstructorReference
forall r. r -> ConstructorId -> GConstructorReference r
ConstructorReference TypeReference
r ConstructorId
cid) ConstructorType
CT.Effect | ConstructorId
cid <- [ConstructorId
0 ..]]
      trim :: [Referent] -> [(Name, Referent)]
trim [] = []
      trim (Referent
h : [Referent]
t) = case Referent -> Relation Name Referent -> Set Name
forall b a. Ord b => b -> Relation a b -> Set a
R.lookupRan Referent
h Names
ns.terms of
        Set Name
s
          | Set Name -> Bool
forall a. Set a -> Bool
Set.null Set Name
s -> []
          | Bool
otherwise -> [(Name
n, Referent
h) | Name
n <- Set Name -> [Name]
forall a. Set a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList Set Name
s] [(Name, Referent)] -> [(Name, Referent)] -> [(Name, Referent)]
forall a. [a] -> [a] -> [a]
++ [Referent] -> [(Name, Referent)]
trim [Referent]
t
   in [Referent] -> [(Name, Referent)]
trim [Referent]
possibleEffects [(Name, Referent)] -> [(Name, Referent)] -> [(Name, Referent)]
forall a. [a] -> [a] -> [a]
++ [Referent] -> [(Name, Referent)]
trim [Referent]
possibleDatas

hashQualifyTermsRelation :: R.Relation Name Referent -> R.Relation (HQ.HashQualified Name) Referent
hashQualifyTermsRelation :: Relation Name Referent -> Relation (HashQualified Name) Referent
hashQualifyTermsRelation = (Name -> Referent -> HashQualified Name)
-> Relation Name Referent -> Relation (HashQualified Name) Referent
forall r.
Ord r =>
(Name -> r -> HashQualified Name)
-> Relation Name r -> Relation (HashQualified Name) r
hashQualifyRelation Name -> Referent -> HashQualified Name
forall n. n -> Referent -> HashQualified n
HQ.fromNamedReferent

hashQualifyTypesRelation :: R.Relation Name TypeReference -> R.Relation (HQ.HashQualified Name) TypeReference
hashQualifyTypesRelation :: Relation Name TypeReference
-> Relation (HashQualified Name) TypeReference
hashQualifyTypesRelation = (Name -> TypeReference -> HashQualified Name)
-> Relation Name TypeReference
-> Relation (HashQualified Name) TypeReference
forall r.
Ord r =>
(Name -> r -> HashQualified Name)
-> Relation Name r -> Relation (HashQualified Name) r
hashQualifyRelation Name -> TypeReference -> HashQualified Name
forall n. n -> TypeReference -> HashQualified n
HQ.fromNamedReference

hashQualifyRelation :: (Ord r) => (Name -> r -> HQ.HashQualified Name) -> R.Relation Name r -> R.Relation (HQ.HashQualified Name) r
hashQualifyRelation :: forall r.
Ord r =>
(Name -> r -> HashQualified Name)
-> Relation Name r -> Relation (HashQualified Name) r
hashQualifyRelation Name -> r -> HashQualified Name
fromNamedRef Relation Name r
rel = ((Name, r) -> (HashQualified Name, r))
-> Relation Name r -> Relation (HashQualified Name) r
forall a b c d.
(Ord a, Ord b, Ord c, Ord d) =>
((a, b) -> (c, d)) -> Relation a b -> Relation c d
R.map (Name, r) -> (HashQualified Name, r)
go Relation Name r
rel
  where
    go :: (Name, r) -> (HashQualified Name, r)
go (Name
n, r
r) =
      if Set r -> Int
forall a. Set a -> Int
Set.size (Name -> Relation Name r -> Set r
forall a b. Ord a => a -> Relation a b -> Set b
R.lookupDom Name
n Relation Name r
rel) Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
1
        then (Int -> HashQualified Name -> HashQualified Name
forall n. Int -> HashQualified n -> HashQualified n
HQ.take Int
numHashChars (HashQualified Name -> HashQualified Name)
-> HashQualified Name -> HashQualified Name
forall a b. (a -> b) -> a -> b
$ Name -> r -> HashQualified Name
fromNamedRef Name
n r
r, r
r)
        else (Name -> HashQualified Name
forall n. n -> HashQualified n
HQ.NameOnly Name
n, r
r)

-- | "Leniently" view a Names as a NameTree
--
-- This function is "lenient" in the sense that it does not handle conflicted names with any smarts whatsoever. The
-- resulting nametree will simply contain one of the associated references of a conflicted name - we don't specify
-- which.
lenientToNametree :: Names -> Nametree (DefnsF (Map NameSegment) Referent TypeReference)
lenientToNametree :: Names -> Nametree (DefnsF (Map NameSegment) Referent TypeReference)
lenientToNametree Names
names =
  (These (Map NameSegment Referent) (Map NameSegment TypeReference)
 -> DefnsF (Map NameSegment) Referent TypeReference)
-> Nametree (Map NameSegment Referent)
-> Nametree (Map NameSegment TypeReference)
-> Nametree (DefnsF (Map NameSegment) Referent TypeReference)
forall a b c.
(These a b -> c) -> Nametree a -> Nametree b -> Nametree c
forall (f :: * -> *) a b c.
Semialign f =>
(These a b -> c) -> f a -> f b -> f c
alignWith
    ( \case
        This Map NameSegment Referent
terms -> Defns {Map NameSegment Referent
terms :: Map NameSegment Referent
$sel:terms:Defns :: Map NameSegment Referent
terms, $sel:types:Defns :: Map NameSegment TypeReference
types = Map NameSegment TypeReference
forall k a. Map k a
Map.empty}
        That Map NameSegment TypeReference
types -> Defns {$sel:terms:Defns :: Map NameSegment Referent
terms = Map NameSegment Referent
forall k a. Map k a
Map.empty, Map NameSegment TypeReference
$sel:types:Defns :: Map NameSegment TypeReference
types :: Map NameSegment TypeReference
types}
        These Map NameSegment Referent
terms Map NameSegment TypeReference
types -> Defns {Map NameSegment Referent
$sel:terms:Defns :: Map NameSegment Referent
terms :: Map NameSegment Referent
terms, Map NameSegment TypeReference
$sel:types:Defns :: Map NameSegment TypeReference
types :: Map NameSegment TypeReference
types}
    )
    (Relation Name Referent -> Nametree (Map NameSegment Referent)
forall a. Ord a => Relation Name a -> Nametree (Map NameSegment a)
lenientRelationToNametree Names
names.terms)
    (Relation Name TypeReference
-> Nametree (Map NameSegment TypeReference)
forall a. Ord a => Relation Name a -> Nametree (Map NameSegment a)
lenientRelationToNametree Names
names.types)
  where
    lenientRelationToNametree :: (Ord a) => Relation Name a -> Nametree (Map NameSegment a)
    lenientRelationToNametree :: forall a. Ord a => Relation Name a -> Nametree (Map NameSegment a)
lenientRelationToNametree =
      -- The partial `Set.findMin` is fine here because Relation.domain only has non-empty Set values. A NESet would be
      -- better.
      Map Name a -> Nametree (Map NameSegment a)
forall a. Ord a => Map Name a -> Nametree (Map NameSegment a)
unflattenNametree (Map Name a -> Nametree (Map NameSegment a))
-> (Relation Name a -> Map Name a)
-> Relation Name a
-> Nametree (Map NameSegment a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Set a -> a) -> Map Name (Set a) -> Map Name a
forall a b k. (a -> b) -> Map k a -> Map k b
Map.map Set a -> a
forall a. Set a -> a
Set.findMin (Map Name (Set a) -> Map Name a)
-> (Relation Name a -> Map Name (Set a))
-> Relation Name a
-> Map Name a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Relation Name a -> Map Name (Set a)
forall a b. Relation a b -> Map a (Set b)
Relation.domain

-- Given a namespace and locally-bound names that shadow it (i.e. from a Unison file that hasn't been typechecked yet),
-- determine what the name resolves to, per the usual suffix-matching rules (where local defnintions and direct
-- dependencies are preferred to indirect dependencies).
resolveName :: forall ref. (Ord ref) => Relation Name ref -> Set Name -> Name -> Set (ResolvesTo ref)
resolveName :: forall ref.
Ord ref =>
Relation Name ref -> Set Name -> Name -> Set (ResolvesTo ref)
resolveName Relation Name ref
namespace Set Name
locals =
  \Name
name ->
    let exactNamespaceMatches :: Set ref
        exactNamespaceMatches :: Set ref
exactNamespaceMatches =
          Name -> Relation Name ref -> Set ref
forall a b. Ord a => a -> Relation a b -> Set b
Relation.lookupDom Name
name Relation Name ref
namespace
        localsPlusNamespaceSuffixMatches :: Set (ResolvesTo ref)
        localsPlusNamespaceSuffixMatches :: Set (ResolvesTo ref)
localsPlusNamespaceSuffixMatches =
          Name -> Relation Name (ResolvesTo ref) -> Set (ResolvesTo ref)
forall r. Ord r => Name -> Relation Name r -> Set r
Name.searchByRankedSuffix Name
name Relation Name (ResolvesTo ref)
localsPlusNamespace
     in if
          | Name -> Set Name -> Bool
forall a. Ord a => a -> Set a -> Bool
Set.member Name
name Set Name
locals -> ResolvesTo ref -> Set (ResolvesTo ref)
forall a. a -> Set a
Set.singleton (Name -> ResolvesTo ref
forall ref. Name -> ResolvesTo ref
ResolvesToLocal Name
name)
          | Set ref -> Int
forall a. Set a -> Int
Set.size Set ref
exactNamespaceMatches Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
1 -> (ref -> ResolvesTo ref) -> Set ref -> Set (ResolvesTo ref)
forall a b. (a -> b) -> Set a -> Set b
Set.mapMonotonic ref -> ResolvesTo ref
forall ref. ref -> ResolvesTo ref
ResolvesToNamespace Set ref
exactNamespaceMatches
          | Bool
otherwise -> Set (ResolvesTo ref)
localsPlusNamespaceSuffixMatches
  where
    localsPlusNamespace :: Relation Name (ResolvesTo ref)
    localsPlusNamespace :: Relation Name (ResolvesTo ref)
localsPlusNamespace =
      Relation Name (ResolvesTo ref)
-> Relation Name (ResolvesTo ref) -> Relation Name (ResolvesTo ref)
forall a b.
(Ord a, Ord b) =>
Relation a b -> Relation a b -> Relation a b
shadowing1
        ( (Relation Name (ResolvesTo ref)
 -> Name -> Relation Name (ResolvesTo ref))
-> Relation Name (ResolvesTo ref)
-> [Name]
-> Relation Name (ResolvesTo ref)
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
List.foldl'
            (\Relation Name (ResolvesTo ref)
acc Name
name -> Name
-> ResolvesTo ref
-> Relation Name (ResolvesTo ref)
-> Relation Name (ResolvesTo ref)
forall a b.
(Ord a, Ord b) =>
a -> b -> Relation a b -> Relation a b
Relation.insert Name
name (Name -> ResolvesTo ref
forall ref. Name -> ResolvesTo ref
ResolvesToLocal Name
name) Relation Name (ResolvesTo ref)
acc)
            Relation Name (ResolvesTo ref)
forall a b. Relation a b
Relation.empty
            (Set Name -> [Name]
forall a. Set a -> [a]
Set.toList Set Name
locals)
        )
        ( ((Name, ref) -> (Name, ResolvesTo ref))
-> Relation Name ref -> Relation Name (ResolvesTo ref)
forall a b c d.
(Ord a, Ord b, Ord c, Ord d) =>
((a, b) -> (c, d)) -> Relation a b -> Relation c d
Relation.map
            (ASetter (Name, ref) (Name, ResolvesTo ref) ref (ResolvesTo ref)
-> (ref -> ResolvesTo ref) -> (Name, ref) -> (Name, ResolvesTo ref)
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over ASetter (Name, ref) (Name, ResolvesTo ref) ref (ResolvesTo ref)
forall s t a b. Field2 s t a b => Lens s t a b
Lens (Name, ref) (Name, ResolvesTo ref) ref (ResolvesTo ref)
_2 ref -> ResolvesTo ref
forall ref. ref -> ResolvesTo ref
ResolvesToNamespace)
            Relation Name ref
namespace
        )