Source file metadata.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
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
open Yojson.Safe.Util

type t = {
  render_modes : string list;
  render_fps : int option;
  authors : string list;
  description : string option;
  version : string option;
  supported_vector_modes : string list;
  tags : string list;
  extra : Yojson.Safe.t option;
}

let default =
  {
    render_modes = [];
    render_fps = None;
    authors = [];
    description = None;
    version = None;
    supported_vector_modes = [];
    tags = [];
    extra = None;
  }

let add_render_mode mode metadata =
  if List.exists (String.equal mode) metadata.render_modes then metadata
  else { metadata with render_modes = metadata.render_modes @ [ mode ] }

let supports_render_mode mode metadata =
  List.exists (String.equal mode) metadata.render_modes

let with_render_fps render_fps metadata = { metadata with render_fps }
let with_description description metadata = { metadata with description }
let with_version version metadata = { metadata with version }

let add_author author metadata =
  if List.exists (String.equal author) metadata.authors then metadata
  else { metadata with authors = metadata.authors @ [ author ] }

let add_tag tag metadata =
  if List.exists (String.equal tag) metadata.tags then metadata
  else { metadata with tags = metadata.tags @ [ tag ] }

let set_tags tags metadata = { metadata with tags }

let to_yojson metadata =
  let assoc =
    [
      ( "render_modes",
        `List (List.map (fun mode -> `String mode) metadata.render_modes) );
      ( "supported_vector_modes",
        `List
          (List.map (fun mode -> `String mode) metadata.supported_vector_modes)
      );
      ( "authors",
        `List (List.map (fun author -> `String author) metadata.authors) );
      ("tags", `List (List.map (fun tag -> `String tag) metadata.tags));
    ]
  in
  let assoc =
    match metadata.render_fps with
    | None -> assoc
    | Some fps -> ("render_fps", `Int fps) :: assoc
  in
  let assoc =
    match metadata.description with
    | None -> assoc
    | Some description -> ("description", `String description) :: assoc
  in
  let assoc =
    match metadata.version with
    | None -> assoc
    | Some version -> ("version", `String version) :: assoc
  in
  let assoc =
    match metadata.extra with
    | None -> assoc
    | Some extra -> ("extra", extra) :: assoc
  in
  `Assoc assoc

let string_list_member key json =
  match member key json with
  | `Null -> []
  | `List values -> List.map to_string values
  | _ ->
      raise
        (Failure (Printf.sprintf "metadata.%s must be a list of strings" key))

let optional_string key json =
  match member key json with
  | `Null -> None
  | `String s -> Some s
  | _ ->
      raise
        (Failure (Printf.sprintf "metadata.%s must be a string or null" key))

let optional_int key json =
  match member key json with
  | `Null -> None
  | `Int i -> Some i
  | `Intlit lit ->
      raise
        (Failure
           (Printf.sprintf
              "metadata.%s must be an int or null (string literal %S received)"
              key lit))
  | _ ->
      raise (Failure (Printf.sprintf "metadata.%s must be an int or null" key))

let extra_member json =
  match member "extra" json with `Null -> None | value -> Some value

let of_yojson json =
  try
    let render_modes = string_list_member "render_modes" json in
    let supported_vector_modes =
      string_list_member "supported_vector_modes" json
    in
    let authors = string_list_member "authors" json in
    let tags = string_list_member "tags" json in
    let render_fps = optional_int "render_fps" json in
    let description = optional_string "description" json in
    let version = optional_string "version" json in
    let extra = extra_member json in
    Ok
      {
        render_modes;
        render_fps;
        authors;
        description;
        version;
        supported_vector_modes;
        tags;
        extra;
      }
  with Failure msg -> Error msg