-- | A utility module for unconflicted namespaces and related types/functionality.
module Unison.NamesUtils
  ( byName,
    forgetNames,
    referentsToIds,
    referentsToRefs,
    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.ReferentPrime (Referent')
import Unison.ReferentPrime 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 TermReferenceId) (Set TermReferenceId)
referentsToIds DefnsF Set Referent TypeReference
defns =
  Defns (Set TermReferenceId) (Set TermReferenceId)
fromTerms Defns (Set TermReferenceId) (Set TermReferenceId)
-> Defns (Set TermReferenceId) (Set TermReferenceId)
-> Defns (Set TermReferenceId) (Set TermReferenceId)
forall a. Semigroup a => a -> a -> a
<> Defns (Set TermReferenceId) (Set TermReferenceId)
fromTypes
  where
    fromTerms :: Defns (Set TermReferenceId) (Set TermReferenceId)
fromTerms =
      (Defns (Set TermReferenceId) (Set TermReferenceId)
 -> Referent -> Defns (Set TermReferenceId) (Set TermReferenceId))
-> Defns (Set TermReferenceId) (Set TermReferenceId)
-> Set Referent
-> Defns (Set TermReferenceId) (Set TermReferenceId)
forall a b. (a -> b -> a) -> a -> Set b -> a
Set.foldl'
        ( \Defns (Set TermReferenceId) (Set TermReferenceId)
acc -> \case
            Referent.Ref (ReferenceDerived TermReferenceId
ref) ->
              let !terms :: Set TermReferenceId
terms = TermReferenceId -> Set TermReferenceId -> Set TermReferenceId
forall a. Ord a => a -> Set a -> Set a
Set.insert TermReferenceId
ref Defns (Set TermReferenceId) (Set TermReferenceId)
acc.terms in Set TermReferenceId
-> Set TermReferenceId
-> Defns (Set TermReferenceId) (Set TermReferenceId)
forall terms types. terms -> types -> Defns terms types
Defns Set TermReferenceId
terms Defns (Set TermReferenceId) (Set TermReferenceId)
acc.types
            Referent.Con (ConstructorReference (ReferenceDerived TermReferenceId
ref) ConstructorId
_) ConstructorType
_ ->
              let !types :: Set TermReferenceId
types = TermReferenceId -> Set TermReferenceId -> Set TermReferenceId
forall a. Ord a => a -> Set a -> Set a
Set.insert TermReferenceId
ref Defns (Set TermReferenceId) (Set TermReferenceId)
acc.types in Set TermReferenceId
-> Set TermReferenceId
-> Defns (Set TermReferenceId) (Set TermReferenceId)
forall terms types. terms -> types -> Defns terms types
Defns Defns (Set TermReferenceId) (Set TermReferenceId)
acc.terms Set TermReferenceId
types
            Referent
_ -> Defns (Set TermReferenceId) (Set TermReferenceId)
acc
        )
        (Set TermReferenceId
-> Set TermReferenceId
-> Defns (Set TermReferenceId) (Set TermReferenceId)
forall terms types. terms -> types -> Defns terms types
Defns Set TermReferenceId
forall a. Set a
Set.empty Set TermReferenceId
forall a. Set a
Set.empty)
        DefnsF Set Referent TypeReference
defns.terms

    fromTypes :: Defns (Set TermReferenceId) (Set TermReferenceId)
fromTypes =
      Set TermReferenceId
-> Defns (Set TermReferenceId) (Set TermReferenceId)
forall terms types. Monoid terms => types -> Defns terms types
Defns.fromTypes ((TypeReference -> Maybe TermReferenceId)
-> Set TypeReference -> Set TermReferenceId
forall b a. Ord b => (a -> Maybe b) -> Set a -> Set b
Set.mapMaybe TypeReference -> Maybe TermReferenceId
Reference.toId DefnsF Set Referent TypeReference
defns.types)

referentsToRefs :: (Ord r) => DefnsF Set (Referent' r) r -> DefnsF Set r r
referentsToRefs :: forall r. Ord r => DefnsF Set (Referent' r) r -> DefnsF Set r r
referentsToRefs DefnsF Set (Referent' r) r
defns =
  Defns (Set r) (Set r)
fromTerms Defns (Set r) (Set r)
-> Defns (Set r) (Set r) -> Defns (Set r) (Set r)
forall a. Semigroup a => a -> a -> a
<> Defns (Set r) (Set r)
fromTypes
  where
    fromTerms :: Defns (Set r) (Set r)
fromTerms =
      (Defns (Set r) (Set r) -> Referent' r -> Defns (Set r) (Set r))
-> Defns (Set r) (Set r)
-> Set (Referent' r)
-> Defns (Set r) (Set r)
forall a b. (a -> b -> a) -> a -> Set b -> a
Set.foldl'
        ( \Defns (Set r) (Set r)
acc -> \case
            Referent'.Ref' r
ref -> let !terms :: Set r
terms = r -> Set r -> Set r
forall a. Ord a => a -> Set a -> Set a
Set.insert r
ref Defns (Set r) (Set r)
acc.terms in Set r -> Set r -> Defns (Set r) (Set r)
forall terms types. terms -> types -> Defns terms types
Defns Set r
terms Defns (Set r) (Set r)
acc.types
            Referent'.Con' (ConstructorReference r
ref ConstructorId
_) ConstructorType
_ ->
              let !types :: Set r
types = r -> Set r -> Set r
forall a. Ord a => a -> Set a -> Set a
Set.insert r
ref Defns (Set r) (Set r)
acc.types in Set r -> Set r -> Defns (Set r) (Set r)
forall terms types. terms -> types -> Defns terms types
Defns Defns (Set r) (Set r)
acc.terms Set r
types
        )
        (Set r -> Set r -> Defns (Set r) (Set r)
forall terms types. terms -> types -> Defns terms types
Defns Set r
forall a. Set a
Set.empty Set r
forall a. Set a
Set.empty)
        DefnsF Set (Referent' r) r
defns.terms

    fromTypes :: Defns (Set r) (Set r)
fromTypes =
      Set r -> Defns (Set r) (Set r)
forall terms types. Monoid terms => types -> Defns terms types
Defns.fromTypes DefnsF Set (Referent' r) r
defns.types