diff --git a/lib/aws.mli b/lib/aws.mli index e618e5a36..ed79709aa 100644 --- a/lib/aws.mli +++ b/lib/aws.mli @@ -285,6 +285,10 @@ module Util : sig val option_all : 'a option list -> 'a list option (** If all values in list are Some v, produce Some (list_filter_opt list), else produce None. *) + + val string_starts_with : string -> string -> bool + (** Judges whether s starts with prefix. + It is ported from stdlib in OCaml 4.13. *) end (** This module contains the V2 and V4 Authorization header AWS signature algorithm. *) diff --git a/lib/endpoints.ml b/lib/endpoints.ml index b28c0d4d9..3ba3117b3 100644 --- a/lib/endpoints.ml +++ b/lib/endpoints.ml @@ -2049,5 +2049,7 @@ let endpoint_of svc_name region = | _ -> None let url_of svc_name region = match endpoint_of svc_name region with - | Some var -> Some ("https://" ^ var) - | None -> None \ No newline at end of file + | Some var when Util.string_starts_with "localhost" var -> + Some "http://localhost:8000" + | Some var -> Some (String.concat "" ["https://"; var]) + | None -> None diff --git a/lib/util.ml b/lib/util.ml index c45a805f0..5131282c2 100644 --- a/lib/util.ml +++ b/lib/util.ml @@ -37,3 +37,15 @@ let rec option_all = function | [] -> Some [] | Some v :: xs -> option_bind (option_all xs) (fun rest -> Some (v :: rest)) | None :: _ -> None + +let string_starts_with prefix s = + let open String in + let len_s = length s and len_pre = length prefix in + let rec aux i = + if i = len_pre + then true + else if unsafe_get s i <> unsafe_get prefix i + then false + else aux (i + 1) + in + len_s >= len_pre && aux 0 diff --git a/src/endpoint_gen.ml b/src/endpoint_gen.ml index ee688f833..8a575b230 100644 --- a/src/endpoint_gen.ml +++ b/src/endpoint_gen.ml @@ -54,10 +54,26 @@ let write_url_of = (fun2 "svc_name" "region" - (matchoption + (match_ (app2 "endpoint_of" (ident "svc_name") (ident "region")) - (app1 "Some" (app2 "^" (str "https://") (ident "var"))) - (ident "None")))) + [ (let some_v = "var" in + casearm + (lid "Some") + (Some (pvar some_v)) + ~guard:(app2 "Util.string_starts_with" (str "localhost") (ident some_v)) + (app1 "Some" (str "http://localhost:8000"))) + ; (let some_v = "var" in + casearm + (lid "Some") + (Some (pvar some_v)) + (app1 + "Some" + (app2 + "String.concat" + (str "") + (list [ ident some_v; str "https://" ])))) + ; casearm (lid "None") None (ident "None") + ]))) let main input outdir = log "Start processing endpoints"; diff --git a/src/syntax.ml b/src/syntax.ml index 49aa629b7..1b20130c2 100644 --- a/src/syntax.ml +++ b/src/syntax.ml @@ -258,6 +258,12 @@ let withty _nm0 nm1 = (* if cond then thn else els *) let ifthen cond thn els = Exp.ifthenelse cond thn (Some els) +let match_ = Exp.match_ + +let casearm ?guard lid pat body = Exp.case (Pat.construct lid pat) ?guard body + +let pvar v = Pat.var (strloc v) + (* match exp with | Constructor -> body | Constructor -> body ... *) let matchvar exp branches = Exp.match_ @@ -266,14 +272,14 @@ let matchvar exp branches = (* match exp with | "String" -> body ... | _ -> els ... *) let matchstrs exp branches els = - Exp.match_ + match_ exp (List.map (fun (nm, body) -> Exp.case (Pat.constant (Const.string nm)) body) branches @ [ Exp.case (Pat.any ()) els ]) (* match exp with | Some var -> some_body | None -> none_body *) let matchoption exp some_body none_body = - Exp.match_ + match_ exp [ Exp.case (construct (lid "Some") (Some (Pat.var (strloc "var")))) some_body ; Exp.case (construct (lid "None") None) none_body