(* -*- tuareg -*- *)
open Stdune;;
open Sexp.Of_sexp;;

let pp_sexp_ast =
  let rec subst_atoms ~f (s : Sexp.t) =
    match s with
    | Atom a -> f a
    | Quoted_string _ -> s
    | List xs -> List (List.map ~f:(subst_atoms ~f) xs)
  in
  fun ppf sexp ->
    sexp
    |> Sexp.Ast.remove_locs
    |> subst_atoms ~f:(fun (A s) ->
      List [(Sexp.atom "atom"); Sexp.atom_or_quoted_string s])
    |> Sexp.pp ppf
;;

#install_printer pp_sexp_ast;;
[%%expect{|
val pp_sexp_ast : Format.formatter -> Stdune.Sexp.Ast.t -> unit = <fun>
|}]

Printexc.record_backtrace false;;
[%%expect{|
- : unit = ()
|}]

let sexp = Sexp.parse_string ~fname:"" ~mode:Single {|
((foo 1)
 (foo 2))
|}
[%%expect{|
val sexp : Usexp.Ast.t = (((atom foo) (atom 1)) ((atom foo) (atom 2)))
|}]

let of_sexp = record (field "foo" int)
let x = parse of_sexp Univ_map.empty sexp
[%%expect{|
val of_sexp : int Stdune.Sexp.Of_sexp.t = <abstr>
Exception:
Stdune__Sexp.Of_sexp.Of_sexp (<abstr>,
 "Field \"foo\" is present too many times", None).
|}]

let of_sexp = record (multi_field "foo" int)
let x = parse of_sexp Univ_map.empty sexp
[%%expect{|
val of_sexp : int list Stdune.Sexp.Of_sexp.t = <abstr>
val x : int list = [1; 2]
|}]

type parse_result_diff =
  { jbuild : (Sexp.Ast.t list, string) result
  ; dune   : (Sexp.Ast.t list, string) result
  }

type parse_result =
  | Same of (Sexp.Ast.t list, string) result
  | Different of parse_result_diff

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)
    | Invalid_argument e -> Error e
  in
  let jbuild = f ~lexer:Sexp.Lexer.jbuild_token in
  let dune   = f ~lexer:Sexp.Lexer.token        in
  if jbuild <> dune then
    Different { jbuild; dune }
  else
    Same jbuild
[%%expect{|
type parse_result_diff = {
  jbuild : (Stdune.Sexp.Ast.t list, string) Stdune.result;
  dune : (Stdune.Sexp.Ast.t list, string) Stdune.result;
}
type parse_result =
    Same of (Stdune.Sexp.Ast.t list, string) Stdune.result
  | Different of parse_result_diff
val parse : string -> parse_result = <fun>
|}]

parse {| # ## x##y x||y a#b|c#d copy# |}
[%%expect{|
- : parse_result =
Same
 (Ok
   [(atom #); (atom ##); (atom x##y); (atom x||y); (atom a#b|c#d);
    (atom copy#)])
|}]


parse {|x #| comment |# y|}
[%%expect{|
- : parse_result =
Different
 {jbuild = Ok [(atom x); (atom y)];
  dune = Ok [(atom x); (atom #|); (atom comment); (atom |#); (atom y)]}
|}]

parse {|x#|y|}
[%%expect{|
- : parse_result =
Different
 {jbuild = Error "jbuild atoms cannot contain #|"; dune = Ok [(atom x#|y)]}
|}]

parse {|x|#y|}
[%%expect{|
- : parse_result =
Different
 {jbuild = Error "jbuild atoms cannot contain |#"; dune = Ok [(atom x|#y)]}
|}]

parse {|"\a"|}
[%%expect{|
- : parse_result =
Different {jbuild = Ok ["\\a"]; dune = Error "unknown escape sequence"}
|}]

parse {|"\%{x}"|}
[%%expect{|
- : parse_result =
Different {jbuild = Ok ["\\%{x}"]; dune = Error "unknown escape sequence"}
|}]

parse {|"$foo"|}
[%%expect{|
- : parse_result = Same (Ok ["$foo"])
|}]

parse {|"%foo"|}
[%%expect{|
- : parse_result = Same (Ok ["%foo"])
|}]

parse {|"bar%foo"|}
[%%expect{|
- : parse_result = Same (Ok ["bar%foo"])
|}]

parse {|"bar$foo"|}
[%%expect{|
- : parse_result = Same (Ok ["bar$foo"])
|}]

parse {|"%bar$foo%"|}
[%%expect{|
- : parse_result = Same (Ok ["%bar$foo%"])
|}]

parse {|"$bar%foo%"|}
[%%expect{|
- : parse_result = Same (Ok ["$bar%foo%"])
|}]

parse {|\${foo}|}
[%%expect{|
- : parse_result = Same (Ok [(atom \${foo})])
|}]

parse {|\%{foo}|}
[%%expect{|
- : parse_result =
Different
 {jbuild = Ok [(atom "\\%{foo}")]; dune = Error "Invalid atom character '%'"}
|}]

parse {|\$bar%foo%|}
[%%expect{|
- : parse_result =
Different
 {jbuild = Ok [(atom "\\$bar%foo%")];
  dune = Error "Invalid atom character '%'"}
|}]

parse {|\$bar\%foo%|}
[%%expect{|
- : parse_result =
Different
 {jbuild = Ok [(atom "\\$bar\\%foo%")];
  dune = Error "Invalid atom character '%'"}
|}]

parse {|\$bar\%foo%{bar}|}
[%%expect{|
- : parse_result =
Different
 {jbuild = Ok [(atom "\\$bar\\%foo%{bar}")];
  dune = Error "Invalid atom character '%'"}
|}]