module Unison.PrettyPrintEnv
  ( PrettyPrintEnv (..),
    patterns,
    patternName,
    terms,
    types,
    allTermNames,
    allTypeNames,
    termName,
    typeName,
    termNameOrHashOnly,
    typeNameOrHashOnly,
    termNameOrHashOnlyFq,
    typeNameOrHashOnlyFq,
    biasTo,
    labeledRefName,
    -- | Exported only for cases where the codebase's configured hash length is unavailable.
    todoHashLength,
    addFallback,
    union,
    empty,
  )
where

import Data.Ord (Down (Down))
import Data.Semigroup (Max (Max))
import Unison.ConstructorReference (ConstructorReference)
import Unison.ConstructorType qualified as CT
import Unison.HashQualified (HashQualified)
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.Prelude hiding (empty)
import Unison.Reference (Reference)
import Unison.Referent (Referent)
import Unison.Referent qualified as Referent

data PrettyPrintEnv = PrettyPrintEnv
  { -- names for terms, constructors, and requests; e.g. [(original name, relativized and/or suffixified pretty name)]
    PrettyPrintEnv
-> Referent -> [(HashQualified Name, HashQualified Name)]
termNames :: Referent -> [(HQ'.HashQualified Name, HQ'.HashQualified Name)],
    -- names for types; e.g. [(original name, possibly suffixified name)]
    PrettyPrintEnv
-> Reference -> [(HashQualified Name, HashQualified Name)]
typeNames :: Reference -> [(HQ'.HashQualified Name, HQ'.HashQualified Name)]
  }
  deriving stock ((forall x. PrettyPrintEnv -> Rep PrettyPrintEnv x)
-> (forall x. Rep PrettyPrintEnv x -> PrettyPrintEnv)
-> Generic PrettyPrintEnv
forall x. Rep PrettyPrintEnv x -> PrettyPrintEnv
forall x. PrettyPrintEnv -> Rep PrettyPrintEnv x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. PrettyPrintEnv -> Rep PrettyPrintEnv x
from :: forall x. PrettyPrintEnv -> Rep PrettyPrintEnv x
$cto :: forall x. Rep PrettyPrintEnv x -> PrettyPrintEnv
to :: forall x. Rep PrettyPrintEnv x -> PrettyPrintEnv
Generic)

allTermNames :: PrettyPrintEnv -> Referent -> [HQ'.HashQualified Name]
allTermNames :: PrettyPrintEnv -> Referent -> [HashQualified Name]
allTermNames PrettyPrintEnv
ppe = ((HashQualified Name, HashQualified Name) -> HashQualified Name)
-> [(HashQualified Name, HashQualified Name)]
-> [HashQualified Name]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (HashQualified Name, HashQualified Name) -> HashQualified Name
forall a b. (a, b) -> b
snd ([(HashQualified Name, HashQualified Name)]
 -> [HashQualified Name])
-> (Referent -> [(HashQualified Name, HashQualified Name)])
-> Referent
-> [HashQualified Name]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PrettyPrintEnv
-> Referent -> [(HashQualified Name, HashQualified Name)]
termNames PrettyPrintEnv
ppe

allTypeNames :: PrettyPrintEnv -> Reference -> [HQ'.HashQualified Name]
allTypeNames :: PrettyPrintEnv -> Reference -> [HashQualified Name]
allTypeNames PrettyPrintEnv
ppe = ((HashQualified Name, HashQualified Name) -> HashQualified Name)
-> [(HashQualified Name, HashQualified Name)]
-> [HashQualified Name]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (HashQualified Name, HashQualified Name) -> HashQualified Name
forall a b. (a, b) -> b
snd ([(HashQualified Name, HashQualified Name)]
 -> [HashQualified Name])
-> (Reference -> [(HashQualified Name, HashQualified Name)])
-> Reference
-> [HashQualified Name]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PrettyPrintEnv
-> Reference -> [(HashQualified Name, HashQualified Name)]
typeNames PrettyPrintEnv
ppe

terms :: PrettyPrintEnv -> Referent -> Maybe (HQ'.HashQualified Name)
terms :: PrettyPrintEnv -> Referent -> Maybe (HashQualified Name)
terms PrettyPrintEnv
ppe = ((HashQualified Name, HashQualified Name) -> HashQualified Name)
-> Maybe (HashQualified Name, HashQualified Name)
-> Maybe (HashQualified Name)
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (HashQualified Name, HashQualified Name) -> HashQualified Name
forall a b. (a, b) -> b
snd (Maybe (HashQualified Name, HashQualified Name)
 -> Maybe (HashQualified Name))
-> (Referent -> Maybe (HashQualified Name, HashQualified Name))
-> Referent
-> Maybe (HashQualified Name)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(HashQualified Name, HashQualified Name)]
-> Maybe (HashQualified Name, HashQualified Name)
forall a. [a] -> Maybe a
listToMaybe ([(HashQualified Name, HashQualified Name)]
 -> Maybe (HashQualified Name, HashQualified Name))
-> (Referent -> [(HashQualified Name, HashQualified Name)])
-> Referent
-> Maybe (HashQualified Name, HashQualified Name)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PrettyPrintEnv
-> Referent -> [(HashQualified Name, HashQualified Name)]
termNames PrettyPrintEnv
ppe

types :: PrettyPrintEnv -> Reference -> Maybe (HQ'.HashQualified Name)
types :: PrettyPrintEnv -> Reference -> Maybe (HashQualified Name)
types PrettyPrintEnv
ppe = ((HashQualified Name, HashQualified Name) -> HashQualified Name)
-> Maybe (HashQualified Name, HashQualified Name)
-> Maybe (HashQualified Name)
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (HashQualified Name, HashQualified Name) -> HashQualified Name
forall a b. (a, b) -> b
snd (Maybe (HashQualified Name, HashQualified Name)
 -> Maybe (HashQualified Name))
-> (Reference -> Maybe (HashQualified Name, HashQualified Name))
-> Reference
-> Maybe (HashQualified Name)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(HashQualified Name, HashQualified Name)]
-> Maybe (HashQualified Name, HashQualified Name)
forall a. [a] -> Maybe a
listToMaybe ([(HashQualified Name, HashQualified Name)]
 -> Maybe (HashQualified Name, HashQualified Name))
-> (Reference -> [(HashQualified Name, HashQualified Name)])
-> Reference
-> Maybe (HashQualified Name, HashQualified Name)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PrettyPrintEnv
-> Reference -> [(HashQualified Name, HashQualified Name)]
typeNames PrettyPrintEnv
ppe

termNameOrHashOnly :: PrettyPrintEnv -> Referent -> HQ.HashQualified Name
termNameOrHashOnly :: PrettyPrintEnv -> Referent -> HashQualified Name
termNameOrHashOnly PrettyPrintEnv
ppe Referent
r = HashQualified Name
-> (HashQualified Name -> HashQualified Name)
-> Maybe (HashQualified Name)
-> HashQualified Name
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Referent -> HashQualified Name
HQ.fromReferent Referent
r) HashQualified Name -> HashQualified Name
forall n. HashQualified n -> HashQualified n
HQ'.toHQ (Maybe (HashQualified Name) -> HashQualified Name)
-> Maybe (HashQualified Name) -> HashQualified Name
forall a b. (a -> b) -> a -> b
$ PrettyPrintEnv -> Referent -> Maybe (HashQualified Name)
terms PrettyPrintEnv
ppe Referent
r

typeNameOrHashOnly :: PrettyPrintEnv -> Reference -> HQ.HashQualified Name
typeNameOrHashOnly :: PrettyPrintEnv -> Reference -> HashQualified Name
typeNameOrHashOnly PrettyPrintEnv
ppe Reference
r = HashQualified Name
-> (HashQualified Name -> HashQualified Name)
-> Maybe (HashQualified Name)
-> HashQualified Name
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Reference -> HashQualified Name
HQ.fromReference Reference
r) HashQualified Name -> HashQualified Name
forall n. HashQualified n -> HashQualified n
HQ'.toHQ (Maybe (HashQualified Name) -> HashQualified Name)
-> Maybe (HashQualified Name) -> HashQualified Name
forall a b. (a -> b) -> a -> b
$ PrettyPrintEnv -> Reference -> Maybe (HashQualified Name)
types PrettyPrintEnv
ppe Reference
r

-- Like 'termNameOrHashOnly' but returns the fully qualified name
termNameOrHashOnlyFq :: PrettyPrintEnv -> Referent -> HQ.HashQualified Name
termNameOrHashOnlyFq :: PrettyPrintEnv -> Referent -> HashQualified Name
termNameOrHashOnlyFq PrettyPrintEnv
ppe Referent
r =
  HashQualified Name
-> (HashQualified Name -> HashQualified Name)
-> Maybe (HashQualified Name)
-> HashQualified Name
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Referent -> HashQualified Name
HQ.fromReferent Referent
r) HashQualified Name -> HashQualified Name
forall n. HashQualified n -> HashQualified n
HQ'.toHQ (Maybe (HashQualified Name) -> HashQualified Name)
-> ([(HashQualified Name, HashQualified Name)]
    -> Maybe (HashQualified Name))
-> [(HashQualified Name, HashQualified Name)]
-> HashQualified Name
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((HashQualified Name, HashQualified Name) -> HashQualified Name)
-> Maybe (HashQualified Name, HashQualified Name)
-> Maybe (HashQualified Name)
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (HashQualified Name, HashQualified Name) -> HashQualified Name
forall a b. (a, b) -> a
fst (Maybe (HashQualified Name, HashQualified Name)
 -> Maybe (HashQualified Name))
-> ([(HashQualified Name, HashQualified Name)]
    -> Maybe (HashQualified Name, HashQualified Name))
-> [(HashQualified Name, HashQualified Name)]
-> Maybe (HashQualified Name)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(HashQualified Name, HashQualified Name)]
-> Maybe (HashQualified Name, HashQualified Name)
forall a. [a] -> Maybe a
listToMaybe ([(HashQualified Name, HashQualified Name)] -> HashQualified Name)
-> [(HashQualified Name, HashQualified Name)] -> HashQualified Name
forall a b. (a -> b) -> a -> b
$ PrettyPrintEnv
-> Referent -> [(HashQualified Name, HashQualified Name)]
termNames PrettyPrintEnv
ppe Referent
r

-- Like 'typeNameOrHashOnly' but returns the fully qualified name
typeNameOrHashOnlyFq :: PrettyPrintEnv -> Reference -> HQ.HashQualified Name
typeNameOrHashOnlyFq :: PrettyPrintEnv -> Reference -> HashQualified Name
typeNameOrHashOnlyFq PrettyPrintEnv
ppe Reference
r =
  HashQualified Name
-> (HashQualified Name -> HashQualified Name)
-> Maybe (HashQualified Name)
-> HashQualified Name
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Reference -> HashQualified Name
HQ.fromReference Reference
r) HashQualified Name -> HashQualified Name
forall n. HashQualified n -> HashQualified n
HQ'.toHQ (Maybe (HashQualified Name) -> HashQualified Name)
-> ([(HashQualified Name, HashQualified Name)]
    -> Maybe (HashQualified Name))
-> [(HashQualified Name, HashQualified Name)]
-> HashQualified Name
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((HashQualified Name, HashQualified Name) -> HashQualified Name)
-> Maybe (HashQualified Name, HashQualified Name)
-> Maybe (HashQualified Name)
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (HashQualified Name, HashQualified Name) -> HashQualified Name
forall a b. (a, b) -> a
fst (Maybe (HashQualified Name, HashQualified Name)
 -> Maybe (HashQualified Name))
-> ([(HashQualified Name, HashQualified Name)]
    -> Maybe (HashQualified Name, HashQualified Name))
-> [(HashQualified Name, HashQualified Name)]
-> Maybe (HashQualified Name)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(HashQualified Name, HashQualified Name)]
-> Maybe (HashQualified Name, HashQualified Name)
forall a. [a] -> Maybe a
listToMaybe ([(HashQualified Name, HashQualified Name)] -> HashQualified Name)
-> [(HashQualified Name, HashQualified Name)] -> HashQualified Name
forall a b. (a -> b) -> a -> b
$ PrettyPrintEnv
-> Reference -> [(HashQualified Name, HashQualified Name)]
typeNames PrettyPrintEnv
ppe Reference
r

patterns :: PrettyPrintEnv -> ConstructorReference -> Maybe (HQ'.HashQualified Name)
patterns :: PrettyPrintEnv
-> ConstructorReference -> Maybe (HashQualified Name)
patterns PrettyPrintEnv
ppe ConstructorReference
r =
  PrettyPrintEnv -> Referent -> Maybe (HashQualified Name)
terms PrettyPrintEnv
ppe (ConstructorReference -> ConstructorType -> Referent
Referent.Con ConstructorReference
r ConstructorType
CT.Data)
    Maybe (HashQualified Name)
-> Maybe (HashQualified Name) -> Maybe (HashQualified Name)
forall a. Maybe a -> Maybe a -> Maybe a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> PrettyPrintEnv -> Referent -> Maybe (HashQualified Name)
terms PrettyPrintEnv
ppe (ConstructorReference -> ConstructorType -> Referent
Referent.Con ConstructorReference
r ConstructorType
CT.Effect)

instance Show PrettyPrintEnv where
  show :: PrettyPrintEnv -> String
show PrettyPrintEnv
_ = String
"PrettyPrintEnv"

-- | Attempts to find a name in primary ppe, falls back to backup ppe only if no names are
-- found. Typically one can use this to shadow global or absolute names with names that are
-- within the current path.
addFallback :: PrettyPrintEnv -> PrettyPrintEnv -> PrettyPrintEnv
addFallback :: PrettyPrintEnv -> PrettyPrintEnv -> PrettyPrintEnv
addFallback PrettyPrintEnv
primary PrettyPrintEnv
fallback =
  (Referent -> [(HashQualified Name, HashQualified Name)])
-> (Reference -> [(HashQualified Name, HashQualified Name)])
-> PrettyPrintEnv
PrettyPrintEnv
    ( \Referent
r ->
        let primaryNames :: [(HashQualified Name, HashQualified Name)]
primaryNames = PrettyPrintEnv
-> Referent -> [(HashQualified Name, HashQualified Name)]
termNames PrettyPrintEnv
primary Referent
r
         in if [(HashQualified Name, HashQualified Name)] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [(HashQualified Name, HashQualified Name)]
primaryNames
              then PrettyPrintEnv
-> Referent -> [(HashQualified Name, HashQualified Name)]
termNames PrettyPrintEnv
fallback Referent
r
              else [(HashQualified Name, HashQualified Name)]
primaryNames
    )
    ( \Reference
r ->
        let primaryNames :: [(HashQualified Name, HashQualified Name)]
primaryNames = PrettyPrintEnv
-> Reference -> [(HashQualified Name, HashQualified Name)]
typeNames PrettyPrintEnv
primary Reference
r
         in if [(HashQualified Name, HashQualified Name)] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [(HashQualified Name, HashQualified Name)]
primaryNames
              then PrettyPrintEnv
-> Reference -> [(HashQualified Name, HashQualified Name)]
typeNames PrettyPrintEnv
fallback Reference
r
              else [(HashQualified Name, HashQualified Name)]
primaryNames
    )

-- | Finds names from both PPEs, if left unbiased the name from the left ppe is preferred.
--
-- This is distinct from `addFallback` with respect to biasing;
-- A bias applied to a union might select a name in the right half of the union.
-- Whereas, a bias applied to the result of `addFallback` will bias within the available names
-- inside the left PPE and will only search in the fallback if there aren't ANY names in the
-- primary ppe.
--
-- If you don't know the difference, it's likely you want 'addFallback' where you add global
-- names as a fallback for local names.
union :: PrettyPrintEnv -> PrettyPrintEnv -> PrettyPrintEnv
union :: PrettyPrintEnv -> PrettyPrintEnv -> PrettyPrintEnv
union PrettyPrintEnv
e1 PrettyPrintEnv
e2 =
  (Referent -> [(HashQualified Name, HashQualified Name)])
-> (Reference -> [(HashQualified Name, HashQualified Name)])
-> PrettyPrintEnv
PrettyPrintEnv
    (\Referent
r -> PrettyPrintEnv
-> Referent -> [(HashQualified Name, HashQualified Name)]
termNames PrettyPrintEnv
e1 Referent
r [(HashQualified Name, HashQualified Name)]
-> [(HashQualified Name, HashQualified Name)]
-> [(HashQualified Name, HashQualified Name)]
forall a. [a] -> [a] -> [a]
++ PrettyPrintEnv
-> Referent -> [(HashQualified Name, HashQualified Name)]
termNames PrettyPrintEnv
e2 Referent
r)
    (\Reference
r -> PrettyPrintEnv
-> Reference -> [(HashQualified Name, HashQualified Name)]
typeNames PrettyPrintEnv
e1 Reference
r [(HashQualified Name, HashQualified Name)]
-> [(HashQualified Name, HashQualified Name)]
-> [(HashQualified Name, HashQualified Name)]
forall a. [a] -> [a] -> [a]
++ PrettyPrintEnv
-> Reference -> [(HashQualified Name, HashQualified Name)]
typeNames PrettyPrintEnv
e2 Reference
r)

-- todo: these need to be a dynamic length, but we need additional info
todoHashLength :: Int
todoHashLength :: Int
todoHashLength = Int
10

termName :: PrettyPrintEnv -> Referent -> HashQualified Name
termName :: PrettyPrintEnv -> Referent -> HashQualified Name
termName PrettyPrintEnv
env Referent
r =
  case PrettyPrintEnv -> Referent -> Maybe (HashQualified Name)
terms PrettyPrintEnv
env Referent
r of
    Maybe (HashQualified Name)
Nothing -> Int -> HashQualified Name -> HashQualified Name
forall n. Int -> HashQualified n -> HashQualified n
HQ.take Int
todoHashLength (Referent -> HashQualified Name
HQ.fromReferent Referent
r)
    Just HashQualified Name
name -> HashQualified Name -> HashQualified Name
forall n. HashQualified n -> HashQualified n
HQ'.toHQ HashQualified Name
name

typeName :: PrettyPrintEnv -> Reference -> HashQualified Name
typeName :: PrettyPrintEnv -> Reference -> HashQualified Name
typeName PrettyPrintEnv
env Reference
r =
  case PrettyPrintEnv -> Reference -> Maybe (HashQualified Name)
types PrettyPrintEnv
env Reference
r of
    Maybe (HashQualified Name)
Nothing -> Int -> HashQualified Name -> HashQualified Name
forall n. Int -> HashQualified n -> HashQualified n
HQ.take Int
todoHashLength (Reference -> HashQualified Name
HQ.fromReference Reference
r)
    Just HashQualified Name
name -> HashQualified Name -> HashQualified Name
forall n. HashQualified n -> HashQualified n
HQ'.toHQ HashQualified Name
name

-- | Get a name for a LabeledDependency from the PPE.
labeledRefName :: PrettyPrintEnv -> LabeledDependency -> HashQualified Name
labeledRefName :: PrettyPrintEnv -> LabeledDependency -> HashQualified Name
labeledRefName PrettyPrintEnv
ppe = \case
  LD.TermReferent Referent
ref -> PrettyPrintEnv -> Referent -> HashQualified Name
termName PrettyPrintEnv
ppe Referent
ref
  LD.TypeReference Reference
ref -> PrettyPrintEnv -> Reference -> HashQualified Name
typeName PrettyPrintEnv
ppe Reference
ref

patternName :: PrettyPrintEnv -> ConstructorReference -> HashQualified Name
patternName :: PrettyPrintEnv -> ConstructorReference -> HashQualified Name
patternName PrettyPrintEnv
env ConstructorReference
r =
  case PrettyPrintEnv
-> ConstructorReference -> Maybe (HashQualified Name)
patterns PrettyPrintEnv
env ConstructorReference
r of
    Just HashQualified Name
name -> HashQualified Name -> HashQualified Name
forall n. HashQualified n -> HashQualified n
HQ'.toHQ HashQualified Name
name
    Maybe (HashQualified Name)
Nothing -> Int -> HashQualified Name -> HashQualified Name
forall n. Int -> HashQualified n -> HashQualified n
HQ.take Int
todoHashLength (HashQualified Name -> HashQualified Name)
-> HashQualified Name -> HashQualified Name
forall a b. (a -> b) -> a -> b
$ ConstructorReference -> HashQualified Name
HQ.fromPattern ConstructorReference
r

empty :: PrettyPrintEnv
empty :: PrettyPrintEnv
empty = (Referent -> [(HashQualified Name, HashQualified Name)])
-> (Reference -> [(HashQualified Name, HashQualified Name)])
-> PrettyPrintEnv
PrettyPrintEnv Referent -> [(HashQualified Name, HashQualified Name)]
forall a. Monoid a => a
mempty Reference -> [(HashQualified Name, HashQualified Name)]
forall a. Monoid a => a
mempty

-- | Prefer names which share a common prefix with any provided target.
--
-- Results are sorted according to the longest common prefix found against ANY target.
biasTo :: [Name] -> PrettyPrintEnv -> PrettyPrintEnv
biasTo :: [Name] -> PrettyPrintEnv -> PrettyPrintEnv
biasTo [Name]
targets PrettyPrintEnv {Referent -> [(HashQualified Name, HashQualified Name)]
$sel:termNames:PrettyPrintEnv :: PrettyPrintEnv
-> Referent -> [(HashQualified Name, HashQualified Name)]
termNames :: Referent -> [(HashQualified Name, HashQualified Name)]
termNames, Reference -> [(HashQualified Name, HashQualified Name)]
$sel:typeNames:PrettyPrintEnv :: PrettyPrintEnv
-> Reference -> [(HashQualified Name, HashQualified Name)]
typeNames :: Reference -> [(HashQualified Name, HashQualified Name)]
typeNames} =
  PrettyPrintEnv
    { $sel:termNames:PrettyPrintEnv :: Referent -> [(HashQualified Name, HashQualified Name)]
termNames = \Referent
r ->
        Referent
r
          Referent
-> (Referent -> [(HashQualified Name, HashQualified Name)])
-> [(HashQualified Name, HashQualified Name)]
forall a b. a -> (a -> b) -> b
& Referent -> [(HashQualified Name, HashQualified Name)]
termNames
          [(HashQualified Name, HashQualified Name)]
-> ([(HashQualified Name, HashQualified Name)]
    -> [(HashQualified Name, HashQualified Name)])
-> [(HashQualified Name, HashQualified Name)]
forall a b. a -> (a -> b) -> b
& [Name]
-> [(HashQualified Name, HashQualified Name)]
-> [(HashQualified Name, HashQualified Name)]
forall a.
[Name] -> [(HashQualified Name, a)] -> [(HashQualified Name, a)]
prioritizeBias [Name]
targets,
      $sel:typeNames:PrettyPrintEnv :: Reference -> [(HashQualified Name, HashQualified Name)]
typeNames = \Reference
r ->
        Reference
r
          Reference
-> (Reference -> [(HashQualified Name, HashQualified Name)])
-> [(HashQualified Name, HashQualified Name)]
forall a b. a -> (a -> b) -> b
& Reference -> [(HashQualified Name, HashQualified Name)]
typeNames
          [(HashQualified Name, HashQualified Name)]
-> ([(HashQualified Name, HashQualified Name)]
    -> [(HashQualified Name, HashQualified Name)])
-> [(HashQualified Name, HashQualified Name)]
forall a b. a -> (a -> b) -> b
& [Name]
-> [(HashQualified Name, HashQualified Name)]
-> [(HashQualified Name, HashQualified Name)]
forall a.
[Name] -> [(HashQualified Name, a)] -> [(HashQualified Name, a)]
prioritizeBias [Name]
targets
    }

-- | Prefer names which share a common prefix with any provided target.
--
-- Results are sorted according to the longest common prefix found against ANY target.
--
-- >>> prioritizeBias ["a.b", "x"] [(HQ'.unsafeFromText "q", ()), (HQ'.unsafeFromText "x.y", ()), (HQ'.unsafeFromText "a.b.c", ())]
-- [(a.b.c,()),(x.y,()),(q,())]
--
-- Sort is stable if there are no common prefixes
-- >>> prioritizeBias ["not-applicable"] [(HQ'.unsafeFromText "q", ()), (HQ'.unsafeFromText "a.b.c", ()), (HQ'.unsafeFromText "x", ())]
-- [(q,()),(a.b.c,()),(x,())]
prioritizeBias :: [Name] -> [(HQ'.HashQualified Name, a)] -> [(HQ'.HashQualified Name, a)]
prioritizeBias :: forall a.
[Name] -> [(HashQualified Name, a)] -> [(HashQualified Name, a)]
prioritizeBias [Name]
targets =
  ((HashQualified Name, a) -> Down (Max Int))
-> [(HashQualified Name, a)] -> [(HashQualified Name, a)]
forall b a. Ord b => (a -> b) -> [a] -> [a]
sortOn \(HashQualified Name
fqn, a
_) ->
    [Name]
targets
      [Name] -> ([Name] -> Maybe (Max Int)) -> Maybe (Max Int)
forall a b. a -> (a -> b) -> b
& (Name -> Maybe (Max Int)) -> [Name] -> Maybe (Max Int)
forall m a. Monoid m => (a -> m) -> [a] -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap
        ( \Name
target ->
            Max Int -> Maybe (Max Int)
forall a. a -> Maybe a
Just (Int -> Max Int
forall a. a -> Max a
Max ([NameSegment] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ([NameSegment] -> Int) -> [NameSegment] -> Int
forall a b. (a -> b) -> a -> b
$ Name -> Name -> [NameSegment]
Name.commonPrefix Name
target (HashQualified Name -> Name
forall n. HashQualified n -> n
HQ'.toName HashQualified Name
fqn)))
        )
      Maybe (Max Int) -> (Maybe (Max Int) -> Max Int) -> Max Int
forall a b. a -> (a -> b) -> b
& Max Int -> Maybe (Max Int) -> Max Int
forall a. a -> Maybe a -> a
fromMaybe Max Int
0
      Max Int -> (Max Int -> Down (Max Int)) -> Down (Max Int)
forall a b. a -> (a -> b) -> b
& Max Int -> Down (Max Int)
forall a. a -> Down a
Down -- Sort large common prefixes highest