Alternative clean-path to fix some issues.

clean-path.red

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

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.

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/