Skip to content
Browse files

Merge branch 'release/1.3.1'

  • Loading branch information...
2 parents 6fd1c7e + 29ade2a commit 54b2859729ae1f75ed9bf2301a011bc957446db4 @amalloy amalloy committed Sep 20, 2011
View
1 config.clj
@@ -9,6 +9,7 @@
:pass ""
:repo-url "https://github.com/4clojure/4clojure"
:golfing-active true
+ :heartbeat nil ; set to, eg, [1 :hour] for periodic heap information on stdout
;; this list is just for bootstrapping - the real DB is authoritative
:contributors ["amalloy" "dbyrne" "raynes" "cmeier" "devn" "0x89"
"citizen428" "daviddavis" "clinteger" "amcnamara"]}
View
2 project.clj
@@ -1,4 +1,4 @@
-(defproject foreclojure "1.3.0.1"
+(defproject foreclojure "1.3.1"
:description "4clojure - a website for lisp beginners"
:dependencies [[clojure "1.2.1"]
[clojure-contrib "1.2.0"]
View
2 resources/public/script/foreclojure.js
@@ -52,7 +52,7 @@ function configureDataTables(){
} );
$('#user-table').dataTable( {
- "iDisplayLength":25,
+ "iDisplayLength":100,
"aaSorting": [[ 0, "asc" ]],
"aoColumns": [
null,
View
14 src/foreclojure/core.clj
@@ -16,6 +16,7 @@
[foreclojure.graphs :only [graph-routes]]
[foreclojure.mongo :only [prepare-mongo]]
[foreclojure.utils :only [wrap-uri-binding]]
+ [foreclojure.periodic :only [schedule-task]]
[ring.adapter.jetty :only [run-jetty]]
[ring.middleware.reload :only [wrap-reload]]
[ring.middleware.stacktrace :only [wrap-stacktrace]]
@@ -51,8 +52,21 @@
wrap-strip-trailing-slash
wrap-gzip))
+(defn register-heartbeat []
+ (when-let [period (:heartbeat config)]
+ (apply schedule-task
+ (let [^java.io.PrintWriter out *out*
+ ^Runtime r (Runtime/getRuntime)]
+ (fn []
+ (.println out (format "%d/%d/%d MB free/total/max"
+ (int (/ (. r (freeMemory)) 1e6))
+ (int (/ (. r (totalMemory)) 1e6))
+ (int (/ (. r (maxMemory)) 1e6))))))
+ period)))
+
(defn run []
(prepare-mongo)
+ (register-heartbeat)
(run-jetty (var app) {:join? *block-server* :port 8080}))
(defn -main [& args]
View
13 src/foreclojure/graphs.clj
@@ -5,8 +5,7 @@
(:import [java.io ByteArrayInputStream
ByteArrayOutputStream])
(:use [compojure.core :only [defroutes GET]]
- [foreclojure.utils :only [from-mongo]]
- [somnium.congomongo :only [fetch-one]]
+ [foreclojure.problems :only [solved-stats]]
[useful.utils :only [with-adjustments]]))
(defn un-group
@@ -18,13 +17,9 @@
(repeat count x))))
(defn fetch-score-frequencies [problem-id]
- (into {}
- (for [[k v] (:scores
- (from-mongo
- (fetch-one :problems
- :where {:_id problem-id}
- :only [:scores])))]
- [(Integer/parseInt (name k)), v])))
+ (-> @solved-stats
+ (get problem-id)
+ (dissoc nil)))
(defn make-problem-plot [id best curr]
(let [freqs (fetch-score-frequencies id)
View
24 src/foreclojure/mongo.clj
@@ -2,7 +2,7 @@
(:use somnium.congomongo
[foreclojure.data-set :only [load-problems]]
[foreclojure.config :only [config]]
- [foreclojure.problems :only [total-solved get-problem-list]]
+ [foreclojure.problems :only [number-from-mongo-key solved-stats get-problem-list]]
[foreclojure.users :only [get-users]]))
(defn connect-to-db []
@@ -43,16 +43,18 @@
(defn reconcile-solved-count
"Overwrites the times-solved field in the problems collection based on data from the users collection. Should only be called on server startup since it isn't a safe operation. Also updates the total-solved agent."
[]
- (let [total (->> (get-users)
- (mapcat :solved)
- (frequencies)
- (reduce (fn [sum [id solved]]
- (update! :problems
- {:_id id}
- {:$set {:times-solved solved}})
- (+ sum solved))
- 0))]
- (send total-solved (constantly total))))
+ (let [+ (fnil + 0)
+ [total scores]
+ (->> (fetch :users :only [:scores])
+ (mapcat :scores)
+ (frequencies)
+ (reduce (fn [[total scores] [[id score] times]]
+ [(+ total times)
+ (update-in scores
+ [(number-from-mongo-key id) score]
+ + times)])
+ [0 {}]))]
+ (send solved-stats (constantly (assoc scores :total total)))))
(defn prepare-mongo []
(connect-to-db)
View
25 src/foreclojure/periodic.clj
@@ -0,0 +1,25 @@
+(ns foreclojure.periodic
+ (:import (java.util.concurrent ScheduledThreadPoolExecutor
+ ScheduledExecutorService
+ TimeUnit)))
+
+;; Stolen from clojail, but I wrote it myself anyway.
+;; I guess it deserves a library of its own? Or maybe in useful?
+(def uglify-time-unit
+ (into {} (for [[enum aliases] {TimeUnit/NANOSECONDS [:ns :nanoseconds]
+ TimeUnit/MICROSECONDS [:us :microseconds]
+ TimeUnit/MILLISECONDS [:ms :milliseconds]
+ TimeUnit/SECONDS [:s :sec :seconds]
+ TimeUnit/MINUTES [:m :min :minutes]
+ TimeUnit/HOURS [:h :hours]
+ TimeUnit/DAYS [:d :days]}
+ alias aliases]
+ {alias enum})))
+
+(def ^ScheduledExecutorService pool
+ (memoize (fn []
+ (ScheduledThreadPoolExecutor. 2))))
+
+(defn schedule-task [task period unit]
+ (.scheduleAtFixedRate (pool) task 0
+ period (uglify-time-unit unit)))
View
103 src/foreclojure/problems.clj
@@ -4,7 +4,7 @@
[clojure.string :as s]
[ring.util.response :as response])
(:import [org.apache.commons.mail EmailException])
- (:use [foreclojure.utils :only [from-mongo get-user get-solved login-link *url* flash-msg flash-error def-page row-class approver? can-submit? send-email image-builder with-user]]
+ (:use [foreclojure.utils :only [from-mongo get-user get-solved login-link *url* flash-msg flash-error def-page row-class approver? can-submit? send-email image-builder with-user as-int maybe-update]]
[foreclojure.social :only [tweet-link gist!]]
[foreclojure.feeds :only [create-feed]]
[foreclojure.users :only [golfer? get-user-id disable-codebox?]]
@@ -20,7 +20,7 @@
[compojure.core :only [defroutes GET POST]]
[clojure.contrib.json :only [json-str]]))
-(def total-solved (agent 0))
+(def solved-stats (agent {:total 0}))
(defn get-problem [x]
(from-mongo
@@ -31,7 +31,7 @@
([criteria]
(from-mongo
(fetch :problems
- :only [:_id :title :difficulty :tags :times-solved :user]
+ :only [:_id :title :difficulty :tags :user]
:where criteria
:sort {:_id 1}))))
@@ -80,6 +80,11 @@
[id]
(keyword (str (int id))))
+(defn number-from-mongo-key
+ "Turn a keyword like :4 into an integer"
+ [k]
+ (Integer. (name k)))
+
(defn trim-code [code]
(when code (.trim code)))
@@ -89,44 +94,39 @@
code)))
(defn record-golf-score! [user-id problem-id score]
- (let [user-score-key (keyword (str "scores." problem-id))
- problem-score-key (keyword (str "scores." score))
- [problem-scores-key user-subkey] (map mongo-key-from-number
- [score problem-id])]
- (when-let [{:keys [_id scores] :as user}
- (from-mongo
- (fetch-one :users
- :where {:_id user-id}))]
- (let [old-score-real (get scores user-subkey)
- old-score-test (or old-score-real 1e6)
- old-score-key (keyword (str "scores." old-score-real))]
- (when (golfer? user)
- (session/session-put! :golf-chart
- {:id problem-id
- :score score
- :best old-score-real}))
- (when (< score old-score-test)
- (update! :problems
- {:_id problem-id,
- old-score-key {:$gt 0}}
- {:$inc {old-score-key -1}})
- (update! :problems
- {:_id problem-id}
- {:$inc {problem-score-key 1}})
- (update! :users
- {:_id _id}
- {:$set {user-score-key score}}))))))
+ (when-let [{user-id :_id {old-score (keyword problem-id)} :scores :as user}
+ (from-mongo
+ (fetch-one :users
+ :where {:_id user-id}))]
+ (when (golfer? user)
+ (session/session-put! :golf-chart
+ {:id problem-id
+ :score score
+ :best old-score}))
+ (when (or (not old-score)
+ (> old-score score))
+ (update! :users
+ {:_id user-id}
+ {:$set {(keyword (str "scores." problem-id)) score}})
+ (send solved-stats (fn [scores]
+ (let [inc (fnil inc 0),
+ dec (fn [x]
+ (when (and x (> x 1))
+ (dec x)))]
+ (maybe-update scores [problem-id]
+ #(-> %
+ (maybe-update [score] inc)
+ (maybe-update [old-score] dec)))))))))
(defn store-completed-state! [username problem-id code]
(let [{user-id :_id} (fetch-one :users
:where {:user username}
:only [:_id])
current-time (java.util.Date.)]
(when (not-any? #{problem-id} (get-solved username))
- (update! :users {:_id user-id} {:$addToSet {:solved problem-id}})
- (update! :problems {:_id problem-id} {:$inc {:times-solved 1}})
- (update! :users {:_id problem-id} {:$set {:last-solved-date current-time}})
- (send total-solved inc))
+ (update! :users {:_id user-id} {:$addToSet {:solved problem-id}
+ :$set {:last-solved-date current-time}})
+ (send solved-stats update-in [:total] inc))
(record-golf-score! user-id problem-id (code-length code))
(save-solution user-id problem-id code)))
@@ -270,7 +270,7 @@ Return a map, {:message, :error, :url, :num-tests-passed}."
(if session-user
(with-user [{:keys [solved]}]
(if (some #{(Integer. id)} solved)
- (link-to (str "/problem/solutions/" id)
+ (link-to (str "/problem/solutions/" id)
[:button#solutions-link {:type "submit"} "Solutions"])
[:div {:style "clear: right; margin-bottom: 15px;"} "&nbsp;"]))
[:div {:style "clear: right; margin-bottom: 15px;"} "&nbsp;"])
@@ -318,7 +318,7 @@ Return a map, {:message, :error, :url, :num-tests-passed}."
[:button.large {:id "approve-button"} "Approve"]]))]}))
(defn problem-page [id]
- (if (or (:approved (get-problem (Integer. id)))
+ (if (or (:approved (get-problem id))
(approver? (session/session-get :user)))
(code-box id)
(flash-error "You cannot access this page" "/problems")))
@@ -347,7 +347,7 @@ Return a map, {:message, :error, :url, :num-tests-passed}."
[:div.follower-username (str f-user "'s solution:")]
[:pre.follower-code f-code]]))
[:p "None of the users you follow have solved this problem yet!"]))))})
-
+
(defn show-solutions [id]
(let [problem-id (Integer. id)
user (session/session-get :user)]
@@ -381,7 +381,7 @@ Return a map, {:message, :error, :url, :num-tests-passed}."
(let [solved (get-solved (session/session-get :user))
problems (get-problem-list)]
(map-indexed
- (fn [x {:keys [title difficulty times-solved tags user], id :_id}]
+ (fn [x {:keys [title difficulty tags user], id :_id}]
[:tr (row-class x)
[:td.titlelink
[:a {:href (str "/problem/" id)}
@@ -391,7 +391,7 @@ Return a map, {:message, :error, :url, :num-tests-passed}."
(s/join " " (map #(str "<span class='tag'>" % "</span>")
tags))]
[:td.centered user]
- [:td.centered (int times-solved)]
+ [:td.centered (reduce + (vals (get @solved-stats id)))]
[:td.centered (checkbox-img (contains? solved id))]])
problems))])}))
@@ -488,16 +488,15 @@ Return a map, {:message, :error, :url, :num-tests-passed}."
(update! :problems
{:_id id}
- {:_id id
- :title title
- :difficulty difficulty
- :times-solved (or (:times-solved existing-problem) 0)
- :description description
- :tags (re-seq #"\S+" tags)
- :restricted (re-seq #"\S+" restricted)
- :tests (s/split code #"\r\n\r\n")
- :user (if (empty? author) user author)
- :approved approved})
+ {:$set
+ {:title title
+ :difficulty difficulty
+ :description description
+ :tags (re-seq #"\S+" tags)
+ :restricted (re-seq #"\S+" restricted)
+ :tests (s/split code #"\r\n\r\n")
+ :user (if (empty? author) user author)
+ :approved approved}})
(flash-msg "Thank you for submitting a problem! Be sure to check back to see it posted." "/problems"))
(flash-error "You are not authorized to submit a problem." "/problems"))))
@@ -551,7 +550,11 @@ Return a map, {:message, :error, :url, :num-tests-passed}."
(defroutes problems-routes
(GET "/problems" [] (problem-list-page))
- (GET "/problem/:id" [id] (problem-page id))
+ (GET "/problem/:id" [id]
+ (if-let [id-int (as-int id)]
+ (problem-page id-int)
+ (flash-error (format "'%s' is not a valid problem number." id)
+ "/problems")))
(GET "/problems/submit" [] (problem-submission-page))
(POST "/problems/submit" [prob-id author title difficulty tags restricted description code]
(create-problem title difficulty tags restricted description code (when (not= "" prob-id) (Integer. prob-id)) author))
View
4 src/foreclojure/static.clj
@@ -1,6 +1,6 @@
(ns foreclojure.static
(:use [compojure.core :only [defroutes GET]]
- [foreclojure.problems :only [total-solved]]
+ [foreclojure.problems :only [solved-stats]]
[foreclojure.config :only [repo-url]]
[foreclojure.utils :only [def-page]]))
@@ -17,7 +17,7 @@
:content
[:div#welcome
[:div#totalcount
- (.format df (deref total-solved)) " problems solved and counting!"]
+ (.format df (:total @solved-stats)) " problems solved and counting!"]
[:div
[:h3 "What is 4Clojure?"]
[:p "4Clojure is a resource to help fledgling clojurians learn the language through interactive problems. The first few problems are easy enough that even someone with no prior experience should find the learning curve forgiving. See 'Help' for more information."]]
View
78 src/foreclojure/users.clj
@@ -27,7 +27,7 @@
(let [users (from-mongo
(fetch :users
:only [:user :solved :contributor]))
- sortfn (comp - count :solved)]
+ sortfn (comp - count :solved)]
(sort-by sortfn users)))
(defn get-user-with-ranking [username, users]
@@ -76,34 +76,57 @@
[:br]
[:br]]))
-
-(def-page users-page []
+(def-page all-users-page []
+ {:title "All 4Clojure Users"
+ :content
+ (list
+ [:h1 "All 4Clojure Users"]
+ [:div
+ [:span.contributor "*"] " "
+ (link-to repo-url "4clojure contributor")]
+ [:br]
+ [:table#user-table.my-table
+ [:thead
+ [:tr
+ [:th {:style "width: 40px;"} "Rank"]
+ [:th "Username"]
+ [:th "Problems Solved"]]]
+ (map-indexed (fn [rownum {:keys [user contributor solved]}]
+ [:tr (row-class rownum)
+ [:td (inc rownum)]
+ [:td
+ (when contributor [:span.contributor "* "])
+ [:a.user-profile-link {:href (str "/user/" user)} user]]
+ [:td.centered (count solved)]])
+ (get-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"
- :content
- (list
- [:h1 "Top 100 Users"]
- (format-user-ranking user-ranking)
- [:div
- [:span.contributor "*"] " "
- (link-to repo-url "4clojure contributor")]
- [:br]
- [:table#user-table.my-table
- [:thead
- [:tr
- [:th {:style "width: 40px;"} "Rank"]
- [:th "Username"]
- [:th "Problems Solved"]]]
- (map-indexed (fn [rownum {:keys [user contributor solved]}]
- [:tr (row-class rownum)
- [:td (inc rownum)]
- [:td
- (when contributor [:span.contributor "* "])
- [:a.user-profile-link {:href (str "/user/" user)} user]]
- [:td.centered (count solved)]])
- top-100)])}))
-
+ :content
+ (list
+ [:h1 "Top 100 Users"]
+ [:span "(or " (link-to "/users/all" "see all") ")"]
+ (format-user-ranking user-ranking)
+ [:div
+ [:span.contributor "*"] " "
+ (link-to repo-url "4clojure contributor")]
+ [:br]
+ [:table#user-table.my-table
+ [:thead
+ [:tr
+ [:th {:style "width: 40px;"} "Rank"]
+ [:th "Username"]
+ [:th "Problems Solved"]]]
+ (map-indexed (fn [rownum {:keys [user contributor solved]}]
+ [:tr (row-class rownum)
+ [:td (inc rownum)]
+ [:td
+ (when contributor [:span.contributor "* "])
+ [:a.user-profile-link {:href (str "/user/" user)} user]]
+ [:td.centered (count solved)]])
+ 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
@@ -187,7 +210,8 @@
(response/redirect "/problems")))
(defroutes users-routes
- (GET "/users" [] (users-page))
+ (GET "/users" [] (top-users-page))
+ (GET "/users/all" [] (all-users-page))
(GET "/user/:username" [username] (user-profile username))
(POST "/user/follow/:username" [username] (follow-user username :$addToSet))
(POST "/user/unfollow/:username" [username] (follow-user username :$pull)))
View
22 src/foreclojure/utils.clj
@@ -21,6 +21,11 @@
(binding [*url* (:uri req)]
(handler req))))
+(defn as-int [s]
+ (if (integer? s) s,
+ (try (Integer. s)
+ (catch Exception _ nil))))
+
(defmacro assuming
"Guard body with a series of tests. Each clause is a test-expression
followed by a failure value. Tests will be performed in order; if
@@ -36,6 +41,23 @@
~fail-expr
~body))
+
+
+(defn maybe-update
+ "Acts like clojure.core/update-in, except that if the value being assoc'd in
+ is nil, then instead the key is dissoc'd entirely."
+ ([m ks f]
+ (let [[k & ks] ks
+ inner (get m k)
+ v (if ks
+ (maybe-update inner ks f)
+ (f inner))]
+ (if v
+ (assoc m k v)
+ (dissoc m k))))
+ ([m ks f & args]
+ (maybe-update m ks #(apply f % args))))
+
(defn image-builder
"Return a function for constructing an [:img] element from a keyword.

0 comments on commit 54b2859

Please sign in to comment.
Something went wrong with that request. Please try again.