From fb93f2f0e003fae60fcaae60e08d9ad583b890fe Mon Sep 17 00:00:00 2001 From: Carl Gay Date: Mon, 30 Dec 2024 12:19:52 -0500 Subject: [PATCH] WIP fixing bugs in rewrite --- sources/commands/utils.dylan | 2 +- sources/pacman/packages.dylan | 7 ++++ sources/workspaces/lid.dylan | 8 +++-- sources/workspaces/registry.dylan | 1 + sources/workspaces/workspaces.dylan | 50 ++++++++++++++++++----------- 5 files changed, 47 insertions(+), 21 deletions(-) diff --git a/sources/commands/utils.dylan b/sources/commands/utils.dylan index 6816e47..5a17957 100644 --- a/sources/commands/utils.dylan +++ b/sources/commands/utils.dylan @@ -7,7 +7,7 @@ Synopsis: Utilities for use by deft commands // Using the comment markers enables recovery if someone commits a string // other than "HEAD" by accident. git's `ident` attribute doesn't use tag // names and `filter` looks more complex than it's worth. -define constant $deft-version :: = /*__*/ "HEAD" /*__*/; +define constant $deft-version :: = /*__*/ "v0.12.0-23-g939c51c 2024-12-30T10:11:06-05:00" /*__*/; // Run an executable or shell command. `command` may be a string or a sequence diff --git a/sources/pacman/packages.dylan b/sources/pacman/packages.dylan index 6f99c36..b83f2ad 100644 --- a/sources/pacman/packages.dylan +++ b/sources/pacman/packages.dylan @@ -156,9 +156,16 @@ end function; // they are all specified in one table and here we extract them and put them in // the right place. There is no conflict since the file doesn't contain // multiple releases. +define variable *count* = 0; define function load-dylan-package-file (file :: ) => (release :: ) debug("Reading package file %s", file); + if (ends-with?(as(, file), "deft/dylan-package.json")) + inc!(*count*); + if (*count* == 2) + break(); + end; + end; fs/with-open-file (stream = file) let json = block () parse-json(stream, table-class: , strict?: #f) diff --git a/sources/workspaces/lid.dylan b/sources/workspaces/lid.dylan index 61b65fe..93b9af1 100644 --- a/sources/workspaces/lid.dylan +++ b/sources/workspaces/lid.dylan @@ -83,6 +83,10 @@ define function add-lid let library-name = lid-value(lid, $library-key); if (library-name) let lids = element(ws.%lids-by-library, library-name, default: #()); + if (member?(lid, lids)) + note("re-adding %s", lid); + break(); + end; ws.%lids-by-library[library-name] := pair(lid, lids); end; ws.%lids-by-pathname[as(, lid.lid-locator)] := lid; @@ -116,12 +120,12 @@ end function; define function skip-lid? (ws :: , lid :: ) => (skip? :: ) if (string-equal-ic?("hdp", lid.lid-locator.locator-extension)) - let library-name = lid-value(lid, $library-key, error?: #t); + let library = lid-value(lid, $library-key, error?: #t); let directory = lid.lid-locator.locator-directory; let existing = choose(method (x) x.lid-locator.locator-directory = directory end, - element(ws.%lids-by-library, library-name, default: #[])); + element(ws.%lids-by-library, library, default: #[])); // Why only size = 1? Shouldn't I be looking for exactly lid.locator-name + ".lid" existing.size = 1 & string-equal-ic?("lid", existing[0].lid-locator.locator-extension) diff --git a/sources/workspaces/registry.dylan b/sources/workspaces/registry.dylan index 9e5eabe..6d0ea3e 100644 --- a/sources/workspaces/registry.dylan +++ b/sources/workspaces/registry.dylan @@ -66,6 +66,7 @@ define function update-registry let written = 0; let no-platform = make(); for (lids keyed-by library in ws.lids-by-library) + note("*** %20s => %s", library, lids); let candidates = choose(method (lid) let platform = lid-value(lid, $platforms-key); diff --git a/sources/workspaces/workspaces.dylan b/sources/workspaces/workspaces.dylan index 62a4d05..bfa0558 100644 --- a/sources/workspaces/workspaces.dylan +++ b/sources/workspaces/workspaces.dylan @@ -90,12 +90,11 @@ define function registry-directory subdirectory-locator(ws.workspace-directory, "registry") end function; -// Loads the workspace definition by looking up from `directory` to find the -// workspace root and loading the workspace.json file. If no workspace.json -// file exists, the workspace is created using the dylan-package.json file (if -// any) and default values. As a last resort `directory` is used as the -// workspace root. Signals `` if either JSON file is found but -// is invalid. +// Loads the workspace definition by looking up from `directory` to find the workspace +// root and loading the workspace.json file. If no workspace.json file exists, the +// workspace is created using the dylan-package.json file (if any) and default values. As +// a last resort `directory` is used as the workspace root. Signals `` +// if either JSON file is found but is invalid. define function load-workspace (#key directory :: = fs/working-directory()) => (workspace :: ) @@ -123,19 +122,25 @@ end function; define function scan-workspace (ws :: ) => () // First do active packages to populate %lids-by-active-package. - for (package in find-active-packages(ws.workspace-directory)) - let directory = active-package-directory(ws, package); - fs/do-directory(curry(scan-workspace-file, ws, package), directory); + for (release in ws.workspace-active-packages) + let directory = active-package-directory(ws, release); + verbose("Scanning active package in %s", directory); + fs/do-directory(curry(scan-workspace-file, ws, release), directory); end; ws.active-packages-scanned? := #t; // Prevent infinite recursion in empty workspaces. // Install dependencies and further update the %lids-by-* tables with them. let (releases, actives) = ensure-deps-installed(ws); for (release in releases) - let directory = active-package-directory(ws, pm/release-package(release)); + let directory = pm/source-directory(release); + verbose("Scanning release in %s", directory); fs/do-directory(curry(scan-workspace-file, ws, release), directory); end; end function; +// Directories that should never be scanned for LID files. +define variable *skip-directories* + = list(".git", "_build", "_packages", "registry"); + define function scan-workspace-file (ws, active-package, dir, name, type) => () select (type) @@ -153,15 +158,19 @@ define function scan-workspace-file end; end; #"directory" => - // TODO: Git submodules could indicate a project in transition from Git - // submodules to Deft, or they could indicate use of a repository that isn't - // available in the package catalog. Ignore them and assume all packages are - // available in the catalog for now. Ultimately we should have an escape hatch - // like the ability to use a local package catalog IN ADDITION to the main - // catalog. Or just make this configurable? + // TODO: Git submodules could indicate use of a repository that isn't available in + // the package catalog. Ignore them and assume all packages are available in the + // catalog for now. Ultimately we should have an escape hatch like the ability to + // use a local package catalog in addition to the main catalog, and/or make this + // configurable? let subdir = subdirectory-locator(dir, name); - let subdir/git = subdirectory-locator(subdir, ".git"); - if (name ~= ".git" & ~fs/file-exists?(subdir/git)) + if (member?(name, *skip-directories*, test: \=)) + verbose(" Skipping %s", subdir); + elseif (fs/file-exists?(file-locator(subdir, ".git"))) + // Note that .git may be a directory or a regular file. Using file-locator + // here works for both. + verbose(" Skipping Git submodule %s", subdir); + else fs/do-directory(curry(scan-workspace-file, ws, active-package), subdir); end; #"link" => @@ -297,6 +306,11 @@ define function find-active-packages | map(pm/load-dylan-package-file, subdir-files) end function; +define method active-package-directory + (ws :: , release :: pm/) => (d :: ) + active-package-directory(ws, pm/package-name(release)) +end method; + define method active-package-directory (ws :: , package :: pm/) => (d :: ) active-package-directory(ws, pm/package-name(package))