HTML writer: preserve the doctype

The HTML5 spec requires outputting <!DOCTYPE html> as the doctype. However, Markup.ml already has a helper (Markup.html5) for replacing any doctype with the HTML5 doctype. So, it is better for the writer to output whatever doctype is present in the signal stream, trusting the user to call Markup.html5 if it is necessary for their purpose. Part of aantron/lambdasoup#37.
aantron · Oct 21, 2020 · b4b59ae · b4b59ae
1 parent 234a2b0
commit b4b59ae
Show file tree

Hide file tree

Showing 4 changed files with 21 additions and 8 deletions.
diff --git a/src/common.ml b/src/common.ml
@@ -179,12 +179,12 @@ let signal_to_string = function
         end
       | Some name ->
         match d.public_identifier, d.system_identifier with
-        | None, None -> name
+        | None, None -> " " ^ name
         | Some p, None -> Printf.sprintf " %s PUBLIC \"%s\"" name p
         | None, Some s -> Printf.sprintf " %s SYSTEM \"%s\"" name s
         | Some p, Some s -> Printf.sprintf " %s PUBLIC \"%s\" \"%s\"" name p s
     in
-    Printf.sprintf "<!DOCTYPE %s>" text
+    Printf.sprintf "<!DOCTYPE%s>" text
 
   | `Start_element (name, attributes) ->
     let name_to_string = function

diff --git a/src/html_writer.ml b/src/html_writer.ml
@@ -151,10 +151,10 @@ let write ?(escape_attribute=escape_attribute) ?(escape_text=escape_text) signal
       | `PI (target, s) ->
         emit_list ["<?"; target; " "; s; ">"] throw e k
 
-      | `Doctype {doctype_name = Some name} ->
-        emit_list ["<!DOCTYPE "; name; ">"] throw e k
+      | `Doctype _ as doctype ->
+        emit_list [signal_to_string doctype] throw e k
 
-      | `Doctype _ | `Xml _ ->
+      | `Xml _ ->
         next_signal throw e k
     end
 

diff --git a/test/test_html_writer.ml b/test/test_html_writer.ml
@@ -36,10 +36,10 @@ let tests = [
        raw_text          = None;
        force_quirks      = false}
     in
-    expect "doctype" [`Doctype doctype] [S "<!DOCTYPE "; S "html"; S ">"];
+    expect "doctype" [`Doctype doctype] [S "<!DOCTYPE html>"];
 
     let doctype = {doctype with doctype_name = None} in
-    expect "bad doctype" [`Doctype doctype] []);
+    expect "bad doctype" [`Doctype doctype] [S "<!DOCTYPE>"]);
 
   ("html.writer.comment" >:: fun _ ->
     expect "comment" [`Comment "foo"] [S "<!--"; S "foo"; S "-->"]);

diff --git a/test/test_integration.ml b/test/test_integration.ml
@@ -90,5 +90,18 @@ let tests = [
       stream |> tree ~text:(fun _ -> ()) ~element:(fun _ _ _ -> ()) in
 
     assert_equal ~msg:"fi" (assemble ()) (Some ());
-    assert_equal ~msg:"fi" (assemble ()) None)
+    assert_equal ~msg:"fi" (assemble ()) None);
+
+  ("integration.doctype.roundtrip" >:: fun _ ->
+    ({|<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Strict//EN" |} ^
+     {|"http://www.w3.org/TR/xhtml1/DTD/xhtml1-strict.dtd">|})
+    |> string
+    |> parse_html
+    |> signals
+    |> write_html
+    |> to_string
+    |> assert_equal
+      ({|<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Strict//EN" |} ^
+       {|"http://www.w3.org/TR/xhtml1/DTD/xhtml1-strict.dtd">|} ^
+       {|<html><head></head><body></body></html>|}))
 ]