sessioned-response now no longer ever returns (group <response/full>)…

… and instead just returns <response/full>. This allows a later contract to pass.
rob7hunter · Dec 6, 2008 · f851d57 · f851d57
1 parent 60e6e0f
commit f851d57
Show file tree

Hide file tree

Showing 3 changed files with 16 additions and 1 deletion.
diff --git a/leftparen.scm b/leftparen.scm
@@ -89,6 +89,7 @@
  fresh-rec-from-data
  same-rec?
  only-rec-of-type
+ if-rec-of-type
  rec-type-is?
  is-descendant?
  find-parent

diff --git a/session.scm b/session.scm
@@ -82,6 +82,7 @@
                                body ...))
            (let ((body-lst (list body ...)))
              (or (single-response-promise-in-list body-lst)
+                 (single-response/full-in-list body-lst)
                  `(group ,@body-lst))))))))
 
 (define (cookied-response cookie-key-str cookie-val-str

diff --git a/web-support.scm b/web-support.scm
@@ -29,6 +29,7 @@
 
          response-promise?
          ;; single-response-promise-in-list (via contract)
+         ;; single-response/full-in-list (via contract)
          ;; response-promise-to-redirect (via contract)
          ;; response-from-promise (via contract)
 
@@ -233,7 +234,19 @@
 (define (single-response-promise-in-list lst)
   (and-let* (((and (length= lst 1)))
              (elt (first lst))
-             ((response-promise? (first lst))))
+             ((response-promise? elt)))
+    elt))
+
+;;
+;; single-response/full-in-list
+;;
+(provide/contract
+ (single-response/full-in-list (-> (listof any/c) (or/c #f response/full?))))
+;;
+(define (single-response/full-in-list lst)
+  (and-let* (((and (length= lst 1)))
+             (elt (first lst))
+             ((response/full? elt)))
     elt))
 
 ;;