mirror of
https://github.com/janet-lang/janet
synced 2024-12-23 15:00:27 +00:00
Add path.janet.
This commit is contained in:
parent
0a9715a94c
commit
46531d9a60
@ -31,8 +31,10 @@ Keys are:
|
||||
(def todo @[])
|
||||
(each arg args
|
||||
(if (string/has-prefix? "--" arg)
|
||||
(let [[key value] (peg/match argpeg arg)]
|
||||
(if-let [m (peg/match argpeg arg)]
|
||||
(let [[key value] m]
|
||||
(setdyn (keyword key) value))
|
||||
(print "invalid argument " arg))
|
||||
(array/push todo arg)))
|
||||
|
||||
(cook/import-rules "./project.janet")
|
||||
|
149
auxlib/path.janet
Normal file
149
auxlib/path.janet
Normal file
@ -0,0 +1,149 @@
|
||||
### path.janet
|
||||
###
|
||||
### A library for path manipulation.
|
||||
###
|
||||
### Copyright 2019 © Calvin Rose
|
||||
|
||||
#
|
||||
# Common
|
||||
#
|
||||
|
||||
(def- ext-peg
|
||||
(peg/compile ~{:back (> -1 (+ (* ($) (set "\\/.")) :back))
|
||||
:main :back}))
|
||||
|
||||
(defn ext
|
||||
"Get the file extension for a path."
|
||||
[path]
|
||||
(if-let [m (peg/match ext-peg path (length path))]
|
||||
(let [i (m 0)]
|
||||
(if (= (path i) 46)
|
||||
(string/slice path (m 0) -1)))))
|
||||
|
||||
(defn- redef
|
||||
"Redef a value, keeping all metadata."
|
||||
[from to]
|
||||
(setdyn (symbol to) (dyn (symbol from))))
|
||||
|
||||
#
|
||||
# Generating Macros
|
||||
#
|
||||
|
||||
(defmacro- decl-sep [pre sep] ~(def ,(symbol pre "/sep") ,sep))
|
||||
(defmacro- decl-delim [pre d] ~(def ,(symbol pre "/delim") ,d))
|
||||
|
||||
(defmacro- decl-last-sep
|
||||
[pre sep]
|
||||
~(def- ,(symbol pre "/last-sep-peg")
|
||||
(peg/compile ~{:back (> -1 (+ (* ,sep ($)) :back))
|
||||
:main :back})))
|
||||
|
||||
(defmacro- decl-basename
|
||||
[pre]
|
||||
~(defn ,(symbol pre "/basename")
|
||||
"Gets the base file name of a path."
|
||||
[path]
|
||||
(if-let [m (peg/match
|
||||
,(symbol pre "/last-sep-peg")
|
||||
path
|
||||
(length path))]
|
||||
(let [[p] m]
|
||||
(string/slice path p -1))
|
||||
path)))
|
||||
|
||||
(defmacro- decl-parts
|
||||
[pre sep]
|
||||
~(defn ,(symbol pre "/parts")
|
||||
"Split a path into its parts."
|
||||
[path]
|
||||
(string/split ,sep path)))
|
||||
|
||||
(defmacro- decl-normalize
|
||||
[pre sep lead]
|
||||
~(defn ,(symbol pre "/normalize")
|
||||
"Normalize a path. This removes . and .. in the
|
||||
path, as well as empty path elements."
|
||||
[path]
|
||||
(def els (string/split ,sep path))
|
||||
(def newparts @[])
|
||||
(if (,(symbol pre "/abspath?") path) (array/push newparts ,lead))
|
||||
(each part els
|
||||
(case part
|
||||
"" nil
|
||||
"." nil
|
||||
".." (array/pop newparts)
|
||||
(array/push newparts part)))
|
||||
(string/join newparts ,sep)))
|
||||
|
||||
(defmacro- decl-join
|
||||
[pre sep]
|
||||
~(defn ,(symbol pre "/join")
|
||||
"Join path elements together."
|
||||
[& els]
|
||||
(,(symbol pre "/normalize") (string/join els ,sep))))
|
||||
|
||||
(defmacro- decl-abspath
|
||||
[pre]
|
||||
~(defn ,(symbol pre "/abspath")
|
||||
"Coerce a path to be absolute."
|
||||
[path]
|
||||
(if (,(symbol pre "/abspath?") path)
|
||||
path
|
||||
(,(symbol pre "/join") (os/cwd) path))))
|
||||
|
||||
#
|
||||
# Posix
|
||||
#
|
||||
|
||||
(defn posix/abspath?
|
||||
"Check if a path is absolute."
|
||||
[path]
|
||||
(string/has-prefix? "/" path))
|
||||
|
||||
(redef "ext" "posix/ext")
|
||||
(decl-sep "posix" "/")
|
||||
(decl-delim "posix" ";")
|
||||
(decl-last-sep "posix" "/")
|
||||
(decl-basename "posix")
|
||||
(decl-parts "posix" "/")
|
||||
(decl-normalize "posix" "/" "")
|
||||
(decl-join "posix" "/")
|
||||
(decl-abspath "posix")
|
||||
|
||||
#
|
||||
# Windows
|
||||
#
|
||||
|
||||
(def- abs-peg (peg/compile '(* (range "AZ") ":\\")))
|
||||
(defn win32/abspath?
|
||||
"Check if a path is absolute."
|
||||
[path]
|
||||
(peg/match abs-peg path))
|
||||
|
||||
(redef "ext" "win32/ext")
|
||||
(decl-sep "win32" "\\")
|
||||
(decl-delim "win32" ":")
|
||||
(decl-last-sep "win32" "\\")
|
||||
(decl-basename "win32")
|
||||
(decl-parts "win32" "\\")
|
||||
(decl-normalize "win32" "\\" "C:")
|
||||
(decl-join "win32" "\\")
|
||||
(decl-abspath "win32")
|
||||
|
||||
#
|
||||
# Specialize for current OS
|
||||
#
|
||||
|
||||
(def- syms
|
||||
["ext"
|
||||
"sep"
|
||||
"delim"
|
||||
"basename"
|
||||
"abspath?"
|
||||
"abspath"
|
||||
"parts"
|
||||
"normalize"
|
||||
"join"])
|
||||
(let [pre (if (= :windows (os/which)) "win32" "posix")]
|
||||
(each sym syms
|
||||
(redef (string pre "/" sym) sym)))
|
Loading…
Reference in New Issue
Block a user