1 (** Reading and validating the TOML configuration. 2 3 The file is looked up at [$OGIT_CONFIG], then 4 [$XDG_CONFIG_HOME/ogit/config.toml], then [/etc/ogit/config.toml]. When no 5 file is chosen explicitly a missing one is fine and {!default} applies; a 6 file that exists but is malformed or invalid is always an error, so a 7 mistake never silently degrades into defaults. 8 9 [config.toml] at the repository root documents every variable and doubles as 10 the reference for its default. Adding a field here means updating that file 11 in the same commit. 12 13 {!to_table} and {!write_file} support the [ogit-write-config] executable, 14 which emits a config file pre-filled with the defaults. *) 15 16 open Toml 17 18 type t = { 19 user_name : string; 20 default_branch : string; 21 git_project_root : string; 22 commits_max_displayed : int; 23 root_title : string; 24 nav_logo : string; 25 host : string; 26 port : int; 27 favorite_repositories : string list; 28 archived_repositories : string list; 29 } 30 31 type load_error = 32 | Not_found of string 33 | Parse_error of string 34 | Invalid_value of string 35 | Io_error of string 36 37 let environment_value name = 38 match Sys.getenv_opt name with Some "" | None -> None | value -> value 39 40 let default = 41 { 42 user_name = ""; 43 default_branch = "main"; 44 git_project_root = "/srv/git"; 45 commits_max_displayed = 10; 46 root_title = ""; 47 nav_logo = "/static/git_icon.svg"; 48 host = "127.0.0.1"; 49 port = 8081; 50 favorite_repositories = []; 51 archived_repositories = []; 52 } 53 54 let locate_config_file () = 55 match environment_value "OGIT_CONFIG" with 56 | Some file -> file 57 | None -> ( 58 match environment_value "XDG_CONFIG_HOME" with 59 | Some config_home -> 60 Filename.concat (Filename.concat config_home "ogit") "config.toml" 61 | None -> "/etc/ogit/config.toml") 62 63 let to_table t = 64 let open Types in 65 let string_list_to_value lst = 66 TArray (if lst = [] then NodeEmpty else NodeString lst) 67 in 68 List.map 69 (fun (key, value) -> (Min.key key, value)) 70 [ 71 ("user_name", TString t.user_name); 72 ("default_branch", TString t.default_branch); 73 ("git_project_root", TString t.git_project_root); 74 ("commits_max_displayed", TInt t.commits_max_displayed); 75 ("ogit_root_title", TString t.root_title); 76 ("nav_logo", TString t.nav_logo); 77 ("host", TString t.host); 78 ("port", TInt t.port); 79 ("favorite_repositories", string_list_to_value t.favorite_repositories); 80 ("archived_repositories", string_list_to_value t.archived_repositories); 81 ] 82 |> Min.of_key_values 83 84 let write_file ?file table = 85 let file = Option.value file ~default:(locate_config_file ()) in 86 Out_channel.with_open_text file (fun channel -> 87 Printer.string_of_table table |> Printf.fprintf channel "%s\n") 88 89 (* Key lookups fall back to [~default] when the key is absent, so a partial 90 file overriding one setting is valid. A key that is present but holds the 91 wrong type is always an error, so a typo is never silently ignored. 92 93 These are deliberately not named [*_opt]: by OCaml convention that suffix 94 means the function returns an option, whereas here the optionality is the 95 key's, not the result's. *) 96 97 let optional_string table key ~default = 98 match Types.Table.find_opt (Min.key key) table with 99 | Some (Types.TString value) -> Ok value 100 | Some _ -> Error (Invalid_value ("expected string for key: " ^ key)) 101 | None -> Ok default 102 103 let optional_int table key ~default = 104 match Types.Table.find_opt (Min.key key) table with 105 | Some (Types.TInt value) -> Ok value 106 | Some _ -> Error (Invalid_value ("expected int for key: " ^ key)) 107 | None -> Ok default 108 109 (* An absent list and an empty list mean the same thing here, so this needs no 110 [~default]. *) 111 let optional_string_list table key = 112 match Types.Table.find_opt (Min.key key) table with 113 | Some (Types.TArray (Types.NodeString values)) -> Ok values 114 | Some (Types.TArray Types.NodeEmpty) -> Ok [] 115 | Some _ -> 116 Error (Invalid_value ("expected array of strings for key: " ^ key)) 117 | None -> Ok [] 118 119 let of_table table = 120 let ( let* ) = Result.bind in 121 let* git_project_root = 122 optional_string table "git_project_root" ~default:default.git_project_root 123 in 124 let* user_name = 125 optional_string table "user_name" ~default:default.user_name 126 in 127 let* default_branch = 128 optional_string table "default_branch" ~default:default.default_branch 129 in 130 let* commits_max_displayed = 131 optional_int table "commits_max_displayed" 132 ~default:default.commits_max_displayed 133 in 134 (* [ogit_root_title] is the current key; a bare [title] is still accepted so 135 that configuration files predating the rename keep working. *) 136 let* root_title = 137 match Types.Table.find_opt (Min.key "ogit_root_title") table with 138 | Some _ -> 139 optional_string table "ogit_root_title" ~default:default.root_title 140 | None -> optional_string table "title" ~default:default.root_title 141 in 142 let* nav_logo = optional_string table "nav_logo" ~default:default.nav_logo in 143 let* host = optional_string table "host" ~default:default.host in 144 let* port = optional_int table "port" ~default:default.port in 145 let* favorite_repositories = 146 optional_string_list table "favorite_repositories" 147 in 148 let* archived_repositories = 149 optional_string_list table "archived_repositories" 150 in 151 if commits_max_displayed <= 0 then 152 Error (Invalid_value "commits_max_displayed must be positive") 153 else if port < 1 || port > 65535 then 154 Error (Invalid_value "port must be between 1 and 65535") 155 else 156 Ok 157 { 158 git_project_root; 159 user_name; 160 default_branch; 161 commits_max_displayed; 162 root_title; 163 nav_logo; 164 host; 165 port; 166 favorite_repositories; 167 archived_repositories; 168 } 169 170 let io_error file error = 171 Io_error (Printf.sprintf "%s: %s" file (Unix.error_message error)) 172 173 let file_exists file = 174 try 175 ignore (Unix.stat file); 176 Ok () 177 with 178 | Unix.Unix_error ((Unix.ENOENT | Unix.ENOTDIR), _, _) -> 179 Error (Not_found file) 180 | Unix.Unix_error (error, _, _) -> Error (io_error file error) 181 182 let read_file ?file () = 183 let file = Option.value file ~default:(locate_config_file ()) in 184 let ( let* ) = Result.bind in 185 let* () = file_exists file in 186 try 187 match Toml.Parser.from_filename file with 188 | `Error (message, location) -> 189 Error 190 (Parse_error 191 (Printf.sprintf "%s: %s at line %d" location.source message 192 location.line)) 193 | `Ok table -> of_table table 194 with Sys_error message -> Error (Io_error message) 195 196 let implicit_config_files () = 197 match environment_value "XDG_CONFIG_HOME" with 198 | Some config_home -> 199 [ 200 Filename.concat (Filename.concat config_home "ogit") "config.toml"; 201 "/etc/ogit/config.toml"; 202 ] 203 | None -> [ "/etc/ogit/config.toml" ] 204 205 let load () = 206 match environment_value "OGIT_CONFIG" with 207 | Some file -> read_file ~file () 208 | None -> 209 let rec first_existing = function 210 | [] -> Ok default 211 | file :: rest -> ( 212 match read_file ~file () with 213 | Error (Not_found _) -> first_existing rest 214 | result -> result) 215 in 216 first_existing (implicit_config_files ()) 217 218 (* [pp_load_error] and [show_load_error] follow the convention established by 219 ppx_deriving: [pp_] is the Format-based printer that composes with "%a", and 220 [show_] is the string-producing convenience built on it. Naming them as a 221 pair signals that relationship, which [load_error_to_string] did not. *) 222 223 let pp_load_error formatter = function 224 | Not_found file -> 225 Format.fprintf formatter "configuration file not found: %s" file 226 | Parse_error message -> 227 Format.fprintf formatter "invalid configuration: %s" message 228 | Invalid_value message -> 229 Format.fprintf formatter "invalid configuration value: %s" message 230 | Io_error message -> 231 Format.fprintf formatter "could not read configuration: %s" message 232 233 let show_load_error error = Format.asprintf "%a" pp_load_error error 234