diff --git a/_oasis b/_oasis index 6d3abb09f..5c6375722 100644 --- a/_oasis +++ b/_oasis @@ -34,18 +34,12 @@ Flag syntax Library tyxml FindlibName: tyxml - Path: lib + Path: implem Modules: Xml, Svg, Html5 - InternalModules: - Xml_iter, - Xml_wrap, - Xml_print, - Svg_f, - Html5_f - BuildDepends: re, uutf + BuildDepends: tyxml.functor, re, uutf Library tyxml_f FindlibName: functor diff --git a/_tags b/_tags index c9bdb6288..6537ccae5 100644 --- a/_tags +++ b/_tags @@ -9,3 +9,5 @@ true: bin_annot not : warn(A-4-9-40-42-44-48) not : warn_error(+1..49), warn_error(-45-3) not : strict_sequence, safe_string, short_paths + +true: keep_locs diff --git a/lib/html5.ml b/implem/html5.ml similarity index 100% rename from lib/html5.ml rename to implem/html5.ml diff --git a/lib/html5.mli b/implem/html5.mli similarity index 100% rename from lib/html5.mli rename to implem/html5.mli diff --git a/lib/svg.ml b/implem/svg.ml similarity index 100% rename from lib/svg.ml rename to implem/svg.ml diff --git a/lib/svg.mli b/implem/svg.mli similarity index 100% rename from lib/svg.mli rename to implem/svg.mli diff --git a/lib/xml.ml b/implem/xml.ml similarity index 100% rename from lib/xml.ml rename to implem/xml.ml diff --git a/lib/xml.mli b/implem/xml.mli similarity index 100% rename from lib/xml.mli rename to implem/xml.mli diff --git a/lib/html5_f.ml b/lib/html5_f.ml index c06491c7a..030616435 100644 --- a/lib/html5_f.ml +++ b/lib/html5_f.ml @@ -33,8 +33,7 @@ module Make_with_wrapped_functions (Xml : Xml_sigs.T) - (C : Html5_sigs.Wrapped_functions - with type ('a, 'b) ft = ('a, 'b) Xml.W.ft) + (C : Html5_sigs.Wrapped_functions with module Xml = Xml) (Svg : Svg_sigs.T with module Xml := Xml) = struct @@ -63,6 +62,12 @@ struct let string_of_uri = Xml.string_of_uri let uri_of_string = Xml.uri_of_string + type image_candidate = + [ `Url of uri + | `Url_width of uri * Html5_types.number + | `Url_pixel of uri * Html5_types.float_number ] + + type 'a attrib = Xml.attrib let to_xmlattribs x = x @@ -844,9 +849,11 @@ struct end -module Wrapped_functions = struct +module Wrapped_functions + (Xml : Xml_sigs.T with type ('a,'b) W.ft = 'a -> 'b) = +struct - type ('a, 'b) ft = 'a -> 'b + module Xml = Xml let string_of_sandbox_token = function | `Allow_forms -> "allow-forms" @@ -1057,14 +1064,18 @@ module Wrapped_functions = struct let string_of_linktypes l = String.concat " " (List.map string_of_linktype l) - let string_of_srcset l = + type image_candidate = + [ `Url of Xml.uri + | `Url_width of Xml.uri * Html5_types.number + | `Url_pixel of Xml.uri * Html5_types.float_number ] + + let string_of_srcset (l : [< image_candidate] list) = let f = function - | `Url url -> - url + | `Url url -> Xml.string_of_uri url | `Url_width (url, v) -> - Printf.sprintf "%s %sw" url (string_of_number v) + Printf.sprintf "%s %sw" (Xml.string_of_uri url) (string_of_number v) | `Url_pixel (url, v) -> - Printf.sprintf "%s %sx" url (Xml_print.string_of_number v) + Printf.sprintf "%s %sx" (Xml.string_of_uri url) (Xml_print.string_of_number v) in String.concat ", " (List.map f l) @@ -1073,4 +1084,4 @@ end module Make (Xml : Xml_sigs.T with type ('a, 'b) W.ft = 'a -> 'b) (Svg : Svg_sigs.T with module Xml := Xml) = - Make_with_wrapped_functions(Xml)(Wrapped_functions)(Svg) + Make_with_wrapped_functions(Xml)(Wrapped_functions(Xml))(Svg) diff --git a/lib/html5_f.mli b/lib/html5_f.mli index 878c1ace9..1fc0e3f77 100644 --- a/lib/html5_f.mli +++ b/lib/html5_f.mli @@ -28,13 +28,13 @@ module Make with type +'a elt = Xml.elt and type +'a attrib = Xml.attrib -module Wrapped_functions : - Html5_sigs.Wrapped_functions with type (-'a, 'b) ft = 'a -> 'b +module Wrapped_functions + (Xml: Xml_sigs.T with type ('a, 'b) W.ft = 'a -> 'b) + : Html5_sigs.Wrapped_functions with module Xml = Xml module Make_with_wrapped_functions (Xml : Xml_sigs.T) - (C : Html5_sigs.Wrapped_functions - with type ('a, 'b) ft = ('a, 'b) Xml.W.ft) + (C : Html5_sigs.Wrapped_functions with module Xml = Xml) (Svg : Svg_sigs.T with module Xml := Xml) : Html5_sigs.Make(Xml)(Svg).T with type +'a elt = Xml.elt diff --git a/lib/html5_sigs.mli b/lib/html5_sigs.mli index 2f19245de..56fd22a05 100644 --- a/lib/html5_sigs.mli +++ b/lib/html5_sigs.mli @@ -30,9 +30,16 @@ module type T = sig type 'a wrap = 'a Xml.W.t type 'a list_wrap = 'a Xml.W.tlist + (** {1 Uri} *) + type uri = Xml.uri - val string_of_uri : uri -> string - val uri_of_string : string -> uri + val string_of_uri : (uri, string) Xml.W.ft + val uri_of_string : (string, uri) Xml.W.ft + + type image_candidate = + [ `Url of uri + | `Url_width of uri * number + | `Url_pixel of uri * float_number ] (** {1 Common Attributes} *) @@ -1191,46 +1198,51 @@ module type NoWrap = T with module Xml.W = Xml_wrap.NoWrap module type Wrapped_functions = sig - type (-'a, 'b) ft + module Xml : Xml_sigs.T val string_of_big_variant : - ([< Html5_types.big_variant], string) ft + ([< Html5_types.big_variant], string) Xml.W.ft - val string_of_bool : (bool, string) ft + val string_of_bool : (bool, string) Xml.W.ft - val onoff_of_bool : (bool, string) ft + val onoff_of_bool : (bool, string) Xml.W.ft - val string_of_character : (Html5_types.character, string) ft + val string_of_character : (Html5_types.character, string) Xml.W.ft val string_of_input_type : - ([< Html5_types.input_type], string) ft + ([< Html5_types.input_type], string) Xml.W.ft val string_of_linktypes : - ([< Html5_types.linktype] list, string) ft + ([< Html5_types.linktype] list, string) Xml.W.ft val string_of_mediadesc : - ([< Html5_types.mediadesc_token] list, string) ft + ([< Html5_types.mediadesc_token] list, string) Xml.W.ft val string_of_multilength : - ([< Html5_types.multilength], string) ft + ([< Html5_types.multilength], string) Xml.W.ft val string_of_multilengths : - ([< Html5_types.multilength] list, string) ft + ([< Html5_types.multilength] list, string) Xml.W.ft - val string_of_numbers : (Html5_types.numbers, string) ft + val string_of_numbers : (Html5_types.numbers, string) Xml.W.ft val string_of_sandbox : - ([< Html5_types.sandbox_token] list, string) ft + ([< Html5_types.sandbox_token] list, string) Xml.W.ft val string_of_sizes : - ((Html5_types.number * Html5_types.number) list option, string) ft + ((Html5_types.number * Html5_types.number) list option, string) Xml.W.ft + + type image_candidate = + [ `Url of Xml.uri + | `Url_width of Xml.uri * Html5_types.number + | `Url_pixel of Xml.uri * Html5_types.float_number ] val string_of_srcset : - ([< Html5_types.image_candidate] list, string) ft + ([< image_candidate] list, string) Xml.W.ft - val string_of_step : (float option, string) ft + val string_of_step : (float option, string) Xml.W.ft - val unoption_string : (string option, string) ft + val unoption_string : (string option, string) Xml.W.ft end diff --git a/lib/html5_types.mli b/lib/html5_types.mli index 762aaf7df..f8756bbdc 100644 --- a/lib/html5_types.mli +++ b/lib/html5_types.mli @@ -1758,11 +1758,6 @@ type embed_content_fun = notag type embed_attrib = [ | common | `Src | `Height | `Mime_type | `Width ] -type image_candidate = - [ `Url of Xml.uri - | `Url_width of Xml.uri * number - | `Url_pixel of Xml.uri * float_number ] - type img = [ `Img ] type img_interactive = [ `Img | `Img_interactive ] type img_content = notag diff --git a/lib/svg_sigs.mli b/lib/svg_sigs.mli index ba12c2a31..a228dd35f 100644 --- a/lib/svg_sigs.mli +++ b/lib/svg_sigs.mli @@ -26,8 +26,8 @@ module type T = sig module Info : Xml_sigs.Info type uri = Xml.uri - val string_of_uri : uri -> string - val uri_of_string : string -> uri + val string_of_uri : (uri, string) Xml.W.ft + val uri_of_string : (string, uri) Xml.W.ft (** {1 Abstraction over XML's types} *) diff --git a/lib/xml_sigs.mli b/lib/xml_sigs.mli index cb2d3464d..dc533d22b 100644 --- a/lib/xml_sigs.mli +++ b/lib/xml_sigs.mli @@ -26,8 +26,8 @@ module type T = sig type 'a list_wrap = 'a W.tlist type uri - val string_of_uri : uri -> string - val uri_of_string : string -> uri + val string_of_uri : (uri, string) W.ft + val uri_of_string : (string, uri) W.ft type aname = string type event_handler diff --git a/tests/html_fail.top.ml b/tests/html_fail.top.ml index fd60de2a3..34b7d0833 100644 --- a/tests/html_fail.top.ml +++ b/tests/html_fail.top.ml @@ -2,6 +2,8 @@ #require "uutf" ;; #require "re" ;; #directory "lib" ;; +#directory "implem" ;; +#load "tyxml_f.cma" ;; #load "tyxml.cma" ;; open Html5.M ;;