Skip to content


Subversion checkout URL

You can clone with
Download ZIP
Fetching contributors…

Cannot retrieve contributors at this time

235 lines (209 sloc) 8.65 KB
(ns foreclojure.users
(:require [ring.util.response :as response]
[sandbar.stateful-session :as session])
(:use [foreclojure.utils :only [from-mongo row-class rank-class get-user with-user]]
[foreclojure.template :only [def-page content-page]]
[foreclojure.config :only [config repo-url]]
[somnium.congomongo :only [fetch-one fetch update!]]
[compojure.core :only [defroutes GET POST]]
[hiccup.form-helpers :only [form-to hidden-field]]
[ :only [link-to]]
[clojure.contrib.json :only [json-str]]))
(def golfer-tags (into [:contributor]
(when (:golfing-active config)
(defn get-user-id [name]
(fetch-one :users
:where {:user name}
:only [:_id])))
(defn get-users []
(fetch :users
:only [:user :solved :contributor])))
(defn get-ranked-users []
(let [users (get-users)
tied-groups (map val
(sort-by #(-> % key -)
(group-by #(count (or (:solved %) []))
(reduce (fn [[user-list position rank] new-group]
[(into user-list
(for [user (sort-by :user new-group)]
(into user {:rank rank
:position position})))
(inc position)
(+ rank (count new-group))])
[[] 1 1]
(defn get-top-100-and-current-user [username]
(let [ranked-users (get-ranked-users)
this-user (first (filter (comp #{username} :user)
this-user-ranking (update-in this-user [:rank] #(str (or % "?") " out of " (count ranked-users)))]
{:user-ranking this-user-ranking
:top-100 (take 100 ranked-users)}))
(defn golfer? [user]
(some user golfer-tags))
(defn disable-codebox? [user]
(true? (:disable-code-box user)))
(defn hide-solutions? [user]
(true? (:hide-solutions user)))
(defn email-address [username]
(:email (fetch-one :users :where {:user username})))
(defn mailto [username]
(link-to (str "mailto:" (email-address username))
(defn format-user-ranking [{:keys [rank user contributor solved]}]
(when user
[:h2 "Your Ranking"]
[:div.ranking (str "Username: ")
(when contributor [:span.contributor "* "])
[:a.user-profile-link {:href (str "/user/" user)} user]]
[:div.ranking (str "Rank: " rank)]
[:div.ranking (str "Problems Solved: " (count solved))]
(defn follow-url [username follow?]
(str "/user/" (if follow? "follow" "unfollow") "/" username))
(defn following-checkbox [current-user-id following user-id user]
(when (and current-user-id (not= current-user-id user-id))
(let [following? (contains? following user-id)]
(form-to [:post (follow-url user (not following?))]
[:input.following {:type "checkbox" :checked following?}]
[:span.following (when following? "yes")]))))
(defn generate-user-list [user-set]
(let [[user-id following]
(when (session/session-get :user)
(with-user [{:keys [_id following]}]
[_id (set following)]))]
[:th {:style "width: 40px;" } "Rank"]
[:th {:style "width: 200px;"} "Username"]
[:th {:style "width: 180px;"} "Problems Solved"]
[:th "Following"]]]
(map-indexed (fn [rownum {:keys [_id position rank user contributor solved]}]
[:tr (row-class rownum)
[:td (rank-class position) rank]
(when contributor [:span.contributor "* "])
[:a.user-profile-link {:href (str "/user/" user)} user]]
[:td.centered (count solved)]
[:td (following-checkbox user-id following _id user)]])
(def-page all-users-page []
{:title "All 4Clojure Users"
{:heading "All 4Clojure Users"
:sub-heading (list [:span.contributor "*"] " " (link-to repo-url "4clojure contributor"))
:main (generate-user-list (get-ranked-users))})})
(def-page top-users-page []
(let [username (session/session-get :user)
{:keys [user-ranking top-100]} (get-top-100-and-current-user username)]
{:title "Top 100 Users"
{:heading "Top 100 Users"
:heading-note (list "[show " (link-to "/users/all" "all") "]")
:sub-heading (list (format-user-ranking user-ranking)
[:span.contributor "*"] " "
(link-to repo-url "4clojure contributor"))
:main (generate-user-list top-100)})}))
;; TODO: this is snagged from problems.clj but can't be imported due to cyclic dependency, must refactor this out.
(defn get-problems
(fetch :problems
:only [:_id :difficulty]
:where {:approved true}
:sort {:_id 1})))
(get (group-by :difficulty (get-problems)) difficulty [{}])))
(defn get-solved
(:solved (get-user username)))
([username difficulty]
(let [ids (->> (from-mongo
(fetch :problems
:only [:_id]
:where {:approved true, :difficulty difficulty}))
(map :_id)
(filter ids (get-solved username)))))
(def-page user-profile [username]
(let [page-title (str "User: " username)
user-id (:_id (get-user username))]
{:title page-title
[:div.user-profile-name page-title]
(if (session/session-get :user)
(with-user [{:keys [_id following]}]
(if (not= _id user-id)
(let [[url label] (if (some #{user-id} following)
["unfollow" "Unfollow"]
["follow" "Follow"])]
(form-to [:post (str "/user/" url "/" username)]
[:button.user-follow-button {:type "submit"} label]))
[:div {:style "clear: right; margin-bottom: 10px;"} " "]))
[:div {:style "clear: right; margin-bottom: 10px;"} " "])
(for [difficulty ["Elementary" "Easy" "Medium" "Hard"]]
(let [solved (count (get-solved username difficulty))
total (count (get-problems difficulty))]
[:td.count-label difficulty]
{:style (str "width: "
(int (* 100 (/ solved total)))
[:td.count-total "TOTAL:" ]
(count (get-solved username)) "/"
(count (get-problems))]]])}))
(defn follow-user [username follow?]
(with-user [{:keys [_id]}]
(let [follow-id (:_id (get-user username))
operation (if follow? :$addToSet :$pull)]
(update! :users
{:_id _id}
{operation {:following follow-id}}))))
(defn static-follow-user [username follow?]
(follow-user username follow?)
(response/redirect (str "/user/" username)))
(defn rest-follow-user [username follow?]
(follow-user username follow?)
(json-str {"following" follow?
"next-action" (follow-url username (not follow?))
"next-label" (if follow? "Unfollow" "Follow")}))
(defn set-disable-codebox [disable-flag]
(with-user [{:keys [_id]}]
(update! :users
{:_id _id}
{:$set {:disable-code-box (boolean disable-flag)}})
(response/redirect "/problems")))
(defn set-hide-solutions [hide-flag]
(with-user [{:keys [_id]}]
(update! :users
{:_id _id}
{:$set {:hide-solutions (boolean hide-flag)}})
(response/redirect "/problems")))
(defroutes users-routes
(GET "/users" [] (top-users-page))
(GET "/users/all" [] (all-users-page))
(GET "/user/:username" [username] (user-profile username))
(POST "/user/follow/:username" [username] (static-follow-user username true))
(POST "/user/unfollow/:username" [username] (static-follow-user username false))
(POST "/rest/user/follow/:username" [username] (rest-follow-user username true))
(POST "/rest/user/unfollow/:username" [username] (rest-follow-user username false)))
Jump to Line
Something went wrong with that request. Please try again.