module Unison.Codebase.Editor.HandleInput.DeleteNamespace
  ( handleDeleteNamespace,
    getEndangeredDependents,
  )
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.Names qualified as PPED
import Unison.Referent qualified as Referent
import Unison.Sqlite qualified as Sqlite

handleDeleteNamespace :: Input -> Insistence -> Maybe (Path.Split Path.Relative) -> Cli ()
handleDeleteNamespace :: Input -> Insistence -> Maybe (Split Relative) -> Cli ()
handleDeleteNamespace Input
input Insistence
insistence = \case
  Maybe (Split Relative)
Nothing -> do
    LoopState
loopState <- Cli LoopState
forall s (m :: * -> *). MonadState s m => m s
State.get
    if LoopState
loopState.lastInput Maybe Input -> Maybe Input -> Bool
forall a. Eq a => a -> a -> Bool
== Input -> Maybe Input
forall a. a -> Maybe a
Just Input
input Bool -> Bool -> Bool
|| Insistence
insistence Insistence -> Insistence -> Bool
forall a. Eq a => a -> a -> Bool
== Insistence
Force
      then do
        ProjectPath
pp <- Cli ProjectPath
Cli.getCurrentProjectPath
        Bool
_ <- Text -> ProjectPath -> (Branch IO -> Branch IO) -> Cli Bool
Cli.updateAt (Text
commandName Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" .") ProjectPath
pp (Branch IO -> Branch IO -> Branch IO
forall a b. a -> b -> a
const Branch IO
forall (m :: * -> *). Branch m
Branch.empty)
        Output -> Cli ()
Cli.respond Output
DeletedEverything
      else Output -> Cli ()
Cli.respond Output
DeleteEverythingConfirmation
  Just p :: Split Relative
p@(Relative
parentPath, NameSegment
childName) -> do
    Branch IO
branch <- Relative -> Cli (Branch IO)
Cli.expectBranchAtPath (Split Relative -> Relative
forall path. Pathy path => Split path -> path
Path.unsplit Split Relative
p)
    let toDelete :: Names
toDelete =
          Name -> Names -> Names
Names.prefix0
            (Split Relative -> Name
forall path. Namey path => Split path -> Name
Path.nameFromSplit (Relative
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))
    Cli ()
afterDelete <- do
      Branch0 IO
currentBranch <- Cli (Branch0 IO)
Cli.getCurrentProjectRoot0
      let names :: Names
names = Branch0 IO -> Names
forall (m :: * -> *). Branch0 m -> Names
Branch.toNames Branch0 IO
currentBranch
          namesSansLib :: Names
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)
      Map LabeledDependency (NESet LabeledDependency)
endangerments <- Transaction (Map LabeledDependency (NESet LabeledDependency))
-> Cli (Map LabeledDependency (NESet LabeledDependency))
forall a. Transaction a -> Cli a
Cli.runTransaction (Names
-> Set LabeledDependency
-> Names
-> Names
-> Transaction (Map LabeledDependency (NESet LabeledDependency))
getEndangeredDependents Names
toDelete Set LabeledDependency
forall a. Set a
Set.empty Names
names Names
namesSansLib)
      case (Map LabeledDependency (NESet LabeledDependency) -> Bool
forall a. Map LabeledDependency a -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null Map LabeledDependency (NESet LabeledDependency)
endangerments, Insistence
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
    ProjectPath
parentPathAbs <- Path' -> Cli ProjectPath
Cli.resolvePath' (Path' -> Cli ProjectPath) -> Path' -> Cli ProjectPath
forall a b. (a -> b) -> a -> b
$ Relative -> Path'
Path.RelativePath' Relative
parentPath
    let description :: Text
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.
    Text -> ProjectPath -> (Branch IO -> Branch IO) -> Cli Bool
Cli.updateAt Text
description ProjectPath
parentPathAbs (Path -> (Branch IO -> Branch IO) -> Branch IO -> Branch IO
forall (m :: * -> *).
Applicative m =>
Path -> (Branch m -> Branch m) -> Branch m -> Branch m
Branch.modifyAt (NameSegment -> Path
Path.singleton NameSegment
childName) \Branch IO
_ -> Branch IO
forall (m :: * -> *). Branch m
Branch.empty)
    Cli ()
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.
  Map LabeledDependency (Set LabeledDependency)
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 :: 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
  Map LabeledDependency (NESet LabeledDependency)
-> Transaction (Map LabeledDependency (NESet LabeledDependency))
forall a. a -> Transaction a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Map LabeledDependency (NESet LabeledDependency)
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)