# HG changeset patch # User Chris Cannam # Date 1499962213 -3600 # Node ID d741e2c90eab3f33e177bf37995459817feabe5a # Parent cf863362a9df3e3af836a68f7e98f59e4ae5a05e Update Vext and subrepos diff -r cf863362a9df -r d741e2c90eab vext --- a/vext Wed Jul 12 08:53:42 2017 +0100 +++ b/vext Thu Jul 13 17:10:13 2017 +0100 @@ -11,12 +11,44 @@ mydir=$(dirname "$0") program="$mydir/vext.sml" +hasher= +local_install= +if [ -w "$mydir" ]; then + if echo | sha256sum >/dev/null 2>&1 ; then + hasher=sha256sum + local_install=true + elif echo | shasum >/dev/null 2>&1 ; then + hasher=shasum + local_install=true + else + echo "WARNING: sha256sum or shasum program not found" 1>&2 + fi +fi + +if [ -n "$local_install" ]; then + hash=$(echo "$sml" | cat "$program" - | $hasher | cut -c1-16) + gen_sml=$mydir/.vext-$hash.sml + gen_out=$mydir/.vext-$hash.bin + trap 'rm -f $gen_sml' 0 +else + gen_sml=$(mktemp /tmp/vext-XXXXXXXX.sml) + gen_out=$(mktemp /tmp/vext-XXXXXXXX.bin) + trap 'rm -f $gen_sml $gen_out' 0 +fi + +if [ -x "$gen_out" ]; then + exec "$gen_out" "$@" +fi + # We need one of Poly/ML, SML/NJ, or MLton. Since we're running a # single-file SML program as if it were a script, our order of -# preference is based on startup speed. +# preference is based on startup speed, except in the local_install +# case where we retain a persistent binary. if [ -z "$sml" ]; then - if sml -h 2>&1 | grep -q 'Standard ML of New Jersey'; then + if [ -n "$local_install" ] && mlton 2>&1 | grep -q 'MLton'; then + sml="mlton" + elif sml -h 2>&1 | grep -q 'Standard ML of New Jersey'; then sml="smlnj" # We would prefer Poly/ML to SML/NJ, except that Poly v5.7 has a # nasty bug that occasionally causes it to deadlock on startup. @@ -55,11 +87,6 @@ fi fi -tmp_sml=$(mktemp /tmp/vext-XXXXXXXX.sml) -tmp_out=$(mktemp /tmp/vext-XXXXXXXX.bin) - -trap 'rm -f $tmp_sml $tmp_out' 0 - arglist="" for arg in "$@"; do if [ -n "$arglist" ]; then arglist="$arglist,"; fi @@ -71,13 +98,22 @@ done case "$sml" in - poly) echo 'use "'"$program"'"; vext ['"$arglist"'];' | - poly -q --error-exit ;; + poly) + if [ -n "$local_install" ] && polyc --help >/dev/null 2>&1 ; then + if [ ! -x "$gen_out" ]; then + polyc -o "$gen_out" "$program" + fi + "$gen_out" "$@" + else + echo 'use "'"$program"'"; vext ['"$arglist"'];' | + poly -q --error-exit + fi ;; mlton) - cat "$program" > "$tmp_sml" - echo 'val _ = main ()' >> "$tmp_sml" - mlton -output "$tmp_out" "$tmp_sml" - "$tmp_out" "$@" ;; + if [ ! -x "$gen_out" ]; then + echo "val _ = main ()" | cat "$program" - > "$gen_sml" + mlton -output "$gen_out" "$gen_sml" + fi + "$gen_out" "$@" ;; smlnj) cat "$program" | ( cat < "$tmp_sml" - CM_VERBOSE=false sml "$tmp_sml" ;; + ) > "$gen_sml" + CM_VERBOSE=false sml "$gen_sml" ;; *) echo "Unknown SML implementation name: $sml"; exit 2 ;; diff -r cf863362a9df -r d741e2c90eab vext-lock.json --- a/vext-lock.json Wed Jul 12 08:53:42 2017 +0100 +++ b/vext-lock.json Thu Jul 13 17:10:13 2017 +0100 @@ -7,7 +7,10 @@ "pin": "a533662c17f4" }, "piper-cpp": { - "pin": "b146634c3686168a9d4bb739986d065b5d2d40a2" + "pin": "85394095a5b04f99a0785ccd32a5a98c90d984b2" + }, + "dataquay": { + "pin": "807b55408d9e" }, "bqvec": { "pin": "e345a5e32c53" diff -r cf863362a9df -r d741e2c90eab vext.ps1 --- a/vext.ps1 Wed Jul 12 08:53:42 2017 +0100 +++ b/vext.ps1 Thu Jul 13 17:10:13 2017 +0100 @@ -14,10 +14,10 @@ # We need either Poly/ML or SML/NJ. No great preference as to which. if (!$sml) { - if (Get-Command "polyml" -ErrorAction SilentlyContinue) { + if (Get-Command "sml" -ErrorAction SilentlyContinue) { + $sml = "smlnj" + } elseif (Get-Command "polyml" -ErrorAction SilentlyContinue) { $sml = "poly" - } elseif (Get-Command "sml" -ErrorAction SilentlyContinue) { - $sml = "smlnj" } else { echo @" @@ -29,12 +29,12 @@ Please ensure you have one of the following SML implementations installed and present in your PATH, and try again. - 1. Poly/ML + 1. Standard ML of New Jersey + - executable name: sml + + 2. Poly/ML - executable name: polyml - 2. Standard ML of New Jersey - - executable name: sml - "@ exit 1 } diff -r cf863362a9df -r d741e2c90eab vext.sml --- a/vext.sml Wed Jul 12 08:53:42 2017 +0100 +++ b/vext.sml Thu Jul 13 17:10:13 2017 +0100 @@ -33,7 +33,7 @@ Software without prior written authorization. *) -val vext_version = "0.9.4" +val vext_version = "0.9.6" datatype vcs = @@ -48,9 +48,11 @@ repo : string option } +type id_or_tag = string + datatype pin = UNPINNED | - PINNED of string + PINNED of id_or_tag datatype libstate = ABSENT | @@ -60,7 +62,8 @@ datatype localstate = MODIFIED | - UNMODIFIED + LOCK_MISMATCHED | + CLEAN datatype branch = BRANCH of string | @@ -77,21 +80,20 @@ type libname = string -type id_or_tag = string - type libspec = { libname : libname, vcs : vcs, source : source, branch : branch, - pin : pin + project_pin : pin, + lock_pin : pin } type lock = { libname : libname, id_or_tag : id_or_tag } - + type remote_spec = { anon : string option, auth : string option @@ -177,6 +179,7 @@ val review : context -> libspec -> (libstate * localstate) result val status : context -> libspec -> (libstate * localstate) result val update : context -> libspec -> id_or_tag result + val id_of : context -> libspec -> id_or_tag result end structure FileBits :> sig @@ -402,7 +405,8 @@ - ABSENT: Repo doesn't exist here at all. *) - fun check with_network context ({ libname, branch, pin, ... } : libspec) = + fun check with_network context + ({ libname, branch, project_pin, lock_pin, ... } : libspec) = let fun check_unpinned () = let val is_newest = if with_network then V.is_newest @@ -422,26 +426,39 @@ ERROR e => ERROR e | OK true => OK CORRECT | OK false => OK WRONG - fun check' () = - case pin of + fun check_remote () = + case project_pin of UNPINNED => check_unpinned () | PINNED target => check_pinned target + fun check_local () = + case V.is_modified_locally context libname of + ERROR e => ERROR e + | OK true => OK MODIFIED + | OK false => + case lock_pin of + UNPINNED => OK CLEAN + | PINNED target => + case V.is_at context (libname, target) of + ERROR e => ERROR e + | OK true => OK CLEAN + | OK false => OK LOCK_MISMATCHED in case V.exists context libname of ERROR e => ERROR e - | OK false => OK (ABSENT, UNMODIFIED) + | OK false => OK (ABSENT, CLEAN) | OK true => - case (check' (), V.is_modified_locally context libname) of + case (check_remote (), check_local ()) of (ERROR e, _) => ERROR e | (_, ERROR e) => ERROR e - | (OK state, OK true) => OK (state, MODIFIED) - | (OK state, OK false) => OK (state, UNMODIFIED) + | (OK r, OK l) => OK (r, l) end val review = check true val status = check false - - fun update context ({ libname, source, branch, pin, ... } : libspec) = + + fun update context + ({ libname, source, branch, + project_pin, lock_pin, ... } : libspec) = let fun update_unpinned () = case V.is_newest context (libname, branch) of ERROR e => ERROR e @@ -453,9 +470,12 @@ | OK true => OK target | OK false => V.update_to context (libname, target) fun update' () = - case pin of - UNPINNED => update_unpinned () - | PINNED target => update_pinned target + case lock_pin of + PINNED target => update_pinned target + | UNPINNED => + case project_pin of + PINNED target => update_pinned target + | UNPINNED => update_unpinned () in case V.exists context libname of ERROR e => ERROR e @@ -465,6 +485,10 @@ ERROR e => ERROR e | OK () => update' () end + + fun id_of context ({ libname, ... } : libspec) = + V.id_of context libname + end (* Simple Standard ML JSON parser @@ -1369,6 +1393,9 @@ fun update context (spec as { vcs, ... } : libspec) = (fn HG => H.update | GIT => G.update) vcs context spec + + fun id_of context (spec as { vcs, ... } : libspec) = + (fn HG => H.id_of | GIT => G.id_of) vcs context spec end val libobjname = "libraries" @@ -1383,10 +1410,14 @@ val repo = retrieve ["repository"] val url = retrieve ["url"] val branch = retrieve ["branch"] - val user_pin = retrieve ["pin"] + val project_pin = case retrieve ["pin"] of + NONE => UNPINNED + | SOME p => PINNED p val lock_pin = case lookup_optional lock_json [libobjname, libname] of - SOME ll => lookup_optional_string ll ["pin"] - | NONE => NONE + NONE => UNPINNED + | SOME ll => case lookup_optional_string ll ["pin"] of + SOME p => PINNED p + | NONE => UNPINNED in { libname = libname, @@ -1401,12 +1432,8 @@ SERVICE_SOURCE { service = ss, owner = owner, repo = repo } | _ => raise Fail ("Must have exactly one of service " ^ "or url string"), - pin = case lock_pin of - SOME p => PINNED p - | NONE => - case user_pin of - SOME p => PINNED p - | NONE => UNPINNED, + project_pin = project_pin, + lock_pin = lock_pin, branch = case branch of SOME b => BRANCH b | NONE => DEFAULT_BRANCH @@ -1502,12 +1529,13 @@ val libname_width = 25 val libstate_width = 11 -val localstate_width = 9 +val localstate_width = 17 val notes_width = 5 val divider = " | " +val clear_line = "\r" ^ pad_to 80 ""; fun print_status_header () = - print ("\r" ^ pad_to 80 "" ^ "\n " ^ + print (clear_line ^ "\n " ^ pad_to libname_width "Library" ^ divider ^ pad_to libstate_width "State" ^ divider ^ pad_to localstate_width "Local" ^ divider ^ @@ -1518,7 +1546,7 @@ hline_to notes_width ^ "\n") fun print_outcome_header () = - print ("\r" ^ pad_to 80 "" ^ "\n " ^ + print (clear_line ^ "\n " ^ pad_to libname_width "Library" ^ divider ^ pad_to libstate_width "Outcome" ^ divider ^ "Notes" ^ "\n " ^ @@ -1537,8 +1565,9 @@ val localstate_str = case status of OK (_, MODIFIED) => "Modified" - | OK (_, UNMODIFIED) => "Clean" - | _ => "" + | OK (_, LOCK_MISMATCHED) => "Differs from Lock" + | OK (_, CLEAN) => "Clean" + | ERROR _ => "" val error_str = case status of ERROR e => e @@ -1612,6 +1641,26 @@ return_code end +fun lock_project ({ context, libs } : project) = + let val outcomes = map (fn lib => + (#libname lib, AnyLibControl.id_of context lib)) + libs + val locks = + List.concat + (map (fn (libname, result) => + case result of + ERROR _ => [] + | OK id => [{ libname = libname, id_or_tag = id }]) + outcomes) + val return_code = return_code_for outcomes + val _ = print clear_line + in + if OS.Process.isSuccess return_code + then save_lock_file (#rootpath context) locks + else (); + return_code + end + fun load_local_project pintype = let val userconfig = load_userconfig () val rootpath = OS.FileSys.getDir () @@ -1630,9 +1679,10 @@ return_code end -fun review () = with_local_project NO_LOCKFILE review_project -fun status () = with_local_project NO_LOCKFILE status_of_project +fun review () = with_local_project USE_LOCKFILE review_project +fun status () = with_local_project USE_LOCKFILE status_of_project fun update () = with_local_project NO_LOCKFILE update_project +fun lock () = with_local_project NO_LOCKFILE lock_project fun install () = with_local_project USE_LOCKFILE update_project fun version () = @@ -1650,6 +1700,7 @@ ^ " review check configured libraries against their providers, and report\n" ^ " install update configured libraries according to project specs and lock file\n" ^ " update update configured libraries and lock file according to project specs\n" + ^ " lock update lock file to match local library status\n" ^ " version print the Vext version number and exit\n\n"); OS.Process.failure) @@ -1660,6 +1711,7 @@ | ["status"] => status () | ["install"] => install () | ["update"] => update () + | ["lock"] => lock () | ["version"] => version () | _ => usage () in