[r2003-11-20 11:36:12 by szach] - major cleanup of schema import code

- schema validation still commented out

Original author: szach
Date: 2003-11-20 11:36:13+00:00

schema/schema_builtin.ml

@@ -9,6 +9,18 @@ open Schema_common
 
   (** {2 Aux/Misc stuff} *)
 
+let zero = Intervals.V.zero
+let one = (Intervals.V.succ Intervals.V.zero)
+let minus_one = (Intervals.V.pred Intervals.V.zero)
+let long_l = (Intervals.V.mk "-9223372036854775808")
+let long_r = (Intervals.V.mk "9223372036854775807")
+let int_l = (Intervals.V.mk "-2147483648")
+let int_r = (Intervals.V.mk "2147483647")
+let short_l = (Intervals.V.mk "-32768")
+let short_r = (Intervals.V.mk "32767")
+let byte_l = (Intervals.V.mk "-128")
+let byte_r = (Intervals.V.mk "127")
+
 let regexp' s = Pcre.regexp ~flags:[`UTF8] s
 let xml_S_RE = regexp' "[ \\t\\r\\n]+"
   (* split a string at XML recommendation "S" production boundaries *)
@@ -28,8 +40,9 @@ let char_of_hex =
 let strip_parens s = Pcre.replace ~pat:"[()]" s
 let add_limits s = "^" ^ s ^ "$"
 
-let simple_type_error ~typ ~value =
-  raise (XSI_validation_error (sprintf "'%s' isn't a valid xsd:%s" value typ))
+exception Schema_builtin_error of string
+let simple_type_error name =
+  raise (Schema_builtin_error (Schema_xml.xsd_prefix ^ name))
 
   (* regular expressions used to validate built-in types *)
 
@@ -89,6 +102,10 @@ let nonPositiveInteger_type = Builtin_defs.non_pos_int
 let negativeInteger_type = Builtin_defs.neg_int
 let nonNegativeInteger_type = Builtin_defs.non_neg_int
 let positiveInteger_type = Builtin_defs.pos_int
+let long_type = Builtin_defs.long_int
+let int_type = Builtin_defs.int_int
+let short_type = Builtin_defs.short_int
+let byte_type = Builtin_defs.byte_int
 
 let string_list_type = Sequence.star Builtin_defs.string
 
@@ -99,12 +116,15 @@ let parse_sign = function "+" | "" -> Value.vtrue | _ -> Value.vfalse
 let validate_integer s =
   try
     Value.Integer (Intervals.V.mk s)
-  with Failure _ -> simple_type_error ~typ:"integer" ~value:s
+  with Failure _ -> simple_type_error "integer"
+
+let strip_decimal_RE = Pcre.regexp "\\..*$"
+let validate_decimal s = validate_integer (Pcre.replace ~rex:strip_decimal_RE s)
 
 let parse_date =
   let rex = Pcre.regexp (add_limits date_RE_raw) in
   fun s ->
-  let abort () = simple_type_error ~typ:"date" ~value:s in
+  let abort () = simple_type_error "date" in
   let subs = try Pcre.extract ~rex s with Not_found -> abort () in
   [ "year", validate_integer subs.(1);
   "month", validate_integer subs.(2);
@@ -113,7 +133,7 @@ let parse_date =
 let parse_time =
   let rex = Pcre.regexp (add_limits time_RE_raw) in
   fun s ->
-  let abort () = simple_type_error ~typ:"time" ~value:s in
+  let abort () = simple_type_error "time" in
   let subs = try Pcre.extract ~rex s with Not_found -> abort () in
   [ "hour", validate_integer subs.(1);
   "minute", validate_integer subs.(2);
@@ -122,9 +142,7 @@ let parse_time =
 let parse_timezone =
   let rex = Pcre.regexp (add_limits timezone_RE_raw) in
   fun s ->
-  let abort () =
-    raise (XSI_validation_error (sprintf "'%s' isn't a valid timezone" s))
-  in
+  let abort () = raise (Schema_builtin_error "timezone") in
   let subs = try Pcre.extract ~rex s with Not_found -> abort () in
   match subs.(1) with
   | "Z" ->
@@ -155,12 +173,12 @@ let validate_interval interval type_name s =
   let integer =
     try
       Intervals.V.mk s
-    with Failure _ -> simple_type_error ~typ:type_name ~value:s
+    with Failure _ -> simple_type_error type_name
   in
   if Intervals.contains integer interval then
     Value.Integer integer
   else
-    simple_type_error ~typ:type_name ~value:s
+    simple_type_error type_name
 let validate_nonPositiveInteger =
   validate_interval (Intervals.left Intervals.V.zero) "nonPositiveInteger"
 let validate_negativeInteger =
@@ -169,18 +187,23 @@ let validate_nonNegativeInteger =
   validate_interval (Intervals.right Intervals.V.zero) "nonNegativeInteger"
 let validate_positiveInteger =
   validate_interval (Intervals.right Intervals.V.one) "positiveInteger"
+let validate_long = validate_interval (Intervals.bounded long_l long_r) "long"
+let validate_int = validate_interval (Intervals.bounded int_l int_r) "int"
+let validate_short =
+  validate_interval (Intervals.bounded short_l short_r) "short"
+let validate_byte = validate_interval (Intervals.bounded byte_l byte_r) "byte"
 
 let validate_bool = function
   | "true" | "1" -> Value.vtrue
   | "false" | "0" -> Value.vfalse
-  | v -> simple_type_error ~typ:"boolean" ~value:v
+  | v -> simple_type_error "boolean"
 
 let validate_duration =
   let rex = Pcre.regexp
   "^([+-])?P((\\d+)Y)?((\\d+)M)?((\\d+)D)?(T((\\d+)H)?((\\d+)M)?((\\d+)S)?)?$"
   in
   fun s ->
-  let abort () = simple_type_error ~typ:"duration" ~value:s in
+  let abort () = simple_type_error "duration" in
   let subs = try Pcre.extract ~rex s with Not_found -> abort () in
   try
     let fields =
@@ -193,7 +216,7 @@ let validate_duration =
       (match subs.(14) with "" -> [] | v -> ["second", validate_integer v])
     in
     Value.vrecord fields
-  with XSI_validation_error _ -> abort ()
+  with Schema_builtin_error _ -> abort ()
 
 let validate_dateTime =
   let rex = Pcre.regexp (sprintf "^([+-])?(%s)T(%s)(%s)?$"
@@ -201,7 +224,7 @@ let validate_dateTime =
     (strip_parens timezone_RE_raw))
   in
   fun s ->
-  let abort () = simple_type_error ~typ:"dateTime" ~value:s in
+  let abort () = simple_type_error "dateTime" in
   let subs = try Pcre.extract ~rex s with Not_found -> abort () in
   try
     let fields =
@@ -211,12 +234,12 @@ let validate_dateTime =
       parse_timezone' subs.(4)
     in
     Value.vrecord fields
-  with XSI_validation_error _ -> abort ()
+  with Schema_builtin_error _ -> abort ()
 
 let validate_gYearMonth =
   let rex = Pcre.regexp (add_limits gYearMonth_RE_raw) in
   fun s ->
-    let abort () = simple_type_error ~typ:"gYearMonth" ~value:s in
+    let abort () = simple_type_error "gYearMonth" in
     let subs = try Pcre.extract ~rex s with Not_found -> abort () in
     try
       let fields = [
@@ -226,12 +249,12 @@ let validate_gYearMonth =
       ] @ parse_timezone' subs.(4)
       in
       Value.vrecord fields
-    with XSI_validation_error _ -> abort ()
+    with Schema_builtin_error _ -> abort ()
 
 let validate_gYear =
   let rex = Pcre.regexp (add_limits gYear_RE_raw) in
   fun s ->
-    let abort () = simple_type_error ~typ:"gYear" ~value:s in
+    let abort () = simple_type_error "gYear" in
     let subs = try Pcre.extract ~rex s with Not_found -> abort () in
     try
       let fields = [
@@ -240,12 +263,12 @@ let validate_gYear =
       ] @ parse_timezone' subs.(3)
       in
       Value.vrecord fields
-    with XSI_validation_error _ -> abort ()
+    with Schema_builtin_error _ -> abort ()
 
 let validate_gMonthDay =
   let rex = Pcre.regexp (add_limits gMonthDay_RE_raw) in
   fun s ->
-    let abort () = simple_type_error ~typ:"gMonthDay" ~value:s in
+    let abort () = simple_type_error "gMonthDay" in
     let subs = try Pcre.extract ~rex s with Not_found -> abort () in
     try
       let fields = [
@@ -254,38 +277,38 @@ let validate_gMonthDay =
       ] @ parse_timezone' subs.(3)
       in
       Value.vrecord fields
-    with XSI_validation_error _ -> abort ()
+    with Schema_builtin_error _ -> abort ()
 
 let validate_gDay =
   let rex = Pcre.regexp (add_limits gDay_RE_raw) in
   fun s ->
-    let abort () = simple_type_error ~typ:"gDay" ~value:s in
+    let abort () = simple_type_error "gDay" in
     let subs = try Pcre.extract ~rex s with Not_found -> abort () in
     try
       let fields =
         ("day", validate_integer subs.(1)) :: (parse_timezone' subs.(2))
       in
       Value.vrecord fields
-    with XSI_validation_error _ -> abort ()
+    with Schema_builtin_error _ -> abort ()
 
 let validate_gMonth =
   let rex = Pcre.regexp (add_limits gMonth_RE_raw) in
   fun s ->
-    let abort () = simple_type_error ~typ:"gMonth" ~value:s in
+    let abort () = simple_type_error "gMonth" in
     let subs = try Pcre.extract ~rex s with Not_found -> abort () in
     try
       let fields =
         ("month", validate_integer subs.(1)) :: (parse_timezone' subs.(2))
       in
       Value.vrecord fields
-    with XSI_validation_error _ -> abort ()
+    with Schema_builtin_error _ -> abort ()
 
 let validate_time =
   let rex = Pcre.regexp (sprintf "^(%s)(%s)?$" (strip_parens time_RE_raw)
     (strip_parens timezone_RE_raw))
   in
   fun s ->
-  let abort () = simple_type_error ~typ:"time" ~value:s in
+  let abort () = simple_type_error "time" in
   let subs = try Pcre.extract ~rex s with Not_found -> abort () in
   try
     let fields =
@@ -295,14 +318,14 @@ let validate_time =
       | v -> [ "timezone", Value.vrecord (parse_timezone v) ])
     in
     Value.vrecord fields
-  with XSI_validation_error _ -> abort ()
+  with Schema_builtin_error _ -> abort ()
 
 let validate_date =
   let rex = Pcre.regexp (sprintf "^(-)?(%s)(%s)?$" (strip_parens date_RE_raw)
     (strip_parens timezone_RE_raw))
   in
   fun s ->
-  let abort () = simple_type_error ~typ:"date" ~value:s in
+  let abort () = simple_type_error "date" in
   let subs = try Pcre.extract ~rex s with Not_found -> abort () in
   try
     let fields =
@@ -313,12 +336,12 @@ let validate_date =
       | v -> [ "timezone", Value.vrecord (parse_timezone v) ])
     in
     Value.vrecord fields
-  with XSI_validation_error _ -> abort ()
+  with Schema_builtin_error _ -> abort ()
 
 let validate_hexBinary s =
   let len = String.length s in
   if len mod 2 <> 0 then
-    simple_type_error ~typ:"hexBinary" ~value:s;
+    simple_type_error "hexBinary";
   let res = String.create (len / 2) in
   let rec aux idx =
     if idx < len then begin
@@ -336,7 +359,7 @@ let validate_anyURI s =
   try
     validate_string (Neturl.string_of_url (Neturl.url_of_string
       Neturl.ip_url_syntax s))
-  with Neturl.Malformed_URL -> simple_type_error ~typ:"anyURI" ~value:s
+  with Neturl.Malformed_URL -> simple_type_error "anyURI"
 
   (** {2 API backend} *)
 
@@ -366,12 +389,7 @@ let list' name itemname =
 let fill () = (* fill "builtins" hashtbl *)
 
   (* TODO missing built-in simple types: xsd:float, xsd:double, xsd:QName,
-   * xsd:NOTATION, xsd:decimal, xsd:long, xsd:int: xsd:short, xsd:byte
-  *)
-
-  let zero = Value.Integer Intervals.V.zero in
-  let one = Value.Integer (Intervals.V.succ Intervals.V.zero) in
-  let minus_one = Value.Integer (Intervals.V.pred Intervals.V.zero) in
+   * xsd:NOTATION, xsd:decimal *)
 
   (* primitive builtins *)
 
@@ -380,10 +398,9 @@ let fill () = (* fill "builtins" hashtbl *)
   alias "xsd:anyType" "xsd:anySimpleType";
   reg "xsd:string"
     (Primitive "xsd:string", Builtin_defs.string, validate_string);
-  reg "xsd:integer"
-    (* not a primitive for Schema, but a primitive for us since we have neither
-     * xsd:decimal nor {total,fraction}Digits support *)
-    (Primitive "xsd:integer", Builtin_defs.int, validate_integer);
+  reg "xsd:decimal"
+    (* collapsed in CDuce to an integer, since CDuce has no decimal numbers *)
+    (Primitive "xsd:decimal", Builtin_defs.int, validate_decimal);
   reg "xsd:boolean"
     (Primitive "xsd:boolean", Builtin_defs.bool, validate_bool);
   reg "xsd:hexBinary"
@@ -413,22 +430,49 @@ let fill () = (* fill "builtins" hashtbl *)
 
   (* derived builtins *)
 
+  reg "xsd:integer"
+    (restrict' "xsd:integer" "xsd:decimal" no_facets, (* fake restriction *)
+    Builtin_defs.int, validate_integer);
   reg "xsd:nonPositiveInteger"
     (restrict' "xsd:nonPositiveInteger" "xsd:integer"
-      { no_facets with maxInclusive = Some (zero, false) },
+      { no_facets with maxInclusive = Some (Value.Integer zero, false) },
     nonPositiveInteger_type, validate_nonPositiveInteger);
   reg "xsd:negativeInteger"
     (restrict' "xsd:negativeInteger" "xsd:nonPositiveInteger"
-      { no_facets with maxInclusive = Some (minus_one, false) },
+      { no_facets with maxInclusive = Some (Value.Integer minus_one, false) },
     negativeInteger_type, validate_negativeInteger);
   reg "xsd:nonNegativeInteger"
     (restrict' "xsd:nonNegativeInteger" "xsd:integer"
-      { no_facets with minInclusive = Some (zero, false) },
+      { no_facets with minInclusive = Some (Value.Integer zero, false) },
     nonNegativeInteger_type, validate_nonNegativeInteger);
   reg "xsd:positiveInteger"
     (restrict' "xsd:positiveInteger" "xsd:nonNegativeInteger"
-      { no_facets with minInclusive = Some (one, false) },
+      { no_facets with minInclusive = Some (Value.Integer one, false) },
     positiveInteger_type, validate_positiveInteger);
+  reg "xsd:long"
+    (restrict' "xsd:long" "xsd:integer"
+      { no_facets with
+          minInclusive = Some (Value.Integer long_l, false);
+          maxInclusive = Some (Value.Integer long_r, false)},
+    long_type, validate_long);
+  reg "xsd:int"
+    (restrict' "xsd:int" "xsd:long"
+      { no_facets with
+          minInclusive = Some (Value.Integer int_l, false);
+          maxInclusive = Some (Value.Integer int_r, false)},
+    int_type, validate_int);
+  reg "xsd:short"
+    (restrict' "xsd:short" "xsd:int"
+      { no_facets with
+          minInclusive = Some (Value.Integer short_l, false);
+          maxInclusive = Some (Value.Integer short_r, false)},
+    short_type, validate_short);
+  reg "xsd:byte"
+    (restrict' "xsd:byte" "xsd:short"
+      { no_facets with
+          minInclusive = Some (Value.Integer byte_l, false);
+          maxInclusive = Some (Value.Integer byte_r, false)},
+    byte_type, validate_short);
   reg "xsd:normalizedString"
     (restrict' "xsd:normalizedString" "xsd:string"
       { no_facets with whiteSpace = `Replace, false },
@@ -466,5 +510,5 @@ let trd (_,_,z) = z
 
 let get_builtin name          = fst (lookup name)
 let cd_type_of_builtin name   = snd (lookup name)
-let validator_of_builtin name = trd (lookup name)
+let validate_builtin name     = trd (lookup name)
 

schema/schema_builtin.mli

@@ -2,10 +2,16 @@
 (** all schema simple type names used in this API are prefixed with
  * Schema_xml.xsd_prefix *)
 
+exception Schema_builtin_error of string
+
 val is_builtin: string -> bool
 val get_builtin: string -> Schema_types.simple_type_definition
 val iter_builtin: (Schema_types.simple_type_definition -> unit) -> unit
 
 val cd_type_of_builtin: string -> Types.descr
-val validator_of_builtin: string -> (string -> Value.t)
+
+  (** @raise Schema_builtin_error [name] in case of validation error, where
+   * [name] is the name of a schema built in type prefixed with
+   * Schema_xml.xsd_prefix *)
+val validate_builtin: string -> string -> Value.t
 

schema/schema_common.ml

@@ -34,6 +34,11 @@ let name_of_type_definition = function
   | Complex ct -> name_of_complex_type_definition ct
 let name_of_attribute_declaration (name, _, _) = name
 let name_of_attribute_use (_, (name, _, _), _) = name
+let name_of_attribute_group_definition = fst
+let name_of_model_group_definition = fst
+let name_of_particle = function
+  | (_, _, Elt elt_decl_ref) -> name_of_element_declaration !elt_decl_ref
+  | _ -> assert false
 let variety_of_simple_type_definition = function
   | (Primitive name) as st -> Atomic st
   | Derived (_, variety, _, _) -> variety
@@ -58,7 +63,7 @@ let iter_attribute_groups schema f = List.iter f schema.attribute_groups
 let iter_model_groups schema f = List.iter f schema.model_groups
 
 exception XSD_validation_error of string
-exception XSI_validation_error of string
+exception XSI_validation_error of validation_context * string
 
 let regexp' s = Pcre.regexp ~flags:[`UTF8] s
 
@@ -207,3 +212,69 @@ let restrict base new_facets new_name =
   in
   Derived (new_name, variety, facets, base)
 
+let get_type name schema =
+  List.find
+    (fun x ->
+      try
+        name_of_type_definition x = name
+      with Invalid_argument _ -> false)
+    schema.types
+let get_attribute name schema =
+  List.find
+    (fun x ->
+      try
+        name_of_attribute_declaration x = name
+      with Invalid_argument _ -> false)
+    schema.attributes
+let get_element name schema =
+  List.find
+    (fun x ->
+      try
+        name_of_element_declaration x = name
+      with Invalid_argument _ -> false)
+    schema.elements
+let get_attribute_group name schema =
+  List.find
+    (fun x ->
+      try
+        name_of_attribute_group_definition x = name
+      with Invalid_argument _ -> false)
+    schema.attribute_groups
+let get_model_group name schema =
+  List.find
+    (fun x ->
+      try
+        name_of_model_group_definition x = name
+      with Invalid_argument _ -> false)
+    schema.model_groups
+
+  (* policy for unqualified schema component resolution. The order should
+   * be consistent with Typer.find_schema_descr *)
+let get_component kind name schema =
+  let rec tries = function
+    | [] -> raise Not_found
+    | hd :: tl -> (try hd () with Not_found -> tries tl)
+  in
+  let elt () = Element (get_element name schema) in
+  let typ () = Type (get_type name schema) in
+  let att () = Attribute (get_attribute name schema) in
+  let att_group () = Attribute_group (get_attribute_group name schema) in
+  let mod_group () = Model_group (get_model_group name schema) in
+  match kind with
+  | Some `Element -> elt ()
+  | Some `Type -> typ ()
+  | Some `Attribute -> att ()
+  | Some `Attribute_group -> att_group ()
+  | Some `Model_group -> mod_group ()
+  | None -> tries [ elt; typ; att; att_group; mod_group ]
+
+let string_of_component_kind (kind: component_kind) =
+  match kind with
+  | Some `Type -> "type"
+  | Some `Element -> "element"
+  | Some `Attribute -> "attribute"
+  | Some `Attribute_group -> "attribute group"
+  | Some `Model_group -> "model group"
+  | None -> "component"
+
+

schema/schema_common.mli

@@ -3,10 +3,10 @@
 
 open Schema_types
 
-  (** validation failure *)
+(** {2 Exceptions} *)
 
 exception XSD_validation_error of string
-exception XSI_validation_error of string
+exception XSI_validation_error of validation_context * string
 
 (** {2 XSD printer *)
 
@@ -19,11 +19,6 @@ val print_attribute_group :
 val print_model_group : Format.formatter -> model_group_definition -> unit
 val print_simple_type : Format.formatter -> simple_type_definition -> unit
 val print_complex_type : Format.formatter -> complex_type_definition -> unit
-(*
-val print_ct : Format.formatter -> content_type -> unit
-val print_particle : Format.formatter -> particle -> unit
-val print_term : Format.formatter -> term -> unit
-*)
 
 (** {2 Deconstruction functions} *)
 
@@ -33,12 +28,26 @@ val name_of_simple_type_definition : simple_type_definition -> string
 val name_of_complex_type_definition : complex_type_definition -> string
 val name_of_attribute_declaration : attribute_declaration -> string
 val name_of_attribute_use : attribute_use -> string
+val name_of_attribute_group_definition : attribute_group_definition -> string
+val name_of_model_group_definition : model_group_definition -> string
+val name_of_particle : particle -> string
+
+val string_of_component_kind : component_kind -> string
+
 val variety_of_simple_type_definition : simple_type_definition -> variety
 val facets_of_simple_type_definition : simple_type_definition -> facets
 val simple_type_of_type : type_definition -> simple_type_definition
 val complex_type_of_type : type_definition -> complex_type_definition
 val content_type_of_type : type_definition -> content_type
 
+val get_type: string -> schema -> type_definition
+val get_attribute: string -> schema -> attribute_declaration
+val get_element: string -> schema -> element_declaration
+val get_attribute_group: string -> schema -> attribute_group_definition
+val get_model_group: string -> schema -> model_group_definition
+
+val get_component: component_kind -> string -> schema -> component
+
 val iter_types: schema -> (type_definition -> unit) -> unit
 val iter_attributes: schema -> (attribute_declaration -> unit) -> unit
 val iter_elements: schema -> (element_declaration -> unit) -> unit
@@ -55,8 +64,7 @@ val merge_facets: facets -> facets -> facets
 val restrict: simple_type_definition -> facets -> string option ->
   simple_type_definition
 
-(** {2 Miscellaneous} *)
-
+(** {2 Miscellaneous} *) 
   (** empty set of facets (with the only exception of "whiteSpace", which is set
   to <`Collapse, true>, the mandatory value for all non string derived simple
   types) *)

schema/schema_parser.ml

@@ -73,7 +73,7 @@ let parse_facets base n =
   debug_print ~n "Schema_parser.parse_facet"; 
   let validate_base_type = Schema_validator.validate_simple_type base in
   let validate_nonNegativeInteger =
-    Schema_builtin.validator_of_builtin "xsd:nonNegativeInteger"
+    Schema_builtin.validate_builtin "xsd:nonNegativeInteger"
   in
   let facets = ref no_facets in
   n#iter_nodes (fun n ->
@@ -92,7 +92,7 @@ let parse_facets base n =
         let length = integer_of_value_t (validate_nonNegativeInteger value) in
         facets := { !facets with maxLength = Some (length, fixed) }
     | T_element "xsd:enumeration" ->
-        let value = _attribute "value" n in
+        let value = Value.string_latin1 (_attribute "value" n) in
         let value = validate_base_type value in
         let new_enumeration =
           (match !facets.enumeration with
@@ -110,19 +110,19 @@ let parse_facets base n =
             | _ -> assert false),
           fixed) }
     | T_element "xsd:maxInclusive" ->
-        let value = _attribute "value" n in
+        let value = Value.string_latin1 (_attribute "value" n) in
         facets := { !facets with
           maxInclusive = Some (validate_base_type value, fixed) }
     | T_element "xsd:maxExclusive" ->
-        let value = _attribute "value" n in
+        let value = Value.string_latin1 (_attribute "value" n) in
         facets := { !facets with
           maxExclusive = Some (validate_base_type value, fixed) }
     | T_element "xsd:minInclusive" ->
-        let value = _attribute "value" n in
+        let value = Value.string_latin1 (_attribute "value" n) in
         facets := { !facets with
           minInclusive = Some (validate_base_type value, fixed) }
     | T_element "xsd:minExclusive" ->
-        let value = _attribute "value" n in
+        let value = Value.string_latin1 (_attribute "value" n) in
         facets := { !facets with
           minExclusive = Some (validate_base_type value, fixed) }
     | _ -> ());
@@ -195,10 +195,12 @@ and find_member_types (resolver: resolver) n =
 let parse_att_value_constraint stype_def n =
   debug_print ~n "Schema_parser.parse_att_value_constraint";
   if _has_attribute "default" n then
-    let value = validate_simple_type stype_def (_attribute "default" n) in
+    let value = Value.string_latin1 (_attribute "default" n) in
+    let value = validate_simple_type stype_def value in
     Some (`Default value)
   else if _has_attribute "fixed" n then
-    let value = validate_simple_type stype_def (_attribute "fixed" n) in
+    let value = Value.string_latin1 (_attribute "fixed" n) in
+    let value = validate_simple_type stype_def value in
     Some (`Fixed value)
   else
     None
@@ -213,10 +215,12 @@ let parse_elt_value_constraint type_def n =
     | _ -> validate_simple_type (Primitive "xsd:string")
   in
   if _has_attribute "default" n then
-    let value = validate_value (_attribute "default" n) in
+    let value = Value.string_latin1 (_attribute "default" n) in
+    let value = validate_value value in
     Some (`Default value)
   else if _has_attribute "fixed" n then
-    let value = validate_value (_attribute "fixed" n) in
+    let value = Value.string_latin1 (_attribute "fixed" n) in
+    let value = validate_value value in
     Some (`Fixed value)
   else
     None

schema/schema_types.mli

@@ -13,8 +13,6 @@
 
 (** {2 XSD representation} *)
 
-  (** {2 XSD representation} *)
-
 type xs_nonNegativeInteger = Intervals.V.t  (* = Big_int.big_int *)
 (* type xs_positiveInteger = Intervals.V.t *)
 
@@ -119,3 +117,21 @@ type schema = {
   model_groups: model_group_definition list;
 }
 
+(** {2 Misc} *)
+
+  (* kind of a schema component *)
+type component_kind =
+  [ `Type | `Element | `Attribute | `Attribute_group | `Model_group ] option