Source file `info_plist.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
(**************************************************************************)
(*                                                                        *)
(*    Copyright 2025 OCamlPro                                             *)
(*                                                                        *)
(*  All rights reserved. This file is distributed under the terms of the  *)
(*  GNU Lesser General Public License version 2.1, with the special       *)
(*  exception on linking described in the file LICENSE.                   *)
(*                                                                        *)
(**************************************************************************)

type value =
  | String of string
  | Bool of bool
  | Dict of (string * value) list
  | Array of value list

type t = (string * value) list

let escape_xml s =
  let buffer = Buffer.create (String.length s) in
  String.iter (function
      | '&' -> Buffer.add_string buffer "&amp;"
      | '<' -> Buffer.add_string buffer "&lt;"
      | '>' -> Buffer.add_string buffer "&gt;"
      | '"' -> Buffer.add_string buffer "&quot;"
      | '\'' -> Buffer.add_string buffer "&apos;"
      | c -> Buffer.add_char buffer c
    ) s;
  Buffer.contents buffer

let rec value_to_xml_element indent = function
  | String s ->
    Printf.sprintf "%s<string>%s</string>" indent (escape_xml s)
  | Bool true ->
    Printf.sprintf "%s<true/>" indent
  | Bool false ->
    Printf.sprintf "%s<false/>" indent
  | Dict entries ->
    let next_indent = indent ^ "    " in
    let dict_content =
      entries
      |> List.map (fun (key, value) ->
          Printf.sprintf "%s<key>%s</key>\n%s"
            next_indent
            (escape_xml key)
            (value_to_xml_element next_indent value)
        )
      |> String.concat "\n"
    in
    if entries = [] then
      Printf.sprintf "%s<dict/>" indent
    else
      Printf.sprintf "%s<dict>\n%s\n%s</dict>"
        indent
        dict_content
        indent
  | Array items ->
    let next_indent = indent ^ "    " in
    let array_content =
      items
      |> List.map (value_to_xml_element next_indent)
      |> String.concat "\n"
    in
    if items = [] then
      Printf.sprintf "%s<array/>" indent
    else
      Printf.sprintf "%s<array>\n%s\n%s</array>"
        indent
        array_content
        indent

let to_xml (plist : t) =
  let header =
    "<?xml version=\"1.0\" encoding=\"UTF-8\"?>\n" ^
    "<!DOCTYPE plist PUBLIC \"-//Apple//DTD PLIST 1.0//EN\" " ^
    "\"http://www.apple.com/DTDs/PropertyList-1.0.dtd\">\n" ^
    "<plist version=\"1.0\">"
  in
  let content = value_to_xml_element "" (Dict plist) in
  let footer = "</plist>" in
  String.concat "\n" [header; content; footer]

let make entries = entries

let add_entry key value plist =
  let rec replace acc = function
    | [] -> List.rev ((key, value) :: acc)
    | (k, _) :: rest when String.equal k key ->
      List.rev_append acc ((key, value) :: rest)
    | entry :: rest ->
      replace (entry :: acc) rest
  in
  replace [] plist

let make_info_plist ~bundle_id ~executable ~name ~display_name ~version =
  [ ("CFBundleExecutable", String executable)
  ; ("CFBundleIdentifier", String bundle_id)
  ; ("CFBundleName", String name)
  ; ("CFBundleDisplayName", String display_name)
  ; ("CFBundleVersion", String version)
  ; ("CFBundleShortVersionString", String version)
  ; ("CFBundlePackageType", String "APPL")
  ; ("NSHighResolutionCapable", Bool true)
  ]

let save plist file =
  let xml = to_xml plist in
  OpamSystem.write (OpamFilename.to_string file) xml