Mercurial > hg > sonic-visualiser
comparison vext.sml @ 1724:e4352ff029cf vext
Update vext
author | Chris Cannam |
---|---|
date | Thu, 29 Jun 2017 14:16:19 +0100 |
parents | b97b2b7af50c |
children | 76872ffc03a3 |
comparison
equal
deleted
inserted
replaced
1723:b97b2b7af50c | 1724:e4352ff029cf |
---|---|
31 Particular Programs Ltd shall not be used in advertising or | 31 Particular Programs Ltd shall not be used in advertising or |
32 otherwise to promote the sale, use or other dealings in this | 32 otherwise to promote the sale, use or other dealings in this |
33 Software without prior written authorization. | 33 Software without prior written authorization. |
34 *) | 34 *) |
35 | 35 |
36 val vext_version = "0.9.3" | 36 val vext_version = "0.9.4" |
37 | 37 |
38 | 38 |
39 datatype vcs = | 39 datatype vcs = |
40 HG | | 40 HG | |
41 GIT | 41 GIT |
943 val known_providers : provider list = | 943 val known_providers : provider list = |
944 [ { | 944 [ { |
945 service = "bitbucket", | 945 service = "bitbucket", |
946 supports = [HG, GIT], | 946 supports = [HG, GIT], |
947 remote_spec = { | 947 remote_spec = { |
948 anon = SOME "https://bitbucket.org/{owner}/{repo}", | 948 anon = SOME "https://bitbucket.org/{owner}/{repository}", |
949 auth = SOME "ssh://{vcs}@bitbucket.org/{owner}/{repo}" | 949 auth = SOME "ssh://{vcs}@bitbucket.org/{owner}/{repository}" |
950 } | 950 } |
951 }, | 951 }, |
952 { | 952 { |
953 service = "github", | 953 service = "github", |
954 supports = [GIT], | 954 supports = [GIT], |
955 remote_spec = { | 955 remote_spec = { |
956 anon = SOME "https://github.com/{owner}/{repo}", | 956 anon = SOME "https://github.com/{owner}/{repository}", |
957 auth = SOME "ssh://{vcs}@github.com/{owner}/{repo}" | 957 auth = SOME "ssh://{vcs}@github.com/{owner}/{repository}" |
958 } | 958 } |
959 } | 959 } |
960 ] | 960 ] |
961 | 961 |
962 fun vcs_name vcs = | 962 fun vcs_name vcs = |
979 map (fn (Json.STRING v) => vcs_from_name v | 979 map (fn (Json.STRING v) => vcs_from_name v |
980 | _ => raise Fail "Strings expected in vcs array") | 980 | _ => raise Fail "Strings expected in vcs array") |
981 vv | 981 vv |
982 | _ => raise Fail "Array expected for vcs", | 982 | _ => raise Fail "Array expected for vcs", |
983 remote_spec = { | 983 remote_spec = { |
984 anon = lookup_optional_string pjson ["anon"], | 984 anon = lookup_optional_string pjson ["anonymous"], |
985 auth = lookup_optional_string pjson ["auth"] | 985 auth = lookup_optional_string pjson ["authenticated"] |
986 } | 986 } |
987 } | 987 } |
988 val loaded = | 988 val loaded = |
989 case lookup_optional json ["services"] of | 989 case lookup_optional json ["services"] of |
990 NONE => [] | 990 NONE => [] |
1011 | "owner" => | 1011 | "owner" => |
1012 (case owner of | 1012 (case owner of |
1013 SOME ostr => ostr | 1013 SOME ostr => ostr |
1014 | NONE => raise Fail ("Owner not specified for service " ^ | 1014 | NONE => raise Fail ("Owner not specified for service " ^ |
1015 service)) | 1015 service)) |
1016 | "repo" => repo | 1016 | "repository" => repo |
1017 | "account" => | 1017 | "account" => |
1018 (case login of | 1018 (case login of |
1019 SOME acc => acc | 1019 SOME acc => acc |
1020 | NONE => raise Fail ("Account not given for service " ^ | 1020 | NONE => raise Fail ("Account not given for service " ^ |
1021 service)) | 1021 service)) |
1057 else | 1057 else |
1058 case (login, #auth remote_spec, #anon remote_spec) of | 1058 case (login, #auth remote_spec, #anon remote_spec) of |
1059 (SOME _, SOME auth, _) => expand_spec auth req login | 1059 (SOME _, SOME auth, _) => expand_spec auth req login |
1060 | (SOME _, _, SOME anon) => expand_spec anon req NONE | 1060 | (SOME _, _, SOME anon) => expand_spec anon req NONE |
1061 | (NONE, _, SOME anon) => expand_spec anon req NONE | 1061 | (NONE, _, SOME anon) => expand_spec anon req NONE |
1062 | _ => raise Fail ("No suitable anon/auth URL spec " ^ | 1062 | _ => raise Fail ("No suitable anonymous or authenticated " ^ |
1063 "provided for service \"" ^ service ^ "\"") | 1063 "URL spec provided for service \"" ^ |
1064 service ^ "\"") | |
1064 | 1065 |
1065 fun login_for ({ accounts, ... } : context) service = | 1066 fun login_for ({ accounts, ... } : context) service = |
1066 case List.find (fn a => service = #service a) accounts of | 1067 case List.find (fn a => service = #service a) accounts of |
1067 SOME { login, ... } => SOME login | 1068 SOME { login, ... } => SOME login |
1068 | NONE => NONE | 1069 | NONE => NONE |
1367 | 1368 |
1368 fun update context (spec as { vcs, ... } : libspec) = | 1369 fun update context (spec as { vcs, ... } : libspec) = |
1369 (fn HG => H.update | GIT => G.update) vcs context spec | 1370 (fn HG => H.update | GIT => G.update) vcs context spec |
1370 end | 1371 end |
1371 | 1372 |
1373 val libobjname = "libraries" | |
1374 | |
1372 fun load_libspec spec_json lock_json libname : libspec = | 1375 fun load_libspec spec_json lock_json libname : libspec = |
1373 let open JsonBits | 1376 let open JsonBits |
1374 val libobj = lookup_mandatory spec_json ["libs", libname] | 1377 val libobj = lookup_mandatory spec_json [libobjname, libname] |
1375 val vcs = lookup_mandatory_string libobj ["vcs"] | 1378 val vcs = lookup_mandatory_string libobj ["vcs"] |
1376 val retrieve = lookup_optional_string libobj | 1379 val retrieve = lookup_optional_string libobj |
1377 val service = retrieve ["service"] | 1380 val service = retrieve ["service"] |
1378 val owner = retrieve ["owner"] | 1381 val owner = retrieve ["owner"] |
1379 val repo = retrieve ["repository"] | 1382 val repo = retrieve ["repository"] |
1380 val url = retrieve ["url"] | 1383 val url = retrieve ["url"] |
1381 val branch = retrieve ["branch"] | 1384 val branch = retrieve ["branch"] |
1382 val user_pin = retrieve ["pin"] | 1385 val user_pin = retrieve ["pin"] |
1383 val lock_pin = case lookup_optional lock_json ["libs", libname] of | 1386 val lock_pin = case lookup_optional lock_json [libobjname, libname] of |
1384 SOME ll => lookup_optional_string ll ["pin"] | 1387 SOME ll => lookup_optional_string ll ["pin"] |
1385 | NONE => NONE | 1388 | NONE => NONE |
1386 in | 1389 in |
1387 { | 1390 { |
1388 libname = libname, | 1391 libname = libname, |
1448 then JsonBits.load_json_from lock_file | 1451 then JsonBits.load_json_from lock_file |
1449 handle IO.Io _ => Json.OBJECT [] | 1452 handle IO.Io _ => Json.OBJECT [] |
1450 else Json.OBJECT [] | 1453 else Json.OBJECT [] |
1451 val extdir = JsonBits.lookup_mandatory_string spec_json | 1454 val extdir = JsonBits.lookup_mandatory_string spec_json |
1452 ["config", "extdir"] | 1455 ["config", "extdir"] |
1453 val spec_libs = JsonBits.lookup_optional spec_json ["libs"] | 1456 val spec_libs = JsonBits.lookup_optional spec_json [libobjname] |
1454 val lock_libs = JsonBits.lookup_optional lock_json ["libs"] | 1457 val lock_libs = JsonBits.lookup_optional lock_json [libobjname] |
1455 val providers = Provider.load_more_providers | 1458 val providers = Provider.load_more_providers |
1456 (#providers userconfig) spec_json | 1459 (#providers userconfig) spec_json |
1457 val libnames = case spec_libs of | 1460 val libnames = case spec_libs of |
1458 NONE => [] | 1461 NONE => [] |
1459 | SOME (Json.OBJECT ll) => map (fn (k, v) => k) ll | 1462 | SOME (Json.OBJECT ll) => map (fn (k, v) => k) ll |
1473 fun save_lock_file rootpath locks = | 1476 fun save_lock_file rootpath locks = |
1474 let val lock_file = FileBits.project_lock_path rootpath | 1477 let val lock_file = FileBits.project_lock_path rootpath |
1475 open Json | 1478 open Json |
1476 val lock_json = | 1479 val lock_json = |
1477 OBJECT [ | 1480 OBJECT [ |
1478 ("libs", OBJECT | 1481 (libobjname, |
1479 (map (fn { libname, id_or_tag } => | 1482 OBJECT (map (fn { libname, id_or_tag } => |
1480 (libname, | 1483 (libname, |
1481 OBJECT [ ("pin", STRING id_or_tag) ])) | 1484 OBJECT [ ("pin", STRING id_or_tag) ])) |
1482 locks)) | 1485 locks)) |
1483 ] | 1486 ] |
1484 in | 1487 in |
1485 JsonBits.save_json_to lock_file lock_json | 1488 JsonBits.save_json_to lock_file lock_json |
1486 end | 1489 end |
1487 | 1490 |