Skip to content

Commit 888a184

Browse files
aryairaniaryairani
authored
Merge pull request #5964 from unisonweb/25-10-16-run-warn
disallow `run` if an update is required
2 parents 5af2a54 + 0fc37c7 commit 888a184

File tree

16 files changed

+837
-28
lines changed

16 files changed

+837
-28
lines changed

‎codebase2/codebase-sqlite/U/Codebase/Sqlite/Operations.hs‎

Lines changed: 39 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -64,6 +64,8 @@ module U.Codebase.Sqlite.Operations
6464
dependentsOfComponent,
6565
directDependentsWithinScope,
6666
transitiveDependentsWithinScope,
67+
DependencyEdge (..),
68+
transitiveDependentsGraphWithinScope,
6769

6870
-- ** type index
6971
Q.addTypeToIndexForTerm,
@@ -1139,6 +1141,43 @@ transitiveDependentsWithinScope scope0 query0
11391141
-- Convert S -> C
11401142
bitraverse (Set.traverse s2cReferenceId) (Set.traverse s2cReferenceId) dependents
11411143

1144+
data DependencyEdge
1145+
= TermDependsOnTerm C.TermReferenceId C.TermReference
1146+
| TermDependsOnType C.TermReferenceId C.TypeReference
1147+
| TypeDependsOnType C.TypeReferenceId C.TypeReference
1148+
1149+
transitiveDependentsGraphWithinScope ::
1150+
(C.Reference -> Bool) ->
1151+
DefnsF Set C.TermReferenceId C.TypeReferenceId ->
1152+
DefnsF Set C.TermReference C.TypeReference ->
1153+
Transaction [DependencyEdge]
1154+
transitiveDependentsGraphWithinScope isBuiltinType scope0 query0
1155+
| defnsAreEmpty scope0 || defnsAreEmpty query0 = mempty
1156+
| otherwise = do
1157+
-- Convert C -> S
1158+
scope1 <- bitraverse (Set.traverse c2sReferenceId) (Set.traverse c2sReferenceId) scope0
1159+
query1 <- bitraverse (Set.traverse c2sReference) (Set.traverse c2sReference) query0
1160+
1161+
-- Do the query
1162+
adjacency <- Q.getTransitiveDependentsGraphWithinScope scope1 query1
1163+
1164+
-- Convert S -> C and classify dependency edge (term depends on term, etc)
1165+
for adjacency \(dependent0 :. Only dependentType :. dependency0 :. Only dependencyType) -> do
1166+
dependent <- s2cReferenceId dependent0
1167+
dependency <- s2cReference dependency0
1168+
let edge =
1169+
case (dependentType, dependencyType) of
1170+
(ObjectType.TermComponent, Just ObjectType.TermComponent) -> TermDependsOnTerm
1171+
(ObjectType.TermComponent, Just ObjectType.DeclComponent) -> TermDependsOnType
1172+
(ObjectType.TermComponent, Nothing) | isBuiltinType dependency -> TermDependsOnType
1173+
(ObjectType.TermComponent, Nothing) -> TermDependsOnTerm
1174+
(ObjectType.DeclComponent, Just ObjectType.DeclComponent) -> TypeDependsOnType
1175+
(ObjectType.DeclComponent, Nothing) | isBuiltinType dependency -> TypeDependsOnType
1176+
(ObjectType.TermComponent, Just _) -> error ("term depends on " ++ show dependency)
1177+
(ObjectType.DeclComponent, Just _) -> error ("type depends on " ++ show dependency)
1178+
(ty, _) -> error ("dependent is " ++ show ty)
1179+
pure (edge dependent dependency)
1180+
11421181
-- | returns a list of known definitions referencing `h`
11431182
dependentsOfComponent :: H.Hash -> Transaction (Set C.Reference.Id)
11441183
dependentsOfComponent h = do

‎codebase2/codebase-sqlite/U/Codebase/Sqlite/Queries.hs‎

Lines changed: 85 additions & 4 deletions
Original file line numberDiff line numberDiff line change
@@ -184,6 +184,7 @@ module U.Codebase.Sqlite.Queries
184184
getDirectDependenciesOfScope,
185185
getDirectDependentsWithinScope,
186186
getTransitiveDependentsWithinScope,
187+
getTransitiveDependentsGraphWithinScope,
187188

188189
-- ** type index
189190
addToTypeIndex,
@@ -2018,13 +2019,13 @@ getTransitiveDependentsWithinScope scope query = do
20182019
WITH RECURSIVE
20192020
dependents_index_in_scope AS (
20202021
SELECT *
2021-
FROM dependents_index d
2022-
WHERE (d.dependent_object_id, d.dependent_component_index) IN (
2022+
FROM dependents_index
2023+
WHERE (dependent_object_id, dependent_component_index) IN (
20232024
SELECT object_id, component_index
20242025
FROM $scopeTableName
20252026
)
20262027
-- Ignore self-dependents
2027-
AND ((d.dependency_object_id, d.dependency_component_index) IS DISTINCT FROM (d.dependent_object_id, d.dependent_component_index))
2028+
AND ((dependency_object_id, dependency_component_index) IS DISTINCT FROM (dependent_object_id, dependent_component_index))
20282029
),
20292030
transitive_dependents (object_id, component_index, type_id) AS (
20302031
SELECT d.dependent_object_id, d.dependent_component_index, o.type_id
@@ -2043,7 +2044,7 @@ getTransitiveDependentsWithinScope scope query = do
20432044
JOIN object o ON d.dependent_object_id = o.id
20442045
)
20452046
SELECT *
2046-
FROM transitive_dependents t
2047+
FROM transitive_dependents
20472048
|]
20482049

20492050
execute [sql| DROP TABLE $scopeTableName |]
@@ -2062,6 +2063,86 @@ getTransitiveDependentsWithinScope scope query = do
20622063

20632064
pure result1
20642065

2066+
-- | Like 'getTransitiveDependentsWithinScope', but returns the dependents as a searchable adjacency matrix rather than
2067+
-- just a set of references.
2068+
--
2069+
-- Returns (dependent ref, dependent type, dependency, dependency type)
2070+
getTransitiveDependentsGraphWithinScope ::
2071+
DefnsF Set S.TermReferenceId S.TypeReferenceId ->
2072+
DefnsF Set S.TermReference S.TypeReference ->
2073+
Transaction [S.Reference.Id :. Only ObjectType :. S.Reference :. Only (Maybe ObjectType)]
2074+
getTransitiveDependentsGraphWithinScope scope query = do
2075+
-- Populate a temporary table with all of the references in `scope`
2076+
let scopeTableName = [sql| dependents_search_scope |]
2077+
createTemporaryTableOfReferenceIds scopeTableName
2078+
for_ scope.terms \ref -> execute [sql| INSERT INTO $scopeTableName VALUES (@ref, @) |]
2079+
for_ scope.types \ref -> execute [sql| INSERT INTO $scopeTableName VALUES (@ref, @) |]
2080+
2081+
-- Populate a temporary table with all of the references in `query`
2082+
let queryTableName = [sql| dependencies_query |]
2083+
createTemporaryTableOfReferences queryTableName
2084+
for_ query.terms \ref -> execute [sql| INSERT INTO $queryTableName VALUES (@ref, @, @) |]
2085+
for_ query.types \ref -> execute [sql| INSERT INTO $queryTableName VALUES (@ref, @, @) |]
2086+
2087+
result :: [S.Reference.Id :. Only ObjectType :. S.Reference :. Only (Maybe ObjectType)] <-
2088+
queryListRow
2089+
[sql|
2090+
WITH RECURSIVE
2091+
dependents_index_in_scope AS (
2092+
SELECT *
2093+
FROM dependents_index
2094+
WHERE
2095+
(dependent_object_id, dependent_component_index) IN (
2096+
SELECT object_id, component_index
2097+
FROM $scopeTableName
2098+
)
2099+
AND (dependency_object_id, dependency_component_index)
2100+
IS DISTINCT FROM (dependent_object_id, dependent_component_index)
2101+
),
2102+
transitive_dependents AS (
2103+
SELECT *
2104+
FROM dependents_index_in_scope
2105+
WHERE
2106+
(dependency_builtin IS NULL AND
2107+
(dependency_object_id, dependency_component_index) IN (
2108+
SELECT dependency_object_id, dependency_component_index
2109+
FROM $queryTableName
2110+
WHERE dependency_builtin IS NULL
2111+
)
2112+
)
2113+
OR
2114+
(dependency_builtin IS NOT NULL AND
2115+
dependency_builtin IN (
2116+
SELECT dependency_builtin
2117+
FROM $queryTableName
2118+
WHERE dependency_builtin IS NOT NULL
2119+
)
2120+
)
2121+
UNION
2122+
SELECT d.*
2123+
FROM transitive_dependents t
2124+
JOIN dependents_index_in_scope d
2125+
ON t.dependent_object_id = d.dependency_object_id
2126+
AND t.dependent_component_index = d.dependency_component_index
2127+
)
2128+
SELECT
2129+
t.dependent_object_id,
2130+
t.dependent_component_index,
2131+
o1.type_id,
2132+
t.dependency_builtin,
2133+
t.dependency_object_id,
2134+
t.dependency_component_index,
2135+
o2.type_id
2136+
FROM transitive_dependents t
2137+
JOIN object o1 ON t.dependent_object_id = o1.id
2138+
LEFT JOIN object o2 ON t.dependency_object_id = o2.id
2139+
|]
2140+
2141+
execute [sql| DROP TABLE $scopeTableName |]
2142+
execute [sql| DROP TABLE $queryTableName |]
2143+
2144+
pure result
2145+
20652146
createTemporaryTableOfReferences :: Sql -> Transaction ()
20662147
createTemporaryTableOfReferences tableName = do
20672148
execute

‎parser-typechecker/src/Unison/Codebase/MainTerm.hs‎

Lines changed: 3 additions & 3 deletions
Original file line numberDiff line numberDiff line change
@@ -14,7 +14,7 @@ import Unison.NamesWithHistory qualified as Names
1414
import Unison.Parser.Ann (Ann)
1515
import Unison.Parser.Ann qualified as Parser.Ann
1616
import Unison.Prelude
17-
import Unison.Reference (Reference)
17+
import Unison.Reference (Reference, TermReference)
1818
import Unison.Referent qualified as Referent
1919
import Unison.Term (Term)
2020
import Unison.Term qualified as Term
@@ -27,7 +27,7 @@ import Unison.Var qualified as Var
2727
data MainTerm v
2828
= NotFound (HQ.HashQualified Name)
2929
| BadType (HQ.HashQualified Name) (Maybe (Type v Ann))
30-
| Success (HQ.HashQualified Name) (Term v Ann) (Type v Ann)
30+
| Success (HQ.HashQualified Name) TermReference (Term v Ann) (Type v Ann)
3131

3232
getMainTerm ::
3333
(Monad m, Var v) =>
@@ -48,7 +48,7 @@ getMainTerm loadTypeOfTerm parseNames mainName mainType = do
4848
if Typechecker.fitsScheme typ mainType
4949
then do
5050
let tm = DD.forceTerm a a (Term.ref a ref)
51-
return (Success mainName tm typ)
51+
return (Success mainName ref tm typ)
5252
else pure (BadType mainName $ Just typ)
5353
_ -> pure (BadType mainName Nothing)
5454
_ -> pure (error "multiple matching refs") -- TODO: make a real exception

‎parser-typechecker/src/Unison/UnisonFile.hs‎

Lines changed: 30 additions & 4 deletions
Original file line numberDiff line numberDiff line change
@@ -37,6 +37,7 @@ module Unison.UnisonFile
3737
Unison.UnisonFile.rewrite,
3838
prepareRewrite,
3939
namespaceBindings,
40+
toDefnsIdsByName,
4041
)
4142
where
4243

@@ -57,10 +58,12 @@ import Unison.Hash qualified as Hash
5758
import Unison.Hashing.V2.Convert qualified as Hashing
5859
import Unison.LabeledDependency (LabeledDependency)
5960
import Unison.LabeledDependency qualified as LD
61+
import Unison.Name (Name)
6062
import Unison.Prelude
61-
import Unison.Reference (Reference, TermReference, TypeReference, TypeReferenceId)
63+
import Unison.Reference (Reference, TermReference, TermReferenceId, TypeReference, TypeReferenceId)
6264
import Unison.Reference qualified as Reference
6365
import Unison.Referent qualified as Referent
66+
import Unison.Syntax.Name qualified as Name
6467
import Unison.Term (Term)
6568
import Unison.Term qualified as Term
6669
import Unison.Type (Type)
@@ -157,13 +160,13 @@ termBindings uf =
157160
Map.foldrWithKey (\k (a, t) b -> (k, a, t) : b) [] uf.terms
158161

159162
-- backwards compatibility with the old data type
160-
dataDeclarations' :: TypecheckedUnisonFile v a -> Map v (Reference, DataDeclaration v a)
163+
dataDeclarations' :: TypecheckedUnisonFile v a -> Map v (TypeReference, DataDeclaration v a)
161164
dataDeclarations' = fmap (first Reference.DerivedId) . dataDeclarationsId'
162165

163-
effectDeclarations' :: TypecheckedUnisonFile v a -> Map v (Reference, EffectDeclaration v a)
166+
effectDeclarations' :: TypecheckedUnisonFile v a -> Map v (TypeReference, EffectDeclaration v a)
164167
effectDeclarations' = fmap (first Reference.DerivedId) . effectDeclarationsId'
165168

166-
hashTerms :: TypecheckedUnisonFile v a -> Map v (a, Reference, Maybe WatchKind, Term v a, Type v a)
169+
hashTerms :: TypecheckedUnisonFile v a -> Map v (a, TermReference, Maybe WatchKind, Term v a, Type v a)
167170
hashTerms = fmap (over _2 Reference.DerivedId) . hashTermsId
168171

169172
mapTerms :: (Term v a -> Term v a) -> UnisonFile v a -> UnisonFile v a
@@ -489,3 +492,26 @@ typeNamespaceBindings uf =
489492
where
490493
datas = Map.keysSet uf.dataDeclarationsId'
491494
effs = Map.keysSet uf.effectDeclarationsId'
495+
496+
-- | View the top-level definitions of a typechecked unison file as a map from name to ref id (throwing away
497+
-- constructors, as well as term and type bodies).
498+
toDefnsIdsByName :: forall a v. (Var v) => TypecheckedUnisonFile v a -> DefnsF (Map Name) TermReferenceId TypeReferenceId
499+
toDefnsIdsByName file =
500+
Defns
501+
{ terms = Map.foldlWithKey' f Map.empty file.hashTermsId,
502+
types = Map.union (g file.dataDeclarationsId') (g file.effectDeclarationsId')
503+
}
504+
where
505+
f ::
506+
Map Name TermReferenceId ->
507+
v ->
508+
(a, TermReferenceId, Maybe WatchKind, Term v a, Type v a) ->
509+
Map Name TermReferenceId
510+
f acc var (_, ref, wk, _, _) =
511+
if WatchKind.watchKindShouldBeStoredInDatabase wk
512+
then Map.insert (Name.unsafeParseVar var) ref acc
513+
else acc
514+
515+
g :: Map v (TypeReferenceId, decl) -> Map Name TypeReferenceId
516+
g =
517+
Map.foldlWithKey' (\acc var (ref, _) -> Map.insert (Name.unsafeParseVar var) ref acc) Map.empty

‎unison-cli/package.yaml‎

Lines changed: 1 addition & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -17,6 +17,7 @@ library:
1717
- ListLike
1818
- aeson >= 2.0.0.0
1919
- aeson-pretty
20+
- algebraic-graphs
2021
- ansi-terminal
2122
- attoparsec
2223
- base

‎unison-cli/src/Unison/Codebase/Editor/HandleInput.hs‎

Lines changed: 3 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -52,6 +52,7 @@ import Unison.Codebase.Editor.HandleInput.Branches (handleBranches)
5252
import Unison.Codebase.Editor.HandleInput.Cancel (handleCancel)
5353
import Unison.Codebase.Editor.HandleInput.Config (handleConfigGet, handleConfigSet)
5454
import Unison.Codebase.Editor.HandleInput.DebugDefinition qualified as DebugDefinition
55+
import Unison.Codebase.Editor.HandleInput.DebugDependentsGraph (handleDebugDependentsGraph)
5556
import Unison.Codebase.Editor.HandleInput.DebugFoldRanges qualified as DebugFoldRanges
5657
import Unison.Codebase.Editor.HandleInput.DebugSynhashTerm (handleDebugSynhashTerm)
5758
import Unison.Codebase.Editor.HandleInput.Delete (handleDelete)
@@ -683,6 +684,7 @@ loop e = do
683684
DebugTypeI hqName -> DebugDefinition.debugDecl hqName
684685
DebugClearWatchI {} ->
685686
Cli.runTransaction Codebase.clearWatches
687+
DebugDependentsGraph -> handleDebugDependentsGraph
686688
DebugDoctorI {} -> do
687689
r <- Cli.runTransaction IntegrityCheck.integrityCheckFullCodebase
688690
Cli.respond (IntegrityCheck r)
@@ -806,6 +808,7 @@ inputDescription input =
806808
ConfigGetI {} -> wat
807809
CreateMessage {} -> wat
808810
DebugClearWatchI {} -> wat
811+
DebugDependentsGraph -> wat
809812
DebugDoctorI {} -> wat
810813
DebugDumpNamespaceSimpleI {} -> wat
811814
DebugDumpNamespacesI {} -> wat

‎unison-cli/src/Unison/Codebase/Editor/HandleInput/DebugDependentsGraph.hs‎

Lines changed: 86 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,86 @@
1+
module Unison.Codebase.Editor.HandleInput.DebugDependentsGraph
2+
( handleDebugDependentsGraph,
3+
)
4+
where
5+
6+
import Algebra.Graph.AdjacencyMap qualified as Graph
7+
import Data.List qualified as List
8+
import Data.Text.IO qualified as Text
9+
import U.Codebase.Sqlite.Operations qualified as Operations
10+
import Unison.Builtin qualified as Builtin
11+
import Unison.Cli.Monad (Cli)
12+
import Unison.Cli.Monad qualified as Cli
13+
import Unison.Cli.MonadUtils qualified as Cli
14+
import Unison.Codebase.Branch qualified as Branch
15+
import Unison.Codebase.Branch.Names qualified as Branch
16+
import Unison.HashQualified (HashQualified)
17+
import Unison.Name (Name)
18+
import Unison.Prelude
19+
import Unison.PrettyPrintEnv qualified as PPE
20+
import Unison.PrettyPrintEnvDecl (PrettyPrintEnvDecl (..))
21+
import Unison.Reference (TermReference, TermReferenceId, TypeReference, TypeReferenceId)
22+
import Unison.Reference qualified as Reference
23+
import Unison.Referent qualified as Referent
24+
import Unison.Syntax.NamePrinter (prettyHashQualified)
25+
import Unison.Util.Defn (Defn (..))
26+
import Unison.Util.Defns (DefnsF)
27+
import Unison.Util.Pretty qualified as Pretty
28+
import Unison.Util.Relation qualified as Relation
29+
import Unison.Util.Set qualified as Set
30+
31+
handleDebugDependentsGraph :: Cli ()
32+
handleDebugDependentsGraph = do
33+
currentNamespace <- Cli.getCurrentBranch0
34+
35+
let currentNamespaceSansLib =
36+
Branch.deleteLibdeps currentNamespace
37+
38+
let query :: DefnsF Set TermReference TypeReference
39+
query =
40+
bimap (Set.mapMaybe Referent.toTermReference . Relation.dom) Relation.dom (Branch.deepDefns currentNamespaceSansLib)
41+
42+
let scope :: DefnsF Set TermReferenceId TypeReferenceId
43+
scope =
44+
bimap (Set.mapMaybe Reference.toId) (Set.mapMaybe Reference.toId) query
45+
46+
edges <-
47+
Cli.runTransaction (Operations.transitiveDependentsGraphWithinScope Builtin.isBuiltinType scope query)
48+
49+
let graph :: Graph.AdjacencyMap (Defn TermReference TypeReference)
50+
graph =
51+
List.foldl
52+
( \acc edge ->
53+
Graph.overlay acc case edge of
54+
Operations.TermDependsOnTerm dependent dependency ->
55+
Graph.edge (TermDefn (Reference.fromId dependent)) (TermDefn dependency)
56+
Operations.TermDependsOnType dependent dependency ->
57+
Graph.edge (TermDefn (Reference.fromId dependent)) (TypeDefn dependency)
58+
Operations.TypeDependsOnType dependent dependency ->
59+
Graph.edge (TypeDefn (Reference.fromId dependent)) (TypeDefn dependency)
60+
)
61+
Graph.empty
62+
edges
63+
64+
let adjacency =
65+
Graph.adjacencyList graph
66+
67+
let ppe =
68+
(Branch.toPrettyPrintEnvDecl 10 currentNamespace).suffixifiedPPE
69+
70+
let prettyDefn :: Defn TermReference TypeReference -> HashQualified Name
71+
prettyDefn = \case
72+
TermDefn ref -> PPE.termName ppe (Referent.fromTermReference ref)
73+
TypeDefn ref -> PPE.typeName ppe ref
74+
75+
let output =
76+
Pretty.lines
77+
( map
78+
( \(dependent, dependencies) ->
79+
prettyHashQualified (prettyDefn dependent)
80+
<> " depends on: "
81+
<> Pretty.commas (map (prettyHashQualified . prettyDefn) dependencies)
82+
)
83+
adjacency
84+
)
85+
86+
liftIO (Text.putStrLn (Pretty.toANSI 80 (Pretty.syntaxToColor output)))

0 commit comments

Comments
 (0)