module Unison.Codebase.Editor.HandleInput.EditNamespace (handleEditNamespace) where

import Control.Monad.Reader
import Data.Foldable qualified as Foldable
import Data.List.Extra qualified as List
import Data.Map qualified as Map
import Data.Set qualified as Set
import U.Codebase.Reference (Reference' (..))
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.DisplayObject qualified as DisplayObject
import Unison.Codebase.Editor.HandleInput.ShowDefinition (showDefinitions)
import Unison.Codebase.Editor.Input (OutputLocation (..))
import Unison.Codebase.Path (Path)
import Unison.Codebase.Path qualified as Path
import Unison.HashQualified qualified as HQ
import Unison.Name (Name)
import Unison.Names qualified as Names
import Unison.Prelude
import Unison.PrettyPrintEnvDecl (PrettyPrintEnvDecl (..))
import Unison.Referent qualified as Referent
import Unison.Server.Backend qualified as Backend
import Unison.Syntax.DeclPrinter qualified as DeclPrinter
import Unison.Util.Monoid (foldMapM)
import qualified Unison.PrettyPrintEnv.Names as PPE
import qualified Unison.PrettyPrintEnvDecl.Names as PPED

handleEditNamespace :: OutputLocation -> [Path] -> Cli ()
handleEditNamespace :: OutputLocation -> [Path] -> Cli ()
handleEditNamespace OutputLocation
outputLoc [Path]
paths0 = do
  Cli.Env {Codebase IO Symbol Ann
codebase :: Codebase IO Symbol Ann
$sel:codebase:Env :: Env -> Codebase IO Symbol Ann
codebase} <- Cli Env
forall r (m :: * -> *). MonadReader r m => m r
ask
  Branch0 IO
currentBranch <- Cli (Branch0 IO)
Cli.getCurrentBranch0
  let currentNames :: Names
currentNames = Branch0 IO -> Names
forall (m :: * -> *). Branch0 m -> Names
Branch.toNames Branch0 IO
currentBranch
  let ppe :: PrettyPrintEnvDecl
ppe = Namer -> Suffixifier -> PrettyPrintEnvDecl
PPED.makePPED (Int -> Names -> Namer
PPE.hqNamer Int
10 Names
currentNames) (Names -> Suffixifier
PPE.suffixifyByHashName Names
currentNames)

  -- Adjust the requested list of paths slightly: if it's missing (i.e. `edit.namespace` without arguments), then behave
  -- as if the empty path (which there is no syntax for, heh) was supplied.
  let paths :: [Path]
paths =
        if [Path] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Path]
paths0
          then [Path
Path.empty]
          else [Path]
paths0

  -- Make a names object that contains the union of all names in the supplied paths (each prefixed with the associated
  -- path of course). Special case: if the path is the empty path, then ignore `lib`.
  let allNamesToEdit :: Names
allNamesToEdit =
        [Path] -> [Path]
forall a. Ord a => [a] -> [a]
List.nubOrd [Path]
paths [Path] -> ([Path] -> Names) -> Names
forall a b. a -> (a -> b) -> b
& (Path -> Names) -> [Path] -> Names
forall m a. Monoid m => (a -> m) -> [a] -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap \Path
path ->
          let branch :: Branch0 IO
branch = (if Path
path Path -> Path -> Bool
forall a. Eq a => a -> a -> Bool
== Path
Path.empty then Branch0 IO -> Branch0 IO
forall (m :: * -> *). Branch0 m -> Branch0 m
Branch.withoutLib else Branch0 IO -> Branch0 IO
forall a. a -> a
id) (Path -> Branch0 IO -> Branch0 IO
forall (m :: * -> *). Path -> Branch0 m -> Branch0 m
Branch.getAt0 Path
path Branch0 IO
currentBranch)
              names :: Names
names = Branch0 IO -> Names
forall (m :: * -> *). Branch0 m -> Names
Branch.toNames Branch0 IO
branch
           in case Path -> Maybe Name
Path.toName Path
path of
                Maybe Name
Nothing -> Names
names
                Just Name
pathPrefix -> Name -> Names -> Names
Names.prefix0 Name
pathPrefix Names
names

  let termRefs :: Set (Reference' Text Hash)
termRefs = Names -> Set (Reference' Text Hash)
Names.termReferences Names
allNamesToEdit
  let typeRefs :: Set (Reference' Text Hash)
typeRefs = Names -> Set (Reference' Text Hash)
Names.typeReferences Names
allNamesToEdit

  (Map (Reference' Text Hash) (DisplayObject () (Decl Symbol Ann))
types, Map
  (Reference' Text Hash)
  (DisplayObject (Type Symbol Ann) (Term Symbol Ann))
terms) <-
    Transaction
  (Map (Reference' Text Hash) (DisplayObject () (Decl Symbol Ann)),
   Map
     (Reference' Text Hash)
     (DisplayObject (Type Symbol Ann) (Term Symbol Ann)))
-> Cli
     (Map (Reference' Text Hash) (DisplayObject () (Decl Symbol Ann)),
      Map
        (Reference' Text Hash)
        (DisplayObject (Type Symbol Ann) (Term Symbol Ann)))
forall a. Transaction a -> Cli a
Cli.runTransaction do
      (Map (Reference' Text Hash) (DisplayObject () (Decl Symbol Ann))
types, Set Name
accessorNames) <-
        ((Map (Reference' Text Hash) (DisplayObject () (Decl Symbol Ann)),
  Set Name)
 -> Reference' Text Hash
 -> Transaction
      (Map (Reference' Text Hash) (DisplayObject () (Decl Symbol Ann)),
       Set Name))
-> (Map
      (Reference' Text Hash) (DisplayObject () (Decl Symbol Ann)),
    Set Name)
-> Set (Reference' Text Hash)
-> Transaction
     (Map (Reference' Text Hash) (DisplayObject () (Decl Symbol Ann)),
      Set Name)
forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
Foldable.foldlM
          ( \(Map (Reference' Text Hash) (DisplayObject () (Decl Symbol Ann))
types, Set Name
accessorNames) Reference' Text Hash
ref ->
              case Reference' Text Hash
ref of
                ReferenceBuiltin Text
_ -> do
                  let !types1 :: Map (Reference' Text Hash) (DisplayObject () (Decl Symbol Ann))
types1 = Reference' Text Hash
-> DisplayObject () (Decl Symbol Ann)
-> Map (Reference' Text Hash) (DisplayObject () (Decl Symbol Ann))
-> Map (Reference' Text Hash) (DisplayObject () (Decl Symbol Ann))
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert Reference' Text Hash
ref (() -> DisplayObject () (Decl Symbol Ann)
forall b a. b -> DisplayObject b a
DisplayObject.BuiltinObject ()) Map (Reference' Text Hash) (DisplayObject () (Decl Symbol Ann))
types
                  (Map (Reference' Text Hash) (DisplayObject () (Decl Symbol Ann)),
 Set Name)
-> Transaction
     (Map (Reference' Text Hash) (DisplayObject () (Decl Symbol Ann)),
      Set Name)
forall a. a -> Transaction a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Map (Reference' Text Hash) (DisplayObject () (Decl Symbol Ann))
types1, Set Name
accessorNames)
                ReferenceDerived Id' Hash
refId -> do
                  Decl Symbol Ann
decl <- Codebase IO Symbol Ann -> Id' Hash -> Transaction (Decl Symbol Ann)
forall (m :: * -> *) v a.
HasCallStack =>
Codebase m v a -> Id' Hash -> Transaction (Decl v a)
Codebase.unsafeGetTypeDeclaration Codebase IO Symbol Ann
codebase Id' Hash
refId
                  let !types1 :: Map (Reference' Text Hash) (DisplayObject () (Decl Symbol Ann))
types1 = Reference' Text Hash
-> DisplayObject () (Decl Symbol Ann)
-> Map (Reference' Text Hash) (DisplayObject () (Decl Symbol Ann))
-> Map (Reference' Text Hash) (DisplayObject () (Decl Symbol Ann))
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert Reference' Text Hash
ref (Decl Symbol Ann -> DisplayObject () (Decl Symbol Ann)
forall b a. a -> DisplayObject b a
DisplayObject.UserObject Decl Symbol Ann
decl) Map (Reference' Text Hash) (DisplayObject () (Decl Symbol Ann))
types
                  let !accessorNames1 :: Set Name
accessorNames1 =
                        Set Name
accessorNames Set Name -> Set Name -> Set Name
forall a. Semigroup a => a -> a -> a
<> case Decl Symbol Ann
decl of
                          Left EffectDeclaration Symbol Ann
_effectDecl -> Set Name
forall a. Set a
Set.empty
                          Right DataDeclaration Symbol Ann
dataDecl ->
                            let declAccessorNames :: Name -> Set Name
                                declAccessorNames :: Name -> Set Name
declAccessorNames Name
declName =
                                  case PrettyPrintEnv
-> Reference' Text Hash
-> HashQualified Name
-> DataDeclaration Symbol Ann
-> Maybe ([Name], [Name])
forall v a.
Var v =>
PrettyPrintEnv
-> Reference' Text Hash
-> HashQualified Name
-> DataDeclaration v a
-> Maybe ([Name], [Name])
DeclPrinter.getFieldAndAccessorNames
                                    PrettyPrintEnvDecl
ppe.unsuffixifiedPPE
                                    Reference' Text Hash
ref
                                    (Name -> HashQualified Name
forall n. n -> HashQualified n
HQ.fromName Name
declName)
                                    DataDeclaration Symbol Ann
dataDecl of
                                    Maybe ([Name], [Name])
Nothing -> Set Name
forall a. Set a
Set.empty
                                    Just ([Name]
_fieldNames, [Name]
theAccessorNames) -> [Name] -> Set Name
forall a. Ord a => [a] -> Set a
Set.fromList [Name]
theAccessorNames
                             in (Name -> Set Name) -> Set Name -> Set Name
forall m a. Monoid m => (a -> m) -> Set a -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap Name -> Set Name
declAccessorNames (Names -> Reference' Text Hash -> Set Name
Names.namesForReference Names
allNamesToEdit Reference' Text Hash
ref)
                  (Map (Reference' Text Hash) (DisplayObject () (Decl Symbol Ann)),
 Set Name)
-> Transaction
     (Map (Reference' Text Hash) (DisplayObject () (Decl Symbol Ann)),
      Set Name)
forall a. a -> Transaction a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Map (Reference' Text Hash) (DisplayObject () (Decl Symbol Ann))
types1, Set Name
accessorNames1)
          )
          (Map (Reference' Text Hash) (DisplayObject () (Decl Symbol Ann))
forall k a. Map k a
Map.empty, Set Name
forall a. Set a
Set.empty)
          Set (Reference' Text Hash)
typeRefs
      Map
  (Reference' Text Hash)
  (DisplayObject (Type Symbol Ann) (Term Symbol Ann))
terms <-
        Set (Reference' Text Hash)
termRefs Set (Reference' Text Hash)
-> (Set (Reference' Text Hash)
    -> Transaction
         (Map
            (Reference' Text Hash)
            (DisplayObject (Type Symbol Ann) (Term Symbol Ann))))
-> Transaction
     (Map
        (Reference' Text Hash)
        (DisplayObject (Type Symbol Ann) (Term Symbol Ann)))
forall a b. a -> (a -> b) -> b
& (Reference' Text Hash
 -> Transaction
      (Map
         (Reference' Text Hash)
         (DisplayObject (Type Symbol Ann) (Term Symbol Ann))))
-> Set (Reference' Text Hash)
-> Transaction
     (Map
        (Reference' Text Hash)
        (DisplayObject (Type Symbol Ann) (Term Symbol Ann)))
forall (m :: * -> *) (f :: * -> *) b a.
(Monad m, Foldable f, Monoid b) =>
(a -> m b) -> f a -> m b
foldMapM \Reference' Text Hash
ref ->
          let isRecordAccessor :: Bool
isRecordAccessor =
                Bool -> Bool
not (Set Name -> Set Name -> Bool
forall a. Ord a => Set a -> Set a -> Bool
Set.disjoint (Names -> Referent -> Set Name
Names.namesForReferent Names
allNamesToEdit (Reference' Text Hash -> Referent
Referent.fromTermReference Reference' Text Hash
ref)) Set Name
accessorNames)
           in if Bool
isRecordAccessor
                then Map
  (Reference' Text Hash)
  (DisplayObject (Type Symbol Ann) (Term Symbol Ann))
-> Transaction
     (Map
        (Reference' Text Hash)
        (DisplayObject (Type Symbol Ann) (Term Symbol Ann)))
forall a. a -> Transaction a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Map
  (Reference' Text Hash)
  (DisplayObject (Type Symbol Ann) (Term Symbol Ann))
forall k a. Map k a
Map.empty
                else Reference' Text Hash
-> DisplayObject (Type Symbol Ann) (Term Symbol Ann)
-> Map
     (Reference' Text Hash)
     (DisplayObject (Type Symbol Ann) (Term Symbol Ann))
forall k a. k -> a -> Map k a
Map.singleton Reference' Text Hash
ref (DisplayObject (Type Symbol Ann) (Term Symbol Ann)
 -> Map
      (Reference' Text Hash)
      (DisplayObject (Type Symbol Ann) (Term Symbol Ann)))
-> Transaction (DisplayObject (Type Symbol Ann) (Term Symbol Ann))
-> Transaction
     (Map
        (Reference' Text Hash)
        (DisplayObject (Type Symbol Ann) (Term Symbol Ann)))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Codebase IO Symbol Ann
-> Reference' Text Hash
-> Transaction (DisplayObject (Type Symbol Ann) (Term Symbol Ann))
forall (m :: * -> *).
Codebase m Symbol Ann
-> Reference' Text Hash
-> Transaction (DisplayObject (Type Symbol Ann) (Term Symbol Ann))
Backend.displayTerm Codebase IO Symbol Ann
codebase Reference' Text Hash
ref
      pure (Map (Reference' Text Hash) (DisplayObject () (Decl Symbol Ann))
types, Map
  (Reference' Text Hash)
  (DisplayObject (Type Symbol Ann) (Term Symbol Ann))
terms)

  let misses :: [a]
misses = []
  OutputLocation
-> PrettyPrintEnvDecl
-> Map
     (Reference' Text Hash)
     (DisplayObject (Type Symbol Ann) (Term Symbol Ann))
-> Map (Reference' Text Hash) (DisplayObject () (Decl Symbol Ann))
-> [HashQualified Name]
-> Cli ()
showDefinitions OutputLocation
outputLoc PrettyPrintEnvDecl
ppe Map
  (Reference' Text Hash)
  (DisplayObject (Type Symbol Ann) (Term Symbol Ann))
terms Map (Reference' Text Hash) (DisplayObject () (Decl Symbol Ann))
types [HashQualified Name]
forall a. [a]
misses