x8x/code.red

## code.red
Red []


#if config/OS <> 'Windows [
	colors: [black red green yellow blue magenta cyan white]
	;https://en.wikipedia.org/wiki/ANSI_escape_code
	color: function [s f /bg b /space][
		o: clear {}
		s: form s
		if space [s: rejoin [{ } s { }]]
		if t: find colors f [
			append o join {3} (index? t) - 1
			; append o join {38;5;} (index? t) - 1
		]
		if all [bg t: find colors b] [
			append o join {;4} (index? t) - 1
			; append o join {;48;5;} (index? t) - 1
		]
		unless empty? o [
			s: rejoin [{^[[} o {m} s {^[[m}]
		]
		s
	]
]

join: func [	;thx Gregg
	"Concatenate values"
	a "Coerced to string if not a series, map, or object"
	b "Single value or block of values; reduced if a is not an object or map"
][
	if all [block? :b  not object? :a  not map? :a] [b: reduce b]
	case [
		series? :a [append copy a :b]
		map?    :a [extend copy a :b]
		object? :a [make a :b]
		'else      [append form :a :b]
	]
]

; object [												;TBD: add /deep refinement see https://github.com/red/red/commit/4eaaf675a08899a1ece647d1c1c04ecd0db1cb5a
; 	replace*: :system/words/replace
; 	set 'replace func [
; 		"Improved replace with support for /case and /tail. Use native replace for binary!"
; 		series [series!] "The series to be modified"
; 		pattern "Specific value or parse rule pattern to match"
; 		value "New value, replaces pattern in the series"
; 		/all "Replace all occurrences, not just the first"
; 		/deep "Replace pattern in all sub-lists as well"
; 		/case "Case-sensitive replacement"
; 		/tail "Return target after the last replacement position"
; 		return: [series!]
; 		/local rule pos
; 	][
; 		either binary? series [
; 			if any [case tail] [do make error! {/case and /tail not supported for type binary!}]
; 			do append copy either all [[replace*/all]][[replace*]] [series pattern value]			;FIXME: hack until dyn-stack
; 		][
; 			rule: [to pattern change pattern value pos:]
; 			if all [rule: append/only copy [any] rule]
; 			either case [
; 				parse/case series rule
; 			][
; 				parse series rule
; 			]
; 			either tail [pos][series]
; 		]
; 	]
; ]

replace: func [
	"Replaces values in a series, in place"
	series [series!] "The series to be modified"
	pattern "Specific value or parse rule pattern to match"
	value "New value, replaces pattern in the series"
	/all "Replace all occurrences, not just the first"
	/deep "Replace pattern in all sub-lists as well"
	/case "Case-sensitive replacement"
	/tail "Return series after the last replacement position (only if that is not in a nested series)"
	/local p rule s e many? len pos ret depth last-depth
][
	ret: series
	if system/words/all [deep any-list? series] [
		if tail [do make error! {/tail makes no sense with nested series}]
		pattern: to block! either word? p: pattern [to lit-word! pattern] [pattern]
		parse series rule: [
			some [
				s: pattern e: (
					s: change/part s value e
					unless all [return series]
				) :s
				| ahead any-list! into rule | skip
			]
		]
		return series

		; ;allow /tail but disable it if series contains sub-series
		; parse series rule: [
		; 	some [
		; 		s: pattern e: opt [any-list! (tail: false)] (
		; 			ret: s: change/part s value e
		; 			unless all [return either tail [ret][series]]
		; 		) :s
		; 		| ahead any-list! into rule | skip
		; 	]
		; ]
		; return either tail [ret][series]

		;; allow /tail but return tail only if last replacement occurred at root of series
		; depth: 0
		; parse series rule: [
		; 	some [
		; 		s: pattern e: (
		; 			ret: s: change/part s value e
		; 			unless all [return either system/words/all [tail 0 = depth] [ret][series]]
		; 			last-depth: depth
		; 		) :s
		; 		| ahead any-list! (depth: depth + 1) into rule | skip
		; 	] (depth: depth - 1)
		; ]
		; return either system/words/all [tail 0 = last-depth] [ret][series]
	]
	if system/words/all [char? :pattern any-string? series] [
		pattern: form pattern
	]
	many?: any [
		system/words/all [series? :pattern any-string? series]
		binary? series
		system/words/all [any-list? series any-list? :pattern]
	]
	len: either many? [length? pattern] [1]
	either all [
		pos: series
		either many? [
			while [pos: either case [find/case pos pattern][find pos pattern]] [
				; remove/part pos len
				; pos: insert pos value
				ret: pos: change/part pos value len
			]
		] [
			while [pos: either case [find/case pos :pattern][find pos :pattern]] [
				ret: pos: insert remove pos value
			]
		]
	] [
		if pos: either case [find/case series :pattern][find series :pattern] [
			; remove/part pos len
			; insert pos value
			ret: pos: change/part pos value len
		]
	]
	either tail [ret][series]
]

; print [1 2 3] = replace [1 4 3] 4 2
; print [1 2 3] = replace [4 5 3] [4 5] [1 2]
; print "abc" = replace "axc" "x" "b"
; print "abc" = replace "xyc" "xy" "ab"
; print "abcx" = replace "abxx" "x" "c"
; print "abcc" = replace/all "abxx" "x" "c"
; print [1 9 [2 3 4]] = replace [1 2 [2 3 4]] 2 9
; print [1 9 [2 3 4]] = replace/all [1 2 [2 3 4]] 2 9
;
; code: [print "Hello"]
; print 'print = first replace code "Hello" "Cheers"
; print "Cheers" = second code
; ; "replace-str"
; print "Xbab" = replace "abab" #"a" #"X"
; print "XbXb" = replace/all "abab" #"a" #"X"
; print "Xab" = replace "abab" "ab" "X"
; print "abab" = replace/all "abab" #"a" #"a"
;
; ; "replace-bin"
; print #{FF0201} = replace #{010201} #{01} #{FF}
; print #{FF02FF} = replace/all #{010201} #{01} #{FF}
; print #{FF03}   = replace #{010203} #{0102} #{FF}
; print #{FFFFFF03} = replace #{010203} #{0102} #{FFFFFF}
;
; ; "replace-bitset-issue-#3132"
; print "s" = replace/all "test" charset [#"t" #"e"] ""
;
; ;new
; print "0A" = replace/case {aA} "a" "0"
; print "a0a0a0a0a" = replace/all/case {aAaAaAaAa} "A" "0"
; print "tail" = replace/case/tail {abcDtail} "D" "0"
; print "tail" = replace/all/case/tail {aAaAaAtail} "A" "0"
; print [4 5] = replace/all/tail [1 2 3 2 4 5] 2 0
; print [z [b [z] c]] = replace/all/deep/tail [a [b [a] c]] 'a 'z
; print [z [b [z] c]] = head replace/all/deep/tail [a [b [a] c]] 'a 'z
; print [[b [a] c]] = replace/deep/tail [a [b [a] c]] 'a 'z
; print [z [b [a] c]] = head replace/deep/tail [a [b [a] c]] 'a 'z
; print [[b [a] c]] = replace/tail [a [b [a] c]] 'a 'z
; print [z [b [a] c]] = head replace/tail [a [b [a] c]] 'a 'z
; print [z [b [z] c]] = replace/all/deep [a [b [a] c]] 'a 'z
; print [z [b [z] c]] = head replace/all/deep [a [b [a] c]] 'a 'z
; print [z [b [z] c]] = replace/all/deep/tail [a [b [a] c]] 'a 'z
; print [z [b [z] c]] = head replace/all/deep/tail [a [b [a] c]] 'a 'z
; print [b b] = replace/all/deep/tail [a b a b a b b] 'a 'z
; print [z b z b z b b] == head replace/all/deep/tail [a b a b a b b] 'a 'z
; print [] = replace/deep/tail [b [b [b] c] a] 'a 'z
;
; replace/deep/tail [a [b [a] c]] 'a 'z
; replace/deep/tail [b [b [b] c] a b] 'a 'z
; replace/deep/tail/all [b [a [a] ] a b] 'a 'z
; replace/deep/tail/all [b [a [a] ] b b] 'a 'z
; replace/deep/tail/all [a b b] 'a 'z

patch: func [
	"Replace all occurrences of patches, return an error if no match"
	file [file!] "File to operate on"
	patches [block!] "Block of patches blocks containing either from/to strings or a parse rule"
	/quiet "Don't bother if no match"
	/local source patch
][
	source: read file
	foreach patch patches [
		unless empty? patch [
			either block? patch/1 [
				all [
					not parse/case source patch/1
					not quiet
					do make error! rejoin [{rule } mold patch/1 { did not match in %} file]
				]
			][
				all [
					not quiet
					not find/case source patch/1
					do make error! rejoin [{string "} patch/1 {" not found in file %} file]
				]
				replace/all/case source patch/1 patch/2
			]
		]
	]
	write file source
]

undirize: func [
	"Return dir or a copy of dir with last slash removed"
	dir [file!]
][
	either #"/" = last dir [
		head remove back tail copy dir
	][dir]
]

; maybe: func[value [any-type!] default /type types [block!] pos [block!] /local b t s][
maybe: func [
	{Convenience function to allow no value, provide default, optionally provide allowed types
	and perform transformations on those. Most useful in console for functions like cd, ls, ecc..}
	;becuse you want to write [ls .] and not  as an example..
	value [any-type!]
	default "Default value"
	/type
		types [block!] "Block of allowed types, each type can be followed by a transformation block"
		error [block!] {Block containing calling function name as word! and calling function arg name as word!
		Values are used to return a proper error string}
	/local b t s
][
	either unset? :value [default][
		either type [
			either find types t: type?/word value [
				either block? b: select types t [
					do bind b 'value
				][
					value
				]
			][
				; s: find stack 'maybe
				; cause-error 'script 'expect-arg [s/(pos/1) t s/(pos/2)]
				cause-error 'script 'expect-arg [error/1 t error/2]
			]
		][value]
	]
]

maybe-dir: func [
	"Convenience function, allow no value for dir, default to current dir, allow specific types"
	dir [any-type!]
	error [block!] {Block containing calling function name as word! and calling function arg name as word!
		Values are used to return a proper error string}
][
	maybe/type :dir %./ either system/state/interpreted? [
		[file! string! integer! word! path!]
	][
		[file! word! [get value] path! [get value]]	;if compiled, word! and path! types gets evaluated, Good or not Good?
	] error
]

ls-ctx: object [

	default-rule: [to end]

	rules: [
		dot [[dot] "dot files"]
		dot-folder [[[dot if (dir? item)]] "dot folders"]
		dot-file [[[dot if (not dir? item)]] "dot files"]
		folder [[if (dir? item)] "folders"]
		file [[if (not dir? item)] "files"]
	]

	list-rules: func [/local name description][
		print "Available rules:"
		foreach [name description] rules [
			print [pad insert form name space 12 "->" description/1/2]
		]
	]

	nice: func [item][
		; either find [macOS Linux] system/platform [
		; 	color undirize item pick [green red] dir? item
		; ][
		; 	dirize item
		; ]
		#either config/OS = 'Windows [
			dirize item
		][
			color undirize item pick [green red] dir? item
		]
	]

	set 'ls func [
		"Improved directory listing"
		'dir [any-type!] "Directory to operate on. If no value use current one"
		/deep "Descend all subfolders"
		/strict
		/level "Descend only x levels"
			level* [integer! none!] "Number of levels to descend"
		/do  "Apply a function to matched items"
			fun	[function!] "Function to apply, spec block can call item and depth"		;see examples..
		/only
			'rule [word! block! none!]
		/skip "Skip value matching parse rule"
			'not-rule [word! block! none!] "parse rule (with optional [to end]) or dot (convenience to skip dot files)"
		/help "Show available rules and exit"
		/pass "Internal arg to pass data for recursion. Don't use!"
			depth? [logic!]
			depth [block!]
			path [file!]
			strict* [logic!]
		/local item list last match? r
	][
		either pass [
			append depth off
			if strict* [strict: on]
		][
			if help [list-rules exit]
			dir: to-file maybe-dir :dir [ls dir]
			unless dir? dir [dir: join dir #"/"]
			all [
				rule
				not-rule
				system/words/do make error! "Only use one of /only or /skip not both"
			]
			if not-rule [rule: not-rule]
			switch type?/word rule [
				none! [rule: default-rule]
				word! [
					r: select rules rule
					unless r [
						system/words/do make error! {Invalid rule! Type "ls/help" to see available rules}
					]
					rule: clear []
					append rule first r
					append rule [to end]
				]
			]
			if not-rule [insert rule 'not]
			unless :fun [
				fun: func [item][print ls-ctx/nice item]
			]
			path: dir
			depth?: parse spec-of :fun [
				2 word! to end
			]			;check if depth is used in passed function
			depth: append clear [] off
			strict: to-logic strict
		]
		list: sort read dir										;macOS sorts, Linux doesn't, Windows?
		if empty? list [exit]
		if depth? [												;look ahead for last match only if depth is used
			list: tail list
			until [
				list: back list
				item: first list
				any [
					parse item rule
					1 = index? list
				]
			]
			last: index? list
			list: head list
		]
		forall list [
			item: first list
			match?: parse item bind rule 'item
			if any [
				match?
				not strict
			][
				all [
					depth?
					last = index? list
					change back tail depth on
				]
				item: join dir item
				if match? [
					system/words/do [fun find/tail item path depth]
				]			;move index of item past path
				all [
					dir? item
					either level* [level* > length? depth][deep]
					ls/deep/level/do/only/pass :item level* :fun :rule depth? depth path strict
					remove back tail depth
				]
			]
		]
		exit
	]

	set 'tree func [
		'dir [any-type!]
		/level
			level* [integer! none!]
		/only
			'rule [word! block! none!]
		/skip
			'not-rule [word! block! none!]
		/help "Show available rules and exit"
		/local cache
	][
		if help [list-rules exit]
		cache: clear make hash! 100
		dir: to-file maybe-dir :dir [tree dir]
		print nice dirize to-file dir
		ls/deep/strict/level/do/only/skip :dir level* func[item depth /local c][
			prin any [
				select/only cache depth
				(
					append cache reduce [copy depth c: copy ""]
					forall depth [
						append c pick either tail? next depth [
							[{└─ } {├─ }]
						][
							[{   } {│  }]
						] first depth
					]
					c
				)
			]
			print ls-ctx/nice last split-path item		;why do I have to do this otherwise nice returns itself as a function ??????
		] :rule :not-rule
	]

] ;end object


;### tests helper functions
object [
	; system/state/trace?: off

	n: newline
	sep: pad/with ";" 80 #"#"
	fill: func [value][pad/with rejoin [";## " value space] 80 #"#"]

	set 'section func [title][
		print [n sep n sep n fill uppercase title n sep n sep n]
	]

	set 'exec func [block /def /local result][
		if string? block/1 [
			print [n sep n fill block/1 n sep n]
			block: next block
		]
		print join ">> " trim/head/tail next head clear back tail mold block
		set/any 'result try block
		if value? 'result [
			all [
				not error? :result
				not empty? result: form :result
				result: head insert result "== "
			]
			unless def [prin result]
			prin n
		]
		prin n
	]

	set 'make-test-folder func [][
		if exists? %folder/.0.txt [call/wait {rm -r folder}]
		make-dir f: %folder
		write f/.0.txt ""
		write f/(%1.txt) ""
		write f/(%2.txt) "pattern to be modified"
		make-dir f: %folder/emptyfolder
		make-dir f: %folder/.subfolder0
		write f/.0.txt ""
		write f/(%1.txt) ""
		write f/(%2.txt) "pattern to be modified"
		make-dir f: %folder/subfolder1
		write f/.0.txt ""
		write f/(%1.txt) ""
		write f/(%2.txt) "pattern to be modified"
		make-dir f: %folder/subfolder2
		write f/.0.txt ""
		write f/(%1.txt) ""
		write f/(%2.txt) "pattern to be modified"
	]

] ;end object

;### run tests
make-test-folder

section {patch tests}
	exec [
		"patch %folder/2.txt with patches, error if no match"
		patch %folder/2.txt [
			[{to be } {}]
			[{ modified} { reverted}]
			[[any [to {pattern} change {pattern} {value}] to end]]
		]
	]
	exec [
		"patch %folder/2.txt with patches, error if no match"
		patch %folder/2.txt [
			[{not-found..} {return an error}]
		]
	]
	exec [
		"patch %folder/2.txt with patches, no error if no match"
		patch/quiet %folder/2.txt [
			[{not-found..} {don't complain}]
		]
	]

section {maybe tests}
	exec/def [
		"allow any value type, default to logic! off if no value"
		test: func ['value [any-type!]][maybe :value off]
	]
	exec [test]
	exec [test off]

	exec/def [
		"allow values of types word! and none!, default to logic! off if no value"
		test: func ['value [any-type!]][maybe/type :value off [word! none!] [test value]]
	]
	exec [test #123]
	exec [test word]

	exec/def [
		"allow values of types word! logic! and none!, type word! value are evaluated, default to logic! off if no value"
		test: func ['value [any-type!]][
			maybe/type :value off [word! [get value] logic! none!
		] [test value]]
	]
	exec [test #123]
	exec [test on]
	exec [test none]
	exec [word: 123 test word]

section {ls tests}
	exec [
		"error .."
		ls/only/skip . dot dot
	]
	exec [
		"list all files and folders in current dir"
		ls
	]
	exec [
		"same, alternative call"
		ls .
	]
	exec [
		"same, alternative call"
		ls %.
	]
	exec [
		"execute provided function for every files and folders in current dir"
		ls/do %. func[][print do load {1 + 1}]]
	exec [
		"list all files and folders in current dir, skip dot files"
		ls/skip %. [dot to end]
	]
	exec [
		"same, alternative call"
		ls/skip %. dot
	]
	exec [
		"list all files, skip folders and dot files in current dir"
		ls/do/skip %. func[item][unless dir? item [print item]] dot
	]
	exec [
		"recursive listing of files and folders in current dir, skipping dot files and printing with padded depth"
		ls/deep/do/skip %. func[item depth][
			print head insert/dup last split-path item space (length? depth) - 1 * 2
		] dot
	]

section {ls + patch test}
	exec [
		"recursively patch files content and change matched file names in one shot"
		ls/deep/do/skip %folder func [item /local f][
			item: head item
			unless dir? item [
				patch/quiet item [
					[[any [to {value} change {value} {new value} (
						print rejoin [{Found "value" in %} item { and replaced with "new value"}]
					)] to end]]
				]
			]
			if find item %2.txt [
				call/wait form reduce ['mv f: copy item replace/all item %2.txt %3.txt]
				print rejoin [{Found %2.txt in file name %} f { and replaced with %} item]
			]
		] dot
	]

section {tree tests}
	;
	exec [
		"directory tree at current path"
		tree
	]
	exec [
		"same, alternative call"
		tree %.
	]
	exec [
		"directory tree at current path, skip dot files"
		tree/skip %. dot
	]
	exec [
		"directory tree for folder %folder, skip dot files"
		tree/skip %folder dot
	]
	Red []


	#if config/OS <> 'Windows [
	colors: [black red green yellow blue magenta cyan white]
	;https://en.wikipedia.org/wiki/ANSI_escape_code
	color: function [s f /bg b /space][
	o: clear {}
	s: form s
	if space [s: rejoin [{ } s { }]]
	if t: find colors f [
	append o join {3} (index? t) - 1
	; append o join {38;5;} (index? t) - 1
	]
	if all [bg t: find colors b] [
	append o join {;4} (index? t) - 1
	; append o join {;48;5;} (index? t) - 1
	]
	unless empty? o [
	s: rejoin [{^[[} o {m} s {^[[m}]
	]
	s
	]
	]

	join: func [ ;thx Gregg
	"Concatenate values"
	a "Coerced to string if not a series, map, or object"
	b "Single value or block of values; reduced if a is not an object or map"
	][
	if all [block? :b not object? :a not map? :a] [b: reduce b]
	case [
	series? :a [append copy a :b]
	map? :a [extend copy a :b]
	object? :a [make a :b]
	'else [append form :a :b]
	]
	]

	; object [ ;TBD: add /deep refinement see https://github.com/red/red/commit/4eaaf675a08899a1ece647d1c1c04ecd0db1cb5a
	; replace*: :system/words/replace
	; set 'replace func [
	; "Improved replace with support for /case and /tail. Use native replace for binary!"
	; series [series!] "The series to be modified"
	; pattern "Specific value or parse rule pattern to match"
	; value "New value, replaces pattern in the series"
	; /all "Replace all occurrences, not just the first"
	; /deep "Replace pattern in all sub-lists as well"
	; /case "Case-sensitive replacement"
	; /tail "Return target after the last replacement position"
	; return: [series!]
	; /local rule pos
	; ][
	; either binary? series [
	; if any [case tail] [do make error! {/case and /tail not supported for type binary!}]
	; do append copy either all [[replace/all]][[replace]] [series pattern value] ;FIXME: hack until dyn-stack
	; ][
	; rule: [to pattern change pattern value pos:]
	; if all [rule: append/only copy [any] rule]
	; either case [
	; parse/case series rule
	; ][
	; parse series rule
	; ]
	; either tail [pos][series]
	; ]
	; ]
	; ]

	replace: func [
	"Replaces values in a series, in place"
	series [series!] "The series to be modified"
	pattern "Specific value or parse rule pattern to match"
	value "New value, replaces pattern in the series"
	/all "Replace all occurrences, not just the first"
	/deep "Replace pattern in all sub-lists as well"
	/case "Case-sensitive replacement"
	/tail "Return series after the last replacement position (only if that is not in a nested series)"
	/local p rule s e many? len pos ret depth last-depth
	][
	ret: series
	if system/words/all [deep any-list? series] [
	if tail [do make error! {/tail makes no sense with nested series}]
	pattern: to block! either word? p: pattern [to lit-word! pattern] [pattern]
	parse series rule: [
	some [
	s: pattern e: (
	s: change/part s value e
	unless all [return series]
	) :s
	\| ahead any-list! into rule \| skip
	]
	]
	return series

	; ;allow /tail but disable it if series contains sub-series
	; parse series rule: [
	; some [
	; s: pattern e: opt [any-list! (tail: false)] (
	; ret: s: change/part s value e
	; unless all [return either tail [ret][series]]
	; ) :s
	; \| ahead any-list! into rule \| skip
	; ]
	; ]
	; return either tail [ret][series]

	;; allow /tail but return tail only if last replacement occurred at root of series
	; depth: 0
	; parse series rule: [
	; some [
	; s: pattern e: (
	; ret: s: change/part s value e
	; unless all [return either system/words/all [tail 0 = depth] [ret][series]]
	; last-depth: depth
	; ) :s
	; \| ahead any-list! (depth: depth + 1) into rule \| skip
	; ] (depth: depth - 1)
	; ]
	; return either system/words/all [tail 0 = last-depth] [ret][series]
	]
	if system/words/all [char? :pattern any-string? series] [
	pattern: form pattern
	]
	many?: any [
	system/words/all [series? :pattern any-string? series]
	binary? series
	system/words/all [any-list? series any-list? :pattern]
	]
	len: either many? [length? pattern] [1]
	either all [
	pos: series
	either many? [
	while [pos: either case [find/case pos pattern][find pos pattern]] [
	; remove/part pos len
	; pos: insert pos value
	ret: pos: change/part pos value len
	]
	] [
	while [pos: either case [find/case pos :pattern][find pos :pattern]] [
	ret: pos: insert remove pos value
	]
	]
	] [
	if pos: either case [find/case series :pattern][find series :pattern] [
	; remove/part pos len
	; insert pos value
	ret: pos: change/part pos value len
	]
	]
	either tail [ret][series]
	]

	; print [1 2 3] = replace [1 4 3] 4 2
	; print [1 2 3] = replace [4 5 3] [4 5] [1 2]
	; print "abc" = replace "axc" "x" "b"
	; print "abc" = replace "xyc" "xy" "ab"
	; print "abcx" = replace "abxx" "x" "c"
	; print "abcc" = replace/all "abxx" "x" "c"
	; print [1 9 [2 3 4]] = replace [1 2 [2 3 4]] 2 9
	; print [1 9 [2 3 4]] = replace/all [1 2 [2 3 4]] 2 9
	;
	; code: [print "Hello"]
	; print 'print = first replace code "Hello" "Cheers"
	; print "Cheers" = second code
	; ; "replace-str"
	; print "Xbab" = replace "abab" #"a" #"X"
	; print "XbXb" = replace/all "abab" #"a" #"X"
	; print "Xab" = replace "abab" "ab" "X"
	; print "abab" = replace/all "abab" #"a" #"a"
	;
	; ; "replace-bin"
	; print #{FF0201} = replace #{010201} #{01} #{FF}
	; print #{FF02FF} = replace/all #{010201} #{01} #{FF}
	; print #{FF03} = replace #{010203} #{0102} #{FF}
	; print #{FFFFFF03} = replace #{010203} #{0102} #{FFFFFF}
	;
	; ; "replace-bitset-issue-#3132"
	; print "s" = replace/all "test" charset [#"t" #"e"] ""
	;
	; ;new
	; print "0A" = replace/case {aA} "a" "0"
	; print "a0a0a0a0a" = replace/all/case {aAaAaAaAa} "A" "0"
	; print "tail" = replace/case/tail {abcDtail} "D" "0"
	; print "tail" = replace/all/case/tail {aAaAaAtail} "A" "0"
	; print [4 5] = replace/all/tail [1 2 3 2 4 5] 2 0
	; print [z [b [z] c]] = replace/all/deep/tail [a [b [a] c]] 'a 'z
	; print [z [b [z] c]] = head replace/all/deep/tail [a [b [a] c]] 'a 'z
	; print [[b [a] c]] = replace/deep/tail [a [b [a] c]] 'a 'z
	; print [z [b [a] c]] = head replace/deep/tail [a [b [a] c]] 'a 'z
	; print [[b [a] c]] = replace/tail [a [b [a] c]] 'a 'z
	; print [z [b [a] c]] = head replace/tail [a [b [a] c]] 'a 'z
	; print [z [b [z] c]] = replace/all/deep [a [b [a] c]] 'a 'z
	; print [z [b [z] c]] = head replace/all/deep [a [b [a] c]] 'a 'z
	; print [z [b [z] c]] = replace/all/deep/tail [a [b [a] c]] 'a 'z
	; print [z [b [z] c]] = head replace/all/deep/tail [a [b [a] c]] 'a 'z
	; print [b b] = replace/all/deep/tail [a b a b a b b] 'a 'z
	; print [z b z b z b b] == head replace/all/deep/tail [a b a b a b b] 'a 'z
	; print [] = replace/deep/tail [b [b [b] c] a] 'a 'z
	;
	; replace/deep/tail [a [b [a] c]] 'a 'z
	; replace/deep/tail [b [b [b] c] a b] 'a 'z
	; replace/deep/tail/all [b [a [a] ] a b] 'a 'z
	; replace/deep/tail/all [b [a [a] ] b b] 'a 'z
	; replace/deep/tail/all [a b b] 'a 'z

	patch: func [
	"Replace all occurrences of patches, return an error if no match"
	file [file!] "File to operate on"
	patches [block!] "Block of patches blocks containing either from/to strings or a parse rule"
	/quiet "Don't bother if no match"
	/local source patch
	][
	source: read file
	foreach patch patches [
	unless empty? patch [
	either block? patch/1 [
	all [
	not parse/case source patch/1
	not quiet
	do make error! rejoin [{rule } mold patch/1 { did not match in %} file]
	]
	][
	all [
	not quiet
	not find/case source patch/1
	do make error! rejoin [{string "} patch/1 {" not found in file %} file]
	]
	replace/all/case source patch/1 patch/2
	]
	]
	]
	write file source
	]

	undirize: func [
	"Return dir or a copy of dir with last slash removed"
	dir [file!]
	][
	either #"/" = last dir [
	head remove back tail copy dir
	][dir]
	]

	; maybe: func[value [any-type!] default /type types [block!] pos [block!] /local b t s][
	maybe: func [
	{Convenience function to allow no value, provide default, optionally provide allowed types
	and perform transformations on those. Most useful in console for functions like cd, ls, ecc..}
	;becuse you want to write [ls .] and not as an example..
	value [any-type!]
	default "Default value"
	/type
	types [block!] "Block of allowed types, each type can be followed by a transformation block"
	error [block!] {Block containing calling function name as word! and calling function arg name as word!
	Values are used to return a proper error string}
	/local b t s
	][
	either unset? :value [default][
	either type [
	either find types t: type?/word value [
	either block? b: select types t [
	do bind b 'value
	][
	value
	]
	][
	; s: find stack 'maybe
	; cause-error 'script 'expect-arg [s/(pos/1) t s/(pos/2)]
	cause-error 'script 'expect-arg [error/1 t error/2]
	]
	][value]
	]
	]

	maybe-dir: func [
	"Convenience function, allow no value for dir, default to current dir, allow specific types"
	dir [any-type!]
	error [block!] {Block containing calling function name as word! and calling function arg name as word!
	Values are used to return a proper error string}
	][
	maybe/type :dir %./ either system/state/interpreted? [
	[file! string! integer! word! path!]
	][
	[file! word! [get value] path! [get value]] ;if compiled, word! and path! types gets evaluated, Good or not Good?
	] error
	]

	ls-ctx: object [

	default-rule: [to end]

	rules: [
	dot [[dot] "dot files"]
	dot-folder [[[dot if (dir? item)]] "dot folders"]
	dot-file [[[dot if (not dir? item)]] "dot files"]
	folder [[if (dir? item)] "folders"]
	file [[if (not dir? item)] "files"]
	]

	list-rules: func [/local name description][
	print "Available rules:"
	foreach [name description] rules [
	print [pad insert form name space 12 "->" description/1/2]
	]
	]

	nice: func [item][
	; either find [macOS Linux] system/platform [
	; color undirize item pick [green red] dir? item
	; ][
	; dirize item
	; ]
	#either config/OS = 'Windows [
	dirize item
	][
	color undirize item pick [green red] dir? item
	]
	]

	set 'ls func [
	"Improved directory listing"
	'dir [any-type!] "Directory to operate on. If no value use current one"
	/deep "Descend all subfolders"
	/strict
	/level "Descend only x levels"
	level* [integer! none!] "Number of levels to descend"
	/do "Apply a function to matched items"
	fun [function!] "Function to apply, spec block can call item and depth" ;see examples..
	/only
	'rule [word! block! none!]
	/skip "Skip value matching parse rule"
	'not-rule [word! block! none!] "parse rule (with optional [to end]) or dot (convenience to skip dot files)"
	/help "Show available rules and exit"
	/pass "Internal arg to pass data for recursion. Don't use!"
	depth? [logic!]
	depth [block!]
	path [file!]
	strict* [logic!]
	/local item list last match? r
	][
	either pass [
	append depth off
	if strict* [strict: on]
	][
	if help [list-rules exit]
	dir: to-file maybe-dir :dir [ls dir]
	unless dir? dir [dir: join dir #"/"]
	all [
	rule
	not-rule
	system/words/do make error! "Only use one of /only or /skip not both"
	]
	if not-rule [rule: not-rule]
	switch type?/word rule [
	none! [rule: default-rule]
	word! [
	r: select rules rule
	unless r [
	system/words/do make error! {Invalid rule! Type "ls/help" to see available rules}
	]
	rule: clear []
	append rule first r
	append rule [to end]
	]
	]
	if not-rule [insert rule 'not]
	unless :fun [
	fun: func [item][print ls-ctx/nice item]
	]
	path: dir
	depth?: parse spec-of :fun [
	2 word! to end
	] ;check if depth is used in passed function
	depth: append clear [] off
	strict: to-logic strict
	]
	list: sort read dir ;macOS sorts, Linux doesn't, Windows?
	if empty? list [exit]
	if depth? [ ;look ahead for last match only if depth is used
	list: tail list
	until [
	list: back list
	item: first list
	any [
	parse item rule
	1 = index? list
	]
	]
	last: index? list
	list: head list
	]
	forall list [
	item: first list
	match?: parse item bind rule 'item
	if any [
	match?
	not strict
	][
	all [
	depth?
	last = index? list
	change back tail depth on
	]
	item: join dir item
	if match? [
	system/words/do [fun find/tail item path depth]
	] ;move index of item past path
	all [
	dir? item
	either level* [level* > length? depth][deep]
	ls/deep/level/do/only/pass :item level* :fun :rule depth? depth path strict
	remove back tail depth
	]
	]
	]
	exit
	]

	set 'tree func [
	'dir [any-type!]
	/level
	level* [integer! none!]
	/only
	'rule [word! block! none!]
	/skip
	'not-rule [word! block! none!]
	/help "Show available rules and exit"
	/local cache
	][
	if help [list-rules exit]
	cache: clear make hash! 100
	dir: to-file maybe-dir :dir [tree dir]
	print nice dirize to-file dir
	ls/deep/strict/level/do/only/skip :dir level* func[item depth /local c][
	prin any [
	select/only cache depth
	(
	append cache reduce [copy depth c: copy ""]
	forall depth [
	append c pick either tail? next depth [
	[{└─ } {├─ }]
	][
	[{ } {│ }]
	] first depth
	]
	c
	)
	]
	print ls-ctx/nice last split-path item ;why do I have to do this otherwise nice returns itself as a function ??????
	] :rule :not-rule
	]

	] ;end object



	;### tests helper functions
	object [
	; system/state/trace?: off

	n: newline
	sep: pad/with ";" 80 #"#"
	fill: func [value][pad/with rejoin [";## " value space] 80 #"#"]

	set 'section func [title][
	print [n sep n sep n fill uppercase title n sep n sep n]
	]

	set 'exec func [block /def /local result][
	if string? block/1 [
	print [n sep n fill block/1 n sep n]
	block: next block
	]
	print join ">> " trim/head/tail next head clear back tail mold block
	set/any 'result try block
	if value? 'result [
	all [
	not error? :result
	not empty? result: form :result
	result: head insert result "== "
	]
	unless def [prin result]
	prin n
	]
	prin n
	]

	set 'make-test-folder func [][
	if exists? %folder/.0.txt [call/wait {rm -r folder}]
	make-dir f: %folder
	write f/.0.txt ""
	write f/(%1.txt) ""
	write f/(%2.txt) "pattern to be modified"
	make-dir f: %folder/emptyfolder
	make-dir f: %folder/.subfolder0
	write f/.0.txt ""
	write f/(%1.txt) ""
	write f/(%2.txt) "pattern to be modified"
	make-dir f: %folder/subfolder1
	write f/.0.txt ""
	write f/(%1.txt) ""
	write f/(%2.txt) "pattern to be modified"
	make-dir f: %folder/subfolder2
	write f/.0.txt ""
	write f/(%1.txt) ""
	write f/(%2.txt) "pattern to be modified"
	]

	] ;end object

	;### run tests
	make-test-folder

	section {patch tests}
	exec [
	"patch %folder/2.txt with patches, error if no match"
	patch %folder/2.txt [
	[{to be } {}]
	[{ modified} { reverted}]
	[[any [to {pattern} change {pattern} {value}] to end]]
	]
	]
	exec [
	"patch %folder/2.txt with patches, error if no match"
	patch %folder/2.txt [
	[{not-found..} {return an error}]
	]
	]
	exec [
	"patch %folder/2.txt with patches, no error if no match"
	patch/quiet %folder/2.txt [
	[{not-found..} {don't complain}]
	]
	]

	section {maybe tests}
	exec/def [
	"allow any value type, default to logic! off if no value"
	test: func ['value [any-type!]][maybe :value off]
	]
	exec [test]
	exec [test off]

	exec/def [
	"allow values of types word! and none!, default to logic! off if no value"
	test: func ['value [any-type!]][maybe/type :value off [word! none!] [test value]]
	]
	exec [test #123]
	exec [test word]

	exec/def [
	"allow values of types word! logic! and none!, type word! value are evaluated, default to logic! off if no value"
	test: func ['value [any-type!]][
	maybe/type :value off [word! [get value] logic! none!
	] [test value]]
	]
	exec [test #123]
	exec [test on]
	exec [test none]
	exec [word: 123 test word]

	section {ls tests}
	exec [
	"error .."
	ls/only/skip . dot dot
	]
	exec [
	"list all files and folders in current dir"
	ls
	]
	exec [
	"same, alternative call"
	ls .
	]
	exec [
	"same, alternative call"
	ls %.
	]
	exec [
	"execute provided function for every files and folders in current dir"
	ls/do %. func[][print do load {1 + 1}]]
	exec [
	"list all files and folders in current dir, skip dot files"
	ls/skip %. [dot to end]
	]
	exec [
	"same, alternative call"
	ls/skip %. dot
	]
	exec [
	"list all files, skip folders and dot files in current dir"
	ls/do/skip %. func[item][unless dir? item [print item]] dot
	]
	exec [
	"recursive listing of files and folders in current dir, skipping dot files and printing with padded depth"
	ls/deep/do/skip %. func[item depth][
	print head insert/dup last split-path item space (length? depth) - 1 * 2
	] dot
	]

	section {ls + patch test}
	exec [
	"recursively patch files content and change matched file names in one shot"
	ls/deep/do/skip %folder func [item /local f][
	item: head item
	unless dir? item [
	patch/quiet item [
	[[any [to {value} change {value} {new value} (
	print rejoin [{Found "value" in %} item { and replaced with "new value"}]
	)] to end]]
	]
	]
	if find item %2.txt [
	call/wait form reduce ['mv f: copy item replace/all item %2.txt %3.txt]
	print rejoin [{Found %2.txt in file name %} f { and replaced with %} item]
	]
	] dot
	]

	section {tree tests}
	;
	exec [
	"directory tree at current path"
	tree
	]
	exec [
	"same, alternative call"
	tree %.
	]
	exec [
	"directory tree at current path, skip dot files"
	tree/skip %. dot
	]
	exec [
	"directory tree for folder %folder, skip dot files"
	tree/skip %folder dot
	]