2018-06-19 08:36:17 +00:00
|
|
|
type t = A of string [@@unboxed]
|
|
|
|
|
|
|
|
let invalid_argf fmt = Printf.ksprintf invalid_arg fmt
|
|
|
|
|
|
|
|
type syntax = Jbuild | Dune
|
|
|
|
|
2018-06-20 08:54:29 +00:00
|
|
|
let is_valid_dune =
|
|
|
|
let rec loop s i len =
|
2018-06-19 08:36:17 +00:00
|
|
|
i = len ||
|
|
|
|
match String.unsafe_get s i with
|
|
|
|
| '%' | '"' | '(' | ')' | ';' | '\000'..'\032' | '\127'..'\255' -> false
|
2018-06-20 08:54:29 +00:00
|
|
|
| _ -> loop s (i + 1) len
|
2018-06-19 08:36:17 +00:00
|
|
|
in
|
2018-06-20 08:54:29 +00:00
|
|
|
fun s ->
|
2018-06-19 08:36:17 +00:00
|
|
|
let len = String.length s in
|
2018-06-20 08:54:29 +00:00
|
|
|
len > 0 && loop s 0 len
|
|
|
|
|
|
|
|
let is_valid_jbuild str =
|
|
|
|
let len = String.length str in
|
|
|
|
len > 0 &&
|
|
|
|
let rec loop ix =
|
|
|
|
match str.[ix] with
|
|
|
|
| '"' | '(' | ')' | ';' -> true
|
|
|
|
| '|' -> ix > 0 && let next = ix - 1 in str.[next] = '#' || loop next
|
|
|
|
| '#' -> ix > 0 && let next = ix - 1 in str.[next] = '|' || loop next
|
|
|
|
| ' ' | '\t' | '\n' | '\012' | '\r' -> true
|
|
|
|
| _ -> ix > 0 && loop (ix - 1)
|
2018-06-19 08:36:17 +00:00
|
|
|
in
|
2018-06-20 08:54:29 +00:00
|
|
|
not (loop (len - 1))
|
2018-06-19 08:36:17 +00:00
|
|
|
|
2018-06-20 05:29:18 +00:00
|
|
|
let of_string s = A s
|
2018-06-20 09:01:18 +00:00
|
|
|
let to_string (A s) = s
|
2018-06-19 08:36:17 +00:00
|
|
|
|
2018-06-20 09:01:18 +00:00
|
|
|
let print (A t) syntax =
|
2018-06-19 08:36:17 +00:00
|
|
|
match syntax with
|
2018-06-20 05:29:18 +00:00
|
|
|
| Jbuild ->
|
|
|
|
if is_valid_jbuild t then
|
|
|
|
t
|
|
|
|
else
|
|
|
|
invalid_argf "Dune atom '%s' cannot be printed" t
|
2018-06-19 08:36:17 +00:00
|
|
|
| Dune ->
|
|
|
|
if is_valid_dune t then
|
|
|
|
t
|
|
|
|
else
|
2018-06-20 05:29:18 +00:00
|
|
|
invalid_argf "Jbuild atom '%s' cannot be printed" t
|
2018-06-19 08:36:17 +00:00
|
|
|
|
2018-06-20 05:29:18 +00:00
|
|
|
let of_int i = of_string (string_of_int i)
|
|
|
|
let of_float x = of_string (string_of_float x)
|
|
|
|
let of_bool x = of_string (string_of_bool x)
|
|
|
|
let of_digest d = of_string (Digest.to_hex d)
|
|
|
|
let of_int64 i = of_string (Int64.to_string i)
|