Commit 83abca50 authored by Kim Nguyễn's avatar Kim Nguyễn
Browse files

Restore support for load_xml.

parent 7ce6ecd8
open Cduce_types
open Cduce_core
open Value
open Ident
open Load_xml
let load_html s =
let rec val_of_doc q = function
| Nethtml.Data data ->
if (only_ws (Bytes.unsafe_of_string data) (String.length data)) then q else string data q
| Nethtml.Element (tag, att, child) ->
let att = List.map (fun (n,v) -> (Label.mk (Ns.empty, U.mk n), U.mk v)) att in
pair (elem Ns.empty_table (Atoms.V.mk (Ns.empty,U.mk tag) )
att (val_of_docs child)) q
and val_of_docs = function
| [] -> nil
| h::t -> val_of_doc (val_of_docs t) h
in
Cduce_loc.protect_op "load_html";
let parse src = Nethtml.parse_document ~dtd:Nethtml.relaxed_html40_dtd src in
let doc =
if Url.is_url s then
parse (Lexing.from_string (Url.load_url s))
else
let ic = open_in s in
let doc =
try parse (Lexing.from_channel ic)
with exn -> close_in ic; raise exn in
close_in ic;
doc
in
let doc = Nethtml.decode ~subst:(fun _ -> "???") doc in
let doc = Nethtml.map_list
(Netconversion.convert ~in_enc:`Enc_iso88591
~out_enc:`Enc_utf8) doc in
val_of_docs doc
let use () = Load_xml.html_loader := load_html
let () =
Cduce_config.register ~priority:~-1
"netstring"
"Load HTML document with netstring"
use
\ No newline at end of file
...@@ -5,7 +5,7 @@ ...@@ -5,7 +5,7 @@
(modules (modules
(:standard (:standard
\ \
("cduce_pxp" cduce_netclient))) ("cduce_pxp" cduce_netclient cduce_netstring)))
(libraries (libraries
unix unix
cduce-types cduce-types
...@@ -30,7 +30,12 @@ ...@@ -30,7 +30,12 @@
fake_cduce_pxp.ml fake_cduce_pxp.ml
from from
(cduce_pxp -> fake_cduce_pxp.empty.ml) (cduce_pxp -> fake_cduce_pxp.empty.ml)
(-> fake_cduce_pxp.empty.ml)))) (-> fake_cduce_pxp.empty.ml))
(select
fake_cduce_netstring.ml
from
(cduce_netstring -> fake_cduce_netstring.empty.ml)
(-> fake_cduce_netstring.empty.ml))))
(library (library
(name cduce_pxp) (name cduce_pxp)
...@@ -47,3 +52,11 @@ ...@@ -47,3 +52,11 @@
(modules cduce_netclient) (modules cduce_netclient)
(library_flags (-linkall)) (library_flags (-linkall))
(libraries threads.posix netclient cduce-types cduce_core)) (libraries threads.posix netclient cduce-types cduce_core))
(library
(name cduce_netstring)
(public_name cduce.lib.native_backend.netstring)
(optional)
(modules cduce_netstring)
(library_flags (-linkall))
(libraries threads.posix netstring cduce-types cduce_core))
# This file is generated by dune, edit dune-project instead # This file is generated by dune, edit dune-project instead
opam-version: "2.0" opam-version: "2.0"
version: "0.7.0-rc8" version: "0.7.0-rc9"
synopsis: "CDuce type library" synopsis: "CDuce type library"
description: """ description: """
This library implements set-theoretic types with This library implements set-theoretic types with
......
# This file is generated by dune, edit dune-project instead # This file is generated by dune, edit dune-project instead
opam-version: "2.0" opam-version: "2.0"
version: "0.7.0-rc8" version: "0.7.0-rc9"
synopsis: "The CDuce compiler" synopsis: "The CDuce compiler"
description: """ description: """
CDuce is a functional, impure, staticaly typed CDuce is a functional, impure, staticaly typed
......
...@@ -2,7 +2,7 @@ ...@@ -2,7 +2,7 @@
(name cduce) (name cduce)
(version 0.7.0-rc8) (version 0.7.0-rc9)
(source (source
(uri "git+https://gitlab.math.univ-paris-diderot.fr/cduce/cduce/")) (uri "git+https://gitlab.math.univ-paris-diderot.fr/cduce/cduce/"))
......
...@@ -124,7 +124,8 @@ let load_xml_subst ?(ns=false) s subst = ...@@ -124,7 +124,8 @@ let load_xml_subst ?(ns=false) s subst =
| e -> raise e | e -> raise e
let load_html _ = Cduce_loc.raise_generic "load_html not implemented" let html_loader = ref (fun _ -> Cduce_loc.raise_generic "load_html not implemented")
let load_html s = !html_loader s
(* (*
let load_html s = let load_html s =
let rec val_of_doc q = function let rec val_of_doc q = function
......
val load_xml: ?ns:bool -> string -> Value.t val string : string -> Value.t -> Value.t
val load_xml_subst: ?ns:bool -> string ->
(Ns.Uri.t * Ns.Uri.t) list -> Value.t
val load_html: string -> Value.t
val attrib :
('a Upool.typed_int * Cduce_types.Ident.U.t) list -> Value.t Imap.t
val elem :
Ns.table ->
Cduce_types.Atoms.V.t ->
('a Upool.typed_int * Cduce_types.Ident.U.t) list ->
Value.t ->
Value.t
val only_ws : bytes -> int -> bool
val load_xml : ?ns:bool -> string -> Value.t
val load_xml_subst : ?ns:bool -> string -> (Ns.Uri.t * Ns.Uri.t) list -> Value.t
val html_loader : (string -> Value.t) ref
val load_html : string -> Value.t
(* To define and register a parser *) (* To define and register a parser *)
val xml_parser: (string -> unit) ref val xml_parser : (string -> unit) ref
val start_element_handler : string -> (string * string) list -> unit val start_element_handler : string -> (string * string) list -> unit
val end_element_handler : 'a -> unit val end_element_handler : 'a -> unit
val text_handler : string -> unit val text_handler : string -> unit
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment