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
139
140
141
142
143
144
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 list_field key values =
    (key, `List (List.map (fun v -> `String v) values))
  in
  let base_fields =
    [
      list_field "authors" metadata.authors;
      list_field "render_modes" metadata.render_modes;
      list_field "supported_vector_modes" metadata.supported_vector_modes;
      list_field "tags" metadata.tags;
    ]
  in
  let add_opt key to_json opt acc =
    match opt with None -> acc | Some value -> (key, to_json value) :: acc
  in
  let fields =
    base_fields
    |> add_opt "description" (fun s -> `String s) metadata.description
    |> add_opt "extra" (fun json -> json) metadata.extra
    |> add_opt "render_fps" (fun fps -> `Int fps) metadata.render_fps
    |> add_opt "version" (fun v -> `String v) metadata.version
  in
  let sorted = List.sort (fun (a, _) (b, _) -> String.compare a b) fields in
  `Assoc sorted

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

let with_render_modes modes metadata = { metadata with render_modes = modes }

let with_supported_vector_modes modes metadata =
  { metadata with supported_vector_modes = modes }

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

let with_authors authors metadata = { metadata with authors }
let with_extra extra metadata = { metadata with extra }