10
0
mirror of https://github.com/QuantumPackage/qp2.git synced 2024-11-03 20:53:54 +01:00
QuantumPackage/ocaml/Generic_input_of_rst.ml

61 lines
1.5 KiB
OCaml
Raw Permalink Normal View History

2019-03-13 13:02:29 +01:00
open Sexplib
open Sexplib.Std
open Qptypes
2019-01-25 11:39:31 +01:00
let fail_msg str (ex,range) =
let msg = match ex with
| Failure msg -> msg
| _ -> raise ex
in
let range = match range with
| Sexp.Annotated.Atom (range,_) -> range
| Sexp.Annotated.List (range,_,_) -> range
in
let open Sexp.Annotated in
let start_pos = range.start_pos.offset
and end_pos = range.end_pos.offset
in
2019-03-13 13:02:29 +01:00
let pre = String.sub str 0 start_pos
and mid = String.sub str start_pos (end_pos-start_pos)
and post = String.sub str (end_pos)
((String.length str)-(end_pos))
2019-01-25 11:39:31 +01:00
in
let str = Printf.sprintf "%s ## %s ## %s" pre mid post
in
2019-03-13 13:02:29 +01:00
let str = String_ext.tr str ~target:'(' ~replacement:' '
|> String_ext.split ~on:')'
|> List.map String_ext.strip
|> List.filter (fun x ->
match String_ext.substr_index ~pos:0 ~pattern:"##" x with
2019-01-25 11:39:31 +01:00
| None -> false
| Some _ -> true
)
2019-03-13 13:02:29 +01:00
|> String.concat "\n"
2019-01-25 11:39:31 +01:00
in
2019-03-13 13:02:29 +01:00
Printf.eprintf "Error: (%s)\n\n %s\n\n" msg str
2019-01-25 11:39:31 +01:00
let evaluate_sexp t_of_sexp s =
let sexp = ("("^s^")") in
match ( Sexp.of_string_conv sexp t_of_sexp ) with
| `Result r -> Some r
| `Error ex -> ( fail_msg sexp ex; None)
2019-03-13 13:02:29 +01:00
2019-01-25 11:39:31 +01:00
let of_rst t_of_sexp s =
Rst_string.to_string s
2019-03-13 13:02:29 +01:00
|> String_ext.split ~on:'\n'
|> List.filter (fun line -> String.contains line '=')
|> List.map (fun line ->
2019-01-25 11:39:31 +01:00
"("^(
2019-03-13 13:02:29 +01:00
String_ext.tr ~target:'=' ~replacement:' ' line
2019-01-25 11:39:31 +01:00
)^")" )
2019-03-13 13:02:29 +01:00
|> String.concat ""
2019-01-25 11:39:31 +01:00
|> evaluate_sexp t_of_sexp
2019-03-13 13:02:29 +01:00
2019-01-25 11:39:31 +01:00