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