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)
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
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