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
        (seg, srcs) <- Map NameSegment [(Path', Path')]
-> [(NameSegment, [(Path', Path')])]
forall k a. Map k a -> [(k, a)]
Map.toList Map NameSegment [(Path', Path')]
nonConflicting
        (src, _parent) <- srcs
        pure (src, seg)

  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
    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
    pure (src', destPath, result)

  -- Collect all the steps and updates, and track what was actually moved
  let 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)]]
-> [(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'
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
  when (not (null allBranchUpdates) || not (null allSteps)) $ do
    pp <- Cli.getCurrentProjectPath
    Cli.updateAndStepAt description (pp ^. #branch) allBranchUpdates allSteps

  -- Build conflict info: just the source paths grouped by segment
  let conflictInfo :: [(NameSegment, [Path.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 null conflicting
    then
      if null movedItems
        then Cli.respond (Output.MoveNothingFound (NE.head sources))
        else Cli.respond (Output.MoveToResult movedItems)
    else do
      -- Report the conflicts (and any items that were moved)
      Cli.respond $ Output.MoveToConflicts movedItems conflictInfo 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
  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
  moveTermTypeSteps <- case (,) <$> Path.split src' <*> Path.split 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
      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
      typeSteps <- moveTypeSteps src dest
      pure (termSteps ++ typeSteps)

  pure (moveBranchResult, moveTermTypeSteps)