Mirrors a field value to another object using a map. It could use a block for modification

mirror.red

Red [
  Title: "Mirror fields"
  Description: "Mirrors a field from a context to another. A modification code can be used"
  Usage: mirror [obj1 obj2] [src-word dest-word [code]....]
]


mirror: func [
	"Mirrors the value of a word in a context to a word in another"
	objects [block!] "The objects to link"
	map [block!] "The map as [source-word dest-word]"
	/code {Run the code provided (paths are shielded),
		 where START and NXT are the first and second object passed}
	/local 
	body 
	specs
	src-word
	dest-word
	cd
	err
	react-function
] [
	
	;--- Working
	;-- This function generates a reaction for each word of the mapping to its destination
	;-- it uses REACT/LINK, creating and passing the following function:
	; FUNC [start nxt] [[:start/word] set/any in nxt 'dest-word :start/:src-word]
	; or
	; FUNC [start nxt] [[:start/word] set/any in nxt bind do CODE 'local]
	;		
	
	;--- Verification phase
	;-- here we check if the arguents ar correct
	;ERR: is set before each test, so if it fails, the EITHER ELSE block will print it
	
	either all [
		err: "Map is wrong, either empty or some elements are not words"
		any [
			parse map [some [2 word!]]
			err: "Map is wrong, either empty or some elements are not words, or code in not BLOCK!"
			all [code parse map [some [2 word! block!]]]
		]
		err: "objects is wrong, either empty or some elements are not words or contexts"		
		parse objects [some [2 [word! | object!]]];TBD: Add test for objects content	
	] [
		err: none
		
		;--- The specification of the function created for each mapping
		;
		
		specs: [
			"Mirrors a word from the start object to the nestination"
			start "The source object"
			nxt "The target object"
			/local
			map
			code
		]

		;--- Function generator, it creates a funtion and a reaction
		; for each [SCR-WORD DEST-WORD] passed in map
		;
		; In the first block of the function body you will find
		; the reactive field mentioned as path
		
		case [
		
			;--- You want a custom code
				
			code [
				
				;--- Generates a function which executes a code whose result is written
				; to the destination word expressed in MAP as [SRC DEST [code]...]
				; code is bound to a function and shielded from path gathering
				;


;				---- Function SPECS for reference
;				[
;					"Mirrors a word from the start object to the nestination"
;					start "The source object"
;					nxt "The target object"
;					/local
;					map
;					code
;				]				

;				--- EXAMPLE BODY
;				 [
;					[start/a] map: [a b] 
;				 	code: get in make object![code: [rejoin [start/a start/a]]] 'code ;Note, the object is literal form, so already reduced in the body
;				 	set/any in nxt 'b do bind code context? 'local]				
;				 ]
				
				
				foreach [src-word dest-word cd] map [
					
					body: copy []


					;--- Appends to function body -> [start/<src-word>] ; to have it mapped in reaction
					;											
					append body reduce [
							reduce copy/deep [to-path copy reduce ['start :src-word]]
					]

					;--- Appends to function body -> map: [start-word dest-word] ; so you have a reference for the reaction source -> end
					;				
					append body reduce [to-set-word 'map reduce [:src-word :dest-word]]
					
					;--- Appends to function body -> code: get in make object! [code: [code you have passed]] 'code
					;
					; An anonymous context is created with the code you have passed inside, and insert it on the body code
					; The it is set to CODE: word at runtime
					; The context shields its content from the gathering of paths from REACT/LINK, 
					; You retrieve it with GET IN <CTX> 'WORD like code
					; so you are free to use any path
					;
					append body reduce compose/deep [
							to-set-word 'code 'get 'in (make object! compose/only [code: (cd)]) to-lit-word 'code						
					]
					
					;--- Appends to function body -> set/any in nxt dest-word do bind code context? 'local
					;
					; You set in the destination context the DEST-WORD the value returned from
					; the code passed executed from the remaining part: DO BIND CODE context? 'local
					; code that has been bound to the function and has
					; START, NXT, MAP, CODE words available (Also LOCAL :)  ) 

					append body reduce [		
							'set/any 'in 'nxt to-lit-word :dest-word 'do 'bind 'code 'context? to-lit-word 'local
					]
					
					;--- The final part, here with react/link
					;
					react-function: func specs copy/deep body
					react/link  :react-function objects										
				]							
			]
			
			;--- A simple mapping where source word is written in dest
			;  START and NXT are first and second object passed 
			;

;				---- Function SPEC for reference
;				[
;					"Mirrors a word from the start object to the nestination"
;					start "The source object"
;					nxt "The target object"
;					/local
;					map
;					code
;				]
;
;				--- EXAMPLE BODY
;				[[start/a] map: [a b] set/any in nxt 'b :start/a]				

			true [
				
				;--- Generates four each couple of SRC-WORD DEST-WORD a function as 
				; [[path] map: [src-word dest-word] set/any in nxt 'dest-word-name :start/<src-word>]
				;
				foreach [src-word dest-word] map [
					body: copy []

					;--- appends to the start of the function a path to be collected by REACT/LINK
					;-- as [start/<src-word>]
					;-- left here for visual referenct as already present at the end of the body
					;
					append body reduce [
							reduce copy/deep [to-path copy reduce ['start :src-word]]
					]					

					;--- Appends to function body -> map: [start-word dest-word] so you have a reference for the reaction source -> end
					;				
					append body reduce [to-set-word 'map reduce [:src-word :dest-word]]

					;--- The main set code: set/any in nxt 'dest-word-name :start/<src-word>
					; 					
					append body reduce [		
							'set/any 'in 'nxt to-lit-word :dest-word to-get-path reduce ['start :src-word]		
					]

					react-function: func specs copy/deep body
					react/link  :react-function objects											
				]			
			]
			
		]


	] [
		;--- Prints the error message and blocks the function
		;
		do make error! err 
	]
]

;--------------------------- TESTS -------------------------------------

;----- Test 1
o1: make reactor! [a: none]
o2: make reactor! [b: none]
o3: make reactor! [c: none]

mirror [o1 o2] [a b]
mirror [o2 o3] [b c]

o1/a: "Hello"

probe o3

;--- Result
;
;make object! [
;    c: "Hello"
;]

;----- Test 2
o1: make reactor! [a: none]
o2: make reactor! [b: none]
o3: make reactor! [c: none]

mirror/code [o1 o2] [a b [rejoin [start/a start/a]]]
mirror/code [o2 o3] [b c [rejoin [start/b start/b]]]

o1/a: "Hello"

probe o3

;--- Result
;
;make object! [
;    c: "HelloHelloHelloHello"
;]