first commit

.gitignore

@@ -0,0 +1 @@
+_build

.ocamlformat

@@ -0,0 +1,42 @@
+version=0.20.1
+assignment-operator=end-line
+break-cases=fit
+break-fun-decl=wrap
+break-fun-sig=wrap
+break-infix=wrap
+break-infix-before-func=false
+break-separators=before
+break-sequences=true
+cases-exp-indent=2
+cases-matching-exp-indent=normal
+doc-comments=before
+doc-comments-padding=2
+doc-comments-tag-only=default
+dock-collection-brackets=false
+exp-grouping=preserve
+field-space=loose
+if-then-else=compact
+indicate-multiline-delimiters=space
+indicate-nested-or-patterns=unsafe-no
+infix-precedence=indent
+leading-nested-match-parens=false
+let-and=sparse
+let-binding-spacing=compact
+let-module=compact
+margin=80
+max-indent=68
+module-item-spacing=sparse
+ocp-indent-compat=false
+parens-ite=false
+parens-tuple=always
+parse-docstrings=true
+sequence-blank-line=preserve-one
+sequence-style=terminator
+single-case=compact
+space-around-arrays=true
+space-around-lists=true
+space-around-records=true
+space-around-variants=true
+type-decl=sparse
+wrap-comments=false
+wrap-fun-args=true

CHANGES.md

@@ -0,0 +1 @@
+## unreleased

LICENSE.md

@@ -0,0 +1,8 @@
+The ISC License (ISC)
+=====================
+
+Copyright © 2021, TODO
+
+Permission to use, copy, modify, and/or distribute this software for any purpose with or without fee is hereby granted, provided that the above copyright notice and this permission notice appear in all copies.
+
+THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.

README.md

@@ -0,0 +1,75 @@
+# scfg
+
+scfg is an [OCaml] executable and library to work with the [scfg configuration file format].
+
+## Installation
+
+`scfg` can be installed with [opam]:
+
+```sh
+opam install scfg
+```
+
+If you don't have `opam`, you can install it following the [how to install opam] guide.
+
+If you can't or don't want to use `opam`, consult the [opam file] for build instructions.
+
+## Quickstart
+
+Using the library to parse a `scfg` file and reprint nicely:
+
+```ocaml
+open Scfg
+
+let config =
+  match Parse.from_file "config.scfg" with
+  | Ok config -> config
+  | Error e -> begin
+    Format.eprintf "error: %s@." e;
+    exit 1
+  end
+
+let () =
+  Format.printf "%a@." Pp.config config
+```
+
+The provided binary does exactly this. If you have the following `config.scfg` file:
+
+```scfg
+   name "a"        "b b b" 'c' {
+
+
+       child1       ""    "I'm léo"
+
+                child2 'nono'
+     }
+```
+
+Running the binary on it will reprint it trying to make the output pretty:
+
+```shell-session
+$ scfg config.scfg
+name a "b b b" c {
+  child1 "" "I'm léo"
+  child2 nono
+}
+```
+
+For more, have a look at the [example] folder, at the [documentation] or at the [test suite].
+
+## About
+
+- [LICENSE]
+- [CHANGELOG]
+
+[CHANGELOG]: ./CHANGES.md
+[example]: ./example/
+[LICENSE]: ./LICENSE.md
+[opam file]: ./scfg.opam
+[test suite]: ./test/
+
+[documentation]: TODO
+[how to install opam]: https://opam.ocaml.org/doc/Install.html
+[OCaml]: https://ocaml.org
+[opam]: https://opam.ocaml.org/
+[scfg configuration file format]: https://git.sr.ht/~emersion/scfg

doc/dune

@@ -0,0 +1,3 @@
+(documentation
+ (package scfg)
+ (mld_files index))

doc/index.mld

@@ -0,0 +1,19 @@
+{0 scfg}
+
+{{:https://TODO} scfg} is an {{:https://ocaml.org} OCaml} library/executable to TODO.
+
+{1:api API}
+
+
+{!modules:
+Scfg
+}
+
+
+{1:private_api Private API}
+
+You shouldn't have to use any of these modules, they're used internally only.
+
+{!modules:
+TODO
+}

dune-project

@@ -0,0 +1,30 @@
+(lang dune 2.8)
+
+(name scfg)
+
+(license ISC)
+
+(authors "L\195\169o Andr\195\168s <contact@ndrs.fr>")
+
+(maintainers "L\195\169o Andr\195\168s <contact@ndrs.fr>")
+
+(source
+ (uri git+https://git.zapashcanon.fr/zapashcanon/scfg.git))
+
+(homepage https://git.zapashcanon.fr/zapashcanon/scfg)
+
+(bug_reports https://git.zapashcanon.fr/zapashcanon/scfg/issues)
+
+(generate_opam_files true)
+
+(package
+ (name scfg)
+ (synopsis "OCaml library/executable to TODO")
+ (description "scfg is an OCaml library/executable to TODO.")
+ (tags
+  (scfg configuration format simple config parser printer))
+ (depends
+  (ocaml
+   (>= 4.08))))
+
+(using menhir 2.1)

example/dune

@@ -0,0 +1,3 @@
+(executable
+ (name main)
+ (modules main))

example/main.ml

@@ -0,0 +1 @@
+let () = Format.printf "TODO@."

scfg.opam

@@ -0,0 +1,30 @@
+# This file is generated by dune, edit dune-project instead
+opam-version: "2.0"
+synopsis: "OCaml library/executable to TODO"
+description: "scfg is an OCaml library/executable to TODO."
+maintainer: ["Léo Andrès <contact@ndrs.fr>"]
+authors: ["Léo Andrès <contact@ndrs.fr>"]
+license: "ISC"
+tags: ["scfg" "configuration" "format" "simple" "config" "parser" "printer"]
+homepage: "https://git.zapashcanon.fr/zapashcanon/scfg"
+bug-reports: "https://git.zapashcanon.fr/zapashcanon/scfg/issues"
+depends: [
+  "dune" {>= "2.8"}
+  "ocaml" {>= "4.08"}
+  "odoc" {with-doc}
+]
+build: [
+  ["dune" "subst"] {dev}
+  [
+    "dune"
+    "build"
+    "-p"
+    name
+    "-j"
+    jobs
+    "@install"
+    "@runtest" {with-test}
+    "@doc" {with-doc}
+  ]
+]
+dev-repo: "git+https://git.zapashcanon.fr/zapashcanon/scfg.git"

src/dune

@@ -0,0 +1,17 @@
+(library
+ (public_name scfg)
+ (modules lexer menhir_parser parse pp types)
+ (private_modules lexer menhir_parser)
+ (preprocess
+  (pps sedlex.ppx))
+ (libraries menhirLib ppxlib sedlex)
+ (instrumentation
+  (backend bisect_ppx)))
+
+(executable
+ (public_name scfg)
+ (modules scfg)
+ (libraries scfg))
+
+(menhir
+ (modules menhir_parser))

src/lexer.ml

@@ -0,0 +1,102 @@
+open Sedlexing
+open Menhir_parser
+
+let ctl = [%sedlex.regexp? '\x00' .. '\x1f' | '\x7F']
+
+let wsp = [%sedlex.regexp? ' ' | '\t']
+
+let vchar = [%sedlex.regexp? Sub (any, ('\n' | ctl))]
+
+let sqchar = [%sedlex.regexp? Sub (any, ('\n' | ctl | '\''))]
+
+let dqchar = [%sedlex.regexp? Sub (any, ('\n' | ctl | '"' | '\\'))]
+
+let achar =
+  [%sedlex.regexp?
+    Sub (any, ('\n' | ctl | '"' | '\\' | '\'' | '{' | '}' | wsp))]
+
+let newline =
+  [%sedlex.regexp? Star wsp, '\n', Star wsp, Opt ('#', Sub (any, '\n'))]
+
+let esc_pair = [%sedlex.regexp? '\\', vchar]
+
+let squote_word = [%sedlex.regexp? '\'', Star sqchar, '\'']
+
+let dquote_word = [%sedlex.regexp? '"', Star (dqchar | esc_pair), '"']
+
+let atom = [%sedlex.regexp? Plus (achar | esc_pair)]
+
+let string_of_atom s =
+  let b = Buffer.create (String.length s) in
+  let i = ref 0 in
+  while !i < String.length s do
+    let c =
+      if s.[!i] <> '\\' then s.[!i]
+      else
+        match
+          incr i;
+          s.[!i]
+        with
+        | 'n' -> '\n'
+        | 'r' -> '\r'
+        | 't' -> '\t'
+        | '\\' -> '\\'
+        | '\'' -> '\''
+        | '"' -> '"'
+        | '{' -> '{'
+        | '}' -> '}'
+        | _c -> assert false
+    in
+    Buffer.add_char b c;
+    incr i
+  done;
+  Buffer.contents b
+
+let string_of_dqword s =
+  let b = Buffer.create (String.length s) in
+  let i = ref 0 in
+  while !i < String.length s do
+    let c =
+      if s.[!i] <> '\\' then s.[!i]
+      else
+        match
+          incr i;
+          s.[!i]
+        with
+        | 'n' -> '\n'
+        | 'r' -> '\r'
+        | 't' -> '\t'
+        | '\\' -> '\\'
+        | '"' -> '"'
+        | _c -> assert false
+    in
+    Buffer.add_char b c;
+    incr i
+  done;
+  Buffer.contents b
+
+exception Error
+
+let rec token buf =
+  match%sedlex buf with
+  (* 1 *)
+  | "{" -> LBRACE
+  | "}" -> RBRACE
+  (* other *)
+  | wsp -> token buf
+  | newline -> NEWLINE
+  | atom ->
+    let word = Utf8.lexeme buf in
+    let word = string_of_atom word in
+    WORD word
+  | dquote_word ->
+    let word = Utf8.lexeme buf in
+    let word = String.sub word 1 (String.length word - 2) in
+    let word = string_of_dqword word in
+    WORD word
+  | squote_word ->
+    let word = Utf8.lexeme buf in
+    let word = String.sub word 1 (String.length word - 2) in
+    WORD word
+  | eof -> EOF
+  | _ -> raise Error

src/menhir_parser.mly

@@ -0,0 +1,23 @@
+%token<String.t> WORD
+%token LBRACE RBRACE NEWLINE EOF
+
+%{ open Types %}
+
+%start <Types.config> config
+
+%%
+
+let params ==
+| ~ = list(WORD); <>
+
+let children ==
+| LBRACE; nonempty_list(NEWLINE); ~ = list(directive); RBRACE; <>
+| { [] }
+
+let directive :=
+| name = WORD; ~ = params; ~ = children; nonempty_list(NEWLINE); {
+  { name; params; children }
+}
+
+let config :=
+| ~ = list(directive); EOF; <>

src/parse.ml

@@ -0,0 +1,25 @@
+let provider buf () =
+  let tok = Lexer.token buf in
+  let start, stop = Sedlexing.lexing_positions buf in
+  (tok, start, stop)
+
+let parser_result =
+  let parser =
+    MenhirLib.Convert.Simplified.traditional2revised Menhir_parser.config
+  in
+  fun buf -> parser (provider buf)
+
+let parse buf =
+  try Ok (parser_result buf) with
+  | Menhir_parser.Error -> Error "parser error"
+  | Lexer.Error -> Error "lexer error"
+
+let from_string s = parse (Sedlexing.Utf8.from_string s)
+
+let from_channel c = parse (Sedlexing.Utf8.from_channel c)
+
+let from_file f =
+  let chan = open_in f in
+  let result = parse (Sedlexing.Utf8.from_channel chan) in
+  close_in chan;
+  result

src/pp.ml

@@ -0,0 +1,62 @@
+open Types
+
+let indent_s = ref "  "
+
+let rec indent fmt n =
+  if n = 0 then () else Format.fprintf fmt "%s%a" !indent_s indent (n - 1)
+
+let param =
+  let chars_to_quote = Hashtbl.create 512 in
+  Array.iter
+    (fun c -> Hashtbl.add chars_to_quote c ())
+    [| ' '; '{'; '}'; '"'; '\\'; '\''; '\n'; '\r'; '\t' |];
+  fun fmt param ->
+    if String.length param = 0 then Format.fprintf fmt {|""|}
+    else if String.exists (Hashtbl.mem chars_to_quote) param then begin
+      if String.contains param '"' && not (String.contains param '\'') then
+        Format.fprintf fmt {|'%s'|} param
+      else
+        let buf = Buffer.create (String.length param) in
+        String.iter
+          (function
+            | '\n' -> Buffer.add_string buf "\\n"
+            | '\r' -> Buffer.add_string buf "\\r"
+            | '\t' -> Buffer.add_string buf "\\t"
+            | '"' -> Buffer.add_string buf "\\\""
+            | '\\' -> Buffer.add_string buf "\\\\"
+            | c -> Buffer.add_char buf c )
+          param;
+        let param = Buffer.contents buf in
+        Format.fprintf fmt {|"%s"|} param
+    end
+    else Format.fprintf fmt "%s" param
+
+let params fmt = function
+  | [] -> ()
+  | params ->
+    Format.fprintf fmt " %a"
+      (Format.pp_print_list
+         ~pp_sep:(fun fmt () -> Format.fprintf fmt " ")
+         param )
+      params
+
+let rec children n fmt = function
+  | [] -> ()
+  | children ->
+    Format.fprintf fmt " {@.%a@.%a}" (config n) children indent (max 0 (n - 1))
+
+and directive n fmt d =
+  Format.fprintf fmt {|%a%a%a%a|} indent n param d.name params d.params
+    (children (n + 1))
+    d.children
+
+and config n fmt config =
+  Format.pp_print_list
+    ~pp_sep:(fun fmt () -> Format.fprintf fmt "@.%a" indent (max 0 (n - 2)))
+    (directive n) fmt config
+
+let children = children 0
+
+let directive = directive 0
+
+let config = config 0

src/scfg.ml

@@ -0,0 +1,21 @@
+open Scfg
+
+let error msg =
+  Format.eprintf "error: %s@." msg;
+  exit 1
+
+let () =
+  let argc = Array.length Sys.argv in
+
+  if argc <> 2 then error (Format.sprintf "usage: %s <file>" Sys.argv.(0));
+
+  let file = Sys.argv.(1) in
+
+  if not @@ Sys.file_exists file then
+    error (Format.sprintf "file `%s` doesn't exist" file);
+
+  match Parse.from_file file with
+  | Ok config -> Format.printf "%a@." Pp.config config
+  | Error e ->
+    Format.eprintf "error: %s@." e;
+    exit 1

src/types.ml

@@ -0,0 +1,7 @@
+type directive =
+  { name : string
+  ; params : string list
+  ; children : directive list
+  }
+
+type config = directive list

test/dune

@@ -0,0 +1,10 @@
+(test
+ (name main)
+ (modules main)
+ (libraries scfg)
+ (deps
+  lex_error.scfg
+  (glob_files parse_error*.scfg)
+  test.scfg
+  test.expected
+  test_chan.scfg))

test/lex_error.scfg

@@ -0,0 +1,2 @@
+a "b
+"

test/main.ml

@@ -0,0 +1,64 @@
+open Scfg
+
+let () =
+  (* Parsing and printing the test *)
+  let config =
+    match Parse.from_file "test.scfg" with
+    | Ok config -> config
+    | Error e ->
+      Format.eprintf "error: %s@." e;
+      assert false
+  in
+  let s = Format.asprintf "%a@." Pp.config config in
+
+  (* Reading the expected test*)
+  let chan = open_in "test.expected" in
+  let buf = Buffer.create (String.length s) in
+  begin
+    try
+      while true do
+        Buffer.add_string buf (input_line chan);
+        Buffer.add_string buf "\n"
+      done
+    with End_of_file -> ()
+  end;
+  let s_expected = Buffer.contents buf in
+
+  (* Comparing the two strings *)
+  assert (s = s_expected);
+
+  (* Checking that parsing the printed strings and reprinting it leads to the same result *)
+  let config =
+    match Parse.from_string s with
+    | Ok config -> config
+    | Error e ->
+      Format.eprintf "error: %s@." e;
+      assert false
+  in
+  let s = Format.asprintf "%a@." Pp.config config in
+
+  assert (s = s_expected)
+
+let () =
+  match Parse.from_file "lex_error.scfg" with
+  | Error "lexer error" -> ()
+  | Error _e -> assert false
+  | Ok _config -> assert false
+
+let () =
+  for i = 1 to 4 do
+    let file_name = Format.sprintf "parse_error%d.scfg" i in
+    match Parse.from_file file_name with
+    | Error "parser error" -> ()
+    | Error _e -> assert false
+    | Ok _config -> assert false
+  done
+
+let () =
+  let chan = open_in "test_chan.scfg" in
+  match Parse.from_channel chan with
+  | Error _e -> assert false
+  | Ok config ->
+    let expected = "a b c" in
+    let s = Format.asprintf "%a" Pp.config config in
+    assert (s = expected)

test/parse_error1.scfg

@@ -0,0 +1 @@
+a { } }

test/parse_error2.scfg

@@ -0,0 +1 @@
+a {

test/parse_error3.scfg

@@ -0,0 +1 @@
+a }

test/parse_error4.scfg

@@ -0,0 +1 @@
+a {}

test/test.expected

@@ -0,0 +1,18 @@
+train Shinkansen {
+  model E5 {
+    max-speed 320km/h
+    weight 453.5t
+    lines-served Tōhoku Hokkaido
+  }
+  model E7 {
+    max-speed 275km/h
+    weight 540t
+    lines-served Hokuriku Jōetsu
+  }
+  escapetests "A random line" "abracket{line" "anotherbracket}line" 'aquote"line' "anesc\\line" "asq'line" 'adq"line' 'asinglequote"{} \line' 'asinglequote"justewithadq' "dq\"and'sq"
+  emptytests "" ""
+  "an escaped name" a b c
+  namewithoutparam
+  p "unesc\nnewline" "unesc\rcr" "unesc\ttab"
+  q "new line \n" "cr \r" "tab \t"
+}

test/test.scfg

@@ -0,0 +1,22 @@
+train "Shinkansen" {
+	model "E5" {
+		max-speed 320km/h
+		weight 453.5t
+
+		lines-served "Tōhoku" "Hokkaido"
+	}
+
+	model "E7" {
+		max-speed 275km/h
+		weight 540t
+
+		lines-served "Hokuriku" "Jōetsu"
+	}
+
+	escapetests "A random line" abracket\{line anotherbracket\}line aquote\"line anesc\\line asq\'line adq\"line 'asinglequote"{} \line' 'asinglequote"justewithadq' "dq\"and'sq"
+	emptytests "" ''
+	"an escaped name" a b c
+	namewithoutparam
+	p unesc\nnewline unesc\rcr unesc\ttab
+	q "new line \n" "cr \r" "tab \t"
+}

test/test_chan.scfg

@@ -0,0 +1 @@
+a b c