make enumerations print the prefix of their enumeration

pkgs/data-pkgs/data-enumerate-lib/data/enumerate.rkt

@@ -194,10 +194,49 @@
   [base/e enum?]
   [any/e enum?]))
 
+(define enum-printing (make-parameter 0))
 ;; an enum a is a struct of < Nat or +Inf, Nat -> a, a -> Nat >
-(struct enum
-        (size from to)
-        #:prefab)
+(struct enum (size from to)
+  #:methods gen:custom-write
+  [(define (write-proc enum port mode)
+     (define recur
+       (case mode
+         [(#t) write]
+         [(#f) display]
+         [else (lambda (p port) (print p port mode))]))
+     (display "#<enum" port)
+     (parameterize ([enum-printing (+ (enum-printing) 1)])
+       (let loop ([i 0] [chars 0])
+         ;; chars is an approximation on how much
+         ;; we've printed so far.
+         (when (<= chars 20)
+           (define ele (from-nat enum i))
+           (define sp (open-output-string))
+           (recur ele sp)
+           (define s (get-output-string sp))
+           (cond
+             [(equal? s "")
+              ;; if any enumeration values print as empty 
+              ;; strings, then we just give up so as to avoid
+              ;; 'i' never incrementing and never terminating
+              (display ">" port)]
+             [else
+              (if (zero? i)
+                  (display ": " port)
+                  (display " " port))
+              
+              ;; only print twice up to depth 2 in order to avoid bad
+              ;; algorithmic behavior (so enumerations of enumerations
+              ;; of enumerations might look less beautiful in drracket)
+              (cond
+                [(<= (enum-printing) 2)
+                 (display s port)]
+                [else
+                 (recur ele port)])
+              
+              (loop (+ i 1)
+                    (+ chars (string-length s) 1))]))))
+     (display "...>" port))])
 
 ;; size : enum a -> Nat or +Inf
 (define (size e)

pkgs/data-pkgs/data-test/tests/data/enumerate.rkt

@@ -456,3 +456,31 @@
 (test-begin
  (check-equal? (from-nat emptys/e 0) '())
  (check-bijection? emptys/e))
+
+
+(define (to-str e print?)
+  (define sp (open-output-string))
+  (if print?
+      (print e sp)
+      (write e sp))
+  (get-output-string sp))
+;; printer tests
+(check-equal? (to-str nat/e #t) "#<enum: 0 1 2 3 4 5 6 7 8 9 10...>")
+(check-equal? (to-str (cons/e nat/e nat/e) #t) "#<enum: '(0 . 0) '(0 . 1) '(1 . 0)...>")
+(check-equal? (to-str (cons/e nat/e nat/e) #f) "#<enum: (0 . 0) (0 . 1) (1 . 0)...>")
+
+;; just check that it doesn't crash when we get deep nesting
+;; (checks that we end up in the case that just uses the string
+;; in the implementation of the enumerator printer)
+(check-equal? (string? (to-str
+                        (map/e (λ (i)
+                                 (map/e (λ (j)
+                                          (map/e (λ (k) (+ i j k))
+                                                 (λ (_) (error 'ack))
+                                                 nat/e))
+                                        (λ (_) (error 'ack))
+                                        nat/e))
+                               (λ (_) (error 'ack))
+                               nat/e)
+                        #t))
+              #t)