From c9eddfa0b76d7fc1b0c37144a29552b03ad8e50d Mon Sep 17 00:00:00 2001
From: Tony Garnock-Jones <tonygarnockjones@gmail.com>
Date: Sun, 30 Oct 2016 20:30:49 -0400
Subject: [PATCH] web-response-header-code-type

---
 racket/syndicate/drivers/web.rkt | 13 +++++++++++++
 1 file changed, 13 insertions(+)

diff --git a/racket/syndicate/drivers/web.rkt b/racket/syndicate/drivers/web.rkt
index 8cceb61..049f717 100644
--- a/racket/syndicate/drivers/web.rkt
+++ b/racket/syndicate/drivers/web.rkt
@@ -11,6 +11,7 @@
 
          (rename-out [web-response-header <web-response-header>])
          (struct-out/defaults [make-web-response-header web-response-header])
+         web-response-header-code-type
          (struct-out web-response-complete)
          (struct-out web-response-chunked)
          (rename-out [web-response-websocket <web-response-websocket>])
@@ -80,6 +81,18 @@
   (define-struct-defaults make-web-response-websocket web-response-websocket
     (#:headers [web-response-websocket-headers '()])))
 
+(define (web-response-header-code-type rh)
+  (if (not rh) ;; network failure of some kind; respondent did not respond
+      'network-failure
+      (let ((code (web-response-header-code rh)))
+        (cond
+          [(<= 100 code 199) 'informational]
+          [(<= 200 code 299) 'successful]
+          [(<= 300 code 399) 'redirection]
+          [(<= 400 code 499) 'client-error]
+          [(<= 500 code 599) 'server-error]
+          [else 'other]))))
+
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;; Ground-level communication messages