Skip to content

Instantly share code, notes, and snippets.

@x8x
Last active February 11, 2020 16:02
Show Gist options
  • Save x8x/612e9fa77378b93d98f0cf19ed27c215 to your computer and use it in GitHub Desktop.
Save x8x/612e9fa77378b93d98f0cf19ed27c215 to your computer and use it in GitHub Desktop.
Alternative clean-path to fix some issues.
Red []
clean-path: func [{Cleans-up '.' and '..' in path; returns the cleaned path}
path [file! url! string!]
/only "Do not prepend current directory"
/dir "Add a trailing / if missing"
/local count e file is-root? is-url? items out prefix s
][
count: 0
is-root?: slash = first path
is-url?: if url? path [
only: false
parse path [
s: thru {://} [thru slash | to end]
e: copy path to end (prefix: copy/part s e)
]
]
items: parse path [
collect any [
[copy s to slash keep (append s slash) | copy file to end] skip
]
]
forall items [
case [
all [is-root? 1 = index? items] []
find [%/ %./] as file! first items [items: back remove items]
%../ = first items [
switch/default as file! first back items [
%../ [count: count + 1]
%/ [items: back remove items]
][items: back remove/part back items 2]
]
]
]
if all [not is-root? not only] [
take/part items count
unless is-url? [
items: head insert items head clear at tail parse what-dir [
collect any [copy s to slash keep (append s slash) skip]
] negate count
]
]
out: append any [prefix copy/part path 0] items
if file [append out file]
all [dir not slash = last out append out slash]
out
]
; ; ## TESTS
;
;
;
; colors: [black red green yellow blue magenta cyan white]
;
; color: func [s f /bg b /space
; /local o t
; ][
; o: clear ""
; s: form s
; if space [s: rejoin [" " s " "]]
; if t: find colors f [
; append o join "3" (index? t) - 1
; ]
; if all [bg t: find colors b] [append o join ";4" (index? t) - 1]
; unless empty? o [
; s: rejoin ["^[[" o "m" s "^[[m"]
; ]
; s
; ]
;
;
; test: func [path expect][
; print color mold path 'white
;
; prin color mold t: clean-path path either t: expect/1 = t ['green]['red]
; prin either t [lf][[{ ->} color mold expect/1 'green lf]]
;
; prin color mold t: clean-path/only path either t: expect/2 = t ['green]['red]
; prin either t [lf][[{ ->} color mold expect/2 'green lf]]
; prin lf
; ]
;
;
;
;
; test %""
; [%/Users/alpha/test/red/clean-path/ %""]
; ; issue #4258
; test %file
; [%/Users/alpha/test/red/clean-path/file %file]
;
; test %/
; [%/ %/]
; test %/file
; [%/file %/file]
;
; test %../path/./../
; [%/Users/alpha/test/red/ %../]
; test %../path/./../file
; [%/Users/alpha/test/red/file %../file]
;
; test {../path/./../}
; [{/Users/alpha/test/red/} {../}]
; test {../path/./../file}
; [{/Users/alpha/test/red/file} {../file}]
;
; test %../../../../path1/./../path2/
; [%/Users/path2/ %../../../../path2/]
; test %../../../../path1/./../path2/file
; [%/Users/path2/file %../../../../path2/file]
;
; test %../path//./../
; [%/Users/alpha/test/red/ %../]
; test %../path//./../file
; [%/Users/alpha/test/red/file %../file]
;
;
; ; issue #3571
; test https://red-lang.org
; [https://red-lang.org https://red-lang.org]
; test https://red-lang.org/file
; [https://red-lang.org/file https://red-lang.org/file]
;
; test https://red-lang.org/../../../../
; [https://red-lang.org/ https://red-lang.org/]
; test https://red-lang.org/../../../../file
; [https://red-lang.org/file https://red-lang.org/file]
;
;
;
; test %a/b/c/../../d/e [%/Users/alpha/test/red/clean-path/a/d/e %a/d/e]
; test %/a/b/c/../../d/e [%/a/d/e %/a/d/e]
;
;
; test %a////b/c///../../d/e [%/Users/alpha/test/red/clean-path/a/d/e %a/d/e]
; test %/////a/b/c/../..////d/e [%/a/d/e %/a/d/e]
;
;
; test %../a/b/c/../../d/ [%/Users/alpha/test/red/a/d/ %../a/d/]
; test %../a/b/c/../../d/file [%/Users/alpha/test/red/a/d/file %../a/d/file]
;
;
; test %/../a/b/c/../../d/ [%/a/d/ %/a/d/]
; test %/../a/b/c/../../d/file [%/a/d/file %/a/d/file]
;
;
; ; timer/loop [clean-path %../a/b/c/../../d] 100000
@x8x
Copy link
Author

x8x commented Jan 25, 2020

Few notes:

  • It's a bit slower than the current implementation, sure there is room for improvement. ;-)
  • Not sure if clean-path http://red-lang.org should get the final slash http://red-lang.org/.
  • Not sure what to do with invalid data like clean-path %.../path//./...../
  • I would probably remove the /dir refinement and use dirize clean-path ...
  • It probably needs some fixes for corner cases.

@Oldes
Copy link

Oldes commented Feb 11, 2020

Things to consider:

>> clean-path scheme:root/..
== /X/GIT/Red/scheme:root/..   ;<---- BAD, better: scheme:root or scheme:root/

>> clean-path http://red-lang.com/..
== http://red-lang.com/..      ;<---- BAD, should be: http://red-lang.com or http://red-lang.com/

Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment