module Unison.Codebase.Editor.HandleInput.EditNamespace
  ( handleEditNamespace,
    getNamesForEdit,
  )
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 (Codebase)
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 (DisplayObject)
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.DataDeclaration (Decl)
import Unison.HashQualified qualified as HQ
import Unison.Name (Name)
import Unison.Names (Names)
import Unison.Names qualified as Names
import Unison.Parser.Ann (Ann)
import Unison.Prelude
import Unison.PrettyPrintEnv.Names qualified as PPE
import Unison.PrettyPrintEnvDecl (PrettyPrintEnvDecl (..))
import Unison.PrettyPrintEnvDecl.Names qualified as PPED
import Unison.Reference (TermReference, TypeReference)
import Unison.Referent qualified as Referent
import Unison.Server.Backend qualified as Backend
import Unison.Sqlite qualified as Sqlite
import Unison.Symbol (Symbol)
import Unison.Syntax.DeclPrinter qualified as DeclPrinter
import Unison.Term (Term)
import Unison.Type (Type)
import Unison.Util.Monoid (foldMapM)
import Unison.Util.Set qualified as Set

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

  (Map TypeReference (DisplayObject () (Decl Symbol Ann))
types, Map
  TypeReference (DisplayObject (Type Symbol Ann) (Term Symbol Ann))
terms) <- Transaction
  (Map TypeReference (DisplayObject () (Decl Symbol Ann)),
   Map
     TypeReference (DisplayObject (Type Symbol Ann) (Term Symbol Ann)))
-> Cli
     (Map TypeReference (DisplayObject () (Decl Symbol Ann)),
      Map
        TypeReference (DisplayObject (Type Symbol Ann) (Term Symbol Ann)))
forall a. Transaction a -> Cli a
Cli.runTransaction (Codebase IO Symbol Ann
-> PrettyPrintEnvDecl
-> Names
-> Transaction
     (Map TypeReference (DisplayObject () (Decl Symbol Ann)),
      Map
        TypeReference (DisplayObject (Type Symbol Ann) (Term Symbol Ann)))
forall (m :: * -> *).
Codebase m Symbol Ann
-> PrettyPrintEnvDecl
-> Names
-> Transaction
     (Map TypeReference (DisplayObject () (Decl Symbol Ann)),
      Map
        TypeReference (DisplayObject (Type Symbol Ann) (Term Symbol Ann)))
getNamesForEdit Codebase IO Symbol Ann
codebase PrettyPrintEnvDecl
ppe Names
allNamesToEdit)
  let misses :: [a]
misses = []
  OutputLocation
-> PrettyPrintEnvDecl
-> Map
     TypeReference (DisplayObject (Type Symbol Ann) (Term Symbol Ann))
-> Map TypeReference (DisplayObject () (Decl Symbol Ann))
-> [HashQualified Name]
-> Cli ()
showDefinitions OutputLocation
outputLoc PrettyPrintEnvDecl
ppe Map
  TypeReference (DisplayObject (Type Symbol Ann) (Term Symbol Ann))
terms Map TypeReference (DisplayObject () (Decl Symbol Ann))
types [HashQualified Name]
forall a. [a]
misses

-- | Get names "for edit": gets types and terms out the codebase as display objects, but is careful not to get an
-- auto-generated record accessor term like `Foo.bar.set` if it's also getting the corresponding type `Foo`. This is
-- because these name are "for edit", i.e. going into a scratch file, where parsing the record type will generate
-- its accessors.
getNamesForEdit ::
  Codebase m Symbol Ann ->
  PrettyPrintEnvDecl ->
  Names ->
  Sqlite.Transaction
    ( Map TypeReference (DisplayObject () (Decl Symbol Ann)),
      Map TermReference (DisplayObject (Type Symbol Ann) (Term Symbol Ann))
    )
getNamesForEdit :: forall (m :: * -> *).
Codebase m Symbol Ann
-> PrettyPrintEnvDecl
-> Names
-> Transaction
     (Map TypeReference (DisplayObject () (Decl Symbol Ann)),
      Map
        TypeReference (DisplayObject (Type Symbol Ann) (Term Symbol Ann)))
getNamesForEdit Codebase m Symbol Ann
codebase PrettyPrintEnvDecl
ppe Names
allNamesToEdit = do
  let termRefs :: Set TypeReference
termRefs = Names -> Set TypeReference
Names.termReferences Names
allNamesToEdit
  let typeRefs :: Set TypeReference
typeRefs = Names -> Set TypeReference
Names.typeReferences Names
allNamesToEdit

  (Map TypeReference (DisplayObject () (Decl Symbol Ann))
types, Set Name
accessorNames) <-
    ((Map TypeReference (DisplayObject () (Decl Symbol Ann)), Set Name)
 -> TypeReference
 -> Transaction
      (Map TypeReference (DisplayObject () (Decl Symbol Ann)), Set Name))
-> (Map TypeReference (DisplayObject () (Decl Symbol Ann)),
    Set Name)
-> Set TypeReference
-> Transaction
     (Map TypeReference (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 TypeReference (DisplayObject () (Decl Symbol Ann))
types, Set Name
accessorNames) TypeReference
ref ->
          case TypeReference
ref of
            ReferenceBuiltin Text
_ -> do
              let !types1 :: Map TypeReference (DisplayObject () (Decl Symbol Ann))
types1 = TypeReference
-> DisplayObject () (Decl Symbol Ann)
-> Map TypeReference (DisplayObject () (Decl Symbol Ann))
-> Map TypeReference (DisplayObject () (Decl Symbol Ann))
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert TypeReference
ref (() -> DisplayObject () (Decl Symbol Ann)
forall b a. b -> DisplayObject b a
DisplayObject.BuiltinObject ()) Map TypeReference (DisplayObject () (Decl Symbol Ann))
types
              (Map TypeReference (DisplayObject () (Decl Symbol Ann)), Set Name)
-> Transaction
     (Map TypeReference (DisplayObject () (Decl Symbol Ann)), Set Name)
forall a. a -> Transaction a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Map TypeReference (DisplayObject () (Decl Symbol Ann))
types1, Set Name
accessorNames)
            ReferenceDerived Id' Hash
refId -> do
              Decl Symbol Ann
decl <- Codebase m 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 m Symbol Ann
codebase Id' Hash
refId
              let !types1 :: Map TypeReference (DisplayObject () (Decl Symbol Ann))
types1 = TypeReference
-> DisplayObject () (Decl Symbol Ann)
-> Map TypeReference (DisplayObject () (Decl Symbol Ann))
-> Map TypeReference (DisplayObject () (Decl Symbol Ann))
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert TypeReference
ref (Decl Symbol Ann -> DisplayObject () (Decl Symbol Ann)
forall b a. a -> DisplayObject b a
DisplayObject.UserObject Decl Symbol Ann
decl) Map TypeReference (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
-> TypeReference
-> HashQualified Name
-> DataDeclaration Symbol Ann
-> Maybe ([Name], [Name])
forall v a.
Var v =>
PrettyPrintEnv
-> TypeReference
-> HashQualified Name
-> DataDeclaration v a
-> Maybe ([Name], [Name])
DeclPrinter.getFieldAndAccessorNames
                                PrettyPrintEnvDecl
ppe.unsuffixifiedPPE
                                TypeReference
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 -> TypeReference -> Set Name
Names.namesForReference Names
allNamesToEdit TypeReference
ref)
              (Map TypeReference (DisplayObject () (Decl Symbol Ann)), Set Name)
-> Transaction
     (Map TypeReference (DisplayObject () (Decl Symbol Ann)), Set Name)
forall a. a -> Transaction a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Map TypeReference (DisplayObject () (Decl Symbol Ann))
types1, Set Name
accessorNames1)
      )
      (Map TypeReference (DisplayObject () (Decl Symbol Ann))
forall k a. Map k a
Map.empty, Set Name
forall a. Set a
Set.empty)
      Set TypeReference
typeRefs

  Map
  TypeReference (DisplayObject (Type Symbol Ann) (Term Symbol Ann))
terms <-
    Set TypeReference
termRefs Set TypeReference
-> (Set TypeReference
    -> Transaction
         (Map
            TypeReference (DisplayObject (Type Symbol Ann) (Term Symbol Ann))))
-> Transaction
     (Map
        TypeReference (DisplayObject (Type Symbol Ann) (Term Symbol Ann)))
forall a b. a -> (a -> b) -> b
& (TypeReference
 -> Transaction
      (Map
         TypeReference (DisplayObject (Type Symbol Ann) (Term Symbol Ann))))
-> Set TypeReference
-> Transaction
     (Map
        TypeReference (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 \TypeReference
ref ->
      let isRecordAccessor :: Bool
isRecordAccessor =
            Set Name -> Set Name -> Bool
forall a. Ord a => Set a -> Set a -> Bool
Set.intersects
              (Names -> Referent -> Set Name
Names.namesForReferent Names
allNamesToEdit (TypeReference -> Referent
Referent.fromTermReference TypeReference
ref))
              Set Name
accessorNames
       in if Bool
isRecordAccessor
            then Map
  TypeReference (DisplayObject (Type Symbol Ann) (Term Symbol Ann))
-> Transaction
     (Map
        TypeReference (DisplayObject (Type Symbol Ann) (Term Symbol Ann)))
forall a. a -> Transaction a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Map
  TypeReference (DisplayObject (Type Symbol Ann) (Term Symbol Ann))
forall k a. Map k a
Map.empty
            else TypeReference
-> DisplayObject (Type Symbol Ann) (Term Symbol Ann)
-> Map
     TypeReference (DisplayObject (Type Symbol Ann) (Term Symbol Ann))
forall k a. k -> a -> Map k a
Map.singleton TypeReference
ref (DisplayObject (Type Symbol Ann) (Term Symbol Ann)
 -> Map
      TypeReference (DisplayObject (Type Symbol Ann) (Term Symbol Ann)))
-> Transaction (DisplayObject (Type Symbol Ann) (Term Symbol Ann))
-> Transaction
     (Map
        TypeReference (DisplayObject (Type Symbol Ann) (Term Symbol Ann)))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Codebase m Symbol Ann
-> TypeReference
-> Transaction (DisplayObject (Type Symbol Ann) (Term Symbol Ann))
forall (m :: * -> *).
Codebase m Symbol Ann
-> TypeReference
-> Transaction (DisplayObject (Type Symbol Ann) (Term Symbol Ann))
Backend.displayTerm Codebase m Symbol Ann
codebase TypeReference
ref

  pure (Map TypeReference (DisplayObject () (Decl Symbol Ann))
types, Map
  TypeReference (DisplayObject (Type Symbol Ann) (Term Symbol Ann))
terms)