implementation module GenRecord

import StdTuple, StdList, StdFunc, Error, Util, GenUpdate, Map, Generic_NG, Tuple
from dynamic_string import copy_to_string, copy_from_string

copyRecord :: !a !b -> b | GenRecord a & GenRecord b
copyRecord src dst
	# srcFields = gGetRecordFields{|*|} src [] newMap
	= fst (gPutRecordFields{|*|} dst [] srcFields)
	
mapRecord :: !a -> b | GenRecord a & GenRecord, gUpdate{|*|} b
mapRecord rec
	# fields = gGetRecordFields{|*|} rec [] newMap
	= fst (gPutRecordFields{|*|} defaultValue [] fields)
	
generic gGetRecordFields r :: !r ![GenType] !*RecordFields -> *RecordFields

gGetRecordFields{|OBJECT|} fx (OBJECT o) _ fields = fields
gGetRecordFields{|CONS|} fx (CONS c) types fields = fx c types fields
gGetRecordFields{|EITHER|} fx fy either types fields = case either of
	LEFT x	= fx x types fields
	RIGHT y	= fy y types fields
gGetRecordFields{|PAIR|} fx fy (PAIR x y) types fields
	# fields = fx x types fields
	= fy y types fields
gGetRecordFields{|RECORD of {grd_type}|} fx (RECORD r) _ fields = fx r (getFieldTypes grd_type) fields
gGetRecordFields{|FIELD of {gfd_name,gfd_index}|} _ f types fields = put gfd_name (GenericDyn (copy_to_string f) (types !! gfd_index)) fields
gGetRecordFields{|UNIT|} _ _ fields = fields
gGetRecordFields{|Int|}		_ _ fields = fields
gGetRecordFields{|Real|}	_ _ fields = fields
gGetRecordFields{|Char|}	_ _ fields = fields
gGetRecordFields{|Bool|}	_ _ fields = fields
gGetRecordFields{|String|}	_ _ fields = fields
gGetRecordFields{|(->)|} _ _ _ _ fields = fields
gGetRecordFields{|Dynamic|} _ _ fields = fields

derive gGetRecordFields [], Maybe, Either, (,), (,,), (,,,), Void, Display, Editable, Hidden, VisualizationHint, Timestamp
derive gGetRecordFields Note, Username, Password, Date, Time, DateTime, Document, FormButton, EUR, USD, User, RadioChoice, CheckMultiChoice, Map, TreeChoice, Tree, TreeNode, HtmlTag, HtmlAttr
derive gGetRecordFields EmailAddress, Action, ButtonState

generic gPutRecordFields r :: !r ![GenType] !*RecordFields -> (!r,!*RecordFields)

gPutRecordFields{|OBJECT|} fx obj=:(OBJECT o) _ fields = (obj,fields)
gPutRecordFields{|CONS|} fx (CONS c) types fields = appFst CONS (fx c types fields)
gPutRecordFields{|EITHER|} fx fy either types fields = case either of
	LEFT x	= appFst LEFT (fx x types fields)
	RIGHT y	= appFst RIGHT (fy y types fields)
gPutRecordFields{|PAIR|} fx fy (PAIR x y) types fields
	# (x`,fields)	= fx x types fields
	# (y`,fields)	= fy y types fields
	= (PAIR x` y`,fields)
gPutRecordFields{|RECORD of {grd_type}|} fx (RECORD r) _ fields
	= appFst RECORD (fx r (getFieldTypes grd_type) fields)
gPutRecordFields{|FIELD of {gfd_name,gfd_index}|} _ f types fields
	# (mbGenDyn,fields) = delU gfd_name fields
	# f` = case mbGenDyn of
		Just genDyn = case matchGenericDyn genDyn (types !! gfd_index) of
			Just f	= f
			Nothing	= f
		Nothing		= f
	= (f`,fields)
gPutRecordFields{|UNIT|} _ _ fields = (UNIT,fields)
gPutRecordFields{|Int|}		c _ fields = (c,fields)
gPutRecordFields{|Real|}	c _ fields = (c,fields)
gPutRecordFields{|Char|}	c _ fields = (c,fields)
gPutRecordFields{|Bool|}	c _ fields = (c,fields)
gPutRecordFields{|String|}	c _ fields = (c,fields)
gPutRecordFields{|(->)|} _ _ f _ fields = (f,fields)
gPutRecordFields{|Dynamic|} dyn _ fields = (dyn,fields)

derive gPutRecordFields [], Maybe, Either, (,), (,,), (,,,), Void, Display, Editable, Hidden, VisualizationHint, Timestamp
derive gPutRecordFields Note, Username, Password, Date, Time, DateTime, Document, FormButton, EUR, USD, User, RadioChoice, CheckMultiChoice, Map, TreeChoice, Tree, TreeNode, HtmlTag, HtmlAttr
derive gPutRecordFields EmailAddress, Action, ButtonState

:: *RecordFields :== Map String GenericDyn
// This type is needed because dynamics can't be used inside generic functions.
// It includes the string representation of the value (generated by copy_to_string)
// and the generic type of it.
:: *GenericDyn = GenericDyn !*String !GenType

/**
* Tries to match & unpack a GenericDyn value.
*
* @param The GenericDyn
* @param The type to match
*
* @return The unpacked value if match succeeded.
*/
matchGenericDyn :: !*GenericDyn !GenType -> Maybe a
matchGenericDyn (GenericDyn str dynType) reqType
	| dynType === reqType	= Just (fst (copy_from_string str))
	| otherwise				= Nothing

// Retrieves the types of a record's fields.
getFieldTypes :: !GenType -> [GenType]
getFieldTypes grd_type = getFieldTypes` grd_type []
where
	getFieldTypes` (GenTypeArrow field next) acc	= getFieldTypes` next [field:acc]
	getFieldTypes` _ acc							= reverse acc

derive gEq GenType