(*
 * Opifex
 *
 * Copyrights(C) 2012,2013 by Pawel Wieczorek <wieczyk at gmail>
 *)

open Camlp4
open Camlp4.PreCast
open Syntax

(*********************************************************************************************************************
 * Helpers
 ********************************************************************************************************************)

let create_ocaml_list _loc exprs =
    let add_to_list expr list_expr = <:expr< $expr$ :: $list_expr$ >> in
    List.fold_right add_to_list exprs <:expr<[]>>

let create_converted_ocaml_list _loc f exprs =
    create_ocaml_list _loc (List.map (f _loc) exprs)

let get_filename _loc = Filename.basename (Loc.file_name _loc)


(*********************************************************************************************************************
 * SYNTAX: testgroup
 *
 * "testgroup" "begin"
 *      <<ModuleName1>> ...
 * "end"
 *
 * is handled as
 * build_testgroup _ [ <<ModuleName1>> ; ...  ]
 *
 ********************************************************************************************************************)

let change_module_name_to_test_suite_reference _loc module_name =
    <:expr< $lid:module_name$.test_suite >>

let build_testgroup _loc list_of_modules =
    let test_group_name             = get_filename _loc in
    let test_group_list_expression  = create_converted_ocaml_list
        _loc
        change_module_name_to_test_suite_reference
        list_of_modules
        in
    <:str_item<
        let test_suite = $str:test_group_name$ >::: $test_group_list_expression$
    >>


(*********************************************************************************************************************
 *
 ********************************************************************************************************************)

let create_test_suite _loc identifier test_body =
    let test_func_name  = "test_" ^ identifier in
    let test_case_name  = <:expr<$str:identifier$>> in
    let test_func_patt  = <:patt<$lid:test_func_name$>> in
    let test_definition =
        <:str_item<
            let $test_func_patt$ = $test_case_name$ >:: begin fun () ->
                $test_body$
            end
        >> in

    (test_func_name, test_definition)

let create_test_list _loc identifier test_names =
    let test_name_expr n = <:expr<$lid:n$>> in
    let test_names_expr = List.map test_name_expr test_names in
    <:str_item<
        let $lid:identifier$ = $create_ocaml_list _loc test_names_expr$
    >>

let create_test_list_and_tests _loc identifier test_suites =
    let test_names          = List.map fst test_suites in
    let test_definitions    = List.map snd test_suites in

    let test_list   = create_test_list _loc identifier test_names in

    Ast.stSem_of_list (test_definitions @ [test_list])

(*********************************************************************************************************************
 * Grammar
 ********************************************************************************************************************)

EXTEND Gram
  GLOBAL: str_item;

    one_test:
      [ [ "test"; identifier = a_ident; "="; test_body = expr -> begin
        create_test_suite _loc identifier test_body
        end

        ]];

    testlist:
    [[ "Testlist"; identifier = a_ident; "begin"; tests = LIST1 one_test;  "end"  -> begin
        create_test_list_and_tests _loc identifier tests
        end
    ]];

    testgroup:
    [[ "testgroup"; "begin"; modules = LIST1 a_UIDENT; "end" -> begin
        build_testgroup _loc modules
        end
    ]];

    str_item:
        [[ testlist = testlist ->
            testlist

        | testgroup = testgroup ->
            testgroup
        ]];

END