Just another update

Task/Object-serialization/Racket/object-serialization-1.rkt

@@ -0,0 +1 @@
+(require racket/serialize)

Task/Object-serialization/Racket/object-serialization-2.rkt

@@ -0,0 +1,72 @@
+#lang racket
+;; Object Serialization: Tim Brown, Oct. 2014
+(require racket/serialize)
+
+(define (join-person-name-list persons)
+  (string-join (map (λ (c) (send c ->string)) persons) ", "))
+
+(define-serializable-class person% object%
+  (init-field name [siblings null])
+  (define/public (->string #:show (show null))
+    (cond
+      [(and (member 'siblings show) (not (null? siblings)))
+       (format "~a (~a)" name (join-person-name-list siblings))]
+      [else name]))
+  (super-new))
+
+(define-serializable-class parent% person%
+  (init-field [children null])
+  (define/override (->string #:show (show null))
+    (cond
+      [(and (member 'children show) (not (null? children)))
+       (format "~a [~a]" (super ->string #:show show) (join-person-name-list children))]
+      [else (super ->string #:show show)]))
+  (super-new))
+
+;; horribly out of fashion and probaly no longer PC
+(define-serializable-class nuclear-family% object%
+  (init-field father mother children)
+  (define/public (->string)
+    (string-append
+     (format "~a + ~a -> " (send father ->string) (send mother ->string))
+     (format "~a" (join-person-name-list children))))
+  (super-new))
+
+;; =| TESTS |=========================================================================================
+(define jack (new person% [name "Jack"]))
+(define joan (new person% [name "Joan"]))
+(set-field! siblings jack (list joan))
+(set-field! siblings joan (list jack))
+(define the-kids (list jack joan))
+(define john (new parent% [name "John"] [children the-kids]))
+(define jane (new parent% [name "Jane"] [children the-kids]))
+
+(define the-family
+  (new nuclear-family% [father john] [mother jane] [children the-kids]))
+
+(define (duplicate-object-through-file o f-name)
+  (with-output-to-file f-name #:exists 'replace (λ () (write (serialize o))))
+  (with-input-from-file f-name (λ () (deserialize (read)))))
+
+(define cloned-family (duplicate-object-through-file the-family "objects.dat"))
+
+(printf "The original family:\t~a~%" (send the-family ->string))
+(printf "The cloned family:\t~a~%~%" (send cloned-family ->string))
+(printf "objects.dat contains ----~%~a~%-------------------~%~%" (file->string "objects.dat"))
+(printf "Clones are different?~%")
+(define cloned-jack (first (get-field children cloned-family)))
+(set-field! name cloned-jack "JACK")
+(printf "Jack's  name is:\t~s~%" (get-field name jack))
+(printf "Clone's name is:\t~s~%~%" (get-field name cloned-jack))
+(printf "Relationships are maintained?~%")
+(define cloned-joan (second (get-field children cloned-family)))
+(printf "Joan's description with siblings:\t~s~%" (send joan ->string #:show '(siblings)))
+(printf "Clone's description with siblings:\t~s~%~%"
+        (send cloned-joan ->string #:show '(siblings)))
+(printf "After Jack's renaming the cloned family is: ~a~%~%" (send cloned-family ->string))
+(printf "Various descriptions of cloned John:~%")
+(define cloned-john (get-field father cloned-family))
+(printf "Just the name:\t~s~%" (send cloned-john ->string))
+(printf "With siblings:\t~s (he hasn't any)~%" (send cloned-john ->string #:show '(siblings)))
+(printf "With children:\t~s~%" (send cloned-john ->string #:show '(children)))
+(printf "With both:\t~s~%" (send cloned-john ->string #:show '(siblings children)))