Skip to content
GitLab
Menu
Projects
Groups
Snippets
Help
Help
Support
Community forum
Keyboard shortcuts
?
Submit feedback
Contribute to GitLab
Sign in
Toggle navigation
Menu
Open sidebar
cduce
cduce
Commits
767d47ea
Commit
767d47ea
authored
Oct 05, 2007
by
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
Changes
2
Hide whitespace changes
Inline
Side-by-side
schema/schema_builtin.ml
View file @
767d47ea
...
...
@@ -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
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
expressible with CDuce types *)
...
...
@@ -541,6 +541,156 @@ let fill () = (* fill "builtins" hashtbl *)
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} *)
let
is_builtin
=
Hashtbl
.
mem
builtins
...
...
schema/schema_builtin.mli
View file @
767d47ea
...
...
@@ -20,3 +20,5 @@ val cd_type_of_builtin: Utf8.t -> Types.descr
* Schema_xml.xsd_prefix *)
val
validate_builtin
:
Utf8
.
t
->
Utf8
.
t
->
Value
.
t
val
string_of_time_type
:
(
Ns
.
qname
*
Value
.
t
)
list
->
Utf8
.
t
Write
Preview
Markdown
is supported
0%
Try again
or
attach a new file
.
Attach a file
Cancel
You are about to add
0
people
to the discussion. Proceed with caution.
Finish editing this message first!
Cancel
Please
register
or
sign in
to comment