Source code in the racket programming language

(require racket/serialize)


#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)))