module Unison.Codebase.Editor.HandleInput.NamespaceDependencies
  ( handleNamespaceDependencies,
  )
where

import Control.Monad.Reader (ask)
import Control.Monad.Trans.Maybe
import Data.Map qualified as Map
import Data.Set qualified as Set
import Unison.Cli.Monad qualified as Cli
import Unison.Cli.MonadUtils qualified as Cli
import Unison.Cli.NamesUtils qualified as Cli
import Unison.Codebase (Codebase)
import Unison.Codebase qualified as Codebase
import Unison.Codebase.Branch (Branch0)
import Unison.Codebase.Branch qualified as Branch
import Unison.Codebase.Editor.Output qualified as Output
import Unison.Codebase.Path qualified as Path
import Unison.DataDeclaration qualified as DD
import Unison.LabeledDependency (LabeledDependency)
import Unison.LabeledDependency qualified as LD
import Unison.Name (Name)
import Unison.NameSegment qualified as NameSegment
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 qualified as Reference
import Unison.Referent qualified as Referent
import Unison.Sqlite qualified as Sqlite
import Unison.Symbol (Symbol)
import Unison.Term qualified as Term
import Unison.Util.Relation qualified as Relation

handleNamespaceDependencies :: Maybe Path.Path' -> Cli.Cli ()
handleNamespaceDependencies :: Maybe Path' -> Cli ()
handleNamespaceDependencies Maybe Path'
namespacePath' = do
  Cli.Env {Codebase IO Symbol Ann
codebase :: Codebase IO Symbol Ann
$sel:codebase:Env :: Env -> Codebase IO Symbol Ann
codebase} <- Cli Env
forall r (m :: * -> *). MonadReader r m => m r
ask
  ProjectPath
pp <- Cli ProjectPath
-> (Path' -> Cli ProjectPath) -> Maybe Path' -> Cli ProjectPath
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Cli ProjectPath
Cli.getCurrentProjectPath Path' -> Cli ProjectPath
Cli.resolvePath' Maybe Path'
namespacePath'
  let pb :: ProjectBranch
pb = ProjectPath
pp ProjectPath
-> Getting ProjectBranch ProjectPath ProjectBranch -> ProjectBranch
forall s a. s -> Getting a s a -> a
^. Getting ProjectBranch ProjectPath ProjectBranch
#branch
  Branch0 IO
branch <-
    ProjectPath -> Cli (Maybe (Branch0 IO))
Cli.getMaybeBranch0FromProjectPath ProjectPath
pp Cli (Maybe (Branch0 IO))
-> (Cli (Maybe (Branch0 IO)) -> Cli (Branch0 IO))
-> Cli (Branch0 IO)
forall a b. a -> (a -> b) -> b
& Cli (Branch0 IO) -> Cli (Maybe (Branch0 IO)) -> Cli (Branch0 IO)
forall (m :: * -> *) a. Monad m => m a -> m (Maybe a) -> m a
onNothingM do
      Output -> Cli (Branch0 IO)
forall a. Output -> Cli a
Cli.returnEarly (WhichBranchEmpty -> Output
Output.BranchEmpty (ProjectPath -> WhichBranchEmpty
Output.WhichBranchEmptyPath ProjectPath
pp))
  Map LabeledDependency (Set Name)
externalDependencies <-
    Transaction (Map LabeledDependency (Set Name))
-> Cli (Map LabeledDependency (Set Name))
forall a. Transaction a -> Cli a
Cli.runTransaction (Codebase IO Symbol Ann
-> Branch0 IO -> Transaction (Map LabeledDependency (Set Name))
forall (m :: * -> *) a.
Codebase m Symbol a
-> Branch0 m -> Transaction (Map LabeledDependency (Set Name))
namespaceDependencies Codebase IO Symbol Ann
codebase Branch0 IO
branch)
  Names
names <- ProjectBranch -> Cli Names
Cli.projectBranchNames ProjectBranch
pb

  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 ppe :: PrettyPrintEnv
ppe = PrettyPrintEnvDecl -> PrettyPrintEnv
PPED.unsuffixifiedPPE PrettyPrintEnvDecl
pped
  NumberedOutput -> Cli ()
Cli.respondNumbered (NumberedOutput -> Cli ()) -> NumberedOutput -> Cli ()
forall a b. (a -> b) -> a -> b
$ PrettyPrintEnv
-> ProjectPath
-> Map LabeledDependency (Set Name)
-> NumberedOutput
Output.ListNamespaceDependencies PrettyPrintEnv
ppe ProjectPath
pp Map LabeledDependency (Set Name)
externalDependencies

-- | Check the dependencies of all types and terms in the current namespace,
-- returns a map of dependencies which do not have a name within the current namespace,
-- alongside the names of all of that thing's dependents.
--
-- This is non-transitive, i.e. only the first layer of external dependencies is returned.
--
-- So if my namespace depends on .base.Bag.map; which depends on base.Map.mapKeys, only
-- .base.Bag.map is returned unless some other definition inside my namespace depends
-- on base.Map.mapKeys directly.
--
-- Returns a Set of names rather than using the PPE since we already have the correct names in
-- scope on this branch, and also want to list ALL names of dependents, including aliases.
namespaceDependencies :: Codebase m Symbol a -> Branch0 m -> Sqlite.Transaction (Map LabeledDependency (Set Name))
namespaceDependencies :: forall (m :: * -> *) a.
Codebase m Symbol a
-> Branch0 m -> Transaction (Map LabeledDependency (Set Name))
namespaceDependencies Codebase m Symbol a
codebase Branch0 m
branch = do
  [Map LabeledDependency (Set Name)]
typeDeps <-
    [(Reference, Set Name)]
-> ((Reference, Set Name)
    -> Transaction (Map LabeledDependency (Set Name)))
-> Transaction [Map LabeledDependency (Set Name)]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
t a -> (a -> f b) -> f (t b)
for (Map Reference (Set Name) -> [(Reference, Set Name)]
forall k a. Map k a -> [(k, a)]
Map.toList (Relation Reference Name -> Map Reference (Set Name)
forall a b. Relation a b -> Map a (Set b)
Relation.domain (Branch0 m -> Relation Reference Name
forall (m :: * -> *). Branch0 m -> Relation Reference Name
Branch.deepTypes Branch0 m
branchWithoutLibdeps))) \(Reference
typeRef, Set Name
names) ->
      (Maybe (Map LabeledDependency (Set Name))
 -> Map LabeledDependency (Set Name))
-> Transaction (Maybe (Map LabeledDependency (Set Name)))
-> Transaction (Map LabeledDependency (Set Name))
forall a b. (a -> b) -> Transaction a -> Transaction b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Map LabeledDependency (Set Name)
-> Maybe (Map LabeledDependency (Set Name))
-> Map LabeledDependency (Set Name)
forall a. a -> Maybe a -> a
fromMaybe Map LabeledDependency (Set Name)
forall k a. Map k a
Map.empty) (Transaction (Maybe (Map LabeledDependency (Set Name)))
 -> Transaction (Map LabeledDependency (Set Name)))
-> (MaybeT Transaction (Map LabeledDependency (Set Name))
    -> Transaction (Maybe (Map LabeledDependency (Set Name))))
-> MaybeT Transaction (Map LabeledDependency (Set Name))
-> Transaction (Map LabeledDependency (Set Name))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MaybeT Transaction (Map LabeledDependency (Set Name))
-> Transaction (Maybe (Map LabeledDependency (Set Name)))
forall (m :: * -> *) a. MaybeT m a -> m (Maybe a)
runMaybeT (MaybeT Transaction (Map LabeledDependency (Set Name))
 -> Transaction (Map LabeledDependency (Set Name)))
-> MaybeT Transaction (Map LabeledDependency (Set Name))
-> Transaction (Map LabeledDependency (Set Name))
forall a b. (a -> b) -> a -> b
$ do
        Id
refId <- Transaction (Maybe Id) -> MaybeT Transaction Id
forall (m :: * -> *) a. m (Maybe a) -> MaybeT m a
MaybeT (Transaction (Maybe Id) -> MaybeT Transaction Id)
-> (Maybe Id -> Transaction (Maybe Id))
-> Maybe Id
-> MaybeT Transaction Id
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe Id -> Transaction (Maybe Id)
forall a. a -> Transaction a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe Id -> MaybeT Transaction Id)
-> Maybe Id -> MaybeT Transaction Id
forall a b. (a -> b) -> a -> b
$ Reference -> Maybe Id
Reference.toId Reference
typeRef
        Decl Symbol a
decl <- Transaction (Maybe (Decl Symbol a))
-> MaybeT Transaction (Decl Symbol a)
forall (m :: * -> *) a. m (Maybe a) -> MaybeT m a
MaybeT (Transaction (Maybe (Decl Symbol a))
 -> MaybeT Transaction (Decl Symbol a))
-> Transaction (Maybe (Decl Symbol a))
-> MaybeT Transaction (Decl Symbol a)
forall a b. (a -> b) -> a -> b
$ Codebase m Symbol a -> Id -> Transaction (Maybe (Decl Symbol a))
forall (m :: * -> *) v a.
Codebase m v a -> Id -> Transaction (Maybe (Decl v a))
Codebase.getTypeDeclaration Codebase m Symbol a
codebase Id
refId
        let typeDeps :: Set LabeledDependency
typeDeps = (Reference -> LabeledDependency)
-> Set Reference -> Set LabeledDependency
forall b a. Ord b => (a -> b) -> Set a -> Set b
Set.map Reference -> LabeledDependency
LD.typeRef (Set Reference -> Set LabeledDependency)
-> Set Reference -> Set LabeledDependency
forall a b. (a -> b) -> a -> b
$ DataDeclaration Symbol a -> Set Reference
forall v a. Ord v => DataDeclaration v a -> Set Reference
DD.typeDependencies (Decl Symbol a -> DataDeclaration Symbol a
forall v a. Decl v a -> DataDeclaration v a
DD.asDataDecl Decl Symbol a
decl)
        Map LabeledDependency (Set Name)
-> MaybeT Transaction (Map LabeledDependency (Set Name))
forall a. a -> MaybeT Transaction a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Map LabeledDependency (Set Name)
 -> MaybeT Transaction (Map LabeledDependency (Set Name)))
-> Map LabeledDependency (Set Name)
-> MaybeT Transaction (Map LabeledDependency (Set Name))
forall a b. (a -> b) -> a -> b
$ (LabeledDependency -> Map LabeledDependency (Set Name))
-> Set LabeledDependency -> Map LabeledDependency (Set Name)
forall m a. Monoid m => (a -> m) -> Set a -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (LabeledDependency -> Set Name -> Map LabeledDependency (Set Name)
forall k a. k -> a -> Map k a
`Map.singleton` Set Name
names) Set LabeledDependency
typeDeps

  [Map LabeledDependency (Set Name)]
termDeps <-
    [(Referent, Set Name)]
-> ((Referent, Set Name)
    -> Transaction (Map LabeledDependency (Set Name)))
-> Transaction [Map LabeledDependency (Set Name)]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
t a -> (a -> f b) -> f (t b)
for (Map Referent (Set Name) -> [(Referent, Set Name)]
forall k a. Map k a -> [(k, a)]
Map.toList (Relation Referent Name -> Map Referent (Set Name)
forall a b. Relation a b -> Map a (Set b)
Relation.domain (Branch0 m -> Relation Referent Name
forall (m :: * -> *). Branch0 m -> Relation Referent Name
Branch.deepTerms Branch0 m
branchWithoutLibdeps))) \(Referent
termRef, Set Name
names) ->
      (Maybe (Map LabeledDependency (Set Name))
 -> Map LabeledDependency (Set Name))
-> Transaction (Maybe (Map LabeledDependency (Set Name)))
-> Transaction (Map LabeledDependency (Set Name))
forall a b. (a -> b) -> Transaction a -> Transaction b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Map LabeledDependency (Set Name)
-> Maybe (Map LabeledDependency (Set Name))
-> Map LabeledDependency (Set Name)
forall a. a -> Maybe a -> a
fromMaybe Map LabeledDependency (Set Name)
forall k a. Map k a
Map.empty) (Transaction (Maybe (Map LabeledDependency (Set Name)))
 -> Transaction (Map LabeledDependency (Set Name)))
-> (MaybeT Transaction (Map LabeledDependency (Set Name))
    -> Transaction (Maybe (Map LabeledDependency (Set Name))))
-> MaybeT Transaction (Map LabeledDependency (Set Name))
-> Transaction (Map LabeledDependency (Set Name))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MaybeT Transaction (Map LabeledDependency (Set Name))
-> Transaction (Maybe (Map LabeledDependency (Set Name)))
forall (m :: * -> *) a. MaybeT m a -> m (Maybe a)
runMaybeT (MaybeT Transaction (Map LabeledDependency (Set Name))
 -> Transaction (Map LabeledDependency (Set Name)))
-> MaybeT Transaction (Map LabeledDependency (Set Name))
-> Transaction (Map LabeledDependency (Set Name))
forall a b. (a -> b) -> a -> b
$ do
        Id
refId <- Transaction (Maybe Id) -> MaybeT Transaction Id
forall (m :: * -> *) a. m (Maybe a) -> MaybeT m a
MaybeT (Transaction (Maybe Id) -> MaybeT Transaction Id)
-> (Maybe Id -> Transaction (Maybe Id))
-> Maybe Id
-> MaybeT Transaction Id
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe Id -> Transaction (Maybe Id)
forall a. a -> Transaction a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe Id -> MaybeT Transaction Id)
-> Maybe Id -> MaybeT Transaction Id
forall a b. (a -> b) -> a -> b
$ Referent -> Maybe Id
Referent.toReferenceId Referent
termRef
        Term Symbol a
term <- Transaction (Maybe (Term Symbol a))
-> MaybeT Transaction (Term Symbol a)
forall (m :: * -> *) a. m (Maybe a) -> MaybeT m a
MaybeT (Transaction (Maybe (Term Symbol a))
 -> MaybeT Transaction (Term Symbol a))
-> Transaction (Maybe (Term Symbol a))
-> MaybeT Transaction (Term Symbol a)
forall a b. (a -> b) -> a -> b
$ Codebase m Symbol a -> Id -> Transaction (Maybe (Term Symbol a))
forall (m :: * -> *) v a.
Codebase m v a -> Id -> Transaction (Maybe (Term v a))
Codebase.getTerm Codebase m Symbol a
codebase Id
refId
        let termDeps :: Set LabeledDependency
termDeps = Term Symbol a -> Set LabeledDependency
forall v vt at ap a.
(Ord v, Ord vt) =>
Term2 vt at ap v a -> Set LabeledDependency
Term.labeledDependencies Term Symbol a
term
        Map LabeledDependency (Set Name)
-> MaybeT Transaction (Map LabeledDependency (Set Name))
forall a. a -> MaybeT Transaction a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Map LabeledDependency (Set Name)
 -> MaybeT Transaction (Map LabeledDependency (Set Name)))
-> Map LabeledDependency (Set Name)
-> MaybeT Transaction (Map LabeledDependency (Set Name))
forall a b. (a -> b) -> a -> b
$ (LabeledDependency -> Map LabeledDependency (Set Name))
-> Set LabeledDependency -> Map LabeledDependency (Set Name)
forall m a. Monoid m => (a -> m) -> Set a -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (LabeledDependency -> Set Name -> Map LabeledDependency (Set Name)
forall k a. k -> a -> Map k a
`Map.singleton` Set Name
names) Set LabeledDependency
termDeps

  let dependenciesToDependents :: Map LabeledDependency (Set Name)
      dependenciesToDependents :: Map LabeledDependency (Set Name)
dependenciesToDependents =
        (Set Name -> Set Name -> Set Name)
-> [Map LabeledDependency (Set Name)]
-> Map LabeledDependency (Set Name)
forall (f :: * -> *) k a.
(Foldable f, Ord k) =>
(a -> a -> a) -> f (Map k a) -> Map k a
Map.unionsWith Set Name -> Set Name -> Set Name
forall a. Semigroup a => a -> a -> a
(<>) ([Map LabeledDependency (Set Name)]
typeDeps [Map LabeledDependency (Set Name)]
-> [Map LabeledDependency (Set Name)]
-> [Map LabeledDependency (Set Name)]
forall a. [a] -> [a] -> [a]
++ [Map LabeledDependency (Set Name)]
termDeps)

  let onlyExternalDeps :: Map LabeledDependency (Set Name)
      onlyExternalDeps :: Map LabeledDependency (Set Name)
onlyExternalDeps =
        (LabeledDependency -> Set Name -> Bool)
-> Map LabeledDependency (Set Name)
-> Map LabeledDependency (Set Name)
forall k a. (k -> a -> Bool) -> Map k a -> Map k a
Map.filterWithKey
          ( \LabeledDependency
x Set Name
_ ->
              (Reference -> Bool)
-> (Referent -> Bool) -> LabeledDependency -> Bool
forall a.
(Reference -> a) -> (Referent -> a) -> LabeledDependency -> a
LD.fold
                (\Reference
k -> Bool -> Bool
not (Reference -> Relation Reference Name -> Bool
forall a b. Ord a => a -> Relation a b -> Bool
Relation.memberDom Reference
k (Branch0 m -> Relation Reference Name
forall (m :: * -> *). Branch0 m -> Relation Reference Name
Branch.deepTypes Branch0 m
branch)))
                (\Referent
k -> Bool -> Bool
not (Referent -> Relation Referent Name -> Bool
forall a b. Ord a => a -> Relation a b -> Bool
Relation.memberDom Referent
k (Branch0 m -> Relation Referent Name
forall (m :: * -> *). Branch0 m -> Relation Referent Name
Branch.deepTerms Branch0 m
branch)))
                LabeledDependency
x
          )
          Map LabeledDependency (Set Name)
dependenciesToDependents

  Map LabeledDependency (Set Name)
-> Transaction (Map LabeledDependency (Set Name))
forall a. a -> Transaction a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Map LabeledDependency (Set Name)
onlyExternalDeps
  where
    branchWithoutLibdeps :: Branch0 m
branchWithoutLibdeps = Branch0 m
branch Branch0 m -> (Branch0 m -> Branch0 m) -> Branch0 m
forall a b. a -> (a -> b) -> b
& ASetter
  (Branch0 m)
  (Branch0 m)
  (Map NameSegment (Branch m))
  (Map NameSegment (Branch m))
-> (Map NameSegment (Branch m) -> Map NameSegment (Branch m))
-> Branch0 m
-> Branch0 m
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over ASetter
  (Branch0 m)
  (Branch0 m)
  (Map NameSegment (Branch m))
  (Map NameSegment (Branch m))
forall (m :: * -> *) (f :: * -> *).
Functor f =>
(Map NameSegment (Branch m) -> f (Map NameSegment (Branch m)))
-> Branch0 m -> f (Branch0 m)
Branch.children (NameSegment
-> Map NameSegment (Branch m) -> Map NameSegment (Branch m)
forall k a. Ord k => k -> Map k a -> Map k a
Map.delete NameSegment
NameSegment.libSegment)