Commit 767d47ea authored by Pietro Abate's avatar Pietro Abate
Browse files

[r2003-11-29 11:31:26 by szach] added string_of_time_type

Original author: szach
Date: 2003-11-29 11:31:26+00:00
parent 426aac0d
...@@ -81,7 +81,7 @@ let time_type_fields = [ hour_field; minute_field; second_field ] ...@@ -81,7 +81,7 @@ let time_type_fields = [ hour_field; minute_field; second_field ]
let date_type_fields = [ year_field; month_field; day_field ] let date_type_fields = [ year_field; month_field; day_field ]
let time_kind_field = false, qualify "time_kind", Builtin_defs.time_kind let time_kind_field = false, qualify "time_kind", Builtin_defs.time_kind
let time_kind kind = (qualify "time_kind", Value.string_latin1 kind) let time_kind kind = (qualify "time_kind", Value.Atom (Atoms.V.mk_ascii kind))
(* TODO the constraint that at least one part should be present isn't easily (* TODO the constraint that at least one part should be present isn't easily
expressible with CDuce types *) expressible with CDuce types *)
...@@ -541,6 +541,156 @@ let fill () = (* fill "builtins" hashtbl *) ...@@ -541,6 +541,156 @@ let fill () = (* fill "builtins" hashtbl *)
let _ = try fill () with Not_found -> assert false let _ = try fill () with Not_found -> assert false
(** {2 Printing} *)
open Big_int
type kind =
Duration | DateTime | Time | Date | GYearMonth | GYear | GMonthDay | GDay |
GMonth
type timezone = bool * Intervals.V.t * Intervals.V.t
(* positive, hour, minute *)
type time_value = {
kind: kind option; positive: bool option; year: Intervals.V.t option;
month: Intervals.V.t option; day: Intervals.V.t option;
hour: Intervals.V.t option; minute: Intervals.V.t option;
second: Intervals.V.t option; timezone: timezone option
}
let null_value = {
kind = None; positive = None; year = None; month = None; day = None;
hour = None; minute = None; second = None; timezone = None
}
let string_of_time_type fields =
let fail () = raise (Schema_builtin_error (Utf8.mk "")) in
let parse_int = function Value.Integer i -> i | _ -> fail () in
let parse_timezone v =
let fields =
try
Value.get_fields v
with Invalid_argument _ -> fail ()
in
let (positive, hour, minute) = (ref true, ref zero, ref zero) in
List.iter
(fun ((ns, name), value) ->
if ns <> Ns.empty then fail ();
(match Utf8.get_str name with
| "positive" -> positive := (Value.equal value Value.vtrue)
| "hour" -> hour := parse_int value
| "minute" -> minute := parse_int value
| _ -> fail ()))
fields;
!positive, !hour, !minute
in
let parse_time_kind = function
| Value.Atom a ->
(match Utf8.get_str (snd (Atoms.V.value a)) with
| "duration" -> Duration | "dateTime" -> DateTime | "time" -> Time
| "date" -> Date | "gYearMonth" -> GYearMonth | "gYear" -> GYear
| "gMonthDay" -> GMonthDay | "gDay" -> GDay | "gMonth" -> GMonth
| _ -> fail ())
| _ -> fail ()
in
let parse_positive = function
| v when Value.equal v Value.vfalse -> false
| _ -> true
in
let string_of_positive v =
match v.positive with Some false -> "-" | _ -> ""
in
let string_of_year v =
match v.year with None -> fail () | Some i -> Intervals.V.to_string i
in
let string_of_month v =
match v.month with None -> fail () | Some i -> Intervals.V.to_string i
in
let string_of_day v =
match v.day with None -> fail () | Some i -> Intervals.V.to_string i
in
let string_of_hour v =
match v.hour with None -> fail () | Some i -> Intervals.V.to_string i
in
let string_of_minute v =
match v.minute with None -> fail () | Some i -> Intervals.V.to_string i
in
let string_of_second v =
match v.second with None -> fail () | Some i -> Intervals.V.to_string i
in
let string_of_date v =
sprintf "%s-%s-%s" (string_of_year v) (string_of_month v) (string_of_day v)
in
let string_of_timezone v =
match v.timezone with
| Some (positive, hour, minute) ->
sprintf "Z%s%s:%s" (if not positive then "-" else "")
(Intervals.V.to_string hour) (Intervals.V.to_string minute)
| None -> ""
in
let string_of_time v =
sprintf "%s:%s:%s" (string_of_hour v) (string_of_minute v)
(string_of_second v)
in
let v =
List.fold_left
(fun acc ((ns, name), value) ->
if ns <> Ns.empty then fail ();
(match Utf8.get_str name with
| "year" -> { acc with year = Some (parse_int value) }
| "month" -> { acc with month = Some (parse_int value) }
| "day" -> { acc with day = Some (parse_int value) }
| "hour" -> { acc with hour = Some (parse_int value) }
| "minute" -> { acc with minute = Some (parse_int value) }
| "second" -> { acc with second = Some (parse_int value) }
| "timezone" -> { acc with timezone = Some (parse_timezone value) }
| "time_kind" -> { acc with kind = Some (parse_time_kind value) }
| "positive" -> { acc with positive = Some (parse_positive value) }
| s -> assert false))
null_value fields
in
let s =
match v.kind with
| None -> fail ()
| Some Duration ->
sprintf "%sP%s%s%s%s"
(string_of_positive v)
(match v.year with Some v -> Intervals.V.to_string v ^ "Y" | _ -> "")
(match v.month with Some v -> Intervals.V.to_string v ^ "M" | _ -> "")
(match v.day with Some v -> Intervals.V.to_string v ^ "D" | _ -> "")
(if v.hour = None && v.minute = None && v.second = None then
""
else
"T" ^
(match v.hour with Some v -> Intervals.V.to_string v ^ "H" | _ ->
"") ^
(match v.minute with Some v -> Intervals.V.to_string v ^ "M" | _ ->
"") ^
(match v.second with Some v -> Intervals.V.to_string v ^ "S" | _ ->
""))
| Some DateTime ->
sprintf "%s%sT%s%s" (string_of_positive v) (string_of_date v)
(string_of_time v) (string_of_timezone v)
| Some Time ->
sprintf "%s%s%s" (string_of_positive v) (string_of_time v)
(string_of_timezone v)
| Some Date ->
sprintf "%s%s%s" (string_of_positive v) (string_of_date v)
(string_of_timezone v)
| Some GYearMonth ->
sprintf "%s%s-%s%s" (string_of_positive v) (string_of_year v)
(string_of_month v) (string_of_timezone v)
| Some GYear ->
sprintf "%s%s%s" (string_of_positive v) (string_of_year v)
(string_of_timezone v)
| Some GMonthDay ->
sprintf "--%s%s%s" (string_of_month v) (string_of_day v)
(string_of_timezone v)
| Some GDay ->
sprintf "---%s%s" (string_of_day v) (string_of_timezone v)
| Some GMonth ->
sprintf "--%s--%s" (string_of_month v) (string_of_timezone v)
in
Utf8.mk s
(** {2 API} *) (** {2 API} *)
let is_builtin = Hashtbl.mem builtins let is_builtin = Hashtbl.mem builtins
......
...@@ -20,3 +20,5 @@ val cd_type_of_builtin: Utf8.t -> Types.descr ...@@ -20,3 +20,5 @@ val cd_type_of_builtin: Utf8.t -> Types.descr
* Schema_xml.xsd_prefix *) * Schema_xml.xsd_prefix *)
val validate_builtin: Utf8.t -> Utf8.t -> Value.t val validate_builtin: Utf8.t -> Utf8.t -> Value.t
val string_of_time_type: (Ns.qname * Value.t) list -> Utf8.t
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment