module Unison.Codebase.Editor.HandleInput.EditDependents
  ( handleEditDependents,
  )
where

import Control.Monad.Reader (ask)
import Data.Bifoldable (bifold)
import Data.Set qualified as Set
import U.Codebase.Sqlite.Operations qualified as Operations
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 qualified as Branch
import Unison.Codebase.Branch.Names qualified as Branch
import Unison.Codebase.Editor.HandleInput.EditNamespace (getNamesForEdit)
import Unison.Codebase.Editor.HandleInput.ShowDefinition (showDefinitions)
import Unison.Codebase.Editor.Input (OutputLocation (..), RelativeToFold (..))
import Unison.Codebase.Editor.Output qualified as Output
import Unison.ConstructorReference qualified as ConstructorReference
import Unison.HashQualified qualified as HQ
import Unison.Name (Name)
import Unison.Names (Names (..))
import Unison.Prelude
import Unison.PrettyPrintEnv.Names qualified as PPE
import Unison.PrettyPrintEnvDecl.Names qualified as PPED
import Unison.Reference (TermReference, TypeReference)
import Unison.Reference qualified as Reference
import Unison.Referent qualified as Referent
import Unison.Util.Defns (Defns (..), DefnsF)
import Unison.Util.Defns qualified as Defns
import Unison.Util.Relation qualified as Relation

handleEditDependents :: HQ.HashQualified Name -> Cli ()
handleEditDependents :: HashQualified Name -> Cli ()
handleEditDependents HashQualified Name
name = do
  -- Get all of the referents and type references this name refers to
  DefnsF Set Referent TermReference
refs0 <- HashQualified Name -> Cli (DefnsF Set Referent TermReference)
resolveHQName HashQualified Name
name

  -- Since we don't track constructor dependents precisely, convert to just the term and type references
  let refs :: DefnsF Set TermReference TypeReference
      refs :: DefnsF Set TermReference TermReference
refs =
        let f :: Referent -> DefnsF Set TermReference TermReference
f = \case
              Referent.Con ConstructorReference
ref ConstructorType
_ -> Set TermReference -> DefnsF Set TermReference TermReference
forall terms types. Monoid terms => types -> Defns terms types
Defns.fromTypes (TermReference -> Set TermReference
forall a. a -> Set a
Set.singleton (ConstructorReference
ref ConstructorReference
-> Getting TermReference ConstructorReference TermReference
-> TermReference
forall s a. s -> Getting a s a -> a
^. Getting TermReference ConstructorReference TermReference
forall r s (f :: * -> *).
Functor f =>
(r -> f s)
-> GConstructorReference r -> f (GConstructorReference s)
ConstructorReference.reference_))
              Referent.Ref TermReference
ref -> Set TermReference -> DefnsF Set TermReference TermReference
forall types terms. Monoid types => terms -> Defns terms types
Defns.fromTerms (TermReference -> Set TermReference
forall a. a -> Set a
Set.singleton TermReference
ref)
         in Set TermReference
-> Set TermReference -> DefnsF Set TermReference TermReference
forall terms types. terms -> types -> Defns terms types
Defns Set TermReference
forall a. Set a
Set.empty DefnsF Set Referent TermReference
refs0.types DefnsF Set TermReference TermReference
-> DefnsF Set TermReference TermReference
-> DefnsF Set TermReference TermReference
forall a. Semigroup a => a -> a -> a
<> (Referent -> DefnsF Set TermReference TermReference)
-> Set Referent -> DefnsF Set TermReference TermReference
forall m a. Monoid m => (a -> m) -> Set a -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap Referent -> DefnsF Set TermReference TermReference
f DefnsF Set Referent TermReference
refs0.terms

  (PrettyPrintEnvDecl
ppe, Map TermReference (DisplayObject () (Decl Symbol Ann))
types, Map
  TermReference (DisplayObject (Type Symbol Ann) (Term Symbol Ann))
terms) <-
    ((Output -> Cli ())
 -> Cli
      (PrettyPrintEnvDecl,
       Map TermReference (DisplayObject () (Decl Symbol Ann)),
       Map
         TermReference (DisplayObject (Type Symbol Ann) (Term Symbol Ann))))
-> Cli
     (PrettyPrintEnvDecl,
      Map TermReference (DisplayObject () (Decl Symbol Ann)),
      Map
        TermReference (DisplayObject (Type Symbol Ann) (Term Symbol Ann)))
forall a. ((Output -> Cli ()) -> Cli a) -> Cli a
Cli.withRespondRegion \Output -> Cli ()
respondRegion -> do
      Output -> Cli ()
respondRegion (Pretty ColorText -> Output
Output.Literal Pretty ColorText
"Loading branch...")

      -- Load the current project namespace and throw away the libdeps
      Branch0 IO
branch <- Cli (Branch0 IO)
Cli.getCurrentBranch0
      let ppe :: PrettyPrintEnvDecl
ppe =
            let names :: Names
names = Branch0 IO -> Names
forall (m :: * -> *). Branch0 m -> Names
Branch.toNames Branch0 IO
branch
             in Namer -> Suffixifier -> PrettyPrintEnvDecl
PPED.makePPED (Int -> Names -> Namer
PPE.hqNamer Int
10 Names
names) (Names -> Suffixifier
PPE.suffixifyByHashName Names
names)

      -- Throw away the libdeps
      let branchWithoutLibdeps :: Branch0 IO
branchWithoutLibdeps = Branch0 IO -> Branch0 IO
forall (m :: * -> *). Branch0 m -> Branch0 m
Branch.deleteLibdeps Branch0 IO
branch

      -- Identify the local dependents of the input name
      Output -> Cli ()
respondRegion (Pretty ColorText -> Output
Output.Literal Pretty ColorText
"Identifying dependents...")
      DefnsF Set Id Id
dependents <-
        Transaction (DefnsF Set Id Id) -> Cli (DefnsF Set Id Id)
forall a. Transaction a -> Cli a
Cli.runTransaction do
          Set Id -> Set TermReference -> Transaction (DefnsF Set Id Id)
Operations.transitiveDependentsWithinScope
            (Branch0 IO -> Set Id
forall (m :: * -> *). Branch0 m -> Set Id
Branch.deepTermReferenceIds Branch0 IO
branchWithoutLibdeps Set Id -> Set Id -> Set Id
forall a. Semigroup a => a -> a -> a
<> Branch0 IO -> Set Id
forall (m :: * -> *). Branch0 m -> Set Id
Branch.deepTypeReferenceIds Branch0 IO
branchWithoutLibdeps)
            (DefnsF Set TermReference TermReference -> Set TermReference
forall m. Monoid m => Defns m m -> m
forall (p :: * -> * -> *) m. (Bifoldable p, Monoid m) => p m m -> m
bifold DefnsF Set TermReference TermReference
refs)

      let refsAndDependents :: DefnsF Set Referent TermReference
refsAndDependents =
            Defns
              { $sel:terms:Defns :: Set Referent
terms =
                  [Set Referent] -> Set Referent
forall (f :: * -> *) a. (Foldable f, Ord a) => f (Set a) -> Set a
Set.unions
                    [ (TermReference -> Referent) -> Set TermReference -> Set Referent
forall a b. (a -> b) -> Set a -> Set b
Set.mapMonotonic TermReference -> Referent
Referent.fromTermReference DefnsF Set TermReference TermReference
refs.terms,
                      (Id -> Referent) -> Set Id -> Set Referent
forall a b. (a -> b) -> Set a -> Set b
Set.mapMonotonic Id -> Referent
Referent.fromTermReferenceId DefnsF Set Id Id
dependents.terms
                    ],
                $sel:types:Defns :: Set TermReference
types =
                  [Set TermReference] -> Set TermReference
forall (f :: * -> *) a. (Foldable f, Ord a) => f (Set a) -> Set a
Set.unions
                    [ DefnsF Set TermReference TermReference
refs.types,
                      (Id -> TermReference) -> Set Id -> Set TermReference
forall a b. (a -> b) -> Set a -> Set b
Set.mapMonotonic Id -> TermReference
Reference.fromId DefnsF Set Id Id
dependents.types
                    ]
              }

      Output -> Cli ()
respondRegion (Pretty ColorText -> Output
Output.Literal Pretty ColorText
"Loading dependents...")
      Env
env <- Cli Env
forall r (m :: * -> *). MonadReader r m => m r
ask
      (Map TermReference (DisplayObject () (Decl Symbol Ann))
types, Map
  TermReference (DisplayObject (Type Symbol Ann) (Term Symbol Ann))
terms) <-
        Transaction
  (Map TermReference (DisplayObject () (Decl Symbol Ann)),
   Map
     TermReference (DisplayObject (Type Symbol Ann) (Term Symbol Ann)))
-> Cli
     (Map TermReference (DisplayObject () (Decl Symbol Ann)),
      Map
        TermReference (DisplayObject (Type Symbol Ann) (Term Symbol Ann)))
forall a. Transaction a -> Cli a
Cli.runTransaction
          ( Codebase IO Symbol Ann
-> PrettyPrintEnvDecl
-> Names
-> Transaction
     (Map TermReference (DisplayObject () (Decl Symbol Ann)),
      Map
        TermReference (DisplayObject (Type Symbol Ann) (Term Symbol Ann)))
forall (m :: * -> *).
Codebase m Symbol Ann
-> PrettyPrintEnvDecl
-> Names
-> Transaction
     (Map TermReference (DisplayObject () (Decl Symbol Ann)),
      Map
        TermReference (DisplayObject (Type Symbol Ann) (Term Symbol Ann)))
getNamesForEdit
              Env
env.codebase
              PrettyPrintEnvDecl
ppe
              Names
                { $sel:terms:Names :: Relation Name Referent
terms =
                    Branch0 IO
branchWithoutLibdeps
                      Branch0 IO
-> (Branch0 IO -> Relation Referent Name) -> Relation Referent Name
forall a b. a -> (a -> b) -> b
& Branch0 IO -> Relation Referent Name
forall (m :: * -> *). Branch0 m -> Relation Referent Name
Branch.deepTerms
                      Relation Referent Name
-> (Relation Referent Name -> Relation Referent Name)
-> Relation Referent Name
forall a b. a -> (a -> b) -> b
& Set Referent -> Relation Referent Name -> Relation Referent Name
forall a b. (Ord a, Ord b) => Set a -> Relation a b -> Relation a b
Relation.restrictDom DefnsF Set Referent TermReference
refsAndDependents.terms
                      Relation Referent Name
-> (Relation Referent Name -> Relation Name Referent)
-> Relation Name Referent
forall a b. a -> (a -> b) -> b
& Relation Referent Name -> Relation Name Referent
forall a b. Relation a b -> Relation b a
Relation.swap,
                  $sel:types:Names :: Relation Name TermReference
types =
                    Branch0 IO
branchWithoutLibdeps
                      Branch0 IO
-> (Branch0 IO -> Relation TermReference Name)
-> Relation TermReference Name
forall a b. a -> (a -> b) -> b
& Branch0 IO -> Relation TermReference Name
forall (m :: * -> *). Branch0 m -> Relation TermReference Name
Branch.deepTypes
                      Relation TermReference Name
-> (Relation TermReference Name -> Relation TermReference Name)
-> Relation TermReference Name
forall a b. a -> (a -> b) -> b
& Set TermReference
-> Relation TermReference Name -> Relation TermReference Name
forall a b. (Ord a, Ord b) => Set a -> Relation a b -> Relation a b
Relation.restrictDom DefnsF Set Referent TermReference
refsAndDependents.types
                      Relation TermReference Name
-> (Relation TermReference Name -> Relation Name TermReference)
-> Relation Name TermReference
forall a b. a -> (a -> b) -> b
& Relation TermReference Name -> Relation Name TermReference
forall a b. Relation a b -> Relation b a
Relation.swap
                }
          )
      pure (PrettyPrintEnvDecl
ppe, Map TermReference (DisplayObject () (Decl Symbol Ann))
types, Map
  TermReference (DisplayObject (Type Symbol Ann) (Term Symbol Ann))
terms)

  let misses :: [a]
misses = []
  OutputLocation
-> PrettyPrintEnvDecl
-> Map
     TermReference (DisplayObject (Type Symbol Ann) (Term Symbol Ann))
-> Map TermReference (DisplayObject () (Decl Symbol Ann))
-> [HashQualified Name]
-> Cli ()
showDefinitions (RelativeToFold -> OutputLocation
LatestFileLocation RelativeToFold
WithinFold) PrettyPrintEnvDecl
ppe Map
  TermReference (DisplayObject (Type Symbol Ann) (Term Symbol Ann))
terms Map TermReference (DisplayObject () (Decl Symbol Ann))
types [HashQualified Name]
forall a. [a]
misses