path: root/lib/fixture.ml

let names =
  [ "Alice"
  ; "Bob"
  ; "Charlie"
  ; "Dave"
  ; "Eve"
  ; "Frank"
  ; "Grace"
  ; "Heidi"
  ; "Ivan"
  ; "Judy"
  ; "Mallory"
  ; "Oscar"
  ; "Peggy"
  ; "Sybil"
  ; "Trent"
  ; "Victor"
  ; "Walter"
  ]


let email_handles =
  [ "alice"
  ; "bob"
  ; "charlie"
  ; "dave"
  ; "eve"
  ; "frank"
  ; "grace"
  ; "heidi"
  ; "ivan"
  ; "judy"
  ; "mallory"
  ; "oscar"
  ; "peggy"
  ; "sybil"
  ; "trent"
  ; "victor"
  ; "walter"
  ; "slash"
  ; "mercenary"
  ; "dollar"
  ; "winz0r"
  ; "h4x0r"
  ]


let email_hosts =
  [ "gmail.com"
  ; "yahoo.com"
  ; "hotmail.com"
  ; "fastmail.fr"
  ; "mccd.space"
  ; "protonmail.com"
  ]


let random_value_in_list values () = List.nth values (Random.int (List.length values))

type compiled =
  | Int of int
  | String of string
  | Bool of bool
  | Float of float
[@@deriving eq]

let show_compiled_csv fixture =
  match fixture with
  | Int i -> string_of_int i
  | String s -> s
  | Bool b -> string_of_bool b
  | Float f -> string_of_float f


let random_email index () =
  random_value_in_list email_handles ()
  ^ index
  ^ "@"
  ^ random_value_in_list email_hosts ()


let random_name () = List.nth names (Random.int (List.length names))
let%test "random_name" = List.mem (random_name ()) names

let json_of_compiled fixture =
  match fixture with
  | Int i -> string_of_int i
  | String s -> "\"" ^ s ^ "\""
  | Bool b -> string_of_bool b
  | Float f -> string_of_float f


let key_of_compiled key =
  match key with
  | Int _ -> failwith "Int is not a valid key"
  | String s -> s
  | Bool _ -> failwith "Bool is not a valid key"
  | Float _ -> failwith "Float is not a valid key"


type t =
  | Name of string
  | Username of string
  | Uuidv4 of string
  | Foreign of string * compiled list
  | Int of string * int * int
  | Increment of string
  | Const of string * string
  | Email of string
  | Past of string
  | Future of string
  | Now of string
  | List of string * string list
(* (Name, foreign ids to pick from) *)

let generate_fixture index fixture =
  let str_index = string_of_int index in
  match fixture with
  | Name _ -> String (random_name () ^ str_index)
  | Username _ -> String (random_value_in_list email_handles () ^ str_index)
  | Uuidv4 _ -> String (Uuidm.v `V4 |> Uuidm.to_string)
  | Foreign (_, reference) -> random_value_in_list reference ()
  | Increment _ -> Int (index + 1)
  | Const (_, value) -> String value
  | Email _ -> String (random_email str_index ())
  | Int (_, min, max) -> Int (Random.int (max - min) + min)
  | Past _ ->
    let now = Unix.time () in
    String (ISO8601.Permissive.string_of_datetimezone (Random.float now, 0.))
  | Future _ ->
    let now = Unix.time () in
    String
      (ISO8601.Permissive.string_of_datetimezone (Random.float (Float.mul now 2.), 0.))
  | Now _ ->
    let now = Unix.time () in
    String (ISO8601.Permissive.string_of_datetimezone (now, 0.))
  | List (_, values) -> String (random_value_in_list values ())


let add_name name fixtures = Name name :: fixtures
let add_uuid uuid fixtures = Uuidv4 uuid :: fixtures
let add_foreign id values fixtures = Foreign (id, values) :: fixtures

let%test "random_value_in_list" =
  let values = [ "a"; "b"; "c" ] in
  let result = random_value_in_list values () in
  List.mem result values


(* TODO: Support "hashed" password *)
(* TODO: Support variables using @ *)

let rec replicate element n =
  match n with
  | 0 -> []
  | n -> element :: replicate element (n - 1)


let%test "generate_uuid" =
  generate_fixture 1 (Uuidv4 "some_id") != generate_fixture 1 (Uuidv4 "some_id")


let id_of_fixture fixture =
  let id =
    match fixture with
    | Name id -> id
    | Uuidv4 id -> id
    | Username id -> id
    | Increment id -> id
    | Foreign (id, _) -> id
    | Const (id, _) -> id
    | Int (id, _, _) -> id
    | List (id, _) -> id
    | Email id -> id
    | Past id -> id
    | Future id -> id
    | Now id -> id
  in
  String id


let compile fixtures ~amount =
  let identifiers = List.map id_of_fixture fixtures in
  let values =
    replicate fixtures amount
    |> List.mapi (fun index -> List.map (generate_fixture index))
  in
  identifiers :: values


let%test "create" =
  let defs = compile [ Uuidv4 "id"; Name "name" ] ~amount:2 in
  match defs with
  | [ [ String "id"; String "name" ]; [ _; _ ]; [ _; _ ] ] -> true
  | _ -> false


let get_id foreign_fixture =
  match String.split_on_char '.' foreign_fixture with
  | [ _; id ] -> Ok id
  | _ -> Error "Not a foreign fixture"


let rec csv_of_string_list (strs : compiled list) =
  match strs with
  | [] -> ""
  | str :: [] -> show_compiled_csv str
  | str :: rest -> show_compiled_csv str ^ "," ^ csv_of_string_list rest


let find_entries_for_header str_fixtures str =
  match str_fixtures with
  | [] -> Error "No fixtures"
  | header :: rest ->
    let maybe_index = List.find_index (fun s -> s = String str) header in
    (match maybe_index with
     | Some index -> Ok (List.map (fun row -> List.nth row index) rest)
     | None -> Error ("Could not find header: " ^ str ^ " in " ^ csv_of_string_list header))


let csv_of_generated_fixtures fixtures =
  let of_strings = List.map csv_of_string_list fixtures in
  String.concat "\n" of_strings


let%test "csv_of_generated_fixtures" =
  let result =
    [ [ String "id"; String "name" ]; [ String "1234"; String "John" ] ]
    |> csv_of_generated_fixtures
  in
  result = "id,name\n1234,John"


let json_of_pair (key, value) =
  "\"" ^ key_of_compiled key ^ "\": " ^ json_of_compiled value


let json_of_generated_fixtures (fixtures : compiled list list) =
  let headers = List.hd fixtures in
  let rows = List.tl fixtures in
  let json_of_row row =
    let pairs = List.combine headers row in
    "{" ^ String.concat ", " (List.map json_of_pair pairs) ^ "}"
  in
  "[" ^ String.concat ", " (List.map json_of_row rows) ^ "]"


let%test "json_of_generated_fixtures" =
  let result =
    [ [ String "id"; String "name" ]; [ Int 1234; String "John" ] ]
    |> json_of_generated_fixtures
  in
  result = "[{\"id\": 1234, \"name\": \"John\"}]"