refactor: clean up merge

lib/unison-util-relation/src/Unison/Util/BiMultimap.hs

@@ -3,6 +3,9 @@ module Unison.Util.BiMultimap
   ( BiMultimap,
     Unison.Util.BiMultimap.empty,
 
+    -- ** Basic queries
+    isEmpty,
+
     -- ** Lookup
     memberDom,
     lookupDom,
@@ -32,6 +35,9 @@ module Unison.Util.BiMultimap
     dom,
     ran,
 
+    -- ** Relations
+    toRelation,
+
     -- ** Insert
     insert,
     unsafeInsert,
@@ -47,6 +53,8 @@ import Data.Set.NonEmpty (NESet)
 import Data.Set.NonEmpty qualified as Set.NonEmpty
 import Unison.Prelude
 import Unison.Util.Map qualified as Map
+import Unison.Util.Relation (Relation)
+import Unison.Util.Relation qualified as Relation
 import Prelude hiding (filter)
 
 -- | A left-unique relation.
@@ -62,6 +70,11 @@ data BiMultimap a b = BiMultimap
 empty :: (Ord a, Ord b) => BiMultimap a b
 empty = BiMultimap mempty mempty
 
+-- | Is a left-unique relation empty?
+isEmpty :: BiMultimap a b -> Bool
+isEmpty =
+  Map.null . domain
+
 memberDom :: (Ord a) => a -> BiMultimap a b -> Bool
 memberDom x =
   Map.member x . domain
@@ -157,6 +170,7 @@ withoutRan ys m =
 domain :: BiMultimap a b -> Map a (NESet b)
 domain = toMultimap
 
+-- | /O(1)/.
 range :: BiMultimap a b -> Map b a
 range = toMapR
 
@@ -200,6 +214,11 @@ ran :: BiMultimap a b -> Set b
 ran =
   Map.keysSet . toMapR
 
+-- | Convert a left-unique relation to a relation (forgetting its left-uniqueness).
+toRelation :: (Ord a, Ord b) => BiMultimap a b -> Relation a b
+toRelation =
+  Relation.fromMultimap . Map.map Set.NonEmpty.toSet . domain
+
 -- | Insert a pair into a left-unique relation, maintaining left-uniqueness, preferring the latest inserted element.
 --
 -- That is, if a left-unique relation already contains the pair @(x, y)@, then inserting the pair @(z, y)@ will cause

parser-typechecker/src/Unison/Codebase/Branch.hs

@@ -86,6 +86,7 @@ module Unison.Codebase.Branch
     -- ** Term/type queries
     deepTerms,
     deepTypes,
+    deepDefns,
     deepEdits,
     deepPaths,
     deepReferents,
@@ -112,6 +113,7 @@ import Unison.Codebase.Branch.Type
     UnwrappedBranch,
     branch0,
     children,
+    deepDefns,
     deepEdits,
     deepPaths,
     deepTerms,

parser-typechecker/src/Unison/Codebase/Branch/Type.hs

@@ -10,15 +10,16 @@ module Unison.Codebase.Branch.Type
     Branch (..),
     Branch0,
     branch0,
-    terms,
-    types,
+    Unison.Codebase.Branch.Type.terms,
+    Unison.Codebase.Branch.Type.types,
     children,
     nonEmptyChildren,
     history,
     edits,
     isEmpty0,
     deepTerms,
     deepTypes,
+    deepDefns,
     deepPaths,
     deepEdits,
     Star,
@@ -47,9 +48,11 @@ import Unison.NameSegment qualified as NameSegment
 import Unison.Prelude hiding (empty)
 import Unison.Reference (Reference, TypeReference)
 import Unison.Referent (Referent)
+import Unison.Util.Defns (Defns (..), DefnsF)
 import Unison.Util.Monoid qualified as Monoid
 import Unison.Util.Relation (Relation)
 import Unison.Util.Relation qualified as R
+import Unison.Util.Relation qualified as Relation
 import Unison.Util.Star2 qualified as Star2
 import Prelude hiding (head, read, subtract)
 
@@ -148,6 +151,13 @@ deepTerms = _deepTerms
 deepTypes :: Branch0 m -> Relation TypeReference Name
 deepTypes = _deepTypes
 
+deepDefns :: Branch0 m -> DefnsF (Relation Name) Referent TypeReference
+deepDefns branch =
+  Defns
+    { terms = Relation.swap (deepTerms branch),
+      types = Relation.swap (deepTypes branch)
+    }
+
 deepPaths :: Branch0 m -> Set Path
 deepPaths = _deepPaths
 

parser-typechecker/src/Unison/Codebase/Type.hs

@@ -9,14 +9,13 @@ module Unison.Codebase.Type
 where
 
 import U.Codebase.HashTags (CausalHash)
-import U.Codebase.Reference qualified as V2
 import Unison.Codebase.Branch (Branch)
 import Unison.CodebasePath (CodebasePath)
 import Unison.ConstructorType qualified as CT
 import Unison.DataDeclaration (Decl)
 import Unison.Hash (Hash)
 import Unison.Prelude
-import Unison.Reference (Reference, TypeReference)
+import Unison.Reference (Reference, TypeReference, TermReferenceId, TypeReferenceId)
 import Unison.Reference qualified as Reference
 import Unison.Referent qualified as Referent
 import Unison.ShortHash (ShortHash)
@@ -31,27 +30,27 @@ data Codebase m v a = Codebase
     --
     -- Note that it is possible to call 'putTerm', then 'getTerm', and receive @Nothing@, per the semantics of
     -- 'putTerm'.
-    getTerm :: Reference.Id -> Sqlite.Transaction (Maybe (Term v a)),
+    getTerm :: TermReferenceId -> Sqlite.Transaction (Maybe (Term v a)),
     -- | Get the type of a user-defined term.
     --
     -- Note that it is possible to call 'putTerm', then 'getTypeOfTermImpl', and receive @Nothing@, per the semantics of
     -- 'putTerm'.
-    getTypeOfTermImpl :: Reference.Id -> Sqlite.Transaction (Maybe (Type v a)),
+    getTypeOfTermImpl :: TermReferenceId -> Sqlite.Transaction (Maybe (Type v a)),
     -- | Get a type declaration.
     --
     -- Note that it is possible to call 'putTypeDeclaration', then 'getTypeDeclaration', and receive @Nothing@, per the
     -- semantics of 'putTypeDeclaration'.
-    getTypeDeclaration :: Reference.Id -> Sqlite.Transaction (Maybe (Decl v a)),
+    getTypeDeclaration :: TypeReferenceId -> Sqlite.Transaction (Maybe (Decl v a)),
     -- | Get the type of a given decl.
-    getDeclType :: V2.Reference -> Sqlite.Transaction CT.ConstructorType,
+    getDeclType :: TypeReference -> Sqlite.Transaction CT.ConstructorType,
     -- | Enqueue the put of a user-defined term (with its type) into the codebase, if it doesn't already exist. The
     -- implementation may choose to delay the put until all of the term's (and its type's) references are stored as
     -- well.
-    putTerm :: Reference.Id -> Term v a -> Type v a -> Sqlite.Transaction (),
+    putTerm :: TermReferenceId -> Term v a -> Type v a -> Sqlite.Transaction (),
     putTermComponent :: Hash -> [(Term v a, Type v a)] -> Sqlite.Transaction (),
     -- | Enqueue the put of a type declaration into the codebase, if it doesn't already exist. The implementation may
     -- choose to delay the put until all of the type declaration's references are stored as well.
-    putTypeDeclaration :: Reference.Id -> Decl v a -> Sqlite.Transaction (),
+    putTypeDeclaration :: TypeReferenceId -> Decl v a -> Sqlite.Transaction (),
     putTypeDeclarationComponent :: Hash -> [Decl v a] -> Sqlite.Transaction (),
     -- getTermComponent :: Hash -> m (Maybe [Term v a]),
     getTermComponentWithTypes :: Hash -> Sqlite.Transaction (Maybe [(Term v a, Type v a)]),
@@ -66,7 +65,7 @@ data Codebase m v a = Codebase
     -- | Copy a branch and all of its dependencies from this codebase into the given codebase.
     syncToDirectory :: CodebasePath -> Branch m -> m (),
     -- | @getWatch k r@ returns watch result @t@ that was previously put by @putWatch k r t@.
-    getWatch :: WK.WatchKind -> Reference.Id -> Sqlite.Transaction (Maybe (Term v a)),
+    getWatch :: WK.WatchKind -> TermReferenceId -> Sqlite.Transaction (Maybe (Term v a)),
     -- | Get the set of user-defined terms-or-constructors that have the given type.
     termsOfTypeImpl :: Reference -> Sqlite.Transaction (Set Referent.Id),
     -- | Get the set of user-defined terms-or-constructors mention the given type anywhere in their signature.

parser-typechecker/src/Unison/PrettyPrintEnvDecl/Names.hs

@@ -1,8 +1,11 @@
 module Unison.PrettyPrintEnvDecl.Names
   ( makePPED,
+    makeFilePPED,
+    makeCodebasePPED,
   )
 where
 
+import Unison.Names (Names)
 import Unison.PrettyPrintEnv.Names qualified as PPE
 import Unison.PrettyPrintEnvDecl (PrettyPrintEnvDecl (PrettyPrintEnvDecl))
 
@@ -11,3 +14,23 @@ makePPED namer suffixifier =
   PrettyPrintEnvDecl
     (PPE.makePPE namer PPE.dontSuffixify)
     (PPE.makePPE namer suffixifier)
+
+-- | Make a PPED suitable for names in a Unison file.
+--
+-- Such names have special suffixification rules: aliases may *not* be referred to by a common suffix. For example, if
+-- a file contains
+--
+--   one.foo = 6
+--   two.foo = 6
+--
+-- then the suffix `foo` will *not* be accepted (currently). So, this PPE uses the "suffixify by name" strategy.
+makeFilePPED :: Names -> PrettyPrintEnvDecl
+makeFilePPED names =
+  makePPED (PPE.namer names) (PPE.suffixifyByName names)
+
+-- | Make a PPED suitable for names in the codebase. These names are hash qualified and suffixified by hash.
+makeCodebasePPED :: Names -> PrettyPrintEnvDecl
+makeCodebasePPED names =
+  makePPED
+    (PPE.hqNamer 10 names)
+    (PPE.suffixifyByHash names)

parser-typechecker/src/Unison/UnisonFile.hs

@@ -36,6 +36,8 @@ module Unison.UnisonFile
     typecheckedUnisonFile,
     Unison.UnisonFile.rewrite,
     prepareRewrite,
+    termNamespaceBindings,
+    typeNamespaceBindings,
   )
 where
 
@@ -49,6 +51,7 @@ import Unison.ConstructorReference (GConstructorReference (..))
 import Unison.ConstructorType qualified as CT
 import Unison.DataDeclaration (DataDeclaration, EffectDeclaration (..))
 import Unison.DataDeclaration qualified as DD
+import Unison.DataDeclaration qualified as DataDeclaration
 import Unison.Hash qualified as Hash
 import Unison.Hashing.V2.Convert qualified as Hashing
 import Unison.LabeledDependency (LabeledDependency)
@@ -67,6 +70,7 @@ import Unison.Util.List qualified as List
 import Unison.Var (Var)
 import Unison.Var qualified as Var
 import Unison.WatchKind (WatchKind, pattern TestWatch)
+import Unison.WatchKind qualified as WatchKind
 
 -- | An empty Unison file.
 emptyUnisonFile :: UnisonFile v a
@@ -390,3 +394,28 @@ constructorsForDecls types uf =
           & fmap (DD.toDataDecl . snd)
           & concatMap DD.constructorVars
    in Set.fromList (dataConstructors <> effectConstructors)
+
+-- | All bindings in the term namespace: terms, test watches (since those are the only watches that are actually stored
+-- in the codebase), data constructors, and effect constructors.
+termNamespaceBindings :: Ord v => TypecheckedUnisonFile v a -> Set v
+termNamespaceBindings uf =
+  terms <> tests <> datacons <> effcons
+  where
+    terms = foldMap (Set.fromList . map (view _1)) uf.topLevelComponents'
+    tests =
+      uf.watchComponents & foldMap \case
+        (WatchKind.TestWatch, watches) -> Set.fromList (map (view _1) watches)
+        _ -> Set.empty
+    datacons = foldMap (Set.fromList . DataDeclaration.constructorVars . view _2) uf.dataDeclarationsId'
+    effcons =
+      foldMap
+        (Set.fromList . DataDeclaration.constructorVars . DataDeclaration.toDataDecl . view _2)
+        uf.effectDeclarationsId'
+
+-- | All bindings in the term namespace: data declarations and effect declarations.
+typeNamespaceBindings :: Ord v => TypecheckedUnisonFile v a -> Set v
+typeNamespaceBindings uf =
+  datas <> effs
+  where
+    datas = Map.keysSet uf.dataDeclarationsId'
+    effs = Map.keysSet uf.effectDeclarationsId'

unison-cli/src/Unison/Cli/Monad.hs

@@ -47,6 +47,7 @@ module Unison.Cli.Monad
     -- * Running transactions
     runTransaction,
     runTransactionWithRollback,
+    runTransactionWithRollback2,
 
     -- * Internal
     setMostRecentProjectPath,
@@ -444,3 +445,10 @@ runTransactionWithRollback action = do
   Env {codebase} <- ask
   liftIO (Codebase.runTransactionWithRollback codebase \rollback -> Right <$> action (\output -> rollback (Left output)))
     & onLeftM returnEarly
+
+-- | Run a transaction that can abort early.
+-- todo: rename to runTransactionWithRollback
+runTransactionWithRollback2 :: ((forall void. a -> Sqlite.Transaction void) -> Sqlite.Transaction a) -> Cli a
+runTransactionWithRollback2 action = do
+  env <- ask
+  liftIO (Codebase.runTransactionWithRollback env.codebase action)

unison-cli/src/Unison/Cli/MonadUtils.hs

@@ -79,6 +79,9 @@ module Unison.Cli.MonadUtils
     expectLatestParsedFile,
     getLatestTypecheckedFile,
     expectLatestTypecheckedFile,
+
+    -- * Parsing env
+    makeParsingEnv,
   )
 where
 
@@ -98,6 +101,7 @@ import U.Codebase.Sqlite.ProjectBranch (ProjectBranch (..))
 import U.Codebase.Sqlite.Queries qualified as Q
 import Unison.Cli.Monad (Cli)
 import Unison.Cli.Monad qualified as Cli
+import Unison.Cli.UniqueTypeGuidLookup (loadUniqueTypeGuid)
 import Unison.Codebase qualified as Codebase
 import Unison.Codebase.Branch (Branch (..), Branch0)
 import Unison.Codebase.Branch qualified as Branch
@@ -122,9 +126,11 @@ import Unison.Prelude
 import Unison.Project (ProjectAndBranch (..), ProjectBranchName, ProjectName)
 import Unison.Reference (TypeReference)
 import Unison.Referent (Referent)
+import Unison.Sqlite (Transaction)
 import Unison.Sqlite qualified as Sqlite
 import Unison.Symbol (Symbol)
 import Unison.Syntax.Name qualified as Name (toText)
+import Unison.Syntax.Parser (ParsingEnv (..))
 import Unison.Term qualified as Term
 import Unison.UnisonFile (TypecheckedUnisonFile, UnisonFile)
 import Unison.UnisonFile qualified as UF
@@ -554,3 +560,15 @@ getNamesFromLatestFile = do
 expectLatestTypecheckedFile :: Cli (TypecheckedUnisonFile Symbol Ann)
 expectLatestTypecheckedFile =
   getLatestTypecheckedFile & onNothingM (Cli.returnEarly Output.NoUnisonFile)
+
+-- @makeParsingEnv path names@ makes a parsing environment with @names@ in scope, which are all relative to @path@.
+makeParsingEnv :: ProjectPath -> Names -> Cli (ParsingEnv Transaction)
+makeParsingEnv path names = do
+  Cli.Env {generateUniqueName} <- ask
+  uniqueName <- liftIO generateUniqueName
+  pure do
+    ParsingEnv
+      { uniqueNames = uniqueName,
+        uniqueTypeGuid = loadUniqueTypeGuid path,
+        names
+      }