-- | A utility module for unconflicted namespaces and related types/functionality.
module Unison.NamesUtils
  ( byName,
    forgetNames,
    referentsToIds,
    restrictNames,
  )
where

import Data.Set qualified as Set
import Unison.ConstructorReference (GConstructorReference (..))
import Unison.Prelude
import Unison.Reference (Reference' (..), TermReferenceId, TypeReference, TypeReferenceId)
import Unison.Reference qualified as Reference
import Unison.Referent (Referent)
import Unison.Referent qualified as Referent
import Unison.Util.BiMultimap (BiMultimap)
import Unison.Util.BiMultimap qualified as BiMultimap
import Unison.Util.Defns (Defns (..), DefnsF, zipDefnsWith)
import Unison.Util.Defns qualified as Defns
import Unison.Util.Set qualified as Set

-- | /O(1)/. View unconflicted names by name (throwing away ref->name mapping).
byName :: Defns (BiMultimap terms name) (BiMultimap types name) -> DefnsF (Map name) terms types
byName :: forall terms name types.
Defns (BiMultimap terms name) (BiMultimap types name)
-> DefnsF (Map name) terms types
byName =
  (BiMultimap terms name -> Map name terms)
-> (BiMultimap types name -> Map name types)
-> Defns (BiMultimap terms name) (BiMultimap types name)
-> Defns (Map name terms) (Map name types)
forall a b c d. (a -> b) -> (c -> d) -> Defns a c -> Defns b d
forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap BiMultimap terms name -> Map name terms
forall a b. BiMultimap a b -> Map b a
BiMultimap.range BiMultimap types name -> Map name types
forall a b. BiMultimap a b -> Map b a
BiMultimap.range

forgetNames :: Defns (BiMultimap terms name) (BiMultimap types name) -> DefnsF Set terms types
forgetNames :: forall terms name types.
Defns (BiMultimap terms name) (BiMultimap types name)
-> DefnsF Set terms types
forgetNames =
  (BiMultimap terms name -> Set terms)
-> (BiMultimap types name -> Set types)
-> Defns (BiMultimap terms name) (BiMultimap types name)
-> Defns (Set terms) (Set types)
forall a b c d. (a -> b) -> (c -> d) -> Defns a c -> Defns b d
forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap BiMultimap terms name -> Set terms
forall a b. BiMultimap a b -> Set a
BiMultimap.dom BiMultimap types name -> Set types
forall a b. BiMultimap a b -> Set a
BiMultimap.dom

restrictNames ::
  (Ord name, Ord terms, Ord types) =>
  DefnsF Set name name ->
  Defns (BiMultimap terms name) (BiMultimap types name) ->
  Defns (BiMultimap terms name) (BiMultimap types name)
restrictNames :: forall name terms types.
(Ord name, Ord terms, Ord types) =>
DefnsF Set name name
-> Defns (BiMultimap terms name) (BiMultimap types name)
-> Defns (BiMultimap terms name) (BiMultimap types name)
restrictNames =
  (Set name -> BiMultimap terms name -> BiMultimap terms name)
-> (Set name -> BiMultimap types name -> BiMultimap types name)
-> Defns (Set name) (Set name)
-> Defns (BiMultimap terms name) (BiMultimap types name)
-> Defns (BiMultimap terms name) (BiMultimap types name)
forall tm1 tm2 tm3 ty1 ty2 ty3.
(tm1 -> tm2 -> tm3)
-> (ty1 -> ty2 -> ty3)
-> Defns tm1 ty1
-> Defns tm2 ty2
-> Defns tm3 ty3
zipDefnsWith Set name -> BiMultimap terms name -> BiMultimap terms name
forall a b.
(Ord a, Ord b) =>
Set b -> BiMultimap a b -> BiMultimap a b
BiMultimap.restrictRan Set name -> BiMultimap types name -> BiMultimap types name
forall a b.
(Ord a, Ord b) =>
Set b -> BiMultimap a b -> BiMultimap a b
BiMultimap.restrictRan

referentsToIds :: DefnsF Set Referent TypeReference -> DefnsF Set TermReferenceId TypeReferenceId
referentsToIds :: DefnsF Set Referent TypeReference
-> Defns (Set (Id' Hash)) (Set (Id' Hash))
referentsToIds DefnsF Set Referent TypeReference
defns =
  Defns (Set (Id' Hash)) (Set (Id' Hash))
fromTerms Defns (Set (Id' Hash)) (Set (Id' Hash))
-> Defns (Set (Id' Hash)) (Set (Id' Hash))
-> Defns (Set (Id' Hash)) (Set (Id' Hash))
forall a. Semigroup a => a -> a -> a
<> Set (Id' Hash) -> Defns (Set (Id' Hash)) (Set (Id' Hash))
forall terms types. Monoid terms => types -> Defns terms types
Defns.fromTypes ((TypeReference -> Maybe (Id' Hash))
-> Set TypeReference -> Set (Id' Hash)
forall b a. Ord b => (a -> Maybe b) -> Set a -> Set b
Set.mapMaybe TypeReference -> Maybe (Id' Hash)
Reference.toId DefnsF Set Referent TypeReference
defns.types)
  where
    fromTerms :: Defns (Set (Id' Hash)) (Set (Id' Hash))
fromTerms =
      (Defns (Set (Id' Hash)) (Set (Id' Hash))
 -> Referent -> Defns (Set (Id' Hash)) (Set (Id' Hash)))
-> Defns (Set (Id' Hash)) (Set (Id' Hash))
-> Set Referent
-> Defns (Set (Id' Hash)) (Set (Id' Hash))
forall a b. (a -> b -> a) -> a -> Set b -> a
Set.foldl'
        ( \Defns (Set (Id' Hash)) (Set (Id' Hash))
acc -> \case
            Referent.Ref (ReferenceDerived Id' Hash
ref) ->
              let !terms :: Set (Id' Hash)
terms = Id' Hash -> Set (Id' Hash) -> Set (Id' Hash)
forall a. Ord a => a -> Set a -> Set a
Set.insert Id' Hash
ref Defns (Set (Id' Hash)) (Set (Id' Hash))
acc.terms in Set (Id' Hash)
-> Set (Id' Hash) -> Defns (Set (Id' Hash)) (Set (Id' Hash))
forall terms types. terms -> types -> Defns terms types
Defns Set (Id' Hash)
terms Defns (Set (Id' Hash)) (Set (Id' Hash))
acc.types
            Referent.Con (ConstructorReference (ReferenceDerived Id' Hash
ref) ConstructorId
_) ConstructorType
_ ->
              let !types :: Set (Id' Hash)
types = Id' Hash -> Set (Id' Hash) -> Set (Id' Hash)
forall a. Ord a => a -> Set a -> Set a
Set.insert Id' Hash
ref Defns (Set (Id' Hash)) (Set (Id' Hash))
acc.types in Set (Id' Hash)
-> Set (Id' Hash) -> Defns (Set (Id' Hash)) (Set (Id' Hash))
forall terms types. terms -> types -> Defns terms types
Defns Defns (Set (Id' Hash)) (Set (Id' Hash))
acc.terms Set (Id' Hash)
types
            Referent
_ -> Defns (Set (Id' Hash)) (Set (Id' Hash))
acc
        )
        (Set (Id' Hash)
-> Set (Id' Hash) -> Defns (Set (Id' Hash)) (Set (Id' Hash))
forall terms types. terms -> types -> Defns terms types
Defns Set (Id' Hash)
forall a. Set a
Set.empty Set (Id' Hash)
forall a. Set a
Set.empty)
        DefnsF Set Referent TypeReference
defns.terms