Remove constructor side validation

And make the tests reflect back Invalid_argument

Signed-off-by: Rudi Grinberg <rudi.grinberg@gmail.com>

src/dune_project.ml

@@ -149,7 +149,7 @@ module Lang = struct
     in
     let ver =
       Sexp.Of_sexp.parse Syntax.Version.t Univ_map.empty
-        (Atom (ver_loc, Sexp.Atom.of_string_exn Sexp.Atom.Dune ver)) in
+        (Atom (ver_loc, Sexp.Atom.of_string ver)) in
     match Hashtbl.find langs name with
     | None ->
       Loc.fail name_loc "Unknown language %S.%s" name

src/loc.ml

@@ -11,8 +11,7 @@ let int n = Usexp.Atom (Usexp.Atom.of_int n)
 let string = Usexp.atom_or_quoted_string
 let record l =
   let open Usexp in
-  List (List.map l ~f:(fun (n, v) ->
-    List [Atom(Atom.of_string_exn Atom.Dune n); v]))
+  List (List.map l ~f:(fun (n, v) -> List [Atom(Atom.of_string n); v]))
 
 let sexp_of_position_no_file (p : Lexing.position) =
   record

src/stdune/sexp.ml

@@ -34,8 +34,7 @@ module To_sexp = struct
   let string_set set = list atom (String.Set.to_list set)
   let string_map f map = list (pair atom f) (String.Map.to_list map)
   let record l =
-    List (List.map l ~f:(fun (n, v) ->
-      List [Atom(Atom.of_string_exn Usexp.Atom.Dune n); v]))
+    List (List.map l ~f:(fun (n, v) -> List [Atom(Atom.of_string n); v]))
   let string_hashtbl f h =
     string_map f
       (Hashtbl.foldi h ~init:String.Map.empty ~f:(fun key data acc ->
@@ -55,7 +54,7 @@ module To_sexp = struct
 
   let record_fields (l : field list) =
     List (List.filter_map l ~f:(fun (k, v) ->
-      Option.map v ~f:(fun v -> List[Atom (Atom.of_string_exn Atom.Dune k); v])))
+      Option.map v ~f:(fun v -> List[Atom (Atom.of_string k); v])))
 
   let unknown _ = unsafe_atom_of_string "<unknown>"
 end

src/usexp/atom.ml

@@ -4,10 +4,6 @@ let invalid_argf fmt = Printf.ksprintf invalid_arg fmt
 
 type syntax = Jbuild | Dune
 
-let string_of_syntax = function
-  | Jbuild -> "jbuild"
-  | Dune -> "dune"
-
 let (is_valid_jbuild, is_valid_dune) =
   let rec jbuild s i len =
     i = len ||
@@ -31,29 +27,23 @@ let (is_valid_jbuild, is_valid_dune) =
   in
   (make jbuild, make dune)
 
-let of_string syn s =
-  match syn with
-  | Jbuild when is_valid_jbuild s -> Some (A s)
-  | Dune when is_valid_dune s -> Some (A s)
-  | _ -> None
-
-let of_string_exn syn s =
-  match of_string syn s with
-  | Some s -> s
-  | None ->
-    invalid_argf "'%s' is not a valid %s atom" s (string_of_syntax syn)
+let of_string s = A s
 
 let to_string (A t) syntax =
   match syntax with
-  | Jbuild -> t
+  | Jbuild ->
+    if is_valid_jbuild t then
+      t
+    else
+      invalid_argf "Dune atom '%s' cannot be printed" t
   | Dune ->
     if is_valid_dune t then
       t
     else
-      invalid_argf "Jbuild atom '%s' is not a valid dune atom" t
+      invalid_argf "Jbuild atom '%s' cannot be printed" t
 
-let of_int i = of_string_exn Dune (string_of_int i)
-let of_float x = of_string_exn Dune (string_of_float x)
-let of_bool x = of_string_exn Dune (string_of_bool x)
-let of_int64 i = of_string_exn Dune (Int64.to_string i)
-let of_digest d = of_string_exn Dune (Digest.to_hex d)
+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)

src/usexp/atom.mli

@@ -2,9 +2,9 @@ type t = private A of string [@@unboxed]
 
 type syntax = Jbuild | Dune
 
-val of_string : syntax -> string -> t option
+val is_valid_dune : string -> bool
 
-val of_string_exn : syntax -> string -> t
+val of_string : string -> t
 
 val to_string : t -> syntax -> string
 

src/usexp/lexer.mll

@@ -77,7 +77,7 @@ let hexdigit  = ['0'-'9' 'a'-'f' 'A'-'F']
 let atom_char_jbuild =
   [^ ';' '(' ')' '"' ' ' '\t' '\r' '\n' '\012']
 let atom_char_dune =
-  [^ ';' '(' ')' '"' '\000'-'\032' '\127'-'\255']
+  [^ '%' ';' '(' ')' '"' '\000'-'\032' '\127'-'\255']
 
 (* rule for jbuild files *)
 rule jbuild_token = parse
@@ -124,7 +124,7 @@ and jbuild_atom acc start = parse
         error lexbuf "Internal error in the S-expression parser, \
                       please report upstream.";
       lexbuf.lex_start_p <- start;
-      Token.Atom (Atom.of_string_exn Jbuild acc)
+      Token.Atom (Atom.of_string acc)
     }
 
 and quoted_string mode = parse
@@ -244,7 +244,8 @@ and token = parse
       Quoted_string s
     }
   | atom_char_dune+ as s
-    { Token.Atom (Atom.of_string_exn Dune s) }
+    { Token.Atom (Atom.of_string s) }
+  | _ as c { error lexbuf (Printf.sprintf "Invalid atom character '%c'" c) }
   | eof
     { Eof }
 

src/usexp/usexp.ml

@@ -19,14 +19,15 @@ type t =
 
 type sexp = t
 
-let atom s = Atom (Atom.of_string_exn Dune s)
+let atom s = Atom (Atom.of_string s)
 
 let unsafe_atom_of_string s = atom s
 
 let atom_or_quoted_string s =
-  match Atom.of_string Atom.Dune s with
-  | None -> Quoted_string s
-  | Some a -> Atom a
+  if Atom.is_valid_dune s then
+    Atom (Atom.of_string s)
+  else
+    Quoted_string s
 
 let quote_length s =
   let n = ref 0 in
@@ -221,9 +222,10 @@ module Ast = struct
     | List of Loc.t * t list
 
   let atom_or_quoted_string loc s =
-    match Atom.of_string Atom.Dune s with
-    | None -> Quoted_string (loc, s)
-    | Some a -> Atom (loc, a)
+    match atom_or_quoted_string s with
+    | Atom a -> Atom (loc, a)
+    | Quoted_string s -> Quoted_string (loc, s)
+    | List _ -> assert false
 
   let loc (Atom (loc, _) | Quoted_string (loc, _) | List (loc, _)) = loc
 

src/usexp/usexp.mli

@@ -9,9 +9,9 @@ module Atom : sig
 
   type syntax = Jbuild | Dune
 
- val of_string : syntax -> string -> t option
+  val is_valid_dune : string -> bool
 
- val of_string_exn : syntax -> string -> t
+  val of_string : string -> t
 
   val to_string : t -> syntax -> string
 

test/unit-tests/sexp.mlt

@@ -52,8 +52,9 @@ let parse s =
   let f ~lexer =
     try
       Ok (Sexp.parse_string ~fname:"" ~mode:Many ~lexer s)
-    with Sexp.Parse_error e ->
-      Error (Sexp.Parse_error.message e)
+    with
+    | Sexp.Parse_error e -> Error (Sexp.Parse_error.message e)
+    | Invalid_argument e -> Error e
   in
   let jbuild = f ~lexer:Sexp.Lexer.jbuild_token in
   let dune   = f ~lexer:Sexp.Lexer.token        in
@@ -140,7 +141,12 @@ parse {|"$bar%foo%"|}
 
 parse {|\%{foo}|}
 [%%expect{|
-Exception: Invalid_argument "'\\%{foo}' is not a valid dune atom".
+- : parse_result =
+Different
+ {jbuild =
+   Ok
+    [<printer pp_sexp_ast raised an exception: Invalid_argument("Jbuild atom '\\%{foo}' cannot be printed")>];
+  dune = Error "Invalid atom character '%'"}
 |}]
 
 parse {|\${foo}|}
@@ -150,15 +156,30 @@ parse {|\${foo}|}
 
 parse {|\$bar%foo%|}
 [%%expect{|
-Exception: Invalid_argument "'\\$bar%foo%' is not a valid dune atom".
+- : parse_result =
+Different
+ {jbuild =
+   Ok
+    [<printer pp_sexp_ast raised an exception: Invalid_argument("Jbuild atom '\\$bar%foo%' cannot be printed")>];
+  dune = Error "Invalid atom character '%'"}
 |}]
 
 parse {|\$bar\%foo%|}
 [%%expect{|
-Exception: Invalid_argument "'\\$bar\\%foo%' is not a valid dune atom".
+- : parse_result =
+Different
+ {jbuild =
+   Ok
+    [<printer pp_sexp_ast raised an exception: Invalid_argument("Jbuild atom '\\$bar\\%foo%' cannot be printed")>];
+  dune = Error "Invalid atom character '%'"}
 |}]
 
 parse {|\$bar\%foo%{bar}|}
 [%%expect{|
-Exception: Invalid_argument "'\\$bar\\%foo%{bar}' is not a valid dune atom".
+- : parse_result =
+Different
+ {jbuild =
+   Ok
+    [<printer pp_sexp_ast raised an exception: Invalid_argument("Jbuild atom '\\$bar\\%foo%{bar}' cannot be printed")>];
+  dune = Error "Invalid atom character '%'"}
 |}]

test/unit-tests/sexp_tests.ml

@@ -23,8 +23,7 @@ let () =
         | Atom _ -> true
         | _      -> false
       in
-      let valid_dune_atom =
-        Option.is_some (Usexp.Atom.of_string Dune s) in
+      let valid_dune_atom = Usexp.Atom.is_valid_dune s in
       if valid_dune_atom <> parser_recognizes_as_atom then begin
         Printf.eprintf
           "Usexp.Atom.is_valid error:\n\