Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with
or
.
Download ZIP
Browse files

Code cleanup.

  • Loading branch information...
commit 058260b319c4c4e738f05bfa2d2b7646a2f140b8 1 parent 90c0180
@tmciver authored
Showing with 6 additions and 85 deletions.
  1. +1 −71 src/hottop/util.clj
  2. +5 −14 test/hottop/test/util.clj
View
72 src/hottop/util.clj
@@ -59,8 +59,7 @@
keys
(map name)
(map str/upper-case)
- (interpose ", ")
- (apply str)))
+ (str/join ", ")))
(defn accepts-html?
"Returns truthy if the request indicates that it will accept a response in
@@ -71,35 +70,6 @@ HTML format (the Accept header contains one or both of 'text/html' or
(let [accept-types (map type-map-to-content-str (parse-accept-header accept-str))]
(some #{"text/html" "application/xhtml+xml"} accept-types))))
-(defn- types-and-subtypes
- "Returns a map of content type (major) to set of content subtypes for the
-given resource. For example, if the resource provides the following three
-content types: 'text/html', 'text/csv' and 'application/json', then the returned
-map will be:
- {'text' #{'html' 'csv'}
- 'application' #{'json'}}"
- [resource]
- (->> (:content-types-provided resource)
- keys
- (map #(str/split % #"/"))
- (group-by first)
- (map (fn [[type subtypes]]
- [type (reduce (fn [res subtype]
- (conj res (second subtype)))
- #{} subtypes)]))
- (into {})))
-
-(defn- types-and-subtypes2
- "Returns a map of content type to set of content subtypes when given a
-collection of maps each with keys :type and :subtype."
- [type-maps]
- (->> (group-by :type type-maps)
- (map (fn [[type typemaps]]
- [type (reduce (fn [res typemap]
- (conj res (:subtype typemap)))
- #{} typemaps)]))
- (into {})))
-
(defn- at-accepts-pt?
"Returns true if provided-type map (pt) is acceptable when compared to the
given accepted-type map (at) irrespective of at's q value."
@@ -156,46 +126,6 @@ http://en.wikipedia.org/wiki/MIME_type for examples of media type strings."
first
type-map-to-content-str))))
-#_(defn ^{:webmachine-node :c4} optimal-media-type
- "Returns a string representing the optimal client-requested media type or nil
-if there isn't one. See RFC 2046 (http://tools.ietf.org/html/rfc2046) or
-http://en.wikipedia.org/wiki/MIME_type for examples of media type strings.
-
- WARNING! This function is broken. Specifically, type/* media types in
- the Accept header are not handled."
- [request resource]
- (let [ ;;types-subtypes (types-and-subtypes resource)
- accept-maps (doto (->> (parse-accept-header (get-in request [:headers "accept"]))
- (sort-by :q >)) prn)
- provided-maps (doto (provided-maps resource) prn)
- ;; returns true if provided type map (pt) is acceptable when compared to
- ;; to the given accepted type map (at)
- acceptable? (fn [pt at] (and (not= (:q at) 0.0)
- (or (= (:type at) "*")
- (and (= (:type at) (:type pt))
- (or (= (:subtype at) "*")
- (= (:subtype at) (:subtype pt)))))))
- acceptable-type? (fn [t] )
- ;; filter out the provided maps that match an accept-map with a quality
- ;; factor of zero
- acceptable-maps (doto (filter (fn [pm]
- (some (partial acceptable? pm)
- accept-maps)) provided-maps) prn)
- types-subtypes (doto (types-and-subtypes2 acceptable-maps) prn)
- choose-type (fn [accepted-type provided-types]
- (if (= accepted-type "*")
- (rand-nth (seq provided-types))
- (some #{accepted-type} provided-types)))
- type (some (fn [{:keys [type subtype]}]
- (let [provided-types (keys types-subtypes)
- atype (choose-type type provided-types)
- provided-subtypes (types-subtypes atype)
- asubtype (choose-type subtype provided-subtypes)]
- (when (and atype asubtype)
- (str/join "/" [atype asubtype]))))
- accept-maps)]
- type))
-
(defn response?
"Returns truthy if argument is a map that contains the key :status, false
otherwise."
View
19 test/hottop/test/util.clj
@@ -45,9 +45,9 @@
(deftest test-allow-header-str
(let [resource (-> base-resource
- (assoc-in [:methods :get] (constantly "Hello!"))
- (assoc-in [:methods :post] (constantly "Hello!"))
- (assoc-in [:methods :put] (constantly "Hello!")))]
+ (add-method-handler :get (constantly "Hello!"))
+ (add-method-handler :post (constantly "Hello!"))
+ (add-method-handler :put (constantly "Hello!")))]
(is (= (allow-header-str resource)
"PUT, POST, GET"))))
@@ -65,15 +65,6 @@
(is (accepts-html? req3))
(is (not (accepts-html? req4)))))
-(deftest test-types-and-subtypes
- (let [res (-> base-resource
- (add-view "text/html" identity)
- (add-view "text/csv" identity)
- (add-view "application/json" identity))]
- (is (= (#'hottop.util/types-and-subtypes res)
- {"text" #{"html" "csv"}
- "application" #{"json"}}))))
-
(deftest test-at-accepts-pt?
(let [pts1 [{:type "text" :subtype "html"}
{:type "text" :subtype "csv"}
@@ -102,8 +93,8 @@
(header "Accept" "image/jpeg;q=0, image/*"))
resource1 (create-readonly-html-resource (constantly "hello!"))
resource2 (-> base-resource
- (assoc-in [:methods :get] (constantly "hello."))
- (assoc-in [:content-types-provided "text/csv"] identity))
+ (add-method-handler :get (constantly "hello."))
+ (add-view "text/csv" identity))
resource3 (-> base-resource
(add-view "image/jpeg" identity)
(add-view "image/png" identity))
Please sign in to comment.
Something went wrong with that request. Please try again.