module Unison.Codebase.Editor.HandleInput.MoveTo (handleMoveTo) where

import Data.List.NonEmpty (NonEmpty)
import Data.List.NonEmpty qualified as NE
import Data.Map.Strict qualified as Map
import Unison.Cli.Monad (Cli)
import Unison.Cli.Monad qualified as Cli
import Unison.Cli.MonadUtils qualified as Cli
import Unison.Codebase.Branch (Branch, Branch0)
import Unison.Codebase.Editor.HandleInput.MoveBranch (moveBranchFunc)
import Unison.Codebase.Editor.HandleInput.MoveTerm (moveTermSteps)
import Unison.Codebase.Editor.HandleInput.MoveType (moveTypeSteps)
import Unison.Codebase.Editor.Output qualified as Output
import Unison.Codebase.Path qualified as Path
import Unison.HashQualifiedPrime qualified as HQ'
import Unison.NameSegment (NameSegment)
import Unison.Prelude

-- | Move one or more items INTO a destination namespace.
-- For example:
--   `moveTo foo.bar baz` moves `foo.bar` to `baz.bar` (keeps the final segment)
--   `moveTo foo bar baz dest` moves all three into `dest.foo`, `dest.bar`, `dest.baz`
--
-- If multiple sources have the same final segment, we move the non-conflicting items
-- and report the conflict to the user.
handleMoveTo :: NonEmpty Path.Path' -> Path.Path' -> Text -> Cli ()
handleMoveTo :: NonEmpty Path' -> Path' -> Text -> Cli ()
handleMoveTo NonEmpty Path'
sources Path'
dest' Text
description = do
  -- Group sources by their final segment to detect conflicts
  let sourcesWithSegments :: [(Path.Path', Maybe (Path.Path', NameSegment))]
      sourcesWithSegments :: [(Path', Maybe (Path', NameSegment))]
sourcesWithSegments = [(Path'
src, Path' -> Maybe (Path', NameSegment)
forall path. Pathy path => path -> Maybe (Split path)
Path.split Path'
src) | Path'
src <- NonEmpty Path' -> [Path']
forall a. NonEmpty a -> [a]
NE.toList NonEmpty Path'
sources]

      -- Partition into sources with valid splits and those without
      ([Path']
invalidSources, [(Path', Path', NameSegment)]
validSources) = ((Path', Maybe (Path', NameSegment))
 -> ([Path'], [(Path', Path', NameSegment)])
 -> ([Path'], [(Path', Path', NameSegment)]))
-> ([Path'], [(Path', Path', NameSegment)])
-> [(Path', Maybe (Path', NameSegment))]
-> ([Path'], [(Path', Path', NameSegment)])
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (Path', Maybe (Path', NameSegment))
-> ([Path'], [(Path', Path', NameSegment)])
-> ([Path'], [(Path', Path', NameSegment)])
forall {a} {b} {c}.
(a, Maybe (b, c)) -> ([a], [(a, b, c)]) -> ([a], [(a, b, c)])
partitionValid ([], []) [(Path', Maybe (Path', NameSegment))]
sourcesWithSegments
        where
          partitionValid :: (a, Maybe (b, c)) -> ([a], [(a, b, c)]) -> ([a], [(a, b, c)])
partitionValid (a
src, Maybe (b, c)
Nothing) ([a]
invalid, [(a, b, c)]
valid) = (a
src a -> [a] -> [a]
forall a. a -> [a] -> [a]
: [a]
invalid, [(a, b, c)]
valid)
          partitionValid (a
src, Just (b
parent, c
seg)) ([a]
invalid, [(a, b, c)]
valid) = ([a]
invalid, (a
src, b
parent, c
seg) (a, b, c) -> [(a, b, c)] -> [(a, b, c)]
forall a. a -> [a] -> [a]
: [(a, b, c)]
valid)

      -- Group valid sources by their final segment
      byFinalSegment :: Map.Map NameSegment [(Path.Path', Path.Path')]
      byFinalSegment :: Map NameSegment [(Path', Path')]
byFinalSegment =
        ([(Path', Path')] -> [(Path', Path')] -> [(Path', Path')])
-> [(NameSegment, [(Path', Path')])]
-> Map NameSegment [(Path', Path')]
forall k a. Ord k => (a -> a -> a) -> [(k, a)] -> Map k a
Map.fromListWith
          [(Path', Path')] -> [(Path', Path')] -> [(Path', Path')]
forall a. [a] -> [a] -> [a]
(++)
          [(NameSegment
seg, [(Path'
src, Path'
parent)]) | (Path'
src, Path'
parent, NameSegment
seg) <- [(Path', Path', NameSegment)]
validSources]

      -- Separate conflicting and non-conflicting sources
      (Map NameSegment [(Path', Path')]
conflicting, Map NameSegment [(Path', Path')]
nonConflicting) = ([(Path', Path')] -> Bool)
-> Map NameSegment [(Path', Path')]
-> (Map NameSegment [(Path', Path')],
    Map NameSegment [(Path', Path')])
forall a k. (a -> Bool) -> Map k a -> (Map k a, Map k a)
Map.partition (\[(Path', Path')]
srcs -> [(Path', Path')] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [(Path', Path')]
srcs Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
1) Map NameSegment [(Path', Path')]
byFinalSegment

  -- Report invalid sources (paths that can't be split, like the root)
  Bool -> Cli () -> Cli ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Bool -> Bool
not ([Path'] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Path']
invalidSources)) (Cli () -> Cli ()) -> Cli () -> Cli ()
forall a b. (a -> b) -> a -> b
$
    Output -> Cli ()
Cli.respond (Output -> Cli ()) -> Output -> Cli ()
forall a b. (a -> b) -> a -> b
$
      Path' -> Output
Output.MoveNothingFound ([Path'] -> Path'
forall a. HasCallStack => [a] -> a
head [Path']
invalidSources)

  -- Process non-conflicting sources
  let nonConflictingSources :: [(Path.Path', NameSegment)]
      nonConflictingSources :: [(Path', NameSegment)]
nonConflictingSources = do
        (NameSegment
seg, [(Path', Path')]
srcs) <- Map NameSegment [(Path', Path')]
-> [(NameSegment, [(Path', Path')])]
forall k a. Map k a -> [(k, a)]
Map.toList Map NameSegment [(Path', Path')]
nonConflicting
        (Path'
src, Path'
_parent) <- [(Path', Path')]
srcs
        (Path', NameSegment) -> [(Path', NameSegment)]
forall a. a -> [a]
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Path'
src, NameSegment
seg)

  [(Path', Path',
  (Maybe (Absolute, Branch IO -> Branch IO),
   [(Absolute, Branch0 IO -> Branch0 IO)]))]
results <- [(Path', NameSegment)]
-> ((Path', NameSegment)
    -> Cli
         (Path', Path',
          (Maybe (Absolute, Branch IO -> Branch IO),
           [(Absolute, Branch0 IO -> Branch0 IO)])))
-> Cli
     [(Path', Path',
       (Maybe (Absolute, Branch IO -> Branch IO),
        [(Absolute, Branch0 IO -> Branch0 IO)]))]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [(Path', NameSegment)]
nonConflictingSources (((Path', NameSegment)
  -> Cli
       (Path', Path',
        (Maybe (Absolute, Branch IO -> Branch IO),
         [(Absolute, Branch0 IO -> Branch0 IO)])))
 -> Cli
      [(Path', Path',
        (Maybe (Absolute, Branch IO -> Branch IO),
         [(Absolute, Branch0 IO -> Branch0 IO)]))])
-> ((Path', NameSegment)
    -> Cli
         (Path', Path',
          (Maybe (Absolute, Branch IO -> Branch IO),
           [(Absolute, Branch0 IO -> Branch0 IO)])))
-> Cli
     [(Path', Path',
       (Maybe (Absolute, Branch IO -> Branch IO),
        [(Absolute, Branch0 IO -> Branch0 IO)]))]
forall a b. (a -> b) -> a -> b
$ \(Path'
src', NameSegment
seg) -> do
    -- Destination is dest'.seg
    let destPath :: Path'
destPath = Path' -> NameSegment -> Path'
forall path. Pathy path => path -> NameSegment -> path
Path.descend Path'
dest' NameSegment
seg
    (Maybe (Absolute, Branch IO -> Branch IO),
 [(Absolute, Branch0 IO -> Branch0 IO)])
result <- Path'
-> Path'
-> Cli
     (Maybe (Absolute, Branch IO -> Branch IO),
      [(Absolute, Branch0 IO -> Branch0 IO)])
forall (m :: * -> *).
Path'
-> Path'
-> Cli
     (Maybe (Absolute, Branch IO -> Branch IO),
      [(Absolute, Branch0 m -> Branch0 m)])
moveSingleItem Path'
src' Path'
destPath
    (Path', Path',
 (Maybe (Absolute, Branch IO -> Branch IO),
  [(Absolute, Branch0 IO -> Branch0 IO)]))
-> Cli
     (Path', Path',
      (Maybe (Absolute, Branch IO -> Branch IO),
       [(Absolute, Branch0 IO -> Branch0 IO)]))
forall a. a -> Cli a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Path'
src', Path'
destPath, (Maybe (Absolute, Branch IO -> Branch IO),
 [(Absolute, Branch0 IO -> Branch0 IO)])
result)

  -- Collect all the steps and updates, and track what was actually moved
  let allBranchUpdates :: [(Absolute, Branch IO -> Branch IO)]
allBranchUpdates = [Maybe (Absolute, Branch IO -> Branch IO)]
-> [(Absolute, Branch IO -> Branch IO)]
forall a. [Maybe a] -> [a]
catMaybes [Maybe (Absolute, Branch IO -> Branch IO)
mupdate | (Path'
_, Path'
_, (Maybe (Absolute, Branch IO -> Branch IO)
mupdate, [(Absolute, Branch0 IO -> Branch0 IO)]
_)) <- [(Path', Path',
  (Maybe (Absolute, Branch IO -> Branch IO),
   [(Absolute, Branch0 IO -> Branch0 IO)]))]
results]
      allSteps :: [(Absolute, Branch0 IO -> Branch0 IO)]
allSteps = [[(Absolute, Branch0 IO -> Branch0 IO)]]
-> [(Absolute, Branch0 IO -> Branch0 IO)]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[(Absolute, Branch0 IO -> Branch0 IO)]
steps | (Path'
_, Path'
_, (Maybe (Absolute, Branch IO -> Branch IO)
_, [(Absolute, Branch0 IO -> Branch0 IO)]
steps)) <- [(Path', Path',
  (Maybe (Absolute, Branch IO -> Branch IO),
   [(Absolute, Branch0 IO -> Branch0 IO)]))]
results]
      -- Items that were actually moved (had branch updates or term/type steps)
      movedItems :: [(Path', Path')]
movedItems = [(Path'
src, Path'
dest) | (Path'
src, Path'
dest, (Maybe (Absolute, Branch IO -> Branch IO)
mupdate, [(Absolute, Branch0 IO -> Branch0 IO)]
steps)) <- [(Path', Path',
  (Maybe (Absolute, Branch IO -> Branch IO),
   [(Absolute, Branch0 IO -> Branch0 IO)]))]
results, Maybe (Absolute, Branch IO -> Branch IO) -> Bool
forall a. Maybe a -> Bool
isJust Maybe (Absolute, Branch IO -> Branch IO)
mupdate Bool -> Bool -> Bool
|| Bool -> Bool
not ([(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)]

  -- Perform the moves
  Bool -> Cli () -> Cli ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Bool -> Bool
not ([(Absolute, Branch IO -> Branch IO)] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [(Absolute, Branch IO -> Branch IO)]
allBranchUpdates) Bool -> Bool -> Bool
|| Bool -> Bool
not ([(Absolute, Branch0 IO -> Branch0 IO)] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [(Absolute, Branch0 IO -> Branch0 IO)]
allSteps)) (Cli () -> Cli ()) -> Cli () -> Cli ()
forall a b. (a -> b) -> a -> b
$ do
    ProjectPath
pp <- Cli ProjectPath
Cli.getCurrentProjectPath
    Text
-> ProjectBranch
-> [(Absolute, Branch IO -> Branch IO)]
-> [(Absolute, Branch0 IO -> Branch0 IO)]
-> Cli ()
forall (f :: * -> *) (g :: * -> *).
(Foldable f, Foldable g, Functor g) =>
Text
-> ProjectBranch
-> f (Absolute, Branch IO -> Branch IO)
-> g (Absolute, Branch0 IO -> Branch0 IO)
-> Cli ()
Cli.updateAndStepAt Text
description (ProjectPath
pp ProjectPath
-> Getting ProjectBranch ProjectPath ProjectBranch -> ProjectBranch
forall s a. s -> Getting a s a -> a
^. Getting ProjectBranch ProjectPath ProjectBranch
#branch) [(Absolute, Branch IO -> Branch IO)]
allBranchUpdates [(Absolute, Branch0 IO -> Branch0 IO)]
allSteps

  -- Build conflict info: just the source paths grouped by segment
  let conflictInfo :: [(NameSegment, [Path.Path'])]
      conflictInfo :: [(NameSegment, [Path'])]
conflictInfo = [(NameSegment
seg, ((Path', Path') -> Path') -> [(Path', Path')] -> [Path']
forall a b. (a -> b) -> [a] -> [b]
map (Path', Path') -> Path'
forall a b. (a, b) -> a
fst [(Path', Path')]
srcs) | (NameSegment
seg, [(Path', Path')]
srcs) <- Map NameSegment [(Path', Path')]
-> [(NameSegment, [(Path', Path')])]
forall k a. Map k a -> [(k, a)]
Map.toList Map NameSegment [(Path', Path')]
conflicting]

  -- Report results
  if Map NameSegment [(Path', Path')] -> Bool
forall a. Map NameSegment a -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null Map NameSegment [(Path', Path')]
conflicting
    then
      if [(Path', Path')] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [(Path', Path')]
movedItems
        then Output -> Cli ()
Cli.respond (Path' -> Output
Output.MoveNothingFound (NonEmpty Path' -> Path'
forall a. NonEmpty a -> a
NE.head NonEmpty Path'
sources))
        else Output -> Cli ()
Cli.respond ([(Path', Path')] -> Output
Output.MoveToResult [(Path', Path')]
movedItems)
    else do
      -- Report the conflicts (and any items that were moved)
      Output -> Cli ()
Cli.respond (Output -> Cli ()) -> Output -> Cli ()
forall a b. (a -> b) -> a -> b
$ [(Path', Path')] -> [(NameSegment, [Path'])] -> Path' -> Output
Output.MoveToConflicts [(Path', Path')]
movedItems [(NameSegment, [Path'])]
conflictInfo Path'
dest'

-- | Move a single item (term, type, and/or namespace) from src to dest
moveSingleItem ::
  Path.Path' ->
  Path.Path' ->
  Cli (Maybe (Path.Absolute, Branch IO -> Branch IO), [(Path.Absolute, Branch0 m -> Branch0 m)])
moveSingleItem :: forall (m :: * -> *).
Path'
-> Path'
-> Cli
     (Maybe (Absolute, Branch IO -> Branch IO),
      [(Absolute, Branch0 m -> Branch0 m)])
moveSingleItem Path'
src' Path'
dest' = do
  -- Move namespace if exists
  Maybe (Absolute, Branch IO -> Branch IO)
moveBranchResult <- Bool
-> Path' -> Path' -> Cli (Maybe (Absolute, Branch IO -> Branch IO))
moveBranchFunc Bool
False Path'
src' Path'
dest'

  -- Move term and type if they exist
  [(Absolute, Branch0 m -> Branch0 m)]
moveTermTypeSteps <- case (,) ((Path', NameSegment)
 -> (Path', NameSegment)
 -> ((Path', NameSegment), (Path', NameSegment)))
-> Maybe (Path', NameSegment)
-> Maybe
     ((Path', NameSegment)
      -> ((Path', NameSegment), (Path', NameSegment)))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Path' -> Maybe (Path', NameSegment)
forall path. Pathy path => path -> Maybe (Split path)
Path.split Path'
src' Maybe
  ((Path', NameSegment)
   -> ((Path', NameSegment), (Path', NameSegment)))
-> Maybe (Path', NameSegment)
-> Maybe ((Path', NameSegment), (Path', NameSegment))
forall a b. Maybe (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Path' -> Maybe (Path', NameSegment)
forall path. Pathy path => path -> Maybe (Split path)
Path.split Path'
dest' of
    Maybe ((Path', NameSegment), (Path', NameSegment))
Nothing -> [(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 []
    Just ((Path', NameSegment) -> HashQualified (Path', NameSegment)
forall n. n -> HashQualified n
HQ'.NameOnly -> HashQualified (Path', NameSegment)
src, (Path', NameSegment)
dest) -> do
      [(Absolute, Branch0 m -> Branch0 m)]
termSteps <- HashQualified (Path', NameSegment)
-> (Path', NameSegment) -> Cli [(Absolute, Branch0 m -> Branch0 m)]
forall (m :: * -> *).
HashQualified (Path', NameSegment)
-> (Path', NameSegment) -> Cli [(Absolute, Branch0 m -> Branch0 m)]
moveTermSteps HashQualified (Path', NameSegment)
src (Path', NameSegment)
dest
      [(Absolute, Branch0 m -> Branch0 m)]
typeSteps <- HashQualified (Path', NameSegment)
-> (Path', NameSegment) -> Cli [(Absolute, Branch0 m -> Branch0 m)]
forall (m :: * -> *).
HashQualified (Path', NameSegment)
-> (Path', NameSegment) -> Cli [(Absolute, Branch0 m -> Branch0 m)]
moveTypeSteps HashQualified (Path', NameSegment)
src (Path', NameSegment)
dest
      [(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 ([(Absolute, Branch0 m -> Branch0 m)]
termSteps [(Absolute, Branch0 m -> Branch0 m)]
-> [(Absolute, Branch0 m -> Branch0 m)]
-> [(Absolute, Branch0 m -> Branch0 m)]
forall a. [a] -> [a] -> [a]
++ [(Absolute, Branch0 m -> Branch0 m)]
typeSteps)

  (Maybe (Absolute, Branch IO -> Branch IO),
 [(Absolute, Branch0 m -> Branch0 m)])
-> Cli
     (Maybe (Absolute, Branch IO -> Branch IO),
      [(Absolute, Branch0 m -> Branch0 m)])
forall a. a -> Cli a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe (Absolute, Branch IO -> Branch IO)
moveBranchResult, [(Absolute, Branch0 m -> Branch0 m)]
moveTermTypeSteps)