module Unison.Codebase.Editor.HandleInput.DeleteNamespace
  ( handleDeleteNamespace,
  )
where

import Control.Monad.State qualified as State
import Data.Map qualified as Map
import Data.Set qualified as Set
import Data.Set.NonEmpty (NESet)
import Data.Set.NonEmpty qualified as NESet
import U.Codebase.Sqlite.Queries qualified as Queries
import Unison.Cli.Monad (Cli)
import Unison.Cli.Monad qualified as Cli
import Unison.Cli.MonadUtils qualified as Cli
import Unison.Codebase qualified as Codebase
import Unison.Codebase.Branch qualified as Branch
import Unison.Codebase.Branch.Names qualified as Branch
import Unison.Codebase.Editor.Input
import Unison.Codebase.Editor.Output
import Unison.Codebase.Path qualified as Path
import Unison.LabeledDependency (LabeledDependency)
import Unison.LabeledDependency qualified as LD
import Unison.Names (Names)
import Unison.Names qualified as Names
import Unison.Prelude
import Unison.PrettyPrintEnv.Names qualified as PPE
import Unison.PrettyPrintEnvDecl qualified as PPED
import Unison.Referent qualified as Referent
import Unison.Sqlite qualified as Sqlite

handleDeleteNamespace :: Input -> Insistence -> Maybe (Path.Split Path.Path) -> Cli ()
handleDeleteNamespace :: Input -> Insistence -> Maybe (Split Path) -> Cli ()
handleDeleteNamespace Input
input Insistence
insistence = \case
  Maybe (Split Path)
Nothing -> do
    loopState <- Cli LoopState
forall s (m :: * -> *). MonadState s m => m s
State.get
    if loopState.lastInput == Just input || insistence == Force
      then do
        pp <- Cli.getCurrentProjectPath
        _ <- Cli.updateAt (commandName <> " .") pp (const Branch.empty)
        Cli.respond DeletedEverything
      else Cli.respond DeleteEverythingConfirmation
  Just p :: Split Path
p@(Path
parentPath, NameSegment
childName) -> do
    branch <- Path -> Cli (Branch IO)
Cli.expectBranchAtPath (Split Path -> Path
forall path. Pathy path => Split path -> path
Path.unsplit Split Path
p)
    let toDelete =
          Name -> Names -> Names
Names.prefix0
            (Split Path -> Name
forall path. Namey path => Split path -> Name
Path.nameFromSplit (Path
parentPath, NameSegment
childName))
            (Branch0 IO -> Names
forall (m :: * -> *). Branch0 m -> Names
Branch.toNames (Branch IO -> Branch0 IO
forall (m :: * -> *). Branch m -> Branch0 m
Branch.head Branch IO
branch))
    afterDelete <- do
      currentBranch <- Cli.getCurrentProjectRoot0
      let names = Branch0 IO -> Names
forall (m :: * -> *). Branch0 m -> Names
Branch.toNames Branch0 IO
currentBranch
          namesSansLib = Branch0 IO -> Names
forall (m :: * -> *). Branch0 m -> Names
Branch.toNames (Branch0 IO -> Branch0 IO
forall (m :: * -> *). Branch0 m -> Branch0 m
Branch.deleteLibdeps Branch0 IO
currentBranch)
      endangerments <- Cli.runTransaction (getEndangeredDependents toDelete Set.empty names namesSansLib)
      case (null endangerments, insistence) of
        (Bool
True, Insistence
_) -> Cli () -> Cli (Cli ())
forall a. a -> Cli a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Output -> Cli ()
Cli.respond Output
Success)
        (Bool
False, Insistence
Force) -> do
          let ppeDecl :: PrettyPrintEnvDecl
ppeDecl = Namer -> Suffixifier -> PrettyPrintEnvDecl
PPED.makePPED (Int -> Names -> Namer
PPE.hqNamer Int
10 Names
names) (Names -> Suffixifier
PPE.suffixifyByHash Names
names)
          Cli () -> Cli (Cli ())
forall a. a -> Cli a
forall (f :: * -> *) a. Applicative f => a -> f a
pure do
            Output -> Cli ()
Cli.respond Output
Success
            NumberedOutput -> Cli ()
Cli.respondNumbered (NumberedOutput -> Cli ()) -> NumberedOutput -> Cli ()
forall a b. (a -> b) -> a -> b
$ PrettyPrintEnvDecl
-> Map LabeledDependency (NESet LabeledDependency)
-> NumberedOutput
DeletedDespiteDependents PrettyPrintEnvDecl
ppeDecl Map LabeledDependency (NESet LabeledDependency)
endangerments
        (Bool
False, Insistence
Try) -> do
          let ppeDecl :: PrettyPrintEnvDecl
ppeDecl = Namer -> Suffixifier -> PrettyPrintEnvDecl
PPED.makePPED (Int -> Names -> Namer
PPE.hqNamer Int
10 Names
names) (Names -> Suffixifier
PPE.suffixifyByHash Names
names)
          NumberedOutput -> Cli ()
Cli.respondNumbered (NumberedOutput -> Cli ()) -> NumberedOutput -> Cli ()
forall a b. (a -> b) -> a -> b
$ PrettyPrintEnvDecl
-> Map LabeledDependency (NESet LabeledDependency)
-> NumberedOutput
CantDeleteNamespace PrettyPrintEnvDecl
ppeDecl Map LabeledDependency (NESet LabeledDependency)
endangerments
          Cli (Cli ())
forall a. Cli a
Cli.returnEarlyWithoutOutput
    parentPathAbs <- Cli.resolvePath' $ Path.RelativePath' parentPath
    let description = Text
commandName Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> forall target source. From source target => source -> target
into @Text (ProjectPath -> NameSegment -> ProjectPath
forall path. Pathy path => path -> NameSegment -> path
Path.descend ProjectPath
parentPathAbs NameSegment
childName)
    -- We have to modify the parent in order to also wipe out the history at the
    -- child.
    _ <- Cli.updateAt description parentPathAbs (Branch.modifyAt (Path.singleton childName) \Branch IO
_ -> Branch IO
forall (m :: * -> *). Branch m
Branch.empty)
    afterDelete
  where
    commandName :: Text
    commandName :: Text
commandName =
      case Insistence
insistence of
        Insistence
Try -> Text
"delete.namespace"
        Insistence
Force -> Text
"delete.namespace.force"

-- How I might do it (is this any better than the current algorithm?)
--
-- 1. Get all direct dependents of the deleted things in the current namespace.
-- 2. For each direct dependent, check a Names built from the deleted namespace – is it there? If not it's the last
--    name.

-- | Goal: When deleting, we might be removing the last name of a given definition (i.e. the
-- definition is going "extinct"). In this case we may wish to take some action or warn the
-- user about these "endangered" definitions which would now contain unnamed references.
-- The argument `otherDesiredDeletions` is included in this function because the user might want to
-- delete a term and all its dependencies in one command, so we give this function access to
-- the full set of entities that the user wishes to delete.
getEndangeredDependents ::
  -- | Prospective target for deletion
  Names ->
  -- | All entities we want to delete (including the target)
  Set LabeledDependency ->
  -- | Names from the current branch
  Names ->
  -- | Names from the current branch, sans `lib`
  Names ->
  -- | map from references going extinct to the set of endangered dependents
  Sqlite.Transaction (Map LabeledDependency (NESet LabeledDependency))
getEndangeredDependents :: Names
-> Set LabeledDependency
-> Names
-> Names
-> Transaction (Map LabeledDependency (NESet LabeledDependency))
getEndangeredDependents Names
targetToDelete Set LabeledDependency
otherDesiredDeletions Names
rootNames Names
rootNamesSansLib = do
  -- deleting and not left over
  let extinct :: Set LabeledDependency
      extinct :: Set LabeledDependency
extinct = Names -> Set LabeledDependency
Names.labeledReferences Names
targetToDelete Set LabeledDependency
-> Set LabeledDependency -> Set LabeledDependency
forall a. Ord a => Set a -> Set a -> Set a
`Set.difference` Names -> Set LabeledDependency
refsAfterDeletingTarget Names
rootNames

  let accumulateDependents :: LabeledDependency -> Sqlite.Transaction (Map LabeledDependency (Set LabeledDependency))
      accumulateDependents :: LabeledDependency
-> Transaction (Map LabeledDependency (Set LabeledDependency))
accumulateDependents LabeledDependency
ld =
        let ref :: Reference
ref = (Reference -> Reference)
-> (Referent -> Reference) -> LabeledDependency -> Reference
forall a.
(Reference -> a) -> (Referent -> a) -> LabeledDependency -> a
LD.fold Reference -> Reference
forall a. a -> a
id Referent -> Reference
Referent.toReference LabeledDependency
ld
         in LabeledDependency
-> Set LabeledDependency
-> Map LabeledDependency (Set LabeledDependency)
forall k a. k -> a -> Map k a
Map.singleton LabeledDependency
ld (Set LabeledDependency
 -> Map LabeledDependency (Set LabeledDependency))
-> (Set Reference -> Set LabeledDependency)
-> Set Reference
-> Map LabeledDependency (Set LabeledDependency)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Reference -> LabeledDependency)
-> Set Reference -> Set LabeledDependency
forall b a. Ord b => (a -> b) -> Set a -> Set b
Set.map Reference -> LabeledDependency
LD.termRef (Set Reference -> Map LabeledDependency (Set LabeledDependency))
-> Transaction (Set Reference)
-> Transaction (Map LabeledDependency (Set LabeledDependency))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> DependentsSelector -> Reference -> Transaction (Set Reference)
Codebase.dependents DependentsSelector
Queries.ExcludeOwnComponent Reference
ref

  -- All dependents of extinct, including terms which might themselves be in the process of being deleted.
  allDependentsOfExtinct :: Map LabeledDependency (Set LabeledDependency) <-
    (Set LabeledDependency
 -> Set LabeledDependency -> Set LabeledDependency)
-> [Map LabeledDependency (Set LabeledDependency)]
-> Map LabeledDependency (Set LabeledDependency)
forall (f :: * -> *) k a.
(Foldable f, Ord k) =>
(a -> a -> a) -> f (Map k a) -> Map k a
Map.unionsWith Set LabeledDependency
-> Set LabeledDependency -> Set LabeledDependency
forall a. Semigroup a => a -> a -> a
(<>) ([Map LabeledDependency (Set LabeledDependency)]
 -> Map LabeledDependency (Set LabeledDependency))
-> Transaction [Map LabeledDependency (Set LabeledDependency)]
-> Transaction (Map LabeledDependency (Set LabeledDependency))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [LabeledDependency]
-> (LabeledDependency
    -> Transaction (Map LabeledDependency (Set LabeledDependency)))
-> Transaction [Map LabeledDependency (Set LabeledDependency)]
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]
Set.toList Set LabeledDependency
extinct) LabeledDependency
-> Transaction (Map LabeledDependency (Set LabeledDependency))
accumulateDependents

  -- Of all the dependents of things going extinct, we filter down to only those that are not themselves being deleted
  -- too (per `otherDesiredDeletion`), and are also somewhere outside `lib`. This allows us to proceed with deleting
  -- an entire dependency out of `lib` even if for some reason it contains the only source of names for some other
  -- dependency.
  let extinctToEndangered :: Map LabeledDependency (NESet LabeledDependency)
      extinctToEndangered =
        (Set LabeledDependency -> Maybe (NESet LabeledDependency))
-> Map LabeledDependency (Set LabeledDependency)
-> Map LabeledDependency (NESet LabeledDependency)
forall a b k. (a -> Maybe b) -> Map k a -> Map k b
Map.mapMaybe
          ( Set LabeledDependency -> Maybe (NESet LabeledDependency)
forall a. Set a -> Maybe (NESet a)
NESet.nonEmptySet
              (Set LabeledDependency -> Maybe (NESet LabeledDependency))
-> (Set LabeledDependency -> Set LabeledDependency)
-> Set LabeledDependency
-> Maybe (NESet LabeledDependency)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Set LabeledDependency
-> Set LabeledDependency -> Set LabeledDependency
forall a. Ord a => Set a -> Set a -> Set a
Set.intersection (Set LabeledDependency
-> Set LabeledDependency -> Set LabeledDependency
forall a. Ord a => Set a -> Set a -> Set a
Set.difference (Names -> Set LabeledDependency
refsAfterDeletingTarget Names
rootNamesSansLib) Set LabeledDependency
otherDesiredDeletions)
          )
          Map LabeledDependency (Set LabeledDependency)
allDependentsOfExtinct
  pure extinctToEndangered
  where
    refsAfterDeletingTarget :: Names -> Set LabeledDependency
    refsAfterDeletingTarget :: Names -> Set LabeledDependency
refsAfterDeletingTarget Names
names =
      Names -> Set LabeledDependency
Names.labeledReferences (Names
names Names -> Names -> Names
`Names.difference` Names
targetToDelete)