module Unison.PrettyPrintEnv.Names
  ( -- * Namer
    Namer (..),
    hqNamer,
    namer,

    -- * Suffixifier
    Suffixifier,
    dontSuffixify,
    suffixifyByHash,
    suffixifyByHashName,
    suffixifyByName,
    suffixifyByHashWithUnhashedTermsInScope,

    -- * Pretty-print env
    makePPE,
    makeTermNames,
    makeTypeNames,
  )
where

import Data.Set qualified as Set
import Unison.HashQualifiedPrime qualified as HQ'
import Unison.Name (Name)
import Unison.Name qualified as Name
import Unison.Names (Names)
import Unison.Names qualified as Names
import Unison.Names.ResolvesTo (ResolvesTo (..))
import Unison.NamesWithHistory qualified as Names
import Unison.Prelude
import Unison.PrettyPrintEnv (PrettyPrintEnv (PrettyPrintEnv))
import Unison.Reference (TypeReference)
import Unison.Referent (Referent)
import Unison.Util.Relation (Relation)
import Unison.Util.Relation qualified as Relation

------------------------------------------------------------------------------------------------------------------------
-- Namer

-- | A "namer" associates a set of (possibly hash-qualified) names with a referent / type reference.
data Namer = Namer
  { Namer -> Referent -> Set (HashQualified Name)
nameTerm :: Referent -> Set (HQ'.HashQualified Name),
    Namer -> TypeReference -> Set (HashQualified Name)
nameType :: TypeReference -> Set (HQ'.HashQualified Name)
  }

-- | Make a "namer" out of a collection of names, ignoring conflicted names. That is, if references #foo and #bar are
-- both associated with name "baz", then the returned namer maps #foo too "baz" (not "baz"#foo) and #bar to "baz" (not
-- "baz"#bar).
namer :: Names -> Namer
namer :: Names -> Namer
namer Names
names =
  Namer
    { $sel:nameTerm:Namer :: Referent -> Set (HashQualified Name)
nameTerm = (Name -> HashQualified Name)
-> Set Name -> Set (HashQualified Name)
forall b a. Ord b => (a -> b) -> Set a -> Set b
Set.map Name -> HashQualified Name
forall n. n -> HashQualified n
HQ'.fromName (Set Name -> Set (HashQualified Name))
-> (Referent -> Set Name) -> Referent -> Set (HashQualified Name)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Names -> Referent -> Set Name
Names.namesForReferent Names
names,
      $sel:nameType:Namer :: TypeReference -> Set (HashQualified Name)
nameType = (Name -> HashQualified Name)
-> Set Name -> Set (HashQualified Name)
forall b a. Ord b => (a -> b) -> Set a -> Set b
Set.map Name -> HashQualified Name
forall n. n -> HashQualified n
HQ'.fromName (Set Name -> Set (HashQualified Name))
-> (TypeReference -> Set Name)
-> TypeReference
-> Set (HashQualified Name)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Names -> TypeReference -> Set Name
Names.namesForReference Names
names
    }

-- | Make a "namer" out of a collection of names, respecting conflicted names. That is, if references #foo and #bar are
-- both associated with name "baz", then the returned namer maps #foo too "baz"#foo and #bar to "baz"#bar, but otherwise
-- if a reference #qux has a single name "qux", then the returned namer maps #qux to "qux" (not "qux"#qux).
hqNamer :: Int -> Names -> Namer
hqNamer :: Int -> Names -> Namer
hqNamer Int
hashLen Names
names =
  Namer
    { $sel:nameTerm:Namer :: Referent -> Set (HashQualified Name)
nameTerm = \Referent
ref -> Int -> Referent -> Names -> Set (HashQualified Name)
Names.termName Int
hashLen Referent
ref Names
names,
      $sel:nameType:Namer :: TypeReference -> Set (HashQualified Name)
nameType = \TypeReference
ref -> Int -> TypeReference -> Names -> Set (HashQualified Name)
Names.typeName Int
hashLen TypeReference
ref Names
names
    }

------------------------------------------------------------------------------------------------------------------------
-- Suffixifier

data Suffixifier = Suffixifier
  { Suffixifier -> Name -> Name
suffixifyTerm :: Name -> Name,
    Suffixifier -> Name -> Name
suffixifyType :: Name -> Name
  }

dontSuffixify :: Suffixifier
dontSuffixify :: Suffixifier
dontSuffixify =
  (Name -> Name) -> (Name -> Name) -> Suffixifier
Suffixifier Name -> Name
forall a. a -> a
id Name -> Name
forall a. a -> a
id

suffixifyByName :: Names -> Suffixifier
suffixifyByName :: Names -> Suffixifier
suffixifyByName Names
names =
  Suffixifier
    { $sel:suffixifyTerm:Suffixifier :: Name -> Name
suffixifyTerm = \Name
name -> Name -> Relation Name Referent -> Name
forall r. Ord r => Name -> Relation Name r -> Name
Name.suffixifyByName Name
name (Names -> Relation Name Referent
Names.terms Names
names),
      $sel:suffixifyType:Suffixifier :: Name -> Name
suffixifyType = \Name
name -> Name -> Relation Name TypeReference -> Name
forall r. Ord r => Name -> Relation Name r -> Name
Name.suffixifyByName Name
name (Names -> Relation Name TypeReference
Names.types Names
names)
    }

suffixifyByHash :: Names -> Suffixifier
suffixifyByHash :: Names -> Suffixifier
suffixifyByHash Names
names =
  Suffixifier
    { $sel:suffixifyTerm:Suffixifier :: Name -> Name
suffixifyTerm = \Name
name -> Name -> Relation Name Referent -> Name
forall r. Ord r => Name -> Relation Name r -> Name
Name.suffixifyByHash Name
name (Names -> Relation Name Referent
Names.terms Names
names),
      $sel:suffixifyType:Suffixifier :: Name -> Name
suffixifyType = \Name
name -> Name -> Relation Name TypeReference -> Name
forall r. Ord r => Name -> Relation Name r -> Name
Name.suffixifyByHash Name
name (Names -> Relation Name TypeReference
Names.types Names
names)
    }

suffixifyByHashName :: Names -> Suffixifier
suffixifyByHashName :: Names -> Suffixifier
suffixifyByHashName Names
names =
  Suffixifier
    { $sel:suffixifyTerm:Suffixifier :: Name -> Name
suffixifyTerm = \Name
name -> Name -> Relation Name Referent -> Name
forall r. Ord r => Name -> Relation Name r -> Name
Name.suffixifyByHashName Name
name (Names -> Relation Name Referent
Names.terms Names
names),
      $sel:suffixifyType:Suffixifier :: Name -> Name
suffixifyType = \Name
name -> Name -> Relation Name TypeReference -> Name
forall r. Ord r => Name -> Relation Name r -> Name
Name.suffixifyByHashName Name
name (Names -> Relation Name TypeReference
Names.types Names
names)
    }

suffixifyByHashWithUnhashedTermsInScope :: Set Name -> Names -> Suffixifier
suffixifyByHashWithUnhashedTermsInScope :: Set Name -> Names -> Suffixifier
suffixifyByHashWithUnhashedTermsInScope Set Name
localTermNames Names
namespaceNames =
  Suffixifier
    { $sel:suffixifyTerm:Suffixifier :: Name -> Name
suffixifyTerm = \Name
name -> Name -> Relation Name (ResolvesTo Referent) -> Name
forall r. Ord r => Name -> Relation Name r -> Name
Name.suffixifyByHash Name
name Relation Name (ResolvesTo Referent)
terms,
      $sel:suffixifyType:Suffixifier :: Name -> Name
suffixifyType = \Name
name -> Name -> Relation Name TypeReference -> Name
forall r. Ord r => Name -> Relation Name r -> Name
Name.suffixifyByHash Name
name (Names -> Relation Name TypeReference
Names.types Names
namespaceNames)
    }
  where
    terms :: Relation Name (ResolvesTo Referent)
    terms :: Relation Name (ResolvesTo Referent)
terms =
      Names -> Relation Name Referent
Names.terms Names
namespaceNames
        Relation Name Referent
-> (Relation Name Referent -> Relation Name Referent)
-> Relation Name Referent
forall a b. a -> (a -> b) -> b
& Set Name -> Relation Name Referent -> Relation Name Referent
forall a b. (Ord a, Ord b) => Set a -> Relation a b -> Relation a b
Relation.subtractDom Set Name
localTermNames
        Relation Name Referent
-> (Relation Name Referent -> Relation Name (ResolvesTo Referent))
-> Relation Name (ResolvesTo Referent)
forall a b. a -> (a -> b) -> b
& (Referent -> ResolvesTo Referent)
-> Relation Name Referent -> Relation Name (ResolvesTo Referent)
forall a b b'.
(Ord a, Ord b, Ord b') =>
(b -> b') -> Relation a b -> Relation a b'
Relation.mapRan Referent -> ResolvesTo Referent
forall ref. ref -> ResolvesTo ref
ResolvesToNamespace
        Relation Name (ResolvesTo Referent)
-> (Relation Name (ResolvesTo Referent)
    -> Relation Name (ResolvesTo Referent))
-> Relation Name (ResolvesTo Referent)
forall a b. a -> (a -> b) -> b
& Relation Name (ResolvesTo Referent)
-> Relation Name (ResolvesTo Referent)
-> Relation Name (ResolvesTo Referent)
forall a b.
(Ord a, Ord b) =>
Relation a b -> Relation a b -> Relation a b
Relation.union ([(Name, ResolvesTo Referent)]
-> Relation Name (ResolvesTo Referent)
forall a b. (Ord a, Ord b) => [(a, b)] -> Relation a b
Relation.fromList ((Name -> (Name, ResolvesTo Referent))
-> [Name] -> [(Name, ResolvesTo Referent)]
forall a b. (a -> b) -> [a] -> [b]
map (\Name
name -> (Name
name, Name -> ResolvesTo Referent
forall ref. Name -> ResolvesTo ref
ResolvesToLocal Name
name)) (Set Name -> [Name]
forall a. Set a -> [a]
Set.toList Set Name
localTermNames)))

------------------------------------------------------------------------------------------------------------------------
-- Pretty-print env

makePPE :: Namer -> Suffixifier -> PrettyPrintEnv
makePPE :: Namer -> Suffixifier -> PrettyPrintEnv
makePPE Namer
namer Suffixifier
suffixifier =
  (Referent -> [(HashQualified Name, HashQualified Name)])
-> (TypeReference -> [(HashQualified Name, HashQualified Name)])
-> PrettyPrintEnv
PrettyPrintEnv
    (Namer
-> Suffixifier
-> Referent
-> [(HashQualified Name, HashQualified Name)]
makeTermNames Namer
namer Suffixifier
suffixifier)
    (Namer
-> Suffixifier
-> TypeReference
-> [(HashQualified Name, HashQualified Name)]
makeTypeNames Namer
namer Suffixifier
suffixifier)

makeTermNames :: Namer -> Suffixifier -> Referent -> [(HQ'.HashQualified Name, HQ'.HashQualified Name)]
makeTermNames :: Namer
-> Suffixifier
-> Referent
-> [(HashQualified Name, HashQualified Name)]
makeTermNames Namer {Referent -> Set (HashQualified Name)
$sel:nameTerm:Namer :: Namer -> Referent -> Set (HashQualified Name)
nameTerm :: Referent -> Set (HashQualified Name)
nameTerm} Suffixifier {Name -> Name
$sel:suffixifyTerm:Suffixifier :: Suffixifier -> Name -> Name
suffixifyTerm :: Name -> Name
suffixifyTerm} =
  [(HashQualified Name, HashQualified Name)]
-> [(HashQualified Name, HashQualified Name)]
prioritize ([(HashQualified Name, HashQualified Name)]
 -> [(HashQualified Name, HashQualified Name)])
-> (Referent -> [(HashQualified Name, HashQualified Name)])
-> Referent
-> [(HashQualified Name, HashQualified Name)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (HashQualified Name -> (HashQualified Name, HashQualified Name))
-> [HashQualified Name]
-> [(HashQualified Name, HashQualified Name)]
forall a b. (a -> b) -> [a] -> [b]
map (\HashQualified Name
name -> (HashQualified Name
name, Name -> Name
suffixifyTerm (Name -> Name) -> HashQualified Name -> HashQualified Name
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> HashQualified Name
name)) ([HashQualified Name]
 -> [(HashQualified Name, HashQualified Name)])
-> (Referent -> [HashQualified Name])
-> Referent
-> [(HashQualified Name, HashQualified Name)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Set (HashQualified Name) -> [HashQualified Name]
forall a. Set a -> [a]
Set.toList (Set (HashQualified Name) -> [HashQualified Name])
-> (Referent -> Set (HashQualified Name))
-> Referent
-> [HashQualified Name]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Referent -> Set (HashQualified Name)
nameTerm

makeTypeNames :: Namer -> Suffixifier -> TypeReference -> [(HQ'.HashQualified Name, HQ'.HashQualified Name)]
makeTypeNames :: Namer
-> Suffixifier
-> TypeReference
-> [(HashQualified Name, HashQualified Name)]
makeTypeNames Namer {TypeReference -> Set (HashQualified Name)
$sel:nameType:Namer :: Namer -> TypeReference -> Set (HashQualified Name)
nameType :: TypeReference -> Set (HashQualified Name)
nameType} Suffixifier {Name -> Name
$sel:suffixifyType:Suffixifier :: Suffixifier -> Name -> Name
suffixifyType :: Name -> Name
suffixifyType} =
  [(HashQualified Name, HashQualified Name)]
-> [(HashQualified Name, HashQualified Name)]
prioritize ([(HashQualified Name, HashQualified Name)]
 -> [(HashQualified Name, HashQualified Name)])
-> (TypeReference -> [(HashQualified Name, HashQualified Name)])
-> TypeReference
-> [(HashQualified Name, HashQualified Name)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (HashQualified Name -> (HashQualified Name, HashQualified Name))
-> [HashQualified Name]
-> [(HashQualified Name, HashQualified Name)]
forall a b. (a -> b) -> [a] -> [b]
map (\HashQualified Name
name -> (HashQualified Name
name, Name -> Name
suffixifyType (Name -> Name) -> HashQualified Name -> HashQualified Name
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> HashQualified Name
name)) ([HashQualified Name]
 -> [(HashQualified Name, HashQualified Name)])
-> (TypeReference -> [HashQualified Name])
-> TypeReference
-> [(HashQualified Name, HashQualified Name)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Set (HashQualified Name) -> [HashQualified Name]
forall a. Set a -> [a]
Set.toList (Set (HashQualified Name) -> [HashQualified Name])
-> (TypeReference -> Set (HashQualified Name))
-> TypeReference
-> [HashQualified Name]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TypeReference -> Set (HashQualified Name)
nameType

-- | Sort the names for a given ref by the following factors (in priority order):
--
-- 1. Prefer Relative Names to Absolute Names
-- 2. Prefer names that aren't hash qualified to those that are
-- 3. Prefer names which have fewer segments in their fully-qualified form
-- 4. Prefer names which have fewer segments in their suffixified form (if applicable)
prioritize :: [(HQ'.HashQualified Name, HQ'.HashQualified Name)] -> [(HQ'.HashQualified Name, HQ'.HashQualified Name)]
prioritize :: [(HashQualified Name, HashQualified Name)]
-> [(HashQualified Name, HashQualified Name)]
prioritize =
  ((HashQualified Name, HashQualified Name)
 -> (Bool, Maybe ShortHash, Int, Int))
-> [(HashQualified Name, HashQualified Name)]
-> [(HashQualified Name, HashQualified Name)]
forall b a. Ord b => (a -> b) -> [a] -> [a]
sortOn \case
    (HashQualified Name
fqn, HQ'.NameOnly Name
name) -> (Name -> Bool
Name.isAbsolute Name
name, Maybe ShortHash
forall a. Maybe a
Nothing, Name -> Int
Name.countSegments (HashQualified Name -> Name
forall n. HashQualified n -> n
HQ'.toName HashQualified Name
fqn), Name -> Int
Name.countSegments Name
name)
    (HashQualified Name
fqn, HQ'.HashQualified Name
name ShortHash
hash) -> (Name -> Bool
Name.isAbsolute Name
name, ShortHash -> Maybe ShortHash
forall a. a -> Maybe a
Just ShortHash
hash, Name -> Int
Name.countSegments (HashQualified Name -> Name
forall n. HashQualified n -> n
HQ'.toName HashQualified Name
fqn), Name -> Int
Name.countSegments Name
name)