Split implementation and make uri abstract again

_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

_tags

@@ -9,3 +9,5 @@ true: bin_annot
 not <syntax/*>: warn(A-4-9-40-42-44-48)
 not <syntax/*>: warn_error(+1..49), warn_error(-45-3)
 not <syntax/*>: strict_sequence, safe_string, short_paths
+
+true: keep_locs

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)

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

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
 

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

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} *)
 

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

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 ;;