module Unison.PrettyPrintEnvDecl.Sqlite
  ( ppedForReferences,
  )
where

import U.Codebase.Sqlite.NameLookups (ReversedName (..))
import U.Codebase.Sqlite.NamedRef (NamedRef (..))
import U.Codebase.Sqlite.Operations (NamesPerspective)
import U.Codebase.Sqlite.Operations qualified as Ops
import Unison.Codebase qualified as Codebase
import Unison.Codebase.SqliteCodebase.Conversions qualified as Cv
import Unison.LabeledDependency (LabeledDependency)
import Unison.LabeledDependency qualified as LD
import Unison.Name (Name)
import Unison.Name qualified as Name
import Unison.NameSegment.Internal (NameSegment (NameSegment))
import Unison.Names qualified as Names
import Unison.Prelude
import Unison.PrettyPrintEnv.Names qualified as PPE
import Unison.PrettyPrintEnvDecl qualified as PPED
import Unison.PrettyPrintEnvDecl.Names qualified as PPED
import Unison.Reference (Reference)
import Unison.Referent (Referent)
import Unison.Sqlite qualified as Sqlite
import Unison.Util.Monoid (foldMapM)

-- | Given a set of references, return a PPE which contains names for only those references.
-- Names are limited to those within the provided perspective
ppedForReferences :: NamesPerspective -> Set LabeledDependency -> Sqlite.Transaction PPED.PrettyPrintEnvDecl
ppedForReferences :: NamesPerspective
-> Set LabeledDependency -> Transaction PrettyPrintEnvDecl
ppedForReferences NamesPerspective
namesPerspective Set LabeledDependency
refs = do
  Int
hashLen <- Transaction Int
Codebase.hashLength
  ([(Name, Referent)]
termNames, [(Name, Reference)]
typeNames) <-
    Set LabeledDependency
refs Set LabeledDependency
-> (Set LabeledDependency
    -> Transaction ([(Name, Referent)], [(Name, Reference)]))
-> Transaction ([(Name, Referent)], [(Name, Reference)])
forall a b. a -> (a -> b) -> b
& (LabeledDependency
 -> Transaction ([(Name, Referent)], [(Name, Reference)]))
-> Set LabeledDependency
-> Transaction ([(Name, Referent)], [(Name, Reference)])
forall (m :: * -> *) (f :: * -> *) b a.
(Monad m, Foldable f, Monoid b) =>
(a -> m b) -> f a -> m b
foldMapM \LabeledDependency
ref ->
      NamesPerspective
-> LabeledDependency
-> Transaction ([(Name, Referent)], [(Name, Reference)])
namesForReference NamesPerspective
namesPerspective LabeledDependency
ref

  -- Ideally we'd only suffixify the name we're actually going to use, but due to name biasing
  -- we won't know that until we actually call the pretty-printer, so
  -- we add suffixifications for every name we have for each reference.
  [(Name, Referent)]
longestTermSuffixMatches <- [(Name, Referent)]
-> ((Name, Referent) -> Transaction (Maybe (Name, Referent)))
-> Transaction [(Name, Referent)]
forall (t :: * -> *) (f :: * -> *) a b.
(Witherable t, Applicative f) =>
t a -> (a -> f (Maybe b)) -> f (t b)
forMaybe [(Name, Referent)]
termNames \(Name
name, Referent
ref) -> do
    Maybe (Name, Referent)
result <-
      NamesPerspective
-> NamedRef Referent
-> Transaction (Maybe (NamedRef (Referent, Maybe ConstructorType)))
Ops.longestMatchingTermNameForSuffixification NamesPerspective
namesPerspective (NamedRef {$sel:reversedSegments:NamedRef :: ReversedName
reversedSegments = NonEmpty NameSegment -> ReversedName
forall a b. Coercible a b => a -> b
coerce (NonEmpty NameSegment -> ReversedName)
-> NonEmpty NameSegment -> ReversedName
forall a b. (a -> b) -> a -> b
$ Name -> NonEmpty NameSegment
Name.reverseSegments Name
name, $sel:ref:NamedRef :: Referent
ref = Referent -> Referent
Cv.referent1to2 Referent
ref})
        Transaction (Maybe (NamedRef (Referent, Maybe ConstructorType)))
-> (Maybe (NamedRef (Referent, Maybe ConstructorType))
    -> Maybe (Name, Referent))
-> Transaction (Maybe (Name, Referent))
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> (NamedRef (Referent, Maybe ConstructorType) -> (Name, Referent))
-> Maybe (NamedRef (Referent, Maybe ConstructorType))
-> Maybe (Name, Referent)
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap \(NamedRef {ReversedName
$sel:reversedSegments:NamedRef :: forall ref. NamedRef ref -> ReversedName
reversedSegments :: ReversedName
reversedSegments, $sel:ref:NamedRef :: forall ref. NamedRef ref -> ref
ref = (Referent
ref, Maybe ConstructorType
mayCt)}) ->
          let ct :: ConstructorType
ct = ConstructorType -> Maybe ConstructorType -> ConstructorType
forall a. a -> Maybe a -> a
fromMaybe ([Char] -> ConstructorType
forall a. HasCallStack => [Char] -> a
error [Char]
"ppedForReferences: Required constructor type for constructor but it was null") Maybe ConstructorType
mayCt
           in (NonEmpty NameSegment -> Name
Name.fromReverseSegments (ReversedName -> NonEmpty NameSegment
forall a b. Coercible a b => a -> b
coerce ReversedName
reversedSegments), ConstructorType -> Referent -> Referent
Cv.referent2to1UsingCT ConstructorType
ct Referent
ref)
    pure Maybe (Name, Referent)
result
  [(Name, Reference)]
longestTypeSuffixMatches <- [(Name, Reference)]
-> ((Name, Reference) -> Transaction (Maybe (Name, Reference)))
-> Transaction [(Name, Reference)]
forall (t :: * -> *) (f :: * -> *) a b.
(Witherable t, Applicative f) =>
t a -> (a -> f (Maybe b)) -> f (t b)
forMaybe [(Name, Reference)]
typeNames \(Name
name, Reference
ref) -> do
    Maybe (Name, Reference)
result <-
      NamesPerspective
-> NamedRef Reference -> Transaction (Maybe (NamedRef Reference))
Ops.longestMatchingTypeNameForSuffixification NamesPerspective
namesPerspective (NamedRef {$sel:reversedSegments:NamedRef :: ReversedName
reversedSegments = NonEmpty NameSegment -> ReversedName
forall a b. Coercible a b => a -> b
coerce (NonEmpty NameSegment -> ReversedName)
-> NonEmpty NameSegment -> ReversedName
forall a b. (a -> b) -> a -> b
$ Name -> NonEmpty NameSegment
Name.reverseSegments Name
name, $sel:ref:NamedRef :: Reference
ref = Reference -> Reference
Cv.reference1to2 Reference
ref})
        Transaction (Maybe (NamedRef Reference))
-> (Maybe (NamedRef Reference) -> Maybe (Name, Reference))
-> Transaction (Maybe (Name, Reference))
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> (NamedRef Reference -> (Name, Reference))
-> Maybe (NamedRef Reference) -> Maybe (Name, Reference)
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap \(NamedRef {ReversedName
$sel:reversedSegments:NamedRef :: forall ref. NamedRef ref -> ReversedName
reversedSegments :: ReversedName
reversedSegments, Reference
$sel:ref:NamedRef :: forall ref. NamedRef ref -> ref
ref :: Reference
ref}) ->
          (NonEmpty NameSegment -> Name
Name.fromReverseSegments (ReversedName -> NonEmpty NameSegment
forall a b. Coercible a b => a -> b
coerce ReversedName
reversedSegments), Reference -> Reference
Cv.reference2to1 Reference
ref)
    pure Maybe (Name, Reference)
result
  let allTermNamesToConsider :: [(Name, Referent)]
allTermNamesToConsider = [(Name, Referent)]
termNames [(Name, Referent)] -> [(Name, Referent)] -> [(Name, Referent)]
forall a. Semigroup a => a -> a -> a
<> [(Name, Referent)]
longestTermSuffixMatches
  let allTypeNamesToConsider :: [(Name, Reference)]
allTypeNamesToConsider = [(Name, Reference)]
typeNames [(Name, Reference)] -> [(Name, Reference)] -> [(Name, Reference)]
forall a. Semigroup a => a -> a -> a
<> [(Name, Reference)]
longestTypeSuffixMatches
  let names :: Names
names = [(Name, Referent)] -> [(Name, Reference)] -> Names
Names.fromTermsAndTypes [(Name, Referent)]
allTermNamesToConsider [(Name, Reference)]
allTypeNamesToConsider
  pure (Namer -> Suffixifier -> PrettyPrintEnvDecl
PPED.makePPED (Int -> Names -> Namer
PPE.hqNamer Int
hashLen Names
names) (Names -> Suffixifier
PPE.suffixifyByHash Names
names))
  where
    namesForReference :: Ops.NamesPerspective -> LabeledDependency -> Sqlite.Transaction ([(Name, Referent)], [(Name, Reference)])
    namesForReference :: NamesPerspective
-> LabeledDependency
-> Transaction ([(Name, Referent)], [(Name, Reference)])
namesForReference NamesPerspective
namesPerspective = \case
      LD.TermReferent Referent
ref -> do
        [Name]
termNames <- (ReversedName -> Name) -> [ReversedName] -> [Name]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (NonEmpty NameSegment -> Name
Name.fromReverseSegments (NonEmpty NameSegment -> Name)
-> (ReversedName -> NonEmpty NameSegment) -> ReversedName -> Name
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ReversedName -> NonEmpty NameSegment
forall a b. Coercible a b => a -> b
coerce) ([ReversedName] -> [Name])
-> Transaction [ReversedName] -> Transaction [Name]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> NamesPerspective
-> Referent -> Maybe ReversedName -> Transaction [ReversedName]
Ops.termNamesForRefWithinNamespace NamesPerspective
namesPerspective (Referent -> Referent
Cv.referent1to2 Referent
ref) Maybe ReversedName
forall a. Maybe a
Nothing
        pure ((,Referent
ref) (Name -> (Name, Referent)) -> [Name] -> [(Name, Referent)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Name]
termNames, [])
      LD.TypeReference Reference
ref -> do
        [Name]
typeNames <- (ReversedName -> Name) -> [ReversedName] -> [Name]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (NonEmpty NameSegment -> Name
Name.fromReverseSegments (NonEmpty NameSegment -> Name)
-> (ReversedName -> NonEmpty NameSegment) -> ReversedName -> Name
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ReversedName -> NonEmpty NameSegment
forall a b. Coercible a b => a -> b
coerce) ([ReversedName] -> [Name])
-> Transaction [ReversedName] -> Transaction [Name]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> NamesPerspective
-> Reference -> Maybe ReversedName -> Transaction [ReversedName]
Ops.typeNamesForRefWithinNamespace NamesPerspective
namesPerspective (Reference -> Reference
Cv.reference1to2 Reference
ref) Maybe ReversedName
forall a. Maybe a
Nothing
        pure ([], (,Reference
ref) (Name -> (Name, Reference)) -> [Name] -> [(Name, Reference)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Name]
typeNames)