Mercurial > hg > sonic-annotator
diff vext.sml @ 314:d741e2c90eab
Update Vext and subrepos
author | Chris Cannam |
---|---|
date | Thu, 13 Jul 2017 17:10:13 +0100 |
parents | 523f8f1789b4 |
children | 9ebb9ac79bdf |
line wrap: on
line diff
--- 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