diff --git a/.ocamlformat b/.ocamlformat new file mode 100644 index 0000000..f946cc0 --- /dev/null +++ b/.ocamlformat @@ -0,0 +1,43 @@ +version=0.25.1 +assignment-operator=end-line +break-cases=fit +break-fun-decl=wrap +break-fun-sig=wrap +break-infix=wrap +break-infix-before-func=false +break-separators=before +break-sequences=true +cases-exp-indent=2 +cases-matching-exp-indent=normal +doc-comments=before +doc-comments-padding=2 +doc-comments-tag-only=default +dock-collection-brackets=false +exp-grouping=preserve +field-space=loose +if-then-else=compact +indicate-multiline-delimiters=space +indicate-nested-or-patterns=unsafe-no +infix-precedence=indent +leading-nested-match-parens=false +let-and=sparse +let-binding-spacing=compact +let-module=compact +margin=80 +max-indent=2 +module-item-spacing=sparse +ocaml-version=4.14.0 +ocp-indent-compat=false +parens-ite=false +parens-tuple=always +parse-docstrings=true +sequence-blank-line=preserve-one +sequence-style=terminator +single-case=compact +space-around-arrays=true +space-around-lists=true +space-around-records=true +space-around-variants=true +type-decl=sparse +wrap-comments=false +wrap-fun-args=true diff --git a/example/print_dir.ml b/example/print_dir.ml index 8cf2a19..b13cd80 100644 --- a/example/print_dir.ml +++ b/example/print_dir.ml @@ -25,40 +25,40 @@ let () = (* Printing base dirs *) Format.printf "* Base dirs:@."; print_dirs - [ B.home_dir, "home_dir: " - ; B.cache_dir, "cache_dir: " - ; B.config_dir, "config_dir: " - ; B.data_dir, "data_dir: " - ; B.data_local_dir, "data_local_dir:" - ; B.preference_dir, "preference_dir:" - ; B.runtime_dir, "runtime_dir: " - ; B.state_dir, "state_dir: " - ; B.executable_dir, "executable_dir:" + [ (B.home_dir, "home_dir: ") + ; (B.cache_dir, "cache_dir: ") + ; (B.config_dir, "config_dir: ") + ; (B.data_dir, "data_dir: ") + ; (B.data_local_dir, "data_local_dir:") + ; (B.preference_dir, "preference_dir:") + ; (B.runtime_dir, "runtime_dir: ") + ; (B.state_dir, "state_dir: ") + ; (B.executable_dir, "executable_dir:") ]; (* Printing user dirs *) Format.printf "* User dirs:@."; print_dirs - [ U.home_dir, "home_dir: " - ; U.audio_dir, "audio_dir: " - ; U.desktop_dir, "desktop_dir: " - ; U.document_dir, "document_dir: " - ; U.download_dir, "download_dir: " - ; U.font_dir, "font_dir: " - ; U.picture_dir, "picture_dir: " - ; U.public_dir, "public_dir: " - ; U.template_dir, "template_dir: " - ; U.video_dir, "video_dir: " + [ (U.home_dir, "home_dir: ") + ; (U.audio_dir, "audio_dir: ") + ; (U.desktop_dir, "desktop_dir: ") + ; (U.document_dir, "document_dir: ") + ; (U.download_dir, "download_dir: ") + ; (U.font_dir, "font_dir: ") + ; (U.picture_dir, "picture_dir: ") + ; (U.public_dir, "public_dir: ") + ; (U.template_dir, "template_dir: ") + ; (U.video_dir, "video_dir: ") ]; (* Printing project dirs*) Format.printf "* Project dirs:@."; print_dirs - [ P.cache_dir, "cache_dir: " - ; P.config_dir, "config_dir: " - ; P.data_dir, "data_dir: " - ; P.data_local_dir, "data_local_dir:" - ; P.preference_dir, "preference_dir:" - ; P.state_dir, "state_dir: " - ; P.runtime_dir, "runtime_dir: " + [ (P.cache_dir, "cache_dir: ") + ; (P.config_dir, "config_dir: ") + ; (P.data_dir, "data_dir: ") + ; (P.data_local_dir, "data_local_dir:") + ; (P.preference_dir, "preference_dir:") + ; (P.state_dir, "state_dir: ") + ; (P.runtime_dir, "runtime_dir: ") ] diff --git a/example/quick_start.ml b/example/quick_start.ml index ad4f54f..9b99c81 100644 --- a/example/quick_start.ml +++ b/example/quick_start.ml @@ -1,7 +1,9 @@ let () = let module App_id = struct let qualifier = "com" + let organization = "YourCompany" + let application = "yourapp" end in let module M = Directories.Project_dirs (App_id) in diff --git a/src/directories.mli b/src/directories.mli index 0ce8378..7182df6 100644 --- a/src/directories.mli +++ b/src/directories.mli @@ -1,38 +1,63 @@ module Base_dirs () : sig val home_dir : string option + val cache_dir : string option + val config_dir : string option + val data_dir : string option + val data_local_dir : string option + val preference_dir : string option + val runtime_dir : string option + val state_dir : string option + val executable_dir : string option end module User_dirs () : sig val home_dir : string option + val audio_dir : string option + val desktop_dir : string option + val document_dir : string option + val download_dir : string option + val font_dir : string option + val picture_dir : string option + val public_dir : string option + val template_dir : string option + val video_dir : string option end module Project_dirs (App_id : sig val qualifier : string + val organization : string + val application : string end) : sig val cache_dir : string option + val config_dir : string option + val data_dir : string option + val data_local_dir : string option + val preference_dir : string option + val runtime_dir : string option + val state_dir : string option end diff --git a/src/directories_common.ml b/src/directories_common.ml index 8ff535c..3247349 100644 --- a/src/directories_common.ml +++ b/src/directories_common.ml @@ -9,21 +9,12 @@ module type App_id = sig end (* TODO: remove once we drop 4.07 *) -let option_map f = function - | None -> None - | Some v -> Some (f v) +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 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 Filename.is_relative dir then None else Some dir let getenv env = match Sys.getenv env with @@ -39,15 +30,10 @@ let lower_and_replace_ws s replace = let should_replace = ref false in for i = 0 to String.length s - 1 do match s.[i] with - | ' ' - | '\012' - | '\n' - | '\r' - | '\t' -> + | ' ' | '\012' | '\n' | '\r' | '\t' -> if !should_replace then ( Buffer.add_string buff replace; - should_replace := false - ) + should_replace := false ) | c -> Buffer.add_char buff c; should_replace := true diff --git a/src/linux/directories.ml b/src/linux/directories.ml index cca33a0..21446c2 100644 --- a/src/linux/directories.ml +++ b/src/linux/directories.ml @@ -66,18 +66,11 @@ module User_dirs () = struct option_map (fun dir -> 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 -> if Sys.file_exists 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) + if Sys.is_directory f then None else Some f ) let user_shell = getenv "SHELL" @@ -91,9 +84,7 @@ module User_dirs () = struct 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 -> Some xdg | _ -> None with _ -> None ) | _ -> None @@ -140,7 +131,8 @@ end module Project_dirs (App_id : App_id) = struct module Base_dirs = Base_dirs () - let project_path = Directories_common.lower_and_replace_ws App_id.application "" + let project_path = + Directories_common.lower_and_replace_ws App_id.application "" let concat_project_path = option_map (fun dir -> dir / project_path) diff --git a/src/macos/directories.ml b/src/macos/directories.ml index 46d247a..c2e4d3d 100644 --- a/src/macos/directories.ml +++ b/src/macos/directories.ml @@ -81,9 +81,11 @@ module Project_dirs (App_id : App_id) = struct let qualifier = Directories_common.lower_and_replace_ws App_id.qualifier "-" - let organization = Directories_common.lower_and_replace_ws App_id.organization "-" + let organization = + Directories_common.lower_and_replace_ws App_id.organization "-" - let application = Directories_common.lower_and_replace_ws App_id.application "-" + let application = + Directories_common.lower_and_replace_ws App_id.application "-" let project_path = Format.sprintf "%s.%s.%s" qualifier organization application diff --git a/src/windows/bindings/gen_functions.ml b/src/windows/bindings/gen_functions.ml old mode 100755 new mode 100644 index 3c6a3a8..c8c86f7 --- a/src/windows/bindings/gen_functions.ml +++ b/src/windows/bindings/gen_functions.ml @@ -1,29 +1,24 @@ - let print_defines fmt = List.iter (fun (d, v) -> Format.fprintf fmt "#define %s (%s)@\n" d v) -let print_headers fmt = - List.iter (Format.fprintf fmt "#include <%s>@\n") +let print_headers fmt = List.iter (Format.fprintf fmt "#include <%s>@\n") -let make_functions_stubs - (c_defines : (string * string) list) - (c_headers : string list) - (functions_functor : (module Cstubs.BINDINGS)) = +let make_functions_stubs (c_defines : (string * string) list) + (c_headers : string list) (functions_functor : (module Cstubs.BINDINGS)) = let fmt = Format.std_formatter in begin match Sys.argv.(1) with | "c" -> - print_defines fmt c_defines; - print_headers fmt c_headers; - Cstubs.write_c ~prefix:"win_stub" fmt functions_functor - | "ml" -> - Cstubs.write_ml ~prefix:"win_stub" fmt functions_functor + print_defines fmt c_defines; + print_headers fmt c_headers; + Cstubs.write_c ~prefix:"win_stub" fmt functions_functor + | "ml" -> Cstubs.write_ml ~prefix:"win_stub" fmt functions_functor | s -> failwith ("unknown functions " ^ s) end; Format.pp_print_flush fmt () let () = make_functions_stubs - [ "NTDDI_VERSION", "NTDDI_VISTA" ] + [ ("NTDDI_VERSION", "NTDDI_VISTA") ] [ "windows.h"; "shlobj.h" ] (module Win_functions_functor.Apply) diff --git a/src/windows/bindings/win_functions.ml b/src/windows/bindings/win_functions.ml old mode 100755 new mode 100644 index 88790b1..c67de25 --- a/src/windows/bindings/win_functions.ml +++ b/src/windows/bindings/win_functions.ml @@ -1,2 +1 @@ - -include Win_functions_functor.Apply(Win_functions_stubs) +include Win_functions_functor.Apply (Win_functions_stubs) diff --git a/src/windows/bindings/win_functions_functor.ml b/src/windows/bindings/win_functions_functor.ml old mode 100755 new mode 100644 index 42f7d1e..ec82a89 --- a/src/windows/bindings/win_functions_functor.ml +++ b/src/windows/bindings/win_functions_functor.ml @@ -1,44 +1,45 @@ - module Apply (F : Cstubs.FOREIGN) = struct - open Ctypes open F open Win_types module Kernel32 = struct - - (** see - https://docs.microsoft.com/en-us/windows/win32/api/stringapiset/nf-stringapiset-widechartomultibyte *) + (** see + https://docs.microsoft.com/en-us/windows/win32/api/stringapiset/nf-stringapiset-widechartomultibyte *) let wide_char_to_multi_byte = - foreign "WideCharToMultiByte" ( - UINT.t @-> (* UINT CodePage *) - DWORD.t @-> (* DWORD dwFlags *) - LPWCH.t @-> (* LPCWCH lpWideCharStr *) - Int.t @-> (* int cchWideChar *) - LPSTR.t @-> (* LPSTR lpMultiByteStr *) - Int.t @-> (* int cbMultiByte *) - LPCH.t @-> (* LPCCH lpDefaultChar *) - LPBOOL.t @-> (* LPBOOL lpUsedDefaultChar *) - returning Int.t (* int *) - ) - + foreign "WideCharToMultiByte" + ( UINT.t (* UINT CodePage *) @-> DWORD.t + (* DWORD dwFlags *) + @-> LPWCH.t + (* LPCWCH lpWideCharStr *) + @-> Int.t + (* int cchWideChar *) + @-> LPSTR.t + (* LPSTR lpMultiByteStr *) + @-> Int.t + (* int cbMultiByte *) + @-> LPCH.t + (* LPCCH lpDefaultChar *) + @-> LPBOOL.t + @-> (* LPBOOL lpUsedDefaultChar *) + returning Int.t (* int *) ) end module Shell32 = struct - - (** see - https://docs.microsoft.com/en-us/windows/win32/api/shlobj_core/nf-shlobj_core-shgetknownfolderpath *) + (** see + https://docs.microsoft.com/en-us/windows/win32/api/shlobj_core/nf-shlobj_core-shgetknownfolderpath *) let sh_get_known_folder_path = - foreign "SHGetKnownFolderPath" ( - ptr GUID.t @-> (* REFKNOWNFOLDERID rfid (= GUID * ) *) - Known_folder_flag.t @-> (* DWORD dwFlags (= unsigned long) *) - Token.t @-> (* HANDLE hToken (= void * ) *) - ptr PWSTR.t @-> (* PWSTR * ppszPath (= short unsigned int ** ) *) - returning Hresult.t (* HRESULT *) - ) - + foreign "SHGetKnownFolderPath" + ( ptr GUID.t + (* REFKNOWNFOLDERID rfid (= GUID * ) *) + @-> Known_folder_flag.t + (* DWORD dwFlags (= unsigned long) *) + @-> Token.t + (* HANDLE hToken (= void * ) *) + @-> ptr PWSTR.t + @-> (* PWSTR * ppszPath (= short unsigned int ** ) *) + returning Hresult.t (* HRESULT *) ) end - end diff --git a/src/windows/bindings/win_types.ml b/src/windows/bindings/win_types.ml old mode 100755 new mode 100644 index 23f0f1c..648d8e7 --- a/src/windows/bindings/win_types.ml +++ b/src/windows/bindings/win_types.ml @@ -2,12 +2,15 @@ open Ctypes module CHAR = struct type t = char typ + let t = char end module LPCH = struct type t = CHAR.t ptr typ + let t = ptr CHAR.t + let null = from_voidp CHAR.t Ctypes.null end @@ -15,12 +18,15 @@ module PCH = LPCH module WCHAR = struct type t = int typ + let t = uint16_t end module LPWCH = struct type t = WCHAR.t ptr typ + let t = ptr WCHAR.t + let null = from_voidp WCHAR.t Ctypes.null end @@ -28,14 +34,19 @@ module PWCH = LPWCH module BOOL = struct type t = bool + let of_int32 i = not (Int32.equal Int32.zero i) + let to_int32 b = if b then Int32.one else Int32.zero + let t = Ctypes.view ~read:of_int32 ~write:to_int32 Ctypes.int32_t end module LPBOOL = struct type t = BOOL.t ptr typ + let t = ptr BOOL.t + let null = from_voidp BOOL.t Ctypes.null end @@ -43,22 +54,27 @@ module PBOOL = LPBOOL module Int = struct type t = int32 typ + let t = int32_t end module UINT = struct type t = int32 typ + let t = int32_t end module DWORD = struct type t = int32 typ + let t = int32_t end module LPSTR = struct type t = CHAR.t ptr typ + let t = ptr CHAR.t + let null = from_voidp CHAR.t Ctypes.null end @@ -66,7 +82,9 @@ module PSTR = LPSTR module LPWSTR = struct type t = WCHAR.t ptr typ + let t = ptr WCHAR.t + let null = from_voidp WCHAR.t Ctypes.null end @@ -95,8 +113,10 @@ module Known_folder_flag = struct | Default -> 0x00000000l | Force_app_data_redirection -> 0x00080000l | Return_filter_redirection_target -> 0x00040000l - | Force_package_redirection -> 0x00020000l (* replaces Force_appcontainer_redirection *) - | No_package_redirection -> 0x00010000l (* replaces No_appcontainer_redirection *) + | Force_package_redirection -> + 0x00020000l (* replaces Force_appcontainer_redirection *) + | No_package_redirection -> + 0x00010000l (* replaces No_appcontainer_redirection *) | Create -> 0x00008000l | Dont_verify -> 0x00004000l | Dont_unexpand -> 0x00002000l @@ -111,7 +131,8 @@ module Known_folder_flag = struct | 0x00000000l -> Default | 0x00080000l -> Force_app_data_redirection | 0x00040000l -> Return_filter_redirection_target - | 0x00020000l -> Force_package_redirection (* Force_appcontainer_redirection *) + | 0x00020000l -> + Force_package_redirection (* Force_appcontainer_redirection *) | 0x00010000l -> No_package_redirection (* No_appcontainer_redirection *) | 0x00008000l -> Create | 0x00004000l -> Dont_verify @@ -137,11 +158,7 @@ module Token = struct | Current_user let to_ptr t = - let i = - match t with - | Default_user -> -1 - | Current_user -> 0 - in + let i = match t with Default_user -> -1 | Current_user -> 0 in Ctypes.ptr_of_raw_address (Nativeint.of_int i) let of_ptr p = @@ -170,17 +187,17 @@ module Hresult = struct | E_unexpected let to_int32 = function - | S_ok -> 0x00000000l - | E_abort -> 0x80004004l + | S_ok -> 0x00000000l + | E_abort -> 0x80004004l | E_accessdenied -> 0x80070005l - | E_fail -> 0x80004005l - | E_handle -> 0x80070006l - | E_invalid_arg -> 0x80070057l - | E_nointerface -> 0x80004002l - | E_notimpl -> 0x80004001l - | E_outofmemory -> 0x8007000El - | E_pointer -> 0x80004003l - | E_unexpected -> 0x8000FFFFl + | E_fail -> 0x80004005l + | E_handle -> 0x80070006l + | E_invalid_arg -> 0x80070057l + | E_nointerface -> 0x80004002l + | E_notimpl -> 0x80004001l + | E_outofmemory -> 0x8007000El + | E_pointer -> 0x80004003l + | E_unexpected -> 0x8000FFFFl let of_int32 (n : Int32.t) = match n with @@ -217,17 +234,138 @@ module GUID = struct | Videos let to_guid = function - | UserProfile -> 0x5E6C858F, 0x0E22, 0x4760, 0x9A, 0xFE, 0xEA, 0x33, 0x17, 0xB6, 0x71, 0x73 - | LocalApplicationData -> 0xF1B32785, 0x6FBA, 0x4FCF, 0x9D, 0x55, 0x7B, 0x8E, 0x7F, 0x15, 0x70, 0x91 - | ApplicationData -> 0x3EB685DB, 0x65F9, 0x4CF6, 0xA0, 0x3A, 0xE3, 0xEF, 0x65, 0x72, 0x9F, 0x3D - | Music -> 0x4BD8D571, 0x6D19, 0x48D3, 0xBE, 0x97, 0x42, 0x22, 0x20, 0x08, 0x0E, 0x43 - | Desktop -> 0xB4BFCC3A, 0xDB2C, 0x424C, 0xB0, 0x29, 0x7F, 0xE9, 0x9A, 0x87, 0xC6, 0x41 - | Documents -> 0xFDD39AD0, 0x238F, 0x46AF, 0xAD, 0xB4, 0x6C, 0x85, 0x48, 0x03, 0x69, 0xC7 - | Downloads -> 0x374DE290, 0x123F, 0x4565, 0x91, 0x64, 0x39, 0xC4, 0x92, 0x5E, 0x46, 0x7B - | Pictures -> 0x33E28130, 0x4E1E, 0x4676, 0x83, 0x5A, 0x98, 0x39, 0x5C, 0x3B, 0xC3, 0xBB - | Public -> 0xDFDF76A2, 0xC82A, 0x4D63, 0x90, 0x6A, 0x56, 0x44, 0xAC, 0x45, 0x73, 0x85 - | Templates -> 0xA63293E8, 0x664E, 0x48DB, 0xA0, 0x79, 0xDF, 0x75, 0x9E, 0x05, 0x09, 0xF7 - | Videos -> 0x18989B1D, 0x99B5, 0x455B, 0x84, 0x1C, 0xAB, 0x7C, 0x74, 0xE4, 0xDD, 0xFC + | UserProfile -> + ( 0x5E6C858F + , 0x0E22 + , 0x4760 + , 0x9A + , 0xFE + , 0xEA + , 0x33 + , 0x17 + , 0xB6 + , 0x71 + , 0x73 ) + | LocalApplicationData -> + ( 0xF1B32785 + , 0x6FBA + , 0x4FCF + , 0x9D + , 0x55 + , 0x7B + , 0x8E + , 0x7F + , 0x15 + , 0x70 + , 0x91 ) + | ApplicationData -> + ( 0x3EB685DB + , 0x65F9 + , 0x4CF6 + , 0xA0 + , 0x3A + , 0xE3 + , 0xEF + , 0x65 + , 0x72 + , 0x9F + , 0x3D ) + | Music -> + ( 0x4BD8D571 + , 0x6D19 + , 0x48D3 + , 0xBE + , 0x97 + , 0x42 + , 0x22 + , 0x20 + , 0x08 + , 0x0E + , 0x43 ) + | Desktop -> + ( 0xB4BFCC3A + , 0xDB2C + , 0x424C + , 0xB0 + , 0x29 + , 0x7F + , 0xE9 + , 0x9A + , 0x87 + , 0xC6 + , 0x41 ) + | Documents -> + ( 0xFDD39AD0 + , 0x238F + , 0x46AF + , 0xAD + , 0xB4 + , 0x6C + , 0x85 + , 0x48 + , 0x03 + , 0x69 + , 0xC7 ) + | Downloads -> + ( 0x374DE290 + , 0x123F + , 0x4565 + , 0x91 + , 0x64 + , 0x39 + , 0xC4 + , 0x92 + , 0x5E + , 0x46 + , 0x7B ) + | Pictures -> + ( 0x33E28130 + , 0x4E1E + , 0x4676 + , 0x83 + , 0x5A + , 0x98 + , 0x39 + , 0x5C + , 0x3B + , 0xC3 + , 0xBB ) + | Public -> + ( 0xDFDF76A2 + , 0xC82A + , 0x4D63 + , 0x90 + , 0x6A + , 0x56 + , 0x44 + , 0xAC + , 0x45 + , 0x73 + , 0x85 ) + | Templates -> + ( 0xA63293E8 + , 0x664E + , 0x48DB + , 0xA0 + , 0x79 + , 0xDF + , 0x75 + , 0x9E + , 0x05 + , 0x09 + , 0xF7 ) + | Videos -> + ( 0x18989B1D + , 0x99B5 + , 0x455B + , 0x84 + , 0x1C + , 0xAB + , 0x7C + , 0x74 + , 0xE4 + , 0xDD + , 0xFC ) let t : t structure typ = structure "_GUID" @@ -242,12 +380,14 @@ module GUID = struct let () = seal t let to_guid guid = - let d1, d2, d3, d4_0, d4_1, d4_2, d4_3, d4_4, d4_5, d4_6, d4_7 = to_guid guid in + let d1, d2, d3, d4_0, d4_1, d4_2, d4_3, d4_4, d4_5, d4_6, d4_7 = + to_guid guid + in let guid = make t in setf guid data1 (Unsigned.ULong.of_int d1); setf guid data2 (Unsigned.UShort.of_int d2); setf guid data3 (Unsigned.UShort.of_int d3); - let d4 = [d4_0; d4_1; d4_2; d4_3; d4_4; d4_5; d4_6; d4_7] in + let d4 = [ d4_0; d4_1; d4_2; d4_3; d4_4; d4_5; d4_6; d4_7 ] in let d4 = List.map Unsigned.UChar.of_int d4 in setf guid data4 (CArray.of_list uchar d4); guid diff --git a/src/windows/directories.ml b/src/windows/directories.ml index 6ae38e4..c6ffcec 100644 --- a/src/windows/directories.ml +++ b/src/windows/directories.ml @@ -5,13 +5,13 @@ open Win_functions let wstring_to_string wstr = let path_len = - Kernel32.wide_char_to_multi_byte - 65001l 0l wstr (-1l) LPSTR.null 0l LPCH.null LPBOOL.null + Kernel32.wide_char_to_multi_byte 65001l 0l wstr (-1l) LPSTR.null 0l + LPCH.null LPBOOL.null in let path = allocate_n CHAR.t ~count:(Int32.to_int path_len) in let _ = - Kernel32.wide_char_to_multi_byte - 65001l 0l wstr (-1l) path path_len LPCH.null LPBOOL.null + Kernel32.wide_char_to_multi_byte 65001l 0l wstr (-1l) path path_len + LPCH.null LPBOOL.null in coerce LPSTR.t string path @@ -19,8 +19,8 @@ let get_folderid id = let wpath_ptr = allocate PWSTR.t PWSTR.null in let result = Shell32.sh_get_known_folder_path - (addr (GUID.to_guid id)) Known_folder_flag.Default - Token.Current_user wpath_ptr + (addr (GUID.to_guid id)) + Known_folder_flag.Default Token.Current_user wpath_ptr in match result with | S_ok -> Some (wstring_to_string !@wpath_ptr)