module Unison.Codebase.Editor.HandleInput.MoveType (doMoveType, moveTypeSteps) 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

moveTypeSteps :: (Path', HQ'.HQSegment) -> (Path', NameSegment) -> Cli [(Path.Absolute, Branch0 m -> Branch0 m)]
moveTypeSteps :: forall (m :: * -> *).
(Path', HQSegment)
-> (Path', NameSegment) -> Cli [(Absolute, Branch0 m -> Branch0 m)]
moveTypeSteps (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 TypeReference
srcTypes <- (ProjectPath, HQSegment) -> Cli (Set TypeReference)
Cli.getTypesAt (ProjectPath, HQSegment)
src
  case Set TypeReference -> [TypeReference]
forall a. Set a -> [a]
Set.toList Set TypeReference
srcTypes 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 []
    TypeReference
_ : TypeReference
_ : [TypeReference]
_ -> 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 TypeReference
-> Output
Output.DeleteNameAmbiguous Int
hqLength (Path', HQSegment)
src' Set Referent
forall a. Set a
Set.empty Set TypeReference
srcTypes)
    [TypeReference
srcType] -> do
      (ProjectPath, NameSegment)
dest <- (Path', NameSegment) -> Cli (ProjectPath, NameSegment)
forall a. (Path', a) -> Cli (ProjectPath, a)
Cli.resolveSplit' (Path', NameSegment)
dest'
      Set TypeReference
destTypes <- (ProjectPath, HQSegment) -> Cli (Set TypeReference)
Cli.getTypesAt (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 TypeReference -> Bool
forall a. Set a -> Bool
Set.null Set TypeReference
destTypes)) do
        Output -> Cli ()
forall a. Output -> Cli a
Cli.returnEarly ((Path', NameSegment) -> Set TypeReference -> Output
Output.TypeAlreadyExists (Path', NameSegment)
dest' Set TypeReference
destTypes)
      let p :: (Absolute, HQSegment)
p = ASetter
  (ProjectPath, HQSegment) (Absolute, HQSegment) ProjectPath Absolute
-> (ProjectPath -> Absolute)
-> (ProjectPath, HQSegment)
-> (Absolute, HQSegment)
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over ASetter
  (ProjectPath, HQSegment) (Absolute, HQSegment) ProjectPath Absolute
forall s t a b. Field1 s t a b => Lens s t a b
Lens
  (ProjectPath, HQSegment) (Absolute, HQSegment) 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, HQSegment)
src
      pure
        [ -- Mitchell: throwing away any hash-qualification here seems wrong!
          (Absolute, NameSegment)
-> TypeReference -> (Absolute, Branch0 m -> Branch0 m)
forall p (m :: * -> *).
(p, NameSegment) -> TypeReference -> (p, Branch0 m -> Branch0 m)
BranchUtil.makeDeleteTypeName (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) TypeReference
srcType,
          (Absolute, NameSegment)
-> TypeReference -> (Absolute, Branch0 m -> Branch0 m)
forall p (m :: * -> *).
(p, NameSegment) -> TypeReference -> (p, Branch0 m -> Branch0 m)
BranchUtil.makeAddTypeName (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) TypeReference
srcType
        ]

doMoveType :: (Path', HQ'.HQSegment) -> (Path', NameSegment) -> Text -> Cli ()
doMoveType :: (Path', HQSegment) -> (Path', NameSegment) -> Text -> Cli ()
doMoveType (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)]
moveTypeSteps (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.TypeNotFound (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