diff --git a/.github/workflows/build.yml b/.github/workflows/build.yml index 08defbd..713f4d4 100644 --- a/.github/workflows/build.yml +++ b/.github/workflows/build.yml @@ -19,7 +19,7 @@ jobs: - "5.3" include: - os: ubuntu-latest - ocaml-compiler: "4.07" + ocaml-compiler: "4.14" runs-on: ${{ matrix.os }} steps: - name: checkout diff --git a/CHANGES.md b/CHANGES.md index 891de49..cd88539 100644 --- a/CHANGES.md +++ b/CHANGES.md @@ -1,3 +1,7 @@ +## unreleased + +- use `Fpath.t` instead of `string` where possible + ## 0.5 - 2022-01-09 - add Base_dirs.state_dir, on linux it uses $XDG_STATE_HOME and default to $HOME/.local/.state on macOS and Windows it's equivalent to Base_dirs.cache_dir ; add Projects_dirs.state_dir diff --git a/directories.opam b/directories.opam index 12be3c8..034a1f7 100644 --- a/directories.opam +++ b/directories.opam @@ -10,8 +10,9 @@ homepage: "https://github.com/ocamlpro/directories" bug-reports: "https://github.com/ocamlpro/directories/issues" depends: [ "dune" {>= "2.1"} - "ocaml" {>= "4.07.0"} + "ocaml" {>= "4.14.0"} "ctypes" {>= "0.17.1" & (os = "win32" | os = "cygwin")} + "fpath" ] build: [ ["dune" "subst"] {pinned} diff --git a/example/print_dir.ml b/example/print_dir.ml index b13cd80..7ec36df 100644 --- a/example/print_dir.ml +++ b/example/print_dir.ml @@ -18,7 +18,7 @@ let () = (* functions to print a dir path *) let print_dir = function | None, s -> Format.printf " %s None@." s - | Some dir, s -> Format.printf " %s Some `%s`@." s dir + | Some dir, s -> Format.printf " %s Some `%a`@." s Fpath.pp dir in let print_dirs = List.iter print_dir in diff --git a/example/quick_start.ml b/example/quick_start.ml index 9b99c81..041d339 100644 --- a/example/quick_start.ml +++ b/example/quick_start.ml @@ -7,7 +7,7 @@ let () = let application = "yourapp" end in let module M = Directories.Project_dirs (App_id) in - let option_value = function None -> "None" | Some v -> v in + let option_value = function None -> "None" | Some v -> Fpath.to_string v in Format.printf "cache dir = `%s`@." (option_value M.cache_dir); Format.printf "config dir = `%s`@." (option_value M.config_dir); Format.printf "data dir = `%s`@." (option_value M.data_dir) diff --git a/src/directories.mli b/src/directories.mli index 7182df6..8278ba7 100644 --- a/src/directories.mli +++ b/src/directories.mli @@ -1,43 +1,43 @@ module Base_dirs () : sig - val home_dir : string option + val home_dir : Fpath.t option - val cache_dir : string option + val cache_dir : Fpath.t option - val config_dir : string option + val config_dir : Fpath.t option - val data_dir : string option + val data_dir : Fpath.t option - val data_local_dir : string option + val data_local_dir : Fpath.t option - val preference_dir : string option + val preference_dir : Fpath.t option - val runtime_dir : string option + val runtime_dir : Fpath.t option - val state_dir : string option + val state_dir : Fpath.t option - val executable_dir : string option + val executable_dir : Fpath.t option end module User_dirs () : sig - val home_dir : string option + val home_dir : Fpath.t option - val audio_dir : string option + val audio_dir : Fpath.t option - val desktop_dir : string option + val desktop_dir : Fpath.t option - val document_dir : string option + val document_dir : Fpath.t option - val download_dir : string option + val download_dir : Fpath.t option - val font_dir : string option + val font_dir : Fpath.t option - val picture_dir : string option + val picture_dir : Fpath.t option - val public_dir : string option + val public_dir : Fpath.t option - val template_dir : string option + val template_dir : Fpath.t option - val video_dir : string option + val video_dir : Fpath.t option end module Project_dirs (App_id : sig @@ -47,17 +47,17 @@ module Project_dirs (App_id : sig val application : string end) : sig - val cache_dir : string option + val cache_dir : Fpath.t option - val config_dir : string option + val config_dir : Fpath.t option - val data_dir : string option + val data_dir : Fpath.t option - val data_local_dir : string option + val data_local_dir : Fpath.t option - val preference_dir : string option + val preference_dir : Fpath.t option - val runtime_dir : string option + val runtime_dir : Fpath.t option - val state_dir : string option + val state_dir : Fpath.t option end diff --git a/src/directories_common.ml b/src/directories_common.ml index 3247349..fae3793 100644 --- a/src/directories_common.ml +++ b/src/directories_common.ml @@ -8,13 +8,7 @@ module type App_id = sig val application : string end -(* TODO: remove once we drop 4.07 *) -let option_map f = function None -> None | Some v -> Some (f v) - -(* TODO: remove once we drop 4.07 *) -let option_bind o f = match o with None -> None | Some v -> f v - -let relative_opt dir = if Filename.is_relative dir then None else Some dir +let relative_opt dir = if Fpath.is_rel dir then None else Some dir let getenv env = match Sys.getenv env with @@ -22,7 +16,11 @@ let getenv env = | "" -> None | v -> Some v -let getenvdir env = option_bind (getenv env) relative_opt +let getenvdir env = + match getenv env with + | None -> None + | Some v -> ( + match Fpath.of_string v with Error _ -> None | Ok v -> relative_opt v ) let lower_and_replace_ws s replace = let s = String.trim s in diff --git a/src/dune b/src/dune index 2394290..2d80253 100644 --- a/src/dune +++ b/src/dune @@ -19,7 +19,7 @@ let () = (wrapped false) (modules directories directories_common) (private_modules directories_common) - (libraries %s)) + (libraries fpath %s)) (copy_files# %s/*) |} diff --git a/src/linux/directories.ml b/src/linux/directories.ml index 21446c2..a98b2ae 100644 --- a/src/linux/directories.ml +++ b/src/linux/directories.ml @@ -9,25 +9,27 @@ module Base_dirs () = struct match (Unix.getpwuid (Unix.getuid ())).Unix.pw_dir with | exception Unix.Unix_error _ -> None | exception Not_found -> None - | dir -> relative_opt dir ) + | dir -> + let dir = Fpath.of_string dir |> Result.to_option in + Option.bind dir relative_opt ) | Some _dir as dir -> dir (** $XDG_CACHE_HOME or $HOME/.cache *) let cache_dir = match getenvdir "XDG_CACHE_HOME" with - | None -> option_map (fun dir -> dir / ".cache") home_dir + | None -> Option.map (fun dir -> Fpath.(dir / ".cache")) home_dir | Some _dir as dir -> dir (** $XDG_CONFIG_HOME or $HOME/.config *) let config_dir = match getenvdir "XDG_CONFIG_DIR" with - | None -> option_map (fun dir -> dir / ".config") home_dir + | None -> Option.map (fun dir -> Fpath.(dir / ".config")) home_dir | Some _dir as dir -> dir (** $XDG_DATA_HOME or $HOME/.local/share *) let data_dir = match getenvdir "XDG_DATA_DIR" with - | None -> option_map (fun dir -> dir / ".local" / "share") home_dir + | None -> Option.map (fun dir -> Fpath.(dir / ".local" / "share")) home_dir | Some _dir as dir -> dir (** $XDG_DATA_HOME or $HOME/.local/share *) @@ -39,7 +41,7 @@ module Base_dirs () = struct (** $XDG_STATE_HOME or $HOME/.local/state *) let state_dir = match getenvdir "XDG_STATE_HOME" with - | None -> option_map (fun dir -> dir / ".local" / "state") home_dir + | None -> Option.map (fun dir -> Fpath.(dir / ".local" / "state")) home_dir | Some _dir as dir -> dir (** $XDG_RUNTIME_DIR *) @@ -50,8 +52,8 @@ module Base_dirs () = struct match getenvdir "XDG_BIN_HOME" with | None -> ( match getenvdir "XDG_DATA_HOME" with - | None -> option_map (fun dir -> dir / ".local" / "bin") home_dir - | Some dir -> Some (dir / ".." / "bin") ) + | None -> Option.map (fun dir -> Fpath.(dir / ".local" / "bin")) home_dir + | Some dir -> Some Fpath.(dir / ".." / "bin") ) | Some _dir as dir -> dir end @@ -63,14 +65,17 @@ module User_dirs () = struct let home_dir = Base_dirs.home_dir let user_dirs = - option_map (fun dir -> dir / "user-dirs.dirs") Base_dirs.config_dir + Option.map (fun dir -> Fpath.(dir / "user-dirs.dirs")) Base_dirs.config_dir let user_dirs = - option_bind user_dirs (fun f -> if Sys.file_exists f then Some f else None) + Option.bind user_dirs (fun f -> + (* TODO: use Bos here instead of Sys? *) + if Sys.file_exists (Fpath.to_string f) then Some f else None ) let user_dirs = - option_bind user_dirs (fun f -> - if Sys.is_directory f then None else Some f ) + Option.bind user_dirs (fun f -> + (* TODO: use Bos here instead of Sys? *) + if Sys.is_directory (Fpath.to_string f) then None else Some f ) let user_shell = getenv "SHELL" @@ -80,18 +85,23 @@ module User_dirs () = struct try let chan = Unix.open_process_in - (Format.sprintf "%s -c '. %s && echo \"$XDG_%s_DIR\"'" sh f dir) + (Format.asprintf "%s -c '. %a && echo \"$XDG_%s_DIR\"'" sh Fpath.pp + f dir ) in let xdg = input_line chan in let result = Unix.close_process_in chan in - match result with WEXITED 0 -> Some xdg | _ -> None + match result with + | WEXITED 0 -> begin + match Fpath.of_string xdg with Error _ -> None | Ok xdg -> Some xdg + end + | _ -> None with _ -> None ) | _ -> None let get_user_dir (env, default) = match get_user_dir env with | Some v -> Some v - | None -> option_map (fun dir -> dir / default) home_dir + | None -> Option.map (fun dir -> Fpath.(dir / default)) home_dir (** Defaults can be found here https://cgit.freedesktop.org/xdg/xdg-user-dirs/tree/user-dirs.defaults *) @@ -112,8 +122,10 @@ module User_dirs () = struct let font_dir = match getenvdir "XDG_DATA_HOME" with | None -> - option_map (fun dir -> dir / ".local" / "share" / "fonts") home_dir - | Some dir -> Some (dir / "fonts") + Option.map + (fun dir -> Fpath.(dir / ".local" / "share" / "fonts")) + home_dir + | Some dir -> Some Fpath.(dir / "fonts") (** $XDG_PICTURES_DIR *) let picture_dir = get_user_dir ("PICTURES", "Pictures") @@ -134,7 +146,7 @@ module Project_dirs (App_id : App_id) = struct let project_path = Directories_common.lower_and_replace_ws App_id.application "" - let concat_project_path = option_map (fun dir -> dir / project_path) + let concat_project_path = Option.map (fun dir -> Fpath.(dir / project_path)) (** $XDG_CACHE_HOME/ or $HOME/.cache/ *) let cache_dir = concat_project_path Base_dirs.cache_dir diff --git a/src/macos/directories.ml b/src/macos/directories.ml index c2e4d3d..091cb26 100644 --- a/src/macos/directories.ml +++ b/src/macos/directories.ml @@ -9,26 +9,33 @@ module Base_dirs () = struct match (Unix.getpwuid (Unix.getuid ())).Unix.pw_dir with | exception Unix.Unix_error _ -> None | exception Not_found -> None - | dir -> relative_opt dir ) - | Some _dir as dir -> dir + | dir -> + let dir = Fpath.of_string dir |> Result.to_option in + Option.bind dir relative_opt ) + | Some _ as dir -> dir (** $HOME/Library/Caches *) - let cache_dir = option_map (fun dir -> dir / "Library" / "Caches") home_dir + let cache_dir = + Option.map (fun dir -> Fpath.(dir / "Library" / "Caches")) home_dir (** $HOME/Library/Application Support *) let config_dir = - option_map (fun dir -> dir / "Library" / "Application Support") home_dir + Option.map + (fun dir -> Fpath.(dir / "Library" / "Application Support")) + home_dir (** $HOME/Library/Application Support *) let data_dir = - option_map (fun dir -> dir / "Library" / "Application Support") home_dir + Option.map + (fun dir -> Fpath.(dir / "Library" / "Application Support")) + home_dir (** $HOME/Library/Application Support *) let data_local_dir = data_dir (** $HOME/Library/Preferences *) let preference_dir = - option_map (fun dir -> dir / "Library" / "Preferences") home_dir + Option.map (fun dir -> Fpath.(dir / "Library" / "Preferences")) home_dir (** None *) let runtime_dir = None @@ -46,7 +53,8 @@ module User_dirs () = struct user database) *) let home_dir = Base_dirs.home_dir - let concat_home_dir suffix = option_map (fun dir -> dir / suffix) home_dir + let concat_home_dir suffix = + Option.map (fun dir -> Fpath.(dir / suffix)) home_dir (** $HOME/Music *) let audio_dir = concat_home_dir "Music" @@ -90,7 +98,7 @@ module Project_dirs (App_id : App_id) = struct let project_path = Format.sprintf "%s.%s.%s" qualifier organization application - let concat_project_path = option_map (fun dir -> dir / project_path) + let concat_project_path = Option.map (fun dir -> Fpath.(dir / project_path)) (** $HOME/Libary/Caches/ *) let cache_dir = concat_project_path Base_dirs.cache_dir diff --git a/src/windows/directories.ml b/src/windows/directories.ml index c6ffcec..b214322 100644 --- a/src/windows/directories.ml +++ b/src/windows/directories.ml @@ -23,26 +23,28 @@ let get_folderid id = Known_folder_flag.Default Token.Current_user wpath_ptr in match result with - | S_ok -> Some (wstring_to_string !@wpath_ptr) + | S_ok -> + let s = wstring_to_string !@wpath_ptr in + Fpath.of_string s |> Result.to_option | _err -> None module Base_dirs () = struct - (** {FOLDERID_UserProfile} *) - let home_dir : string option = get_folderid GUID.UserProfile + (** `FOLDERID_UserProfile` *) + let home_dir : Fpath.t option = get_folderid GUID.UserProfile - (** {FOLDERID_LocalApplicationData} *) + (** `FOLDERID_LocalApplicationData` *) let cache_dir = get_folderid GUID.LocalApplicationData - (** {FOLDERID_ApplicationData} *) + (** `FOLDERID_ApplicationData` *) let config_dir = get_folderid GUID.ApplicationData - (** {FOLDERID_ApplicationData} *) + (** `FOLDERID_ApplicationData` *) let data_dir = get_folderid GUID.ApplicationData - (** {FOLDERID_LocalApplicationData} *) + (** `FOLDERID_LocalApplicationData` *) let data_local_dir = get_folderid GUID.LocalApplicationData - (** {FOLDERID_ApplicationData} *) + (** `FOLDERID_ApplicationData` *) let preference_dir = get_folderid GUID.ApplicationData (** None *) @@ -57,59 +59,57 @@ end module User_dirs () = struct module Base_dirs = Base_dirs () - (** {FOLDERID_UserProfile} *) + (** `FOLDERID_UserProfile` *) let home_dir = Base_dirs.home_dir - (** {FOLDERID_Music} *) + (** `FOLDERID_Music` *) let audio_dir = get_folderid GUID.Music - (** {FOLDERID_Desktop} *) + (** `FOLDERID_Desktop` *) let desktop_dir = get_folderid GUID.Desktop - (** {FOLDERID_Documents} *) + (** `FOLDERID_Documents` *) let document_dir = get_folderid GUID.Documents - (** {FOLDERID_Downloads} *) + (** `FOLDERID_Downloads` *) let download_dir = get_folderid GUID.Downloads (** None *) let font_dir = None - (** {FOLDERID_Pictures} *) + (** `FOLDERID_Pictures` *) let picture_dir = get_folderid GUID.Pictures - (** {FOLDERID_Public} *) + (** `FOLDERID_Public` *) let public_dir = get_folderid GUID.Public - (** {FOLDERID_Templates} *) + (** `FOLDERID_Templates` *) let template_dir = get_folderid GUID.Templates - (** {FOLDERID_Videos} *) + (** `FOLDERID_Videos` *) let video_dir = get_folderid GUID.Videos end module Project_dirs (App_id : App_id) = struct - let project_path = - Format.sprintf "%s\\%s" App_id.organization App_id.application - let mk folderid dir = - option_map - (fun folderid_path -> folderid_path / project_path / dir) + Option.map + (fun folderid_path -> + Fpath.(folderid_path / App_id.organization / App_id.application / dir) ) (get_folderid folderid) - (** {FOLDERID_LocalApplicationData}//cache *) + (** `FOLDERID_LocalApplicationData`//cache *) let cache_dir = mk GUID.LocalApplicationData "cache" - (** {FOLDERID_ApplicationData}//config *) + (** `FOLDERID_ApplicationData`//config *) let config_dir = mk GUID.ApplicationData "config" - (** {FOLDERID_ApplicationData}//data *) + (** `FOLDERID_ApplicationData`//data *) let data_dir = mk GUID.ApplicationData "data" - (** {FOLDERID_LocalApplicationData}//data *) + (** `FOLDERID_LocalApplicationData`//data *) let data_local_dir = mk GUID.LocalApplicationData "data" - (** {FOLDERID_ApplicationData}//config *) + (** `FOLDERID_ApplicationData`//config *) let preference_dir = mk GUID.ApplicationData "config" let state_dir = cache_dir