module Unison.Codebase.Editor.HandleInput.MoveTerm (doMoveTerm, moveTermSteps) where

import Control.Lens (_1, _2)
import Data.Set qualified as Set
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 (Branch0)
import Unison.Codebase.BranchUtil qualified as BranchUtil
import Unison.Codebase.Editor.Output qualified as Output
import Unison.Codebase.Path (Path')
import Unison.Codebase.Path qualified as Path
import Unison.Codebase.ProjectPath qualified as PP
import Unison.HashQualifiedPrime qualified as HQ'
import Unison.NameSegment (NameSegment)
import Unison.Prelude

moveTermSteps :: (Path', HQ'.HQSegment) -> (Path', NameSegment) -> Cli [(Path.Absolute, Branch0 m -> Branch0 m)]
moveTermSteps :: forall (m :: * -> *).
(Path', HQSegment)
-> (Path', NameSegment) -> Cli [(Absolute, Branch0 m -> Branch0 m)]
moveTermSteps (Path', HQSegment)
src' (Path', NameSegment)
dest' = do
  (ProjectPath, HQSegment)
src <- (Path', HQSegment) -> Cli (ProjectPath, HQSegment)
forall a. (Path', a) -> Cli (ProjectPath, a)
Cli.resolveSplit' (Path', HQSegment)
src'
  Set Referent
srcTerms <- (ProjectPath, HQSegment) -> Cli (Set Referent)
Cli.getTermsAt (ProjectPath, HQSegment)
src
  case Set Referent -> [Referent]
forall a. Set a -> [a]
Set.toList Set Referent
srcTerms of
    [] -> [(Absolute, Branch0 m -> Branch0 m)]
-> Cli [(Absolute, Branch0 m -> Branch0 m)]
forall a. a -> Cli a
forall (f :: * -> *) a. Applicative f => a -> f a
pure []
    Referent
_ : Referent
_ : [Referent]
_ -> do
      Int
hqLength <- Transaction Int -> Cli Int
forall a. Transaction a -> Cli a
Cli.runTransaction Transaction Int
Codebase.hashLength
      Output -> Cli [(Absolute, Branch0 m -> Branch0 m)]
forall a. Output -> Cli a
Cli.returnEarly (Int
-> (Path', HQSegment) -> Set Referent -> Set Reference -> Output
Output.DeleteNameAmbiguous Int
hqLength (Path', HQSegment)
src' Set Referent
srcTerms Set Reference
forall a. Set a
Set.empty)
    [Referent
srcTerm] -> do
      (ProjectPath, NameSegment)
dest <- (Path', NameSegment) -> Cli (ProjectPath, NameSegment)
forall a. (Path', a) -> Cli (ProjectPath, a)
Cli.resolveSplit' (Path', NameSegment)
dest'
      Set Referent
destTerms <- (ProjectPath, HQSegment) -> Cli (Set Referent)
Cli.getTermsAt (NameSegment -> HQSegment
forall n. n -> HashQualified n
HQ'.NameOnly (NameSegment -> HQSegment)
-> (ProjectPath, NameSegment) -> (ProjectPath, HQSegment)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (ProjectPath, NameSegment)
dest)
      Bool -> Cli () -> Cli ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Bool -> Bool
not (Set Referent -> Bool
forall a. Set a -> Bool
Set.null Set Referent
destTerms)) do
        Output -> Cli ()
forall a. Output -> Cli a
Cli.returnEarly ((Path', NameSegment) -> Set Referent -> Output
Output.TermAlreadyExists (Path', NameSegment)
dest' Set Referent
destTerms)
      let p :: (Absolute, HQSegment)
p = (ProjectPath, HQSegment)
src (ProjectPath, HQSegment)
-> ((ProjectPath, HQSegment) -> (Absolute, HQSegment))
-> (Absolute, HQSegment)
forall a b. a -> (a -> b) -> b
& (ProjectPath -> Identity Absolute)
-> (ProjectPath, HQSegment) -> Identity (Absolute, HQSegment)
forall s t a b. Field1 s t a b => Lens s t a b
Lens
  (ProjectPath, HQSegment) (Absolute, HQSegment) ProjectPath Absolute
_1 ((ProjectPath -> Identity Absolute)
 -> (ProjectPath, HQSegment) -> Identity (Absolute, HQSegment))
-> (ProjectPath -> Absolute)
-> (ProjectPath, HQSegment)
-> (Absolute, HQSegment)
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ Getting Absolute ProjectPath Absolute -> ProjectPath -> Absolute
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting Absolute ProjectPath Absolute
forall p b (f :: * -> *).
Functor f =>
(Absolute -> f Absolute)
-> ProjectPathG p b -> f (ProjectPathG p b)
PP.absPath_
      pure
        [ -- Mitchell: throwing away any hash-qualification here seems wrong!
          (Absolute, NameSegment)
-> Referent -> (Absolute, Branch0 m -> Branch0 m)
forall p (m :: * -> *).
(p, NameSegment) -> Referent -> (p, Branch0 m -> Branch0 m)
BranchUtil.makeDeleteTermName (ASetter
  (Absolute, HQSegment) (Absolute, NameSegment) HQSegment NameSegment
-> (HQSegment -> NameSegment)
-> (Absolute, HQSegment)
-> (Absolute, NameSegment)
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over ASetter
  (Absolute, HQSegment) (Absolute, NameSegment) HQSegment NameSegment
forall s t a b. Field2 s t a b => Lens s t a b
Lens
  (Absolute, HQSegment) (Absolute, NameSegment) HQSegment NameSegment
_2 HQSegment -> NameSegment
forall n. HashQualified n -> n
HQ'.toName (Absolute, HQSegment)
p) Referent
srcTerm,
          (Absolute, NameSegment)
-> Referent -> (Absolute, Branch0 m -> Branch0 m)
forall p (m :: * -> *).
(p, NameSegment) -> Referent -> (p, Branch0 m -> Branch0 m)
BranchUtil.makeAddTermName (ASetter
  (ProjectPath, NameSegment)
  (Absolute, NameSegment)
  ProjectPath
  Absolute
-> (ProjectPath -> Absolute)
-> (ProjectPath, NameSegment)
-> (Absolute, NameSegment)
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over ASetter
  (ProjectPath, NameSegment)
  (Absolute, NameSegment)
  ProjectPath
  Absolute
forall s t a b. Field1 s t a b => Lens s t a b
Lens
  (ProjectPath, NameSegment)
  (Absolute, NameSegment)
  ProjectPath
  Absolute
_1 (Getting Absolute ProjectPath Absolute -> ProjectPath -> Absolute
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting Absolute ProjectPath Absolute
forall p b (f :: * -> *).
Functor f =>
(Absolute -> f Absolute)
-> ProjectPathG p b -> f (ProjectPathG p b)
PP.absPath_) (ProjectPath, NameSegment)
dest) Referent
srcTerm
        ]

doMoveTerm :: (Path', HQ'.HQSegment) -> (Path', NameSegment) -> Text -> Cli ()
doMoveTerm :: (Path', HQSegment) -> (Path', NameSegment) -> Text -> Cli ()
doMoveTerm (Path', HQSegment)
src' (Path', NameSegment)
dest' Text
description = do
  [(Absolute, Branch0 IO -> Branch0 IO)]
steps <- (Path', HQSegment)
-> (Path', NameSegment)
-> Cli [(Absolute, Branch0 IO -> Branch0 IO)]
forall (m :: * -> *).
(Path', HQSegment)
-> (Path', NameSegment) -> Cli [(Absolute, Branch0 m -> Branch0 m)]
moveTermSteps (Path', HQSegment)
src' (Path', NameSegment)
dest'
  Bool -> Cli () -> Cli ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when ([(Absolute, Branch0 IO -> Branch0 IO)] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [(Absolute, Branch0 IO -> Branch0 IO)]
steps) do
    Output -> Cli ()
forall a. Output -> Cli a
Cli.returnEarly ((Path', HQSegment) -> Output
Output.TermNotFound (Path', HQSegment)
src')
  ProjectBranch
pb <- Cli ProjectBranch
Cli.getCurrentProjectBranch
  ProjectBranch
-> Text -> [(Absolute, Branch0 IO -> Branch0 IO)] -> Cli ()
Cli.stepManyAt ProjectBranch
pb Text
description [(Absolute, Branch0 IO -> Branch0 IO)]
steps
  Output -> Cli ()
Cli.respond Output
Output.Success