Issue #4: checkpoint ... working on 'TDProjectCommandTests debug: #te…

…stProjectNew'
GsDevKit · Aug 2, 2023 · 3e31716 · 3e31716
1 parent 858a9da
commit 3e31716
Show file tree

Hide file tree

Showing 9 changed files with 128 additions and 13 deletions.
diff --git a/bin/registerTodeSharedDir.solo b/bin/registerTodeSharedDir.solo
@@ -65,14 +65,18 @@ RwLoadSpecificationV2 {
 ]
 %
 doit
-	| registryClass stonesRegistry todeHomeDir todeHomeDirPath |
+	| registryClass stonesRegistry todeHomeDir todeHomeDirPath projectDir |
+	projectDir := self dirname asFileReference parent.
 	self preDoitSpecLoad: [:spec |
-		spec projectsHome: self dirname asFileReference parent parent].
+		spec projectsHome: projectDir  parent].
 	registryClass := (self globalNamed: 'GDKRegistry').	
 	stonesRegistry := registryClass stonesRegistryNamed: self registry.
 	todeHomeDir := self todeHome asFileReference.
 	todeHomeDirPath := GsFile serverRealPath: todeHomeDir pathString.
-	stonesRegistry todeHomeDirectory: todeHomeDirPath populate: self populate.
+	stonesRegistry 
+		todeHomeDirectory: todeHomeDirPath
+		templatesDir: projectDir / 'templates'
+		populate: self populate.
 	stonesRegistry export.
 
 %
diff --git a/bin/validateStoneSysNodes.stone b/bin/validateStoneSysNodes.stone
@@ -93,12 +93,12 @@ doit
 	        self repair
 	          ifTrue: [ 
 	            | templateNodePath |
-	            templateNodePath := self todeHome, '/sys/local/server/templates/'.
-							(ServerFileDirectory on:  templateNodePath , nodename) exists
-								ifFalse: [  templateNodePath := self todeHome, '/sys/default/server/templates/' ].
+	            templateNodePath := '/sys/local/server/templates/'.
+							(ServerFileDirectory on:  self todeHome, templateNodePath , nodename) exists
+								ifFalse: [  templateNodePath := '/sys/default/server/templates/' ].
 	            cpTool
 	              cp: templateNodePath , nodename
-	              to: self todeHome, '/sys/stones/' , self stoneName ]
+	              to: '/sys/stones/' , self stoneName ]
 	          ifFalse: [ 
 	            nil
 	              error:

diff --git a/...s/instance/todeHomeDirectory.populate..st → ...deHomeDirectory.templatesDir.populate..st b/...s/instance/todeHomeDirectory.populate..st → ...deHomeDirectory.templatesDir.populate..st
@@ -1,9 +1,9 @@
 accessing
-todeHomeDirectory: todeHomePath populate: populate
+todeHomeDirectory: todeHomePath templatesDir: sourceTemplatesDir populate: populate
 	"The tode shared directory is equivalent to the $GS_HOME/sys/local directory in GsDevKit_home. 
 		The directories created in this method are required for the proper functioning of a tODE client."
 
-	| todeHomeDir |
+	| todeHomeDir todeTemplatesDir |
 	todeHomeDir := todeHomePath asFileReference.
 	self todeHome: todeHomeDir pathString.
 	(todeHomeDir exists not or: [ populate ])
@@ -12,13 +12,22 @@ todeHomeDirectory: todeHomePath populate: populate
 			(todeHomeDir / 'sys') ensureCreateDirectory.
 			(todeHomeDir / 'sys' / 'default') ensureCreateDirectory.
 			(todeHomeDir / 'sys' / 'default' / 'server') ensureCreateDirectory.
-			(todeHomeDir / 'sys' / 'default' / 'server' / 'gemstone') ensureCreateDirectory.
+			(todeHomeDir / 'sys' / 'default' / 'server' / 'gemstone')
+				ensureCreateDirectory.
 			(todeHomeDir / 'sys' / 'default' / 'server' / 'home') ensureCreateDirectory.
-			(todeHomeDir / 'sys' / 'default' / 'server' / 'projects') ensureCreateDirectory.
+			(todeHomeDir / 'sys' / 'default' / 'server' / 'projects')
+				ensureCreateDirectory.
 			(todeHomeDir / 'sys' / 'default' / 'server' / 'stones') ensureCreateDirectory.
-			(todeHomeDir / 'sys' / 'default' / 'server' / 'templates')
+
+			(todeTemplatesDir := todeHomeDir / 'sys' / 'default' / 'server' / 'templates')
+				ensureCreateDirectory.
+			sourceTemplatesDir files
+				do: [ :templateFile | 
+					templateFile extension = 'ston'
+						ifTrue: [ templateFile copyTo: todeTemplatesDir ] ].
+
+			(todeHomeDir / 'sys' / 'default' / 'server' / 'upgrade')
 				ensureCreateDirectory.
-			(todeHomeDir / 'sys' / 'default' / 'server' / 'upgrade') ensureCreateDirectory.
 
 			(todeHomeDir / 'sys' / 'local') ensureCreateDirectory.
 			(todeHomeDir / 'sys' / 'local' / 'server' / 'gemstone') ensureCreateDirectory.

diff --git a/todeTemplates/README.md b/todeTemplates/README.md
@@ -0,0 +1,3 @@
+# Default stone /sys/stone/\<stone-name\> files
+
+The files in this directory are installed by the `/sys/default/bin/validateStoneSysNodes` script
diff --git a/todeTemplates/dirs.ston b/todeTemplates/dirs.ston
@@ -0,0 +1,25 @@
+TDRawGatewayNode{#name:'dirs',#contents:'| dirNode projectTool |
+  dirNode := TDDirectoryNode new
+    name: \'dirs\';
+    yourself.
+  projectTool := self topez toolInstanceFor: \'project\'.
+  (projectTool projectRegistrationDefinitionList
+    select: [ :registration | registration hasGitBasedRepo or: [ registration hasGitRepository ] ])
+    collect: [ :registration | 
+      | diskPath |
+      diskPath := registration hasGitRepository
+        ifTrue: [ registration gitRootDirectory pathName ]
+        ifFalse: [ 
+          | githubRepo |
+          githubRepo := registration repository.
+          (githubRepo class
+            projectDirectoryFrom: githubRepo projectPath
+            version: githubRepo projectVersion) pathName ].
+      dirNode
+        addChildNode:
+          (TDObjectGatewayNode new
+            name: registration projectName;
+            contents: \'ServerFileDirectory on: \' , diskPath printString;
+            visitAsLeafNode: true;
+            yourself) ].
+  ^ dirNode'}
diff --git a/todeTemplates/homeComposition.ston b/todeTemplates/homeComposition.ston
@@ -0,0 +1,7 @@
+TDRawGatewayNode{#name:'homeComposition',#contents:'(TDComposedDirectoryNode
+    pathComposedDirectoryNodeNamed: \'home\'
+    topez: self topez)
+    addPathNode: \'/sys/stone/home\';
+    addPathNode: \'/sys/local/server/home\';
+    addPathNode: \'/sys/default/server/home\' includes: #( \'tode\' \'utils\' );
+    yourself'}
diff --git a/todeTemplates/packages.ston b/todeTemplates/packages.ston
@@ -0,0 +1,15 @@
+TDRawGatewayNode{#name:'packages',#contents:'| dirNode monticelloTool |
+  dirNode := TDDirectoryNode new
+    name: \'packages\';
+    readMe: \'I have a listing of the packages loaded into this stone.\';
+    yourself.
+  monticelloTool := self topez toolInstanceFor: \'mc\'.
+  (monticelloTool mclist: \'\')
+    collect: [ :each | 
+      dirNode
+        addChildNode:
+          (TDObjectNode new
+            name: each packageName;
+            basicContents: each;
+            yourself) ].
+  ^ dirNode'}
diff --git a/todeTemplates/projectComposition.ston b/todeTemplates/projectComposition.ston
@@ -0,0 +1,7 @@
+TDRawGatewayNode{#name:'projectComposition',#contents:'(TDComposedProjectEntryNode
+    pathComposedDirectoryNodeNamed: \'home\'
+    topez: self topez)
+    addPathNode: \'/sys/stone/projects\';
+    addPathNode: \'/sys/local/server/projects\';
+    addPathNode: \'/sys/default/server/projects\'; 
+    yourself'}
diff --git a/todeTemplates/repos.ston b/todeTemplates/repos.ston
@@ -0,0 +1,45 @@
+TDRawGatewayNode{#name:'repos',#contents:'| dirNode projectTool monticelloTool |
+  dirNode := TDDirectoryNode new
+    name: \'repos\';
+    yourself.
+  projectTool := self topez toolInstanceFor: \'project\'.
+  monticelloTool := self topez toolInstanceFor: \'mc\'.
+  (projectTool projectRegistrationDefinitionList
+    select: [ :registration | registration hasGitBasedRepo or: [ registration hasFileTreeRepo ] ])
+    collect: [ :each | 
+      | node repos |
+      repos := [ each repository ]
+        on: Error
+        do: [ :ignored | 
+          \"not a valid repository, so skip it\"
+          nil ].
+      repos
+        ifNotNil: [ 
+          node := TDObjectNode new
+            name: each projectName;
+            basicContents: repos;
+            listBlock: [ :theNode | ((monticelloTool mrpackageNamesIn: theNode basicContents) at: 1) sorted ];
+            elementBlock: [ :theNode :elementName :absentBlock | 
+                  | resolvedDict versionReferences info |
+                  info := monticelloTool mrpackageNamesIn: theNode basicContents.
+                  resolvedDict := info at: 3.
+                  versionReferences := resolvedDict
+                    at: elementName
+                    ifAbsent: [ absentBlock value ].
+                  TDObjectNode new
+                    name: elementName;
+                    basicContents: versionReferences asArray;
+                    listBlock: [ :theNode | (theNode basicContents collect: [ :each | each name ]) sorted ];
+                    elementBlock: [ :theNode :elementName :absentBlock | 
+                          | versionReference |
+                          versionReference := theNode basicContents
+                            detect: [ :each | each name = elementName ]
+                            ifNone: absentBlock.
+                          TDObjectNode new
+                            name: versionReference name;
+                            basicContents: versionReference version;
+                            yourself ];
+                    yourself ];
+            yourself.
+          dirNode addChildNode: node ] ].
+  ^ dirNode'}