module Unison.Codebase.Editor.HandleInput.Dependencies
  ( handleDependencies,
  )
where

import Control.Arrow ((***))
import Data.Bifoldable (bifoldMap, binull)
import Data.Set qualified as Set
import U.Codebase.Sqlite.Operations qualified as Operations
import Unison.Builtin qualified as Builtin
import Unison.Cli.Monad (Cli)
import Unison.Cli.Monad qualified as Cli
import Unison.Cli.MonadUtils qualified as Cli
import Unison.Cli.NameResolutionUtils (resolveHQName)
import Unison.Codebase.Branch.Names qualified as Branch
import Unison.Codebase.Editor.Output
import Unison.Codebase.Editor.StructuredArgument qualified as SA
import Unison.ConstructorReference qualified as ConstructorReference
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.Prelude
import Unison.PrettyPrintEnv qualified as PPE
import Unison.PrettyPrintEnv.Names qualified as PPE
import Unison.Reference (Reference)
import Unison.Reference qualified as Reference
import Unison.Referent qualified as Referent
import Unison.Syntax.HashQualifiedPrime qualified as HQ'
import Unison.Util.Defns (Defns (..), DefnsF)
import Unison.Util.Defns qualified as Defns

handleDependencies :: HQ.HashQualified Name -> Cli ()
handleDependencies :: HashQualified Name -> Cli ()
handleDependencies HashQualified Name
hq = do
  DefnsF Set Referent Reference
refs <- HashQualified Name -> Cli (DefnsF Set Referent Reference)
resolveHQName HashQualified Name
hq

  Bool -> Cli () -> Cli ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (DefnsF Set Referent Reference -> Bool
forall (t :: * -> * -> *) a b. Bifoldable t => t a b -> Bool
binull DefnsF Set Referent Reference
refs) do
    Output -> Cli ()
forall a. Output -> Cli a
Cli.returnEarly (HashQualified Name -> Output
LabeledReferenceNotFound HashQualified Name
hq)

  Branch0 IO
namespace <- Cli (Branch0 IO)
Cli.getCurrentProjectRoot0
  let ppe :: PrettyPrintEnv
ppe =
        let names :: Names
names = Branch0 IO -> Names
forall (m :: * -> *). Branch0 m -> Names
Branch.toNames Branch0 IO
namespace
         in Namer -> Suffixifier -> PrettyPrintEnv
PPE.makePPE (Int -> Names -> Namer
PPE.hqNamer Int
10 Names
names) (Names -> Suffixifier
PPE.suffixifyByHash Names
names)

  DefnsF Set Reference Reference
dependencies <- do
    Transaction (DefnsF Set Reference Reference)
-> Cli (DefnsF Set Reference Reference)
forall a. Transaction a -> Cli a
Cli.runTransaction do
      (Reference -> Bool)
-> DefnsF Set TermReferenceId TermReferenceId
-> Transaction (DefnsF Set Reference Reference)
Operations.directDependenciesOfScope
        Reference -> Bool
Builtin.isBuiltinType
        ( let refToIds :: Reference -> Set Reference.Id
              refToIds :: Reference -> Set TermReferenceId
refToIds =
                Set TermReferenceId
-> (TermReferenceId -> Set TermReferenceId)
-> Maybe TermReferenceId
-> Set TermReferenceId
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Set TermReferenceId
forall a. Set a
Set.empty TermReferenceId -> Set TermReferenceId
forall a. a -> Set a
Set.singleton (Maybe TermReferenceId -> Set TermReferenceId)
-> (Reference -> Maybe TermReferenceId)
-> Reference
-> Set TermReferenceId
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Reference -> Maybe TermReferenceId
Reference.toId
           in (Set Referent -> DefnsF Set TermReferenceId TermReferenceId)
-> (Set Reference -> DefnsF Set TermReferenceId TermReferenceId)
-> DefnsF Set Referent Reference
-> DefnsF Set TermReferenceId TermReferenceId
forall m a b. Monoid m => (a -> m) -> (b -> m) -> Defns a b -> m
forall (p :: * -> * -> *) m a b.
(Bifoldable p, Monoid m) =>
(a -> m) -> (b -> m) -> p a b -> m
bifoldMap
                ( (Referent -> DefnsF Set TermReferenceId TermReferenceId)
-> Set Referent -> DefnsF Set TermReferenceId TermReferenceId
forall m a. Monoid m => (a -> m) -> Set a -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap \case
                    Referent.Con ConstructorReference
ref ConstructorType
_ -> Set TermReferenceId -> DefnsF Set TermReferenceId TermReferenceId
forall terms types. Monoid terms => types -> Defns terms types
Defns.fromTypes (Reference -> Set TermReferenceId
refToIds (ConstructorReference
ref ConstructorReference
-> Getting Reference ConstructorReference Reference -> Reference
forall s a. s -> Getting a s a -> a
^. Getting Reference ConstructorReference Reference
forall r s (f :: * -> *).
Functor f =>
(r -> f s)
-> GConstructorReference r -> f (GConstructorReference s)
ConstructorReference.reference_))
                    Referent.Ref Reference
ref -> Set TermReferenceId -> DefnsF Set TermReferenceId TermReferenceId
forall types terms. Monoid types => terms -> Defns terms types
Defns.fromTerms (Reference -> Set TermReferenceId
refToIds Reference
ref)
                )
                ((Reference -> DefnsF Set TermReferenceId TermReferenceId)
-> Set Reference -> DefnsF Set TermReferenceId TermReferenceId
forall m a. Monoid m => (a -> m) -> Set a -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (Reference -> Set TermReferenceId
refToIds (Reference -> Set TermReferenceId)
-> (Set TermReferenceId
    -> DefnsF Set TermReferenceId TermReferenceId)
-> Reference
-> DefnsF Set TermReferenceId TermReferenceId
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> Set TermReferenceId -> DefnsF Set TermReferenceId TermReferenceId
forall terms types. Monoid terms => types -> Defns terms types
Defns.fromTypes))
                DefnsF Set Referent Reference
refs
        )

  let dependencyNames ::
        DefnsF
          []
          (HQ.HashQualified Name, HQ.HashQualified Name)
          (HQ.HashQualified Name, HQ.HashQualified Name)
      dependencyNames :: DefnsF
  []
  (HashQualified Name, HashQualified Name)
  (HashQualified Name, HashQualified Name)
dependencyNames =
        (Set Reference -> [(HashQualified Name, HashQualified Name)])
-> (Set Reference -> [(HashQualified Name, HashQualified Name)])
-> DefnsF Set Reference Reference
-> DefnsF
     []
     (HashQualified Name, HashQualified Name)
     (HashQualified Name, HashQualified Name)
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
          ((Reference -> [(HashQualified Name, HashQualified Name)])
-> Set Reference -> [(HashQualified Name, HashQualified Name)]
f (Reference -> Referent
Referent.fromTermReference (Reference -> Referent)
-> (Referent -> [(HashQualified Name, HashQualified Name)])
-> Reference
-> [(HashQualified Name, HashQualified Name)]
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> PrettyPrintEnv
-> Referent -> [(HashQualified Name, HashQualified Name)]
PPE.termNames PrettyPrintEnv
ppe))
          ((Reference -> [(HashQualified Name, HashQualified Name)])
-> Set Reference -> [(HashQualified Name, HashQualified Name)]
f (PrettyPrintEnv
-> Reference -> [(HashQualified Name, HashQualified Name)]
PPE.typeNames PrettyPrintEnv
ppe))
          DefnsF Set Reference Reference
dependencies
        where
          f ::
            (Reference -> [(HQ'.HashQualified Name, HQ'.HashQualified Name)]) ->
            Set Reference ->
            [(HQ.HashQualified Name, HQ.HashQualified Name)]
          f :: (Reference -> [(HashQualified Name, HashQualified Name)])
-> Set Reference -> [(HashQualified Name, HashQualified Name)]
f Reference -> [(HashQualified Name, HashQualified Name)]
g =
            Set Reference -> [Reference]
forall a. Set a -> [a]
Set.toList
              -- Pick the best name for a reference (with `listToMaybe`), else use the ref (if nameless)
              (Set Reference -> [Reference])
-> ([Reference] -> [(HashQualified Name, HashQualified Name)])
-> Set Reference
-> [(HashQualified Name, HashQualified Name)]
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> (Reference
 -> Either Reference (HashQualified Name, HashQualified Name))
-> [Reference]
-> [Either Reference (HashQualified Name, HashQualified Name)]
forall a b. (a -> b) -> [a] -> [b]
map (\Reference
x -> Either Reference (HashQualified Name, HashQualified Name)
-> ((HashQualified Name, HashQualified Name)
    -> Either Reference (HashQualified Name, HashQualified Name))
-> Maybe (HashQualified Name, HashQualified Name)
-> Either Reference (HashQualified Name, HashQualified Name)
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Reference
-> Either Reference (HashQualified Name, HashQualified Name)
forall a b. a -> Either a b
Left Reference
x) (HashQualified Name, HashQualified Name)
-> Either Reference (HashQualified Name, HashQualified Name)
forall a b. b -> Either a b
Right ([(HashQualified Name, HashQualified Name)]
-> Maybe (HashQualified Name, HashQualified Name)
forall a. [a] -> Maybe a
listToMaybe (Reference -> [(HashQualified Name, HashQualified Name)]
g Reference
x)))
              ([Reference]
 -> [Either Reference (HashQualified Name, HashQualified Name)])
-> ([Either Reference (HashQualified Name, HashQualified Name)]
    -> [(HashQualified Name, HashQualified Name)])
-> [Reference]
-> [(HashQualified Name, HashQualified Name)]
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> [Either Reference (HashQualified Name, HashQualified Name)]
-> ([Reference], [(HashQualified Name, HashQualified Name)])
forall a b. [Either a b] -> ([a], [b])
partitionEithers
              -- Sort the named references alphabetically, then stick the hash-only ones at the end
              ([Either Reference (HashQualified Name, HashQualified Name)]
 -> ([Reference], [(HashQualified Name, HashQualified Name)]))
-> (([Reference], [(HashQualified Name, HashQualified Name)])
    -> [(HashQualified Name, HashQualified Name)])
-> [Either Reference (HashQualified Name, HashQualified Name)]
-> [(HashQualified Name, HashQualified Name)]
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> ([Reference], [(HashQualified Name, HashQualified Name)])
-> [(HashQualified Name, HashQualified Name)]
h

          h ::
            ([Reference], [(HQ'.HashQualified Name, HQ'.HashQualified Name)]) ->
            [(HQ.HashQualified Name, HQ.HashQualified Name)]
          h :: ([Reference], [(HashQualified Name, HashQualified Name)])
-> [(HashQualified Name, HashQualified Name)]
h ([Reference]
nameless, [(HashQualified Name, HashQualified Name)]
named) =
            [[(HashQualified Name, HashQualified Name)]]
-> [(HashQualified Name, HashQualified Name)]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
              [ [(HashQualified Name, HashQualified Name)]
named
                  [(HashQualified Name, HashQualified Name)]
-> ([(HashQualified Name, HashQualified Name)]
    -> [(HashQualified Name, HashQualified Name)])
-> [(HashQualified Name, HashQualified Name)]
forall a b. a -> (a -> b) -> b
& ((HashQualified Name, HashQualified Name) -> Text)
-> [(HashQualified Name, HashQualified Name)]
-> [(HashQualified Name, HashQualified Name)]
forall a. (a -> Text) -> [a] -> [a]
Name.sortByText ((HashQualified Name, HashQualified Name) -> HashQualified Name
forall a b. (a, b) -> a
fst ((HashQualified Name, HashQualified Name) -> HashQualified Name)
-> (HashQualified Name -> Text)
-> (HashQualified Name, HashQualified Name)
-> Text
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> HashQualified Name -> Text
HQ'.toText)
                  [(HashQualified Name, HashQualified Name)]
-> ([(HashQualified Name, HashQualified Name)]
    -> [(HashQualified Name, HashQualified Name)])
-> [(HashQualified Name, HashQualified Name)]
forall a b. a -> (a -> b) -> b
& ((HashQualified Name, HashQualified Name)
 -> (HashQualified Name, HashQualified Name))
-> [(HashQualified Name, HashQualified Name)]
-> [(HashQualified Name, HashQualified Name)]
forall a b. (a -> b) -> [a] -> [b]
map (HashQualified Name -> HashQualified Name
forall n. HashQualified n -> HashQualified n
HQ'.toHQ (HashQualified Name -> HashQualified Name)
-> (HashQualified Name -> HashQualified Name)
-> (HashQualified Name, HashQualified Name)
-> (HashQualified Name, HashQualified Name)
forall b c b' c'. (b -> c) -> (b' -> c') -> (b, b') -> (c, c')
forall (a :: * -> * -> *) b c b' c'.
Arrow a =>
a b c -> a b' c' -> a (b, b') (c, c')
*** HashQualified Name -> HashQualified Name
forall n. HashQualified n -> HashQualified n
HQ'.toHQ),
                [Reference]
nameless
                  [Reference]
-> ([Reference] -> [(HashQualified Name, HashQualified Name)])
-> [(HashQualified Name, HashQualified Name)]
forall a b. a -> (a -> b) -> b
& (Reference -> (HashQualified Name, HashQualified Name))
-> [Reference] -> [(HashQualified Name, HashQualified Name)]
forall a b. (a -> b) -> [a] -> [b]
map (\Reference
x -> let y :: HashQualified Name
y = Reference -> HashQualified Name
HQ.fromReference Reference
x in (HashQualified Name
y, HashQualified Name
y))
              ]

  -- Set numbered args
  (DefnsF
  []
  (HashQualified Name, HashQualified Name)
  (HashQualified Name, HashQualified Name)
dependencyNames.types [(HashQualified Name, HashQualified Name)]
-> [(HashQualified Name, HashQualified Name)]
-> [(HashQualified Name, HashQualified Name)]
forall a. [a] -> [a] -> [a]
++ DefnsF
  []
  (HashQualified Name, HashQualified Name)
  (HashQualified Name, HashQualified Name)
dependencyNames.terms)
    [(HashQualified Name, HashQualified Name)]
-> ([(HashQualified Name, HashQualified Name)]
    -> [StructuredArgument])
-> [StructuredArgument]
forall a b. a -> (a -> b) -> b
& ((HashQualified Name, HashQualified Name) -> StructuredArgument)
-> [(HashQualified Name, HashQualified Name)]
-> [StructuredArgument]
forall a b. (a -> b) -> [a] -> [b]
map (HashQualified Name -> StructuredArgument
SA.HashQualified (HashQualified Name -> StructuredArgument)
-> ((HashQualified Name, HashQualified Name) -> HashQualified Name)
-> (HashQualified Name, HashQualified Name)
-> StructuredArgument
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (HashQualified Name, HashQualified Name) -> HashQualified Name
forall a b. (a, b) -> a
fst)
    [StructuredArgument] -> ([StructuredArgument] -> Cli ()) -> Cli ()
forall a b. a -> (a -> b) -> b
& [StructuredArgument] -> Cli ()
Cli.setNumberedArgs

  let lds :: Set LabeledDependency
lds = (Set Referent -> Set LabeledDependency)
-> (Set Reference -> Set LabeledDependency)
-> DefnsF Set Referent Reference
-> Set LabeledDependency
forall m a b. Monoid m => (a -> m) -> (b -> m) -> Defns a b -> m
forall (p :: * -> * -> *) m a b.
(Bifoldable p, Monoid m) =>
(a -> m) -> (b -> m) -> p a b -> m
bifoldMap ((Referent -> LabeledDependency)
-> Set Referent -> Set LabeledDependency
forall b a. Ord b => (a -> b) -> Set a -> Set b
Set.map Referent -> LabeledDependency
LD.referent) ((Reference -> LabeledDependency)
-> Set Reference -> Set LabeledDependency
forall b a. Ord b => (a -> b) -> Set a -> Set b
Set.map Reference -> LabeledDependency
LD.typeRef) DefnsF Set Referent Reference
refs
  Output -> Cli ()
Cli.respond (PrettyPrintEnv
-> Set LabeledDependency
-> DefnsF
     []
     (HashQualified Name, HashQualified Name)
     (HashQualified Name, HashQualified Name)
-> Output
ListDependencies PrettyPrintEnv
ppe Set LabeledDependency
lds DefnsF
  []
  (HashQualified Name, HashQualified Name)
  (HashQualified Name, HashQualified Name)
dependencyNames)