10
0
mirror of https://github.com/QuantumPackage/qp2.git synced 2024-11-14 10:03:47 +01:00
QuantumPackage/ocaml/Generic_input_of_rst.ml
2019-03-13 14:08:02 +01:00

61 lines
1.5 KiB
OCaml

open Sexplib
open Sexplib.Std
open Qptypes
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
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))
in
let str = Printf.sprintf "%s ## %s ## %s" pre mid post
in
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
| None -> false
| Some _ -> true
)
|> String.concat "\n"
in
Printf.eprintf "Error: (%s)\n\n %s\n\n" msg str
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)
let of_rst t_of_sexp s =
Rst_string.to_string s
|> String_ext.split ~on:'\n'
|> List.filter (fun line -> String.contains line '=')
|> List.map (fun line ->
"("^(
String_ext.tr ~target:'=' ~replacement:' ' line
)^")" )
|> String.concat ""
|> evaluate_sexp t_of_sexp