Composite func (compose for strings) for Red

composite.red

Red [
	Author: [@greggirwin @endo @toomasv]
	Purpose: "COMPOSE for strings"
	Notes: {
		TBD: Security model for eval'ing expressions
		TBD: Decide if support for custom marker and eval contexts are worthwhile
		TBD: Finalize refinement names
	}
]

composite-ctx: context [

	eval: func [
		"Evaluate expr and return the result"
		expr [string!] "Valid Red, as a string expression"
		err-val "If not none, return this instead of formed error information, if eval fails"
		ctx [none! object! function!] "Evaluate expr in the given context; none means use global context"
		/local res
	][
		expr: load expr
		; If expression evaluates to a non-block value that is anything other than a 
		; word, we can't bind it.
		if all [:ctx  any [block? :expr  word? :expr]][expr: bind expr :ctx]
		either error? set/any 'res try [do expr][
			any [err-val  form reduce [" *** Error:" res/id "Where:" expr "*** "]]
		][
			either unset? get/any 'res [""][:res]
		]
	]

	; One of the big questions is what to do if there are mismatched expr
	; markers. We can treat them as errors, or just pass through them, so
	; they will be visible in the output. We can support both behaviors
	; with a refinement, and then just have to choose the default.
	; Putting the colons on the outside gives you a clean paren expression
	; on the inside.
	set 'composite func [
		"Replace :( ... ): sections in a string with their evaluated results."
		data [string! file! url!]
		/marks markers [block!] "Use custom expression markers in place of :( and ):"
		/with ctx [object! function!] "Evaluate the expressions in the given context"
		/err-val e "Use instead of formed error info from eval error"
		/local expr expr-beg= expr-end= pos
	][
		if all [marks  not parse markers [2 [char! | string! | tag!]]][
			cause-error 'script 'invalid-arg [arg1: markers]
			;cause-error 'script 'invalid-data [arg1: markers]
			;return make error! "Markers must be a block containing two char/string/tag values"
		]
		set [expr-beg= expr-end=] either marks [markers][ [":(" "):"] ]
		data: either string? data [copy data][read data]    ; Don't modify the input
		parse data [
			; If we take out the cause-error actions here, mismatched expression markers
			; will pass through unscathed. That would adhere to Postel's Law
			; (https://en.wikipedia.org/wiki/Robustness_principle), but I think that's a
			; bad criteria when we're evaluating expressions. R2's build-markup treats
			; an unterminated expression as a full expression to the end of input, and 
			; an uninitiated expression as data thru the expr-end marker.
			any [
				end break
				| change [expr-beg= copy expr to expr-end= expr-end=] (eval expr e :ctx)
				| expr-beg= pos: to end (cause-error 'syntax 'missing [arg1: expr-end= arg2: pos])
				| to expr-beg= ; find the next expression
				| pos: to expr-end= (cause-error 'syntax 'missing [arg1: expr-beg= arg2: pos])
			]
		]
		data
	]

]

test-composite.red

Red []

do %composite.red

test-composite: func [input][
	print [mold input "==" mold composite input]
]
test-composite-custom-err: func [input][
	print [mold input "==" mold composite/err-val input "#ERR"]
]
test-bad-composite: func [input][
	print [mold input "==" mold try [composite input]]
]
test-composite-marks: func [input markers][
	print [mold input mold marks tab "==" mold composite/marks input markers]
]
test-composite-with: func [input ctx][
	print [mold input "==" mold composite/with input ctx]
]

print "Composite"
foreach val [
	""
	":(1):"
	":(pi):"
	":(rejoin ['a 'b]):"
	"a:('--):b"
	"a:('--):"
	":('--):b"
	"ax:(1 / 0):xb"

	"alpha: :(rejoin ['a 'b]): answer: :(42 / 3):"
	{
		name: :(form-full-name cust):
		rank: :(as-ordinal index? find scores cust):
		ser#: :(cust/uuid):
	}

	"a :('--): b"
	"a :('--):"
	":('--): b"
	"ax :(1 / 0): xb"
][test-composite val]

print "^/Composite/custom-error-val"

test-composite-custom-err "ax:(1 / 0):xb"
test-composite-custom-err "ax :(1 / 0): xb"

print "^/Bad Composite Input"
foreach val [
	":("
	":('end"
	"asdf:('end"
	"):"
	"beg):"
	")::("
	":(1):beg):"
	"asdf:(1):beg):"
][test-bad-composite val]

print "^/Composite/Marks"
foreach [val marks] [
	"" 				["" ""]
	":(1):"			[":(" "):"]
	"):pi:("		["):" ":("]
	"a<%'--%>b"		["<%" "%>"]
	"a{'--}b"		[#"{" #"}"]
	"a{'--}}b"		[#"{" "}}"]
	"a{{'--}b"		["{{" #"}"]
	"a<c>'--</c>b"	["<c>" "</c>"]
	"a<c>'--</c>b"	[<c> </c>]
][test-composite-marks val marks]

print "^/Composite/with"
o: object [a: 1 b: 2]
foreach val [
	""
	":(1):"
	":(pi + a):"
	":(reduce [a b]):"
	":(rejoin [a b]):"
	"a:(a + b):b"
][test-composite-with val o]
	
print ""

halt