From ac033d64c33200b0e3b809a231b4dd90988fc86b Mon Sep 17 00:00:00 2001 From: Duncan McGreggor Date: Mon, 27 Nov 2023 18:58:19 -0600 Subject: [PATCH] Added support for appending dirs (new arities for all functions). --- README.md | 13 ++++++ src/dirs-common.lfe | 32 ++++++++++++- src/dirs-lin.lfe | 4 +- src/dirs-mac.lfe | 26 +++++++---- src/dirs-win.lfe | 14 ++---- src/dirs.lfe | 109 +++++++++++++++++++++++++++++--------------- 6 files changed, 140 insertions(+), 58 deletions(-) diff --git a/README.md b/README.md index 68121f4..e4119e8 100644 --- a/README.md +++ b/README.md @@ -78,6 +78,19 @@ lfe> (dirs:executable) ;; Mac: undefined ``` +Note that all `dirs:*` functions support an additional arity, allowing one to append one or more path segments to the given directory: + +``` erlang +1> dirs:home("lab"). +"/Users/oubiwann/lab" +2> dirs:home(["lab", "lfe"]). +"/Users/oubiwann/lab/lfe" +3> dirs:video(["Conferences", "EUC", 2019, drafts]). +"/Users/oubiwann/Movies/Conferences/EUC/2019/drafts" +4> dirs:cache([2023,11,27,d34db33fcafe,0,1,5,12,42]). +"/Users/oubiwann/Library/Caches/2023/11/27/d34db33fcafe/0/1/5/12/42" +``` + ## Design Goals - The _dirs_ library is a low-level crate designed to provide the paths to standard directories diff --git a/src/dirs-common.lfe b/src/dirs-common.lfe index 3eed58b..2f3ef7b 100644 --- a/src/dirs-common.lfe +++ b/src/dirs-common.lfe @@ -2,7 +2,8 @@ (export (abs-path? 1) (home 0) - (home-subdir 1))) + (home-subdir 1) + (norm-path 2))) (defun abs-path? ((`(#\/ . ,_)) 'true) @@ -13,4 +14,31 @@ home)) (defun home-subdir (path-segs) - (filename:join (++ (dirs-common:home) path-segs))) \ No newline at end of file + (norm-path (home) path-segs)) + +(defun norm-path + ((prefix segs) (when (is_list segs)) + (if (io_lib:printable_unicode_list segs) + (norm-path prefix (list segs)) + (filename:join (++ (list prefix) (norm-segs segs))))) + ((prefix seg) + (norm-path prefix (list (norm-seg seg))))) + +(defun norm-segs (segs) + (norm-segs segs '())) + +(defun norm-segs + (('() acc) + acc) + ((`(,seg . ,rest) acc) + (norm-segs rest (++ acc (list (norm-seg seg)))))) + +(defun norm-seg + ((seg) (when (is_list seg)) + seg) + ((seg) (when (is_atom seg)) + (atom_to_list seg)) + ((seg) (when (is_binary seg)) + (binary_to_list seg)) + ((seg) + (io_lib:format "~p" (list seg)))) diff --git a/src/dirs-lin.lfe b/src/dirs-lin.lfe index 0eb473a..50bb8d5 100644 --- a/src/dirs-lin.lfe +++ b/src/dirs-lin.lfe @@ -26,11 +26,11 @@ ;;; Private Functions (defun config () - (env-or-default "XDG_CONFIG_HOME" (dirs-common:home-subdir '(".config")))) + (env-or-default "XDG_CONFIG_HOME" (dirs-common:home-subdir ".config"))) (defun data () (env-or-default "XDG_DATA_HOME" (dirs-common:home-subdir '(".local" "share")))) - + (defun env-or-default (env-var default) (case (os:getenv env-var) ("" default) diff --git a/src/dirs-mac.lfe b/src/dirs-mac.lfe index 3b0f4fb..99f26b3 100644 --- a/src/dirs-mac.lfe +++ b/src/dirs-mac.lfe @@ -8,23 +8,28 @@ (('runtime) 'undefined) (('state) 'undefined) (('template) 'undefined) + ;; Erlang-supported (('cache) (filename:basedir 'user_cache "")) + (('config) (app-support)) (('config-local) (app-support)) (('data) (app-support)) (('data-local) (app-support)) + ;; Custom (('home) (dirs-common:home)) - (('preference) (filename:join (list (library) "Preferences"))) - (('font) (filename:join (list (library) "Fonts"))) - (('audio) (dirs-common:home-subdir '("Music"))) - (('desktop) (dirs-common:home-subdir '("Desktop"))) - (('document) (dirs-common:home-subdir '("Documents"))) - (('download) (dirs-common:home-subdir '("Downloads"))) - (('picture) (dirs-common:home-subdir '("Pictures"))) - (('public) (dirs-common:home-subdir '("Public"))) - (('video) (dirs-common:home-subdir '("Movies")))) + + (('preference) (library-subdir "Preferences")) + (('font) (library-subdir "Fonts")) + + (('audio) (dirs-common:home-subdir "Music")) + (('desktop) (dirs-common:home-subdir "Desktop")) + (('document) (dirs-common:home-subdir "Documents")) + (('download) (dirs-common:home-subdir "Downloads")) + (('picture) (dirs-common:home-subdir "Pictures")) + (('public) (dirs-common:home-subdir "Public")) + (('video) (dirs-common:home-subdir "Movies"))) ;;; Private Functions @@ -33,3 +38,6 @@ (defun library () (filename:dirname (app-support))) + +(defun library-subdir (path) + (dirs-common:norm-path (library) path)) diff --git a/src/dirs-win.lfe b/src/dirs-win.lfe index 09574c2..2c23a72 100644 --- a/src/dirs-win.lfe +++ b/src/dirs-win.lfe @@ -2,10 +2,6 @@ (export (assemble 1))) -;;extern crate dirs_sys; - -;;use std::path::PathBuf; - ;;pub fn home_dir() -> Option { dirs_sys::known_folder_profile() } ;;pub fn cache_dir() -> Option { data_local_dir() } @@ -35,9 +31,9 @@ (('state) 'undefined) (('font) 'undefined) ;; Erlang-supported - (('cache) (filename:basedir 'user_cache "")) - (('config) (filename:basedir 'user_config "")) - (('config-local) (filename:basedir 'user_config "")) - (('data) (filename:basedir 'user_config "share")) + ;;(('cache) (filename:basedir 'user_cache "")) + ;;(('config) (filename:basedir 'user_config "")) + ;;(('config-local) (filename:basedir 'user_config "")) + ;;(('data) (filename:basedir 'user_config "share")) ;; Custom - ) \ No newline at end of file + ) diff --git a/src/dirs.lfe b/src/dirs.lfe index f52185f..552ad19 100644 --- a/src/dirs.lfe +++ b/src/dirs.lfe @@ -1,22 +1,24 @@ (defmodule dirs (export - (home 0) - (cache 0) + (home 0) (home 1) + (cache 0) (cache 1) (config 0) (config-local 0) (config_local 0) + (config 1) (config-local 1) (config_local 1) (data 0) (data-local 0) (data_local 0) - (executable 0) - (preference 0) - (runtime 0) - (state 0) - (audio 0) - (desktop 0) - (document 0) - (download 0) - (font 0) - (picture 0) - (public 0) - (template 0) - (video 0))) + (data 1) (data-local 1) (data_local 1) + (executable 0) (executable 1) + (preference 0) (preference 1) + (runtime 0) (runtime 1) + (state 0) (state 1) + (audio 0) (audio 1) + (desktop 0) (desktop 1) + (document 0) (document 1) + (download 0) (download 1) + (font 0) (font 1) + (picture 0) (picture 1) + (public 0) (public 1) + (template 0) (template 1) + (video 0) (video 1))) ;;; Returns the path to the user's home directory. ;;; @@ -43,7 +45,8 @@ ;;; All the examples on this page mentioning `$HOME` use this behavior. ;;; -(defun home() (dispatch 'home)) +(defun home () (assemble 'home '())) +(defun home (path-segs) (assemble 'home path-segs)) ;;; Returns the path to the user's cache directory. ;;; @@ -55,7 +58,8 @@ ;;; | macOS | `$HOME`/Library/Caches | /Users/Alice/Library/Caches | ;;; | Windows | `{FOLDERID_LocalAppData}` | C:\Users\Alice\AppData\Local | -(defun cache() (dispatch 'cache)) +(defun cache () (assemble 'cache '())) +(defun cache (path-segs) (assemble 'cache path-segs)) ;;; Returns the path to the user's config directory. ;;; @@ -67,7 +71,8 @@ ;;; | macOS | `$HOME`/Library/Application Support | /Users/Alice/Library/Application Support | ;;; | Windows | `{FOLDERID_RoamingAppData}` | C:\Users\Alice\AppData\Roaming | -(defun config() (dispatch 'config)) +(defun config () (assemble 'config '())) +(defun config (path-segs) (assemble 'config path-segs)) ;;; Returns the path to the user's local config directory. ;;; @@ -79,8 +84,13 @@ ;;; | macOS | `$HOME`/Library/Application Support | /Users/Alice/Library/Application Support | ;;; | Windows | `{FOLDERID_LocalAppData}` | C:\Users\Alice\AppData\Local | -(defun config-local() (dispatch 'config-local)) -(defun config_local() (dispatch 'config-local)) ; for Erlanger's +(defun config-local () (assemble 'config-local '())) +(defun config-local (path-segs) (assemble 'config-local path-segs)) + +;; for Erlanger's + +(defun config_local () (assemble 'config-local '())) +(defun config_local (path-segs) (assemble 'config-local path-segs)) ;;; Returns the path to the user's data directory. ;;; @@ -92,7 +102,8 @@ ;;; | macOS | `$HOME`/Library/Application Support | /Users/Alice/Library/Application Support | ;;; | Windows | `{FOLDERID_RoamingAppData}` | C:\Users\Alice\AppData\Roaming | -(defun data() (dispatch 'data)) +(defun data () (assemble 'data '())) +(defun data (path-segs) (assemble 'data path-segs)) ;;; Returns the path to the user's local data directory. ;;; @@ -104,8 +115,13 @@ ;;; | macOS | `$HOME`/Library/Application Support | /Users/Alice/Library/Application Support | ;;; | Windows | `{FOLDERID_LocalAppData}` | C:\Users\Alice\AppData\Local | -(defun data-local() (dispatch 'data-local)) -(defun data_local() (dispatch 'data-local)) ; for Erlanger's +(defun data-local () (assemble 'data-local '())) +(defun data-local (path-segs) (assemble 'data-local path-segs)) + +;; for Erlanger's + +(defun data_local () (assemble 'data-local '())) +(defun data_local (path-segs) (assemble 'data-local path-segs)) ;;; Returns the path to the user's executable directory. ;;; @@ -117,7 +133,8 @@ ;;; | macOS | – | – | ;;; | Windows | – | – | -(defun executable() (dispatch 'executable)) +(defun executable () (assemble 'executable '())) +(defun executable (path-segs) (assemble 'executable path-segs)) ;;; Returns the path to the user's preference directory. ;;; @@ -129,7 +146,8 @@ ;;; | macOS | `$HOME`/Library/Preferences | /Users/Alice/Library/Preferences | ;;; | Windows | `{FOLDERID_RoamingAppData}` | C:\Users\Alice\AppData\Roaming | -(defun preference() (dispatch 'preference)) +(defun preference () (assemble 'preference '())) +(defun preference (path-segs) (assemble 'preference path-segs)) ;;; Returns the path to the user's runtime directory. ;;; @@ -144,7 +162,8 @@ ;;; | macOS | – | – | ;;; | Windows | – | – | -(defun runtime() (dispatch 'runtime)) +(defun runtime () (assemble 'runtime '())) +(defun runtime (path-segs) (assemble 'runtime path-segs)) ;;; Returns the path to the user's state directory. ;;; @@ -160,7 +179,8 @@ ;;; | macOS | – | – | ;;; | Windows | – | – | -(defun state() (dispatch 'state)) +(defun state () (assemble 'state '())) +(defun state (path-segs) (assemble 'state path-segs)) ;;; Returns the path to the user's audio directory. ;;; @@ -172,7 +192,8 @@ ;;; | macOS | `$HOME`/Music | /Users/Alice/Music | ;;; | Windows | `{FOLDERID_Music}` | C:\Users\Alice\Music | -(defun audio() (dispatch 'audio)) +(defun audio() (assemble 'audio '())) +(defun audio(path-segs) (assemble 'audio path-segs)) ;;; Returns the path to the user's desktop directory. ;;; @@ -184,7 +205,8 @@ ;;; | macOS | `$HOME`/Desktop | /Users/Alice/Desktop | ;;; | Windows | `{FOLDERID_Desktop}` | C:\Users\Alice\Desktop | -(defun desktop() (dispatch 'desktop)) +(defun desktop () (assemble 'desktop '())) +(defun desktop (path-segs) (assemble 'desktop path-segs)) ;;; Returns the path to the user's document directory. ;;; @@ -196,7 +218,8 @@ ;;; | macOS | `$HOME`/Documents | /Users/Alice/Documents | ;;; | Windows | `{FOLDERID_Documents}` | C:\Users\Alice\Documents | -(defun document() (dispatch 'document)) +(defun document () (assemble 'document '())) +(defun document (path-segs) (assemble 'document path-segs)) ;;; Returns the path to the user's download directory. ;;; @@ -208,7 +231,8 @@ ;;; | macOS | `$HOME`/Downloads | /Users/Alice/Downloads | ;;; | Windows | `{FOLDERID_Downloads}` | C:\Users\Alice\Downloads | -(defun download() (dispatch 'download)) +(defun download () (assemble 'download '())) +(defun download (path-segs) (assemble 'download path-segs)) ;;; Returns the path to the user's font directory. ;;; @@ -220,7 +244,8 @@ ;;; | macOS | `$HOME/Library/Fonts` | /Users/Alice/Library/Fonts | ;;; | Windows | – | – | -(defun font() (dispatch 'font)) +(defun font () (assemble 'font '())) +(defun font (path-segs) (assemble 'font path-segs)) ;;; Returns the path to the user's picture directory. ;;; @@ -232,7 +257,8 @@ ;;; | macOS | `$HOME`/Pictures | /Users/Alice/Pictures | ;;; | Windows | `{FOLDERID_Pictures}` | C:\Users\Alice\Pictures | -(defun picture() (dispatch 'picture)) +(defun picture () (assemble 'picture '())) +(defun picture (path-segs) (assemble 'picture path-segs)) ;;; Returns the path to the user's public directory. ;;; @@ -244,7 +270,8 @@ ;;; | macOS | `$HOME`/Public | /Users/Alice/Public | ;;; | Windows | `{FOLDERID_Public}` | C:\Users\Public | -(defun public() (dispatch 'public)) +(defun public () (assemble 'public '())) +(defun public (path-segs) (assemble 'hopublicme path-segs)) ;;; Returns the path to the user's template directory. ;;; @@ -256,7 +283,8 @@ ;;; | macOS | – | – | ;;; | Windows | `{FOLDERID_Templates}` | C:\Users\Alice\AppData\Roaming\Microsoft\Windows\Templates | -(defun template() (dispatch 'template)) +(defun template () (assemble 'template '())) +(defun template (path-segs) (assemble 'template path-segs)) ;;; Returns the path to the user's video directory. ;;; @@ -268,10 +296,19 @@ ;;; | macOS | `$HOME`/Movies | /Users/Alice/Movies | ;;; | Windows | `{FOLDERID_Videos}` | C:\Users\Alice\Videos | -(defun video() (dispatch 'video)) +(defun video () (assemble 'video '())) +(defun video (path-segs) (assemble 'video path-segs)) ;;; Private functions +(defun assemble + ((dir-type '()) + (dispatch dir-type)) + ((dir-type path-segs) + (case (dispatch dir-type) + ('undefined 'undefined) + (prefix (dirs-common:norm-path prefix path-segs))))) + (defun dispatch (dir-type) ;; Erlang supports some of these natively, but the results in Erlang are not ;; consistent with those of the upstream Rust library. We follow the Rust