Mercurial > hg > sonic-visualiser
comparison repoint.sml @ 1865:ecc44dd16172
Update Repoint
author | Chris Cannam |
---|---|
date | Tue, 19 Jun 2018 14:58:06 +0100 |
parents | 1b6ffed298a2 |
children | a3951575def3 |
comparison
equal
deleted
inserted
replaced
1864:3c47a2a5e85d | 1865:ecc44dd16172 |
---|---|
36 shall not be used in advertising or otherwise to promote the sale, | 36 shall not be used in advertising or otherwise to promote the sale, |
37 use or other dealings in this Software without prior written | 37 use or other dealings in this Software without prior written |
38 authorization. | 38 authorization. |
39 *) | 39 *) |
40 | 40 |
41 val repoint_version = "1.0" | 41 val repoint_version = "1.1" |
42 | 42 |
43 | 43 |
44 datatype vcs = | 44 datatype vcs = |
45 HG | | 45 HG | |
46 GIT | | 46 GIT | |
134 } | 134 } |
135 | 135 |
136 structure RepointFilenames = struct | 136 structure RepointFilenames = struct |
137 val project_file = "repoint-project.json" | 137 val project_file = "repoint-project.json" |
138 val project_lock_file = "repoint-lock.json" | 138 val project_lock_file = "repoint-lock.json" |
139 val project_completion_file = ".repoint.point" | |
139 val user_config_file = ".repoint.json" | 140 val user_config_file = ".repoint.json" |
140 val archive_dir = ".repoint-archive" | 141 val archive_dir = ".repoint-archive" |
141 end | 142 end |
142 | 143 |
143 signature VCS_CONTROL = sig | 144 signature VCS_CONTROL = sig |
213 val mkpath : string -> unit result | 214 val mkpath : string -> unit result |
214 val rmpath : string -> unit result | 215 val rmpath : string -> unit result |
215 val nonempty_dir_exists : string -> bool | 216 val nonempty_dir_exists : string -> bool |
216 val project_spec_path : string -> string | 217 val project_spec_path : string -> string |
217 val project_lock_path : string -> string | 218 val project_lock_path : string -> string |
219 val project_completion_path : string -> string | |
218 val verbose : unit -> bool | 220 val verbose : unit -> bool |
219 end = struct | 221 end = struct |
220 | 222 |
221 fun verbose () = | 223 fun verbose () = |
222 case OS.Process.getEnv "REPOINT_VERBOSE" of | 224 case OS.Process.getEnv "REPOINT_VERBOSE" of |
269 fun project_spec_path rootpath = | 271 fun project_spec_path rootpath = |
270 project_file_path rootpath (RepointFilenames.project_file) | 272 project_file_path rootpath (RepointFilenames.project_file) |
271 | 273 |
272 fun project_lock_path rootpath = | 274 fun project_lock_path rootpath = |
273 project_file_path rootpath (RepointFilenames.project_lock_file) | 275 project_file_path rootpath (RepointFilenames.project_lock_file) |
276 | |
277 fun project_completion_path rootpath = | |
278 project_file_path rootpath (RepointFilenames.project_completion_file) | |
274 | 279 |
275 fun trim str = | 280 fun trim str = |
276 hd (String.fields (fn x => x = #"\n" orelse x = #"\r") str) | 281 hd (String.fields (fn x => x = #"\n" orelse x = #"\r") str) |
277 | 282 |
278 fun file_url path = | 283 fun file_url path = |
2418 locks)) | 2423 locks)) |
2419 ] | 2424 ] |
2420 in | 2425 in |
2421 JsonBits.save_json_to lock_file lock_json | 2426 JsonBits.save_json_to lock_file lock_json |
2422 end | 2427 end |
2423 | 2428 |
2429 fun checkpoint_completion_file rootpath = | |
2430 let val completion_file = FileBits.project_completion_path rootpath | |
2431 val stream = TextIO.openOut completion_file | |
2432 in | |
2433 TextIO.closeOut stream | |
2434 end | |
2435 | |
2424 fun pad_to n str = | 2436 fun pad_to n str = |
2425 if n <= String.size str then str | 2437 if n <= String.size str then str |
2426 else pad_to n (str ^ " ") | 2438 else pad_to n (str ^ " ") |
2427 | 2439 |
2428 fun hline_to 0 = "" | 2440 fun hline_to 0 = "" |
2584 print_outcome_header print_update_outcome | 2596 print_outcome_header print_update_outcome |
2585 context libs | 2597 context libs |
2586 val _ = if List.exists (fn (_, OK _) => true | _ => false) outcomes | 2598 val _ = if List.exists (fn (_, OK _) => true | _ => false) outcomes |
2587 then lock_project project | 2599 then lock_project project |
2588 else OS.Process.success | 2600 else OS.Process.success |
2601 val return_code = return_code_for outcomes | |
2589 in | 2602 in |
2590 return_code_for outcomes | 2603 if OS.Process.isSuccess return_code |
2604 then checkpoint_completion_file (#rootpath context) | |
2605 else (); | |
2606 return_code | |
2591 end | 2607 end |
2592 | 2608 |
2593 fun load_local_project pintype = | 2609 fun load_local_project pintype = |
2594 let val userconfig = load_userconfig () | 2610 let val userconfig = load_userconfig () |
2595 val rootpath = OS.FileSys.getDir () | 2611 val rootpath = OS.FileSys.getDir () |
2626 (print "\nRepoint "; | 2642 (print "\nRepoint "; |
2627 version (); | 2643 version (); |
2628 print ("\n A simple manager for third-party source code dependencies.\n" | 2644 print ("\n A simple manager for third-party source code dependencies.\n" |
2629 ^ " http://all-day-breakfast.com/repoint/\n\n" | 2645 ^ " http://all-day-breakfast.com/repoint/\n\n" |
2630 ^ "Usage:\n\n" | 2646 ^ "Usage:\n\n" |
2631 ^ " repoint <command>\n\n" | 2647 ^ " repoint <command> [<options>]\n\n" |
2632 ^ "where <command> is one of:\n\n" | 2648 ^ "where <command> is one of:\n\n" |
2633 ^ " status print quick report on local status only, without using network\n" | 2649 ^ " status print quick report on local status only, without using network\n" |
2634 ^ " review check configured libraries against their providers, and report\n" | 2650 ^ " review check configured libraries against their providers, and report\n" |
2635 ^ " install update configured libraries according to project specs and lock file\n" | 2651 ^ " install update configured libraries according to project specs and lock file\n" |
2636 ^ " update update configured libraries and lock file according to project specs\n" | 2652 ^ " update update configured libraries and lock file according to project specs\n" |
2637 ^ " lock rewrite lock file to match local library status\n" | 2653 ^ " lock rewrite lock file to match local library status\n" |
2638 ^ " archive pack up project and all libraries into an archive file:\n" | 2654 ^ " archive pack up project and all libraries into an archive file:\n" |
2639 ^ " invoke as 'repoint archive targetfile.tar.gz --exclude unwanted.txt'\n" | 2655 ^ " invoke as 'repoint archive targetfile.tar.gz --exclude unwanted.txt'\n" |
2640 ^ " version print the Repoint version number and exit\n\n"); | 2656 ^ " version print the Repoint version number and exit\n\n" |
2657 ^ "and <options> may include:\n\n" | |
2658 ^ " --directory <dir>\n" | |
2659 ^ " change to directory <dir> before doing anything; in particular,\n" | |
2660 ^ " expect to find project spec file in that directory\n\n"); | |
2641 OS.Process.failure) | 2661 OS.Process.failure) |
2642 | 2662 |
2643 fun archive target args = | 2663 fun archive target args = |
2644 case args of | 2664 case args of |
2645 [] => | 2665 [] => |
2646 with_local_project USE_LOCKFILE (Archive.archive (target, [])) | 2666 with_local_project USE_LOCKFILE (Archive.archive (target, [])) |
2647 | "--exclude"::xs => | 2667 | "--exclude"::xs => |
2648 with_local_project USE_LOCKFILE (Archive.archive (target, xs)) | 2668 with_local_project USE_LOCKFILE (Archive.archive (target, xs)) |
2649 | _ => usage () | 2669 | _ => usage () |
2650 | 2670 |
2671 fun handleSystemArgs args = | |
2672 let fun handleSystemArgs' leftover args = | |
2673 case args of | |
2674 "--directory"::dir::rest => | |
2675 (OS.FileSys.chDir dir; | |
2676 handleSystemArgs' leftover rest) | |
2677 | arg::rest => | |
2678 handleSystemArgs' (leftover @ [arg]) rest | |
2679 | [] => leftover | |
2680 in | |
2681 OK (handleSystemArgs' [] args) | |
2682 handle e => ERROR (exnMessage e) | |
2683 end | |
2684 | |
2651 fun repoint args = | 2685 fun repoint args = |
2652 let val return_code = | 2686 case handleSystemArgs args of |
2687 ERROR e => (print ("Error: " ^ e ^ "\n"); | |
2688 OS.Process.exit OS.Process.failure) | |
2689 | OK args => | |
2690 let val return_code = | |
2653 case args of | 2691 case args of |
2654 ["review"] => review () | 2692 ["review"] => review () |
2655 | ["status"] => status () | 2693 | ["status"] => status () |
2656 | ["install"] => install () | 2694 | ["install"] => install () |
2657 | ["update"] => update () | 2695 | ["update"] => update () |
2659 | ["version"] => version () | 2697 | ["version"] => version () |
2660 | "archive"::target::args => archive target args | 2698 | "archive"::target::args => archive target args |
2661 | arg::_ => (print ("Error: unknown argument \"" ^ arg ^ "\"\n"); | 2699 | arg::_ => (print ("Error: unknown argument \"" ^ arg ^ "\"\n"); |
2662 usage ()) | 2700 usage ()) |
2663 | _ => usage () | 2701 | _ => usage () |
2664 in | 2702 in |
2665 OS.Process.exit return_code; | 2703 OS.Process.exit return_code |
2666 () | 2704 end |
2667 end | |
2668 | 2705 |
2669 fun main () = | 2706 fun main () = |
2670 repoint (CommandLine.arguments ()) | 2707 repoint (CommandLine.arguments ()) |