73 lines
3.2 KiB
Racket
73 lines
3.2 KiB
Racket
#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)))
|