comparison vext.sml @ 1758:42d57c382e56

Update Vext

     (** Check out, i.e. clone a fresh copy of, the repo for the given
         library on the given branch *)
     val checkout : context -> libname * source * branch -> unit result
 
     (** Update the library to the given branch tip. Assumes that a
-        local copy of the library already exists. Return the new id *)
-    val update : context -> libname * source * branch -> id_or_tag result
+        local copy of the library already exists *)
+    val update : context -> libname * source * branch -> unit result
 
     (** Update the library to the given specific id or tag *)
-    val update_to : context -> libname * source * id_or_tag -> id_or_tag result
+    val update_to : context -> libname * source * id_or_tag -> unit result
 
     (** Return a URL from which the library can be cloned, given that
         the local copy already exists. For a DVCS this can be the
         local copy, but for a centralised VCS it will have to be the
         remote repository URL. Used for archiving *)

 end
 
 signature LIB_CONTROL = sig
     val review : context -> libspec -> (libstate * localstate) result
     val status : context -> libspec -> (libstate * localstate) result
-    val update : context -> libspec -> id_or_tag result
+    val update : context -> libspec -> unit result
     val id_of : context -> libspec -> id_or_tag result
 end
 
 structure FileBits :> sig
     val extpath : context -> string

                ({ libname, source, branch,
                   project_pin, lock_pin, ... } : libspec) =
         let fun update_unpinned () =
                 case V.is_newest context (libname, source, branch) of
                     ERROR e => ERROR e
-                  | OK true => V.id_of context libname
+                  | OK true => OK ()
                   | OK false => V.update context (libname, source, branch)
             fun update_pinned target =
                 case V.is_at context (libname, target) of
                     ERROR e => ERROR e
-                  | OK true => OK target
+                  | OK true => OK ()
                   | OK false => V.update_to context (libname, source, target)
             fun update' () =
                 case lock_pin of
                     PINNED target => update_pinned target
                   | UNPINNED =>

             case hg_command context libname ["update", branch_name branch] of
                 ERROR e => ERROR e
               | _ =>
                 case pull_result of
                     ERROR e => ERROR e
-                  | _ => id_of context libname
+                  | _ => OK ()
         end
 
     fun update_to context (libname, _, "") =
         ERROR "Non-empty id (tag or revision id) required for update_to"
       | update_to context (libname, source, id) = 
         let val pull_result = pull context (libname, source)
         in
             case hg_command context libname ["update", "-r", id] of
-                OK _ => id_of context libname
+                OK _ => OK ()
               | ERROR e =>
                 case pull_result of
                     ERROR e' => ERROR e' (* this was the ur-error *)
                   | _ => ERROR e
         end

             ERROR e => ERROR e
           | _ =>
             case git_command context libname ["checkout", "--detach",
                                               remote_branch_name branch] of
                 ERROR e => ERROR e
-              | _ => id_of context libname
+              | _ => OK ()
 
     (* 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, regardless of whether fetch succeeded or not. We do
        attempt the fetch first, though, purely in order to avoid ugly

         ERROR "Non-empty id (tag or revision id) required for update_to"
       | update_to context (libname, source, id) =
         let val fetch_result = fetch context (libname, source)
         in
             case git_command context libname ["checkout", "--detach", id] of
-                OK _ => id_of context libname
+                OK _ => OK ()
               | ERROR e =>
                 case fetch_result of
                     ERROR e' => ERROR e' (* this was the ur-error *)
                   | _ => ERROR e
         end

                                                     
     fun update context (libname, source, branch) =
         case svn_command context libname
                          ["update", "--accept", "postpone"] of
             ERROR e => ERROR e
-          | _ => id_of context libname
+          | _ => OK ()
 
     fun update_to context (libname, _, "") =
         ERROR "Non-empty id (tag or revision id) required for update_to"
       | update_to context (libname, source, id) = 
         case svn_command context libname
                          ["update", "-r", id, "--accept", "postpone"] of
             ERROR e => ERROR e
-          | OK _ => id_of context libname
+          | OK _ => OK ()
 
     fun copy_url_for context libname =
         svn_info_item context libname "URL"
 
 end

             }
         in
             foldl (fn (lib, acc) =>
                       case acc of
                           ERROR e => ERROR e
-                        | OK _ => AnyLibControl.update synthetic_context lib)
-                  (OK "")
+                        | OK () => AnyLibControl.update synthetic_context lib)
+                  (OK ())
                   (#libs project)
         end
 
     datatype packer = TAR
                     | TAR_GZ