Mercurial > hg > sonic-visualiser
changeset 1723:b97b2b7af50c vext
Update Vext
author | Chris Cannam |
---|---|
date | Thu, 29 Jun 2017 11:23:15 +0100 (2017-06-29) |
parents | fd23206b0d9a |
children | e4352ff029cf |
files | vext.sml |
diffstat | 1 files changed, 31 insertions(+), 26 deletions(-) [+] |
line wrap: on
line diff
--- a/vext.sml Wed Jun 28 13:23:17 2017 +0100 +++ b/vext.sml Thu Jun 29 11:23:15 2017 +0100 @@ -33,7 +33,7 @@ Software without prior written authorization. *) -val vext_version = "0.9.2" +val vext_version = "0.9.3" datatype vcs = @@ -1206,15 +1206,15 @@ fun update_to context (libname, "") = ERROR "Non-empty id (tag or revision id) required for update_to" | update_to context (libname, id) = - case hg_command context libname ["update", "-r" ^ id] of - OK () => id_of context libname - | ERROR _ => - case pull context libname of - ERROR e => ERROR e - | _ => - case hg_command context libname ["update", "-r" ^ id] of - ERROR e => ERROR e - | _ => id_of context libname + let val pull_result = pull context libname + in + case hg_command context libname ["update", "-r", id] of + OK _ => id_of context libname + | ERROR e => + case pull_result of + ERROR e' => ERROR e' (* this was the ur-error *) + | _ => ERROR e + end end @@ -1270,11 +1270,11 @@ then OK true else case git_command_output context libname - ["rev-list", "-1", id_or_tag] of - ERROR e => OK false (* id_or_tag is not an id or tag, but - that could just mean it hasn't been - fetched *) - | OK tid => OK (tid = id) + ["show-ref", + "refs/tags/" ^ id_or_tag] of + OK "" => OK false + | ERROR _ => OK false + | OK s => OK (id = hd (String.tokens (fn c => c = #" ") s)) fun branch_tip context (libname, branch) = git_command_output context libname @@ -1332,21 +1332,26 @@ | _ => id_of context libname (* This function is dealing with a specific id or tag, so if we - can successfully check it out (detached) then that's all we need - to do. Otherwise we need to fetch and try again *) + can successfully check it out (detached) then that's all we + need to do, regardless of whether fetch succeeded or not. We do + attempt the fetch first, though, purely in order to avoid ugly + error messages in the common case where we're being asked to + update to a new pin (from the lock file) that hasn't been + fetched yet. *) fun update_to context (libname, "") = ERROR "Non-empty id (tag or revision id) required for update_to" | update_to context (libname, id) = - case git_command context libname ["checkout", "--detach", id] of - OK () => id_of context libname - | ERROR _ => - case git_command context libname ["fetch"] of - ERROR e => ERROR e - | _ => - case git_command context libname ["checkout", "--detach", id] of - ERROR e => ERROR e - | _ => id_of context libname + let val fetch_result = git_command context libname ["fetch"] + in + case git_command context libname ["checkout", "--detach", id] of + OK _ => id_of context libname + | ERROR e => + case fetch_result of + ERROR e' => ERROR e' (* this was the ur-error *) + | _ => ERROR e + end + end structure AnyLibControl :> LIB_CONTROL = struct