basic architecture for the doc tests

.gitignore

@@ -8,7 +8,6 @@ Version.ml
 **/.DS_Store
 .vscode/
 /ligo.install
+*.coverage
 /_coverage/
-/_coverage_all/
-/_coverage_ligo/
-/_coverage_cli/
+/_coverage_*/

Makefile

@@ -45,9 +45,12 @@ coverage-ligo: clean
 	bisect-ppx-report html -o ./_coverage_ligo --title="LIGO test coverage"
 	bisect-ppx-report summary --per-file
 
+coverage-doc: clean
+	BISECT_ENABLE=yes dune build @doc-test --force
+	bisect-ppx-report html -o ./_coverage_doc --title="LIGO doc coverage"
+	bisect-ppx-report summary --per-file
+
 coverage-cli: clean
 	BISECT_ENABLE=yes dune runtest src/bin/expect_tests
 	bisect-ppx-report html -o ./_coverage_cli --title="CLI test coverage"
-	bisect-ppx-report summary --per-file
-	# PRE="CLI coverage: "
-	# bisect-ppx-report summary --per-file | grep 'src/bin/cli.ml\|src/bin/cli_helpers.ml' | awk -v ORS=" " '{print $1}' | awk -v PRE=${PRE} -v POST="%" '{print PRE ($1 + $2 / NF) POST}'
+	bisect-ppx-report summary --per-file

gitlab-pages/docs/language-basics/sets-lists-touples.md

@@ -15,7 +15,7 @@ Sets are similar to lists. The main difference is that elements of a `set` must
 
 <!--DOCUSAURUS_CODE_TABS-->
 <!--Pascaligo-->
-```pascaligo
+```pascaligo group=a
 type int_set is set(int);
 const my_set: int_set = set 
     1; 
@@ -25,14 +25,14 @@ end
 ```
 
 <!--CameLIGO-->
-```cameligo
+```cameligo group=a
 type int_set = int set
 let my_set: int_set =
   Set.add 3 (Set.add 2 (Set.add 1 (Set.empty: int set)))
 ```
 
 <!--ReasonLIGO-->
-```reasonligo
+```reasonligo group=a
 type int_set = set(int);
 let my_set: int_set =
   Set.add(3, Set.add(2, Set.add(1, Set.empty: set(int))));
@@ -44,16 +44,16 @@ let my_set: int_set =
 
 <!--DOCUSAURUS_CODE_TABS-->
 <!--Pascaligo-->
-```pascaligo
+```pascaligo group=a
 const my_set: int_set = set end;
 const my_set_2: int_set = set_empty;
 ```
 <!--CameLIGO-->
-```cameligo
+```cameligo group=a
 let my_set: int_set = (Set.empty: int set)
 ```
 <!--ReasonLIGO-->
-```reasonligo
+```reasonligo group=a
 let my_set: int_set = (Set.empty: set(int));
 ```
 <!--END_DOCUSAURUS_CODE_TABS-->
@@ -62,18 +62,18 @@ let my_set: int_set = (Set.empty: set(int));
 
 <!--DOCUSAURUS_CODE_TABS-->
 <!--Pascaligo-->
-```pascaligo
+```pascaligo group=a
 const contains_three: bool = my_set contains 3;
 // or alternatively
 const contains_three_fn: bool = set_mem(3, my_set);
 ```
 
 <!--CameLIGO-->
-```cameligo
+```cameligo group=a
 let contains_three: bool = Set.mem 3 my_set
 ```
 <!--ReasonLIGO-->
-```reasonligo
+```reasonligo group=a
 let contains_three: bool = Set.mem(3, my_set);
 ```
 
@@ -83,17 +83,17 @@ let contains_three: bool = Set.mem(3, my_set);
 ### Obtaining the size of a set
 <!--DOCUSAURUS_CODE_TABS-->
 <!--Pascaligo-->
-```pascaligo
+```pascaligo group=a
 const set_size: nat = size(my_set);
 ```
 
 <!--CameLIGO-->
-```cameligo
+```cameligo group=a
 let set_size: nat = Set.size my_set
 ```
 
 <!--ReasonLIGO-->
-```reasonligo
+```reasonligo group=a
 let set_size: nat = Set.size(my_set);
 ```
 
@@ -103,21 +103,21 @@ let set_size: nat = Set.size(my_set);
 ### Modifying a set
 <!--DOCUSAURUS_CODE_TABS-->
 <!--Pascaligo-->
-```pascaligo
+```pascaligo group=a
 const larger_set: int_set = set_add(4, my_set);
 const smaller_set: int_set = set_remove(3, my_set);
 ```
 
 <!--CameLIGO-->
 
-```cameligo
+```cameligo group=a
 let larger_set: int_set = Set.add 4 my_set
 let smaller_set: int_set = Set.remove 3 my_set
 ```
 
 <!--ReasonLIGO-->
 
-```reasonligo
+```reasonligo group=a
 let larger_set: int_set = Set.add(4, my_set);
 let smaller_set: int_set = Set.remove(3, my_set);
 ```
@@ -128,20 +128,20 @@ let smaller_set: int_set = Set.remove(3, my_set);
 ### Folding a set
 <!--DOCUSAURUS_CODE_TABS-->
 <!--Pascaligo-->
-```pascaligo
+```pascaligo group=a
 function sum(const result: int; const i: int): int is result + i;
 // Outputs 6
 const sum_of_a_set: int = set_fold(sum, my_set, 0);
 ```
 
 <!--CameLIGO-->
-```cameligo
+```cameligo group=a
 let sum (result: int) (i: int) : int = result + i
 let sum_of_a_set: int = Set.fold sum my_set 0
 ```
 
 <!--ReasonLIGO-->
-```reasonligo
+```reasonligo group=a
 let sum = (result: int, i: int): int => result + i;
 let sum_of_a_set: int = Set.fold(sum, my_set, 0);
 ```
@@ -157,7 +157,7 @@ Lists are similar to sets, but their elements don't need to be unique and they d
 
 <!--DOCUSAURUS_CODE_TABS-->
 <!--Pascaligo-->
-```pascaligo
+```pascaligo group=b
 type int_list is list(int);
 const my_list: int_list = list
     1;
@@ -167,13 +167,13 @@ end
 ```
 
 <!--CameLIGO-->
-```cameligo
+```cameligo group=b
 type int_list = int list
 let my_list: int_list = [1; 2; 3]
 ```
 
 <!--ReasonLIGO-->
-```reasonligo
+```reasonligo group=b
 type int_list = list(int);
 let my_list: int_list = [1, 2, 3];
 ```
@@ -185,21 +185,21 @@ let my_list: int_list = [1, 2, 3];
 
 <!--DOCUSAURUS_CODE_TABS-->
 <!--Pascaligo-->
-```pascaligo
+```pascaligo group=b
 const larger_list: int_list = cons(4, my_list);
 const even_larger_list: int_list = 5 # larger_list;
 ```
 
 <!--CameLIGO-->
-```cameligo
+```cameligo group=b
 let larger_list: int_list = 4 :: my_list
 (* CameLIGO doesn't have a List.cons *)
 ```
 
 <!--ReasonLIGO-->
-```reasonligo
+```reasonligo group=b
 let larger_list: int_list = [4, ...my_list];
-/* ReasonLIGO doesn't have a List.cons */
+(* ReasonLIGO doesn't have a List.cons *)
 ```
 
 <!--END_DOCUSAURUS_CODE_TABS-->
@@ -211,7 +211,7 @@ let larger_list: int_list = [4, ...my_list];
 
 <!--DOCUSAURUS_CODE_TABS-->
 <!--Pascaligo-->
-```pascaligo
+```pascaligo group=b
 function increment(const i: int): int is block { skip } with i + 1;
 // Creates a new list with elements incremented by 1
 const incremented_list: int_list = list_map(increment, even_larger_list);
@@ -219,7 +219,7 @@ const incremented_list: int_list = list_map(increment, even_larger_list);
 
 <!--CameLIGO-->
 
-```cameligo
+```cameligo group=b
 let increment (i: int) : int = i + 1
 (* Creates a new list with elements incremented by 1 *)
 let incremented_list: int_list = List.map increment larger_list
@@ -228,9 +228,9 @@ let incremented_list: int_list = List.map increment larger_list
 
 <!--ReasonLIGO-->
 
-```reasonligo
+```reasonligo group=b
 let increment = (i: int): int => i + 1;
-/* Creates a new list with elements incremented by 1 */
+(* Creates a new list with elements incremented by 1 *)
 let incremented_list: int_list = List.map(increment, larger_list);
 ```
 
@@ -240,7 +240,7 @@ let incremented_list: int_list = List.map(increment, larger_list);
 ### Folding of a list:
 <!--DOCUSAURUS_CODE_TABS-->
 <!--Pascaligo-->
-```pascaligo
+```pascaligo group=b
 function sum(const result: int; const i: int): int is block { skip } with result + i;
 // Outputs 6
 const sum_of_a_list: int = list_fold(sum, my_list, 0);
@@ -248,7 +248,7 @@ const sum_of_a_list: int = list_fold(sum, my_list, 0);
 
 <!--CameLIGO-->
 
-```cameligo
+```cameligo group=b
 let sum (result: int) (i: int) : int = result + i
 // Outputs 6
 let sum_of_a_list: int = List.fold sum my_list 0
@@ -256,9 +256,9 @@ let sum_of_a_list: int = List.fold sum my_list 0
 
 <!--ReasonLIGO-->
 
-```reasonligo
+```reasonligo group=b
 let sum = (result: int, i: int): int => result + i;
-/* Outputs 6 */
+(* Outputs 6 *)
 let sum_of_a_list: int = List.fold(sum, my_list, 0);
 ```
 
@@ -287,22 +287,22 @@ sake of illustration.
 
 <!--DOCUSAURUS_CODE_TABS-->
 <!--Pascaligo-->
-```pascaligo
+```pascaligo group=c
 type full_name is string * string;
 const full_name: full_name = ("Alice", "Johnson");
 ```
 
 <!--CameLIGO-->
-```cameligo
+```cameligo group=c
 type full_name = string * string
 (* The parenthesis here are optional *)
 let full_name: full_name = ("Alice", "Johnson")
 ```
 
 <!--ReasonLIGO-->
-```reasonligo
+```reasonligo group=c
 type full_name = (string, string);
-/* The parenthesis here are optional */
+(* The parenthesis here are optional *)
 let full_name: full_name = ("Alice", "Johnson");
 ```
 
@@ -320,17 +320,17 @@ Tuple elements are one-indexed and accessed like so:
 
 <!--DOCUSAURUS_CODE_TABS-->
 <!--Pascaligo-->
-```pascaligo
+```pascaligo group=c
 const first_name: string = full_name.1;
 ```
 
 <!--CameLIGO-->
-```cameligo
+```cameligo group=c
 let first_name: string = full_name.1
 ```
 
 <!--ReasonLIGO-->
-```reasonligo
+```reasonligo group=c
 let first_name: string = full_name[1];
 ```
 

src/main/compile/helpers.ml

@@ -68,15 +68,6 @@ let parsify_reasonligo = fun source ->
     Simplify.Cameligo.simpl_program raw in
   ok simplified
 
-let parsify_string_reasonligo = fun source ->
-  let%bind raw =
-    trace (simple_error "parsing") @@
-    Parser.Reasonligo.parse_string source in
-  let%bind simplified =
-    trace (simple_error "simplifying") @@
-    Simplify.Cameligo.simpl_program raw in
-  ok simplified
-
 let parsify_expression_reasonligo = fun source ->
   let%bind raw =
     trace (simple_error "parsing expression") @@
@@ -105,3 +96,40 @@ let parsify_expression = fun syntax source ->
   let%bind parsified = parsify source in
   let%bind applied = Self_ast_simplified.all_expression parsified in
   ok applied
+
+let parsify_string_reasonligo = fun source ->
+  let%bind raw =
+    trace (simple_error "parsing") @@
+    Parser.Reasonligo.parse_string source in
+  let%bind simplified =
+    trace (simple_error "simplifying") @@
+    Simplify.Cameligo.simpl_program raw in
+  ok simplified
+
+let parsify_string_pascaligo = fun source ->
+  let%bind raw =
+    trace (simple_error "parsing") @@
+    Parser.Pascaligo.parse_string source in
+  let%bind simplified =
+    trace (simple_error "simplifying") @@
+    Simplify.Pascaligo.simpl_program raw in
+  ok simplified
+
+let parsify_string_cameligo = fun source ->
+  let%bind raw =
+    trace (simple_error "parsing") @@
+    Parser.Cameligo.parse_string source in
+  let%bind simplified =
+    trace (simple_error "simplifying") @@
+    Simplify.Cameligo.simpl_program raw in
+  ok simplified
+
+let parsify_string = fun (syntax : v_syntax) source_filename ->
+  let%bind parsify = match syntax with
+    | Pascaligo -> ok parsify_string_pascaligo
+    | Cameligo -> ok parsify_string_cameligo
+    | ReasonLIGO -> ok parsify_string_reasonligo
+  in
+  let%bind parsified = parsify source_filename in
+  let%bind applied = Self_ast_simplified.all_program parsified in
+  ok applied

src/main/compile/of_source.ml

@@ -6,6 +6,10 @@ let compile (source_filename:string) syntax : Ast_simplified.program result =
   let%bind simplified = parsify syntax source_filename in
   ok simplified
 
+let compile_string (source:string) syntax : Ast_simplified.program result =
+  let%bind simplified = parsify_string syntax source in
+  ok simplified
+
 let compile_expression : v_syntax -> string -> Ast_simplified.expression result =
     fun syntax exp ->
   parsify_expression syntax exp

src/test/doc_test.ml

@@ -0,0 +1,8 @@
+open Test_helpers
+
+let () =
+  Printexc.record_backtrace true ;
+  run_test @@ test_suite "LIGO" [
+    Md_file_tests.main ;
+  ] ;
+  ()

src/test/dune

@@ -1,5 +1,7 @@
+(ocamllex md)
+
 (executables
-  (names test manual_test)
+  (names test manual_test doc_test)
   (libraries
     simple-utils
     ligo
@@ -12,6 +14,12 @@
   (flags (:standard -w +1..62-4-9-44-40-42-48@39@33 -open Simple_utils ))
 )
 
+(alias
+  (name doc-test)
+  (action (run ./doc_test.exe))
+  (deps (source_tree ../../gitlab-pages/docs/language-basics))
+)
+
 (alias
   (name ligo-test)
   (action (run ./test.exe))

src/test/md.mll

@@ -0,0 +1,62 @@
+{
+(* initial version taken from https://github.com/realworldocaml/mdx *)
+type arg = 
+  | Field of string
+  | NameValue of string * string
+
+type block = {
+  line    : int;
+  file    : string;
+  arguments: arg list;
+  header  : string option;
+  contents: string list;
+}
+
+exception Err of string
+
+let line_ref = ref 1
+
+let newline lexbuf =
+  Lexing.new_line lexbuf;
+  incr line_ref
+}
+
+let eol = '\n' | eof
+let ws = ' ' | '\t'
+
+rule text = parse
+  | eof { [] }
+  | "```" ([^' ' '\n']* as h) ws* ([^'\n']* as l) eol
+      { 
+        let header = if h = "" then None else Some h in
+        let contents = block lexbuf in
+        let arguments = String.split_on_char ' ' l in
+        let arguments = List.map (fun a -> 
+          if (String.contains a '=') then
+            ( let a = String.split_on_char '=' a in
+            NameValue (List.nth a 0, List.nth a 1))
+          else 
+            Field a
+        ) arguments in
+        let file = lexbuf.Lexing.lex_start_p.Lexing.pos_fname in
+        newline lexbuf;
+        let line = !line_ref in
+        List.iter (fun _ -> newline lexbuf) contents;
+        newline lexbuf;
+        { file; line; header; arguments; contents; }
+        :: text lexbuf }
+  | [^'\n']* eol
+      { newline lexbuf;
+        text lexbuf }
+
+and block = parse
+  | eof | "```" ws* eol    { [] }
+  | ([^'\n'] * as str) eol { str :: block lexbuf }
+
+{
+let token lexbuf =
+  try
+    text lexbuf
+  with Failure _ -> 
+    raise (Err "incomplete code block")
+}

src/test/md_file_tests.ml

@@ -0,0 +1,74 @@
+open Trace
+open Test_helpers
+
+module SnippetsGroup = Map.Make(struct type t = (string * string) let compare a b = compare a b end)
+
+let failed_to_compile_md_file md_file (s,group,prg) =
+  let title () = "Failed to compile "^s^" group '"^group^"' in file '"^md_file^"'" in
+  let content () = "unable to compile the program down to michelson" in
+  let data = [
+    ("source" , fun () -> Format.asprintf "%s" prg) ;
+  ] in
+  error ~data title content
+
+(**
+  binds the snippets by (syntax, group_name)
+  e.g. :(pascaligo, a) -> "let .. in let .. in"
+        (cameligo,  a) -> "let .. in let .. in"
+  syntax and group_name being retrieved from the .md file header & arguments
+  e.g. : ```syntax group=group_name ...some code ...  ```
+**)
+let get_groups md_file =
+  let channel = open_in md_file in
+  let lexbuf = Lexing.from_channel channel in
+  let code_blocks = Md.token lexbuf in
+  List.fold_left
+    (fun (grp_map: _ SnippetsGroup.t) (el:Md.block) ->
+      match el.header  with
+      | Some s ->
+        List.fold_left
+          (fun grp_map arg -> match arg with
+              | Md.NameValue ("group", name) ->
+                SnippetsGroup.update (s,name)
+                  (fun arg_content ->
+                    match arg_content with
+                    | Some ct -> Some (String.concat "\n" (ct::el.contents))
+                    | None -> Some (String.concat "\n" el.contents)
+                  )
+                  grp_map
+              | _ -> grp_map
+          )
+          grp_map el.arguments
+      | None -> grp_map
+    )
+    SnippetsGroup.empty code_blocks
+
+(**
+  evaluate each expression in each programs from the snippets group map
+**)
+let compile_groups _filename (grp_map: _ SnippetsGroup.t) =
+  let grp_list = SnippetsGroup.bindings grp_map in
+  let%bind _michelsons = bind_map_list 
+    (fun ((s,_grp),contents) ->
+      (*TODO: hierarchical error ?*)
+      trace_strong (failed_to_compile_md_file _filename (s,_grp,contents)) @@
+      let%bind v_syntax   = Compile.Helpers.syntax_to_variant (Syntax_name s) None in
+      let%bind simplified = Compile.Of_source.compile_string contents v_syntax in
+      let%bind typed,_    = Compile.Of_simplified.compile simplified in
+      let%bind mini_c     = Compile.Of_typed.compile typed in
+      bind_map_list
+        (fun ((_,exp),_) -> Compile.Of_mini_c.aggregate_and_compile_expression mini_c exp) 
+        mini_c
+    ) 
+    grp_list in
+  ok ()
+
+let compile filename () = 
+  let groups = get_groups filename in
+  let%bind () = compile_groups filename groups in
+  ok ()
+
+let md_root = "../../gitlab-pages/docs/language-basics/"
+let main = test_suite "Markdown files" [
+    test "sets_lists_touples" (compile (md_root^"sets-lists-touples.md")) ;
+  ]