Suggestion: switch to using Git directly

[athas]

smlpkg is closely based on the Futhark package manager, which recently switched to using git directly instead of downloading from GitHub/GitLab websites. This means arbitrary Git hosting sites (or Git over random SSH connections) can be supported. Most importantly, private repositories also work. Discussion here: diku-dk/futhark#1835

Since the implementation of smlpkg is still very similar to the original Haskell code, such a switch would not be difficult. In fact, it turns out that it is less code in total.

[athas]

This is the commit to futhark pkg that made the change to calling git directly: diku-dk/futhark@8af73c1

These are the pertinent lines of code: https://github.com/diku-dk/futhark/blob/8af73c12e5d9dba76971e60091a7ba4f4c8f583b/src/Futhark/Pkg/Info.hs#L115-L245

The trick is to clone the repository and then just use git commands to determine which versions are available and what their dependencies are (by git checkouting each revision).

The code to replace in smlpkg is this:

smlpkg/src/pkginfo.sml

Lines 47 to 169 in 5fdb1b1

	fun httpRequest (url:string) : string =
	let val cmd = "curl -L " ^ url
	val (status,out,err) = System.command cmd
	in if OS.Process.isSuccess status then out
	else (TextIO.output(TextIO.stdErr,err);
	raise Fail ("Failed to execute http request using curl: '" ^ cmd ^ "'"))
	end
	fun gitCmd (opts : string list) : string = (* may raise Fail and print errors on stderr *)
	let val cmd = String.concatWith " " ("git"::opts)
	(*
	val () = (* Avoid Git asking for credentials. We prefer failure. *)
	setEnv "GIT_TERMINAL_PROMPT" "0"
	*)
	val (status,out,err) = System.command cmd
	in if OS.Process.isSuccess status then out
	else (TextIO.output(TextIO.stdErr,err);
	raise Fail ("Failed to execute git command '" ^ cmd ^ "'"))
	end
	(* The GitLab and GitHub interactions are very similar, so we define a
	couple of generic functions that are used to implement support for
	both. *)
	fun ghglRevGetManifest (url:string) (owner:string) (repo:string) (tag:string) : Manifest.t =
	let val () = log ("downloading package manifest from " ^ url)
	val path = owner ^ "/" ^ repo ^ "@" ^ tag ^ "/" ^ Manifest.smlpkg_filename()
	val s = httpRequest url
	handle Fail e =>
	raise Fail ("Network error when reading " ^ path ^ ":\n" ^ e)
	in Manifest.fromString path s
	end
	val cache =
	let val m : (string * Manifest.t) list ref = ref nil
	in fn f => fn a => fn b => fn c => fn d => fn () =>
	let val s = String.concatWith "/" [a,b,c,d]
	in case List.find (fn (k,_) => k=s) (!m) of
	SOME (_,v) => v
	| NONE => let val v = f a b c d
	in m := (s,v) :: !m
	; v
	end
	end
	end
	fun ghglLookupCommit (archive_url:string) (manifest_url:string)
	(owner:string) (repo:string) (d:string)
	(tag:string) (hash:string) (version_prefix:string)
	: pkg_revinfo =
	let val mc = cache ghglRevGetManifest manifest_url owner repo tag
	val dir = repo ^ "-" ^ version_prefix ^ d
	val time = Time.now()
	val () = log ("zip url: " ^ archive_url)
	val () = log ("zip dir: " ^ dir)
	in {pkgRevZipballUrl=archive_url,
	pkgRevZipballDir=dir,
	pkgRevCommit=hash,
	pkgRevGetManifest=mc,
	pkgRevTime=time}
	end
	fun ghglPkgInfo (repo_url:string) mk_archive_url mk_manifest_url
	(owner:string) (repo:string) (versions:int list)
	(version_prefix:string) : pkg_info =
	let val () = log ("retrieving list of tags from " ^ repo_url)
	val remote_lines = gitCmd ["ls-remote", repo_url]
	val remote_lines = String.tokens (fn c => c = #"\n") remote_lines
	fun isHeadRef (l:string) : string option =
	case String.tokens Char.isSpace l of
	[hash,"HEAD"] => SOME hash
	| _ => NONE
	fun revInfo l : (semver * pkg_revinfo) option =
	case String.tokens Char.isSpace l of
	[hash,refe] =>
	(case String.fields (fn s => s = #"/") refe of
	["refs", "tags", t] =>
	if String.isPrefix "v" t then
	(case SemVer.fromString(String.extract(t,1,NONE)) of
	SOME v =>
	let val m = SemVer.major v
	in if List.exists (fn i => i=m) versions then
	let val pinfo = ghglLookupCommit (mk_archive_url t) (mk_manifest_url t)
	owner repo (SemVer.toString v) t hash version_prefix
	in SOME (v,pinfo)
	end
	else NONE
	end
	| NONE => NONE)
	else NONE
	| _ => NONE)
	| _ => NONE
	in case List.mapPartial isHeadRef remote_lines of
	head_ref :: _ =>
	let fun def (opt:string option) : string = Option.getOpt(opt,head_ref)
	val rev_info = M.fromList_eq (List.mapPartial revInfo remote_lines)
	fun lookupCommit (r:string option) =
	ghglLookupCommit (mk_archive_url (def r)) (mk_manifest_url (def r))
	owner repo (def r) (def r) (def r) version_prefix
	in {pkgVersions=rev_info,
	pkgLookupCommit=lookupCommit}
	end
	| _ => raise Fail ("Cannot find HEAD ref for " ^ repo_url)
	end
	fun ghPkgInfo (owner:string) (repo:string) (versions:int list) : pkg_info =
	let val repo_url = "https://github.com/" ^ owner ^ "/" ^ repo
	fun mk_archive_url r = repo_url ^ "/archive/" ^ r ^ ".zip"
	fun mk_manifest_url r = "https://raw.githubusercontent.com/" ^
	owner ^ "/" ^ repo ^ "/" ^
	r ^ "/" ^ Manifest.smlpkg_filename()
	in ghglPkgInfo repo_url mk_archive_url mk_manifest_url owner repo versions ""
	end
	fun glPkgInfo (owner:string) (repo:string) (versions:int list) : pkg_info =
	let val base_url = "https://gitlab.com/" ^ owner ^ "/" ^ repo
	val repo_url = base_url ^ ".git"
	fun mk_archive_url r = base_url ^ "/-/archive/" ^ r ^
	"/" ^ repo ^ "-" ^ r ^ ".zip"
	fun mk_manifest_url r = base_url ^ "/raw/" ^
	r ^ "/" ^ Manifest.smlpkg_filename()
	in ghglPkgInfo repo_url mk_archive_url mk_manifest_url owner repo versions "v"
	end

[athas]

Let us see if linear algebra is capable of doing this rather well-defined but also rather boring task.

[ratsclub]

@athas I faced this issue this weekend and used Claude to finish off #15. Would you be open to receive the contribution on another PR? The only big difference is that I set GIT_TERMINAL_PROMPT=0 to avoid having git ask for credentials.

[athas]

I would be OK with anything you prefer, especially if you also check that it works properly.