module Unison.Codebase.Editor.HandleInput.Dependents
  ( handleDependents,
  )
where

import Data.Set qualified as Set
import U.Codebase.Sqlite.Queries qualified as Queries
import Unison.Cli.Monad (Cli)
import Unison.Cli.Monad qualified as Cli
import Unison.Cli.NameResolutionUtils (resolveHQToLabeledDependencies)
import Unison.Cli.NamesUtils qualified as Cli
import Unison.Codebase qualified as Codebase
import Unison.Codebase.Editor.Output
import Unison.Codebase.Editor.StructuredArgument qualified as SA
import Unison.ConstructorReference (GConstructorReference (..))
import Unison.HashQualified qualified as HQ
import Unison.HashQualifiedPrime qualified as HQ'
import Unison.LabeledDependency qualified as LD
import Unison.Name (Name)
import Unison.Name qualified as Name
import Unison.NameSegment qualified as NameSegment
import Unison.Prelude
import Unison.PrettyPrintEnv qualified as PPE
import Unison.PrettyPrintEnv.Names qualified as PPE
import Unison.PrettyPrintEnvDecl qualified as PPE hiding (biasTo, empty)
import Unison.PrettyPrintEnvDecl.Names qualified as PPED
import Unison.Reference (Reference)
import Unison.Referent qualified as Referent
import Unison.Syntax.HashQualified qualified as HQ (toText)
import Unison.Util.List (nubOrdOn)

handleDependents :: HQ.HashQualified Name -> Cli ()
handleDependents :: HashQualified Name -> Cli ()
handleDependents HashQualified Name
hq = do
  -- todo: add flag to handle transitive efficiently
  Set LabeledDependency
lds <- HashQualified Name -> Cli (Set LabeledDependency)
resolveHQToLabeledDependencies HashQualified Name
hq
  -- Use an unsuffixified PPE here, so we display full names (relative to the current path),
  -- rather than the shortest possible unambiguous name.
  Names
names <- Cli Names
Cli.currentNames
  let pped :: PrettyPrintEnvDecl
pped = Namer -> Suffixifier -> PrettyPrintEnvDecl
PPED.makePPED (Int -> Names -> Namer
PPE.hqNamer Int
10 Names
names) (Names -> Suffixifier
PPE.suffixifyByHash Names
names)
  let fqppe :: PrettyPrintEnv
fqppe = PrettyPrintEnvDecl -> PrettyPrintEnv
PPE.unsuffixifiedPPE PrettyPrintEnvDecl
pped
  let ppe :: PrettyPrintEnv
ppe = PrettyPrintEnvDecl -> PrettyPrintEnv
PPE.suffixifiedPPE PrettyPrintEnvDecl
pped
  Bool -> Cli () -> Cli ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Set LabeledDependency -> Bool
forall a. Set a -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null Set LabeledDependency
lds) do
    Output -> Cli ()
forall a. Output -> Cli a
Cli.returnEarly (HashQualified Name -> Output
LabeledReferenceNotFound HashQualified Name
hq)

  [[(Bool, HashQualified Name, Reference)]]
results <- [LabeledDependency]
-> (LabeledDependency
    -> Cli [(Bool, HashQualified Name, Reference)])
-> Cli [[(Bool, HashQualified Name, Reference)]]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
t a -> (a -> f b) -> f (t b)
for (Set LabeledDependency -> [LabeledDependency]
forall a. Set a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList Set LabeledDependency
lds) \LabeledDependency
ld -> do
    -- The full set of dependent references, any number of which may not have names in the current namespace.
    Set Reference
dependents <-
      let tp :: Reference -> Transaction (Set Reference)
tp = DependentsSelector -> Reference -> Transaction (Set Reference)
Codebase.dependents DependentsSelector
Queries.ExcludeOwnComponent
          tm :: Referent -> Transaction (Set Reference)
tm = \case
            Referent.Ref Reference
r -> DependentsSelector -> Reference -> Transaction (Set Reference)
Codebase.dependents DependentsSelector
Queries.ExcludeOwnComponent Reference
r
            Referent.Con (ConstructorReference Reference
r ConstructorId
_cid) ConstructorType
_ct ->
              DependentsSelector -> Reference -> Transaction (Set Reference)
Codebase.dependents DependentsSelector
Queries.ExcludeOwnComponent Reference
r
       in Transaction (Set Reference) -> Cli (Set Reference)
forall a. Transaction a -> Cli a
Cli.runTransaction ((Reference -> Transaction (Set Reference))
-> (Referent -> Transaction (Set Reference))
-> LabeledDependency
-> Transaction (Set Reference)
forall a.
(Reference -> a) -> (Referent -> a) -> LabeledDependency -> a
LD.fold Reference -> Transaction (Set Reference)
tp Referent -> Transaction (Set Reference)
tm LabeledDependency
ld)
    let -- True is term names, False is type names
        results :: [(Bool, HQ.HashQualified Name, Reference)]
        results :: [(Bool, HashQualified Name, Reference)]
results = do
          Reference
r <- Set Reference -> [Reference]
forall a. Set a -> [a]
Set.toList Set Reference
dependents
          Just (Bool
isTerm, HashQualified Name
hq) <- [(Bool
True,) (HashQualified Name -> (Bool, HashQualified Name))
-> Maybe (HashQualified Name) -> Maybe (Bool, HashQualified Name)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> PrettyPrintEnv -> Referent -> Maybe (HashQualified Name)
PPE.terms PrettyPrintEnv
fqppe (Reference -> Referent
Referent.Ref Reference
r), (Bool
False,) (HashQualified Name -> (Bool, HashQualified Name))
-> Maybe (HashQualified Name) -> Maybe (Bool, HashQualified Name)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> PrettyPrintEnv -> Reference -> Maybe (HashQualified Name)
PPE.types PrettyPrintEnv
fqppe Reference
r]
          Name
fullName <- [HashQualified Name -> Name
forall n. HashQualified n -> n
HQ'.toName HashQualified Name
hq]
          Bool -> [()]
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> Bool
not (Name -> NameSegment -> Bool
Name.beginsWithSegment Name
fullName NameSegment
NameSegment.libSegment))
          Just HashQualified Name
shortName <- Maybe (HashQualified Name) -> [Maybe (HashQualified Name)]
forall a. a -> [a]
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe (HashQualified Name) -> [Maybe (HashQualified Name)])
-> Maybe (HashQualified Name) -> [Maybe (HashQualified Name)]
forall a b. (a -> b) -> a -> b
$ PrettyPrintEnv -> Referent -> Maybe (HashQualified Name)
PPE.terms PrettyPrintEnv
ppe (Reference -> Referent
Referent.Ref Reference
r) 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 -> Reference -> Maybe (HashQualified Name)
PPE.types PrettyPrintEnv
ppe Reference
r
          (Bool, HashQualified Name, Reference)
-> [(Bool, HashQualified Name, Reference)]
forall a. a -> [a]
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Bool
isTerm, HashQualified Name -> HashQualified Name
forall n. HashQualified n -> HashQualified n
HQ'.toHQ HashQualified Name
shortName, Reference
r)
    [(Bool, HashQualified Name, Reference)]
-> Cli [(Bool, HashQualified Name, Reference)]
forall a. a -> Cli a
forall (f :: * -> *) a. Applicative f => a -> f a
pure [(Bool, HashQualified Name, Reference)]
results
  let sort :: [(HashQualified Name, Reference)] -> [HashQualified Name]
sort = ((HashQualified Name, Reference) -> HashQualified Name)
-> [(HashQualified Name, Reference)] -> [HashQualified Name]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (HashQualified Name, Reference) -> HashQualified Name
forall a b. (a, b) -> a
fst ([(HashQualified Name, Reference)] -> [HashQualified Name])
-> ([(HashQualified Name, Reference)]
    -> [(HashQualified Name, Reference)])
-> [(HashQualified Name, Reference)]
-> [HashQualified Name]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((HashQualified Name, Reference) -> Reference)
-> [(HashQualified Name, Reference)]
-> [(HashQualified Name, Reference)]
forall (f :: * -> *) b a.
(Foldable f, Ord b) =>
(a -> b) -> f a -> [a]
nubOrdOn (HashQualified Name, Reference) -> Reference
forall a b. (a, b) -> b
snd ([(HashQualified Name, Reference)]
 -> [(HashQualified Name, Reference)])
-> ([(HashQualified Name, Reference)]
    -> [(HashQualified Name, Reference)])
-> [(HashQualified Name, Reference)]
-> [(HashQualified Name, Reference)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((HashQualified Name, Reference) -> Text)
-> [(HashQualified Name, Reference)]
-> [(HashQualified Name, Reference)]
forall a. (a -> Text) -> [a] -> [a]
Name.sortByText (HashQualified Name -> Text
HQ.toText (HashQualified Name -> Text)
-> ((HashQualified Name, Reference) -> HashQualified Name)
-> (HashQualified Name, Reference)
-> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (HashQualified Name, Reference) -> HashQualified Name
forall a b. (a, b) -> a
fst)
  let types :: [HashQualified Name]
types = [(HashQualified Name, Reference)] -> [HashQualified Name]
sort [(HashQualified Name
n, Reference
r) | (Bool
False, HashQualified Name
n, Reference
r) <- [[(Bool, HashQualified Name, Reference)]]
-> [(Bool, HashQualified Name, Reference)]
forall (m :: * -> *) a. Monad m => m (m a) -> m a
join [[(Bool, HashQualified Name, Reference)]]
results]
  let terms :: [HashQualified Name]
terms = [(HashQualified Name, Reference)] -> [HashQualified Name]
sort [(HashQualified Name
n, Reference
r) | (Bool
True, HashQualified Name
n, Reference
r) <- [[(Bool, HashQualified Name, Reference)]]
-> [(Bool, HashQualified Name, Reference)]
forall (m :: * -> *) a. Monad m => m (m a) -> m a
join [[(Bool, HashQualified Name, Reference)]]
results]
  NumberedArgs -> Cli ()
Cli.setNumberedArgs (NumberedArgs -> Cli ())
-> ([HashQualified Name] -> NumberedArgs)
-> [HashQualified Name]
-> Cli ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (HashQualified Name -> StructuredArgument)
-> [HashQualified Name] -> NumberedArgs
forall a b. (a -> b) -> [a] -> [b]
map HashQualified Name -> StructuredArgument
SA.HashQualified ([HashQualified Name] -> Cli ()) -> [HashQualified Name] -> Cli ()
forall a b. (a -> b) -> a -> b
$ [HashQualified Name]
types [HashQualified Name]
-> [HashQualified Name] -> [HashQualified Name]
forall a. Semigroup a => a -> a -> a
<> [HashQualified Name]
terms
  Output -> Cli ()
Cli.respond (PrettyPrintEnv
-> Set LabeledDependency
-> [HashQualified Name]
-> [HashQualified Name]
-> Output
ListDependents PrettyPrintEnv
ppe Set LabeledDependency
lds [HashQualified Name]
types [HashQualified Name]
terms)