test/test_overlay.ml


1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45

module L = Colitur_kernel.Layer
module Cel = Colitur_kernel.Celebration
module S = Colitur_kernel.Slug
module DS = Colitur_kernel.Date_spec
module Col = Colitur_kernel.Colour

type rank = Class1 | Class3 [@@deriving sexp]

let slug = S.of_string_exn

let cel ?(rank = Class3) ?(colour = Col.White) s =
  Cel.make ~slug:(slug s) ~rank ~colour ~layer:"base" ()

let entry ?(month = 1) ?(day = 1) ?rank ?colour s =
  { L.date = (match DS.fixed ~month ~day with Ok d -> d | Error e -> failwith e);
    cel = cel ?rank ?colour s }

let base () =
  L.of_entries ~id:"base" ~name:"Test base"
    [ entry ~month:1 ~day:5 "telesphorus"; entry ~month:1 ~day:14 "hilary" ]

let test_layer_basics () =
  let l = base () in
  Alcotest.(check bool) "find present" true (L.find l (slug "hilary") <> None);
  Alcotest.(check bool) "find absent" true (L.find l (slug "nobody") = None);
  Alcotest.(check bool) "mem" true (L.mem l (slug "telesphorus"));
  (* canonical order is by slug, so sexp output is byte-stable *)
  Alcotest.(check (list string)) "canonical order" [ "hilary"; "telesphorus" ]
    (List.map (fun e -> S.to_string e.L.cel.Cel.slug) l.L.entries)

let test_layer_index () =
  let idx = L.index_by_date (base ()) in
  Alcotest.(check int) "Jan 14 has one" 1 (List.length (L.on_date idx ~month:1 ~day:14));
  Alcotest.(check int) "Jan 20 has none" 0 (List.length (L.on_date idx ~month:1 ~day:20))

let test_layer_sexp () =
  let l = base () in
  let sexp = L.sexp_of_t sexp_of_rank l in
  Alcotest.(check bool) "roundtrip" true (L.t_of_sexp rank_of_sexp sexp = l)

let suite =
  ( "Layer/Overlay",
    [ Alcotest.test_case "layer basics" `Quick test_layer_basics;
      Alcotest.test_case "layer by-date index" `Quick test_layer_index;
      Alcotest.test_case "layer sexp" `Quick test_layer_sexp ] )