enum pass

xenomorph/xenomorph/enum.rkt

@@ -1,5 +1,5 @@
 #lang racket/base
-(require "helper.rkt" racket/list)
+(require racket/class "helper.rkt" racket/list)
 (provide (all-defined-out))
 
 #|
@@ -7,38 +7,53 @@ approximates
 https://github.com/mbutterick/restructure/blob/master/src/Enum.coffee
 |#
 
-(define/post-decode (xenum-decode xe [port-arg (current-input-port)] #:parent [parent #f])
-  (define port (->input-port port-arg))
-  (parameterize ([current-input-port port])
-  (define index (decode (xenum-type xe)))
-  (or (list-ref (xenum-options xe) index) index)))
-
-(define (xenum-size xe [val #f] #:parent [parent #f])
-  (size (xenum-type xe)))
-
-(define/pre-encode (xenum-encode xe val [port-arg (current-output-port)] #:parent [parent #f])
-  (define port (if (output-port? port-arg) port-arg (open-output-bytes)))
-  (parameterize ([current-output-port port])
-  (define index (index-of (xenum-options xe) val))
-  (unless index
-    (raise-argument-error 'xenum-encode "valid option" val))
-  (encode (xenum-type xe) index)
-  (unless port-arg (get-output-bytes port))))
-
-(struct xenum xbase (type options) #:transparent
-  #:methods gen:xenomorphic
-  [(define decode xenum-decode)
-   (define xdecode xenum-decode)
-   (define encode xenum-encode)
-   (define size xenum-size)])
+#;(define/post-decode (xenum-decode xe [port-arg (current-input-port)] #:parent [parent #f])
+    (define port (->input-port port-arg))
+    (parameterize ([current-input-port port])
+      ))
+
+#;(define (xenum-size xe [val #f] #:parent [parent #f])
+    )
+
+#;(define/pre-encode (xenum-encode xe val [port-arg (current-output-port)] #:parent [parent #f])
+    (define port (if (output-port? port-arg) port-arg (open-output-bytes)))
+    (parameterize ([current-output-port port])
+
+      (unless port-arg (get-output-bytes port))))
+
+#;(struct xenum xbase (type options) #:transparent
+    #:methods gen:xenomorphic
+    [(define decode xenum-decode)
+     (define xdecode xenum-decode)
+     (define encode xenum-encode)
+     (define size xenum-size)])
+
+(define xenum%
+  (class xenobase%
+    (super-new)
+    (init-field type values)
+
+    (define/augment (xxdecode port parent)
+      (define index (send type xxdecode port parent))
+      (or (list-ref values index) index))
+
+    (define/augment (xxencode val port [parent #f])
+      (define index (index-of values val))
+      (unless index
+        (raise-argument-error 'xenum-encode "valid option" val))
+      (send type xxencode index port parent))
+    
+    (define/augment (xxsize [val #f] [parent #f])
+      (send type xxsize))))
 
 (define (+xenum [type-arg #f] [values-arg #f]
                 #:type [type-kwarg #f]
-                #:values [values-kwarg #f])
+                #:values [values-kwarg #f]
+                #:subclass [class xenum%])
   (define type (or type-arg type-kwarg))
-  (unless (xenomorphic? type)
+  (unless (xenomorphic-type? type)
     (raise-argument-error '+xenum "xenomorphic type" type))
   (define values (or values-arg values-kwarg))
   (unless (list? values)
     (raise-argument-error '+xenum "list of values" values))
-  (xenum type values))
+  (new class [type type] [values values]))

xenomorph/xenomorph/test/enum-test.rkt

@@ -1,9 +1,11 @@
 #lang racket/base
 (require rackunit
+         racket/class
          sugar/unstable/dict
          "../helper.rkt"
          "../number.rkt"
-         "../enum.rkt")
+         "../enum.rkt"
+         "../generic.rkt")
 
 #|
 approximates
@@ -35,10 +37,15 @@ https://github.com/mbutterick/restructure/blob/master/test/Enum.coffee
 (test-case
  "decode should decode with post-decode"
  (parameterize ([current-input-port (open-input-bytes (bytes 1 2 0))])
-   (set-post-decode! e (λ (val) "foobar"))
-   (check-equal? (decode e) "foobar")
-   (check-equal? (decode e) "foobar")
-   (check-equal? (decode e) "foobar")))
+   (define myenum% (class xenum%
+                         (super-new)
+                         (define/override (post-decode val) "foobar")))
+   (define e2 (+xenum #:type uint8
+                  #:values '("foo" "bar" "baz")
+                  #:subclass myenum%))
+   (check-equal? (decode e2) "foobar")
+   (check-equal? (decode e2) "foobar")
+   (check-equal? (decode e2) "foobar")))
 
 (test-case
  "encode should encode"
@@ -51,14 +58,17 @@ https://github.com/mbutterick/restructure/blob/master/test/Enum.coffee
 (test-case
  "encode should encode with pre-encode"
  (parameterize ([current-output-port (open-output-bytes)])
-   (set-pre-encode! e (λ (val) "foo"))
-   (encode e "bar")
-   (encode e "baz")
-   (encode e "foo")
+   (define myenum% (class xenum%
+                         (super-new)
+                         (define/override (pre-encode val) "foo")))
+   (define e2 (+xenum #:type uint8
+                  #:values '("foo" "bar" "baz")
+                  #:subclass myenum%))
+   (encode e2 "bar")
+   (encode e2 "baz")
+   (encode e2 "foo")
    (check-equal? (get-output-bytes (current-output-port)) (bytes 0 0 0))))
 
 (test-case
  "should throw on unknown option"
- (set-pre-encode! e values)
- (set-post-decode! e values)
  (check-exn exn:fail:contract? (λ () (encode e "unknown" (open-output-bytes)))))