Permalink
Browse files

Merge branch '1.0.5'

  • Loading branch information...
2 parents 74f3203 + 569238e commit dedc8bab6861f16257f40b3579ac3a795365c1a3 @dbyrne dbyrne committed Jun 14, 2011
View
@@ -39,13 +39,13 @@ vaguely like this:
## Contributors
* [David Byrne](https://github.com/dbyrne) (dbyrne)
- * [Alan Malloy](https://github.com/amalloy) (amalloy)
- * [Anthony Grimes](https://github.com/Raynes) (raynes)
- * [Carin Meier](https://github.com/gigasquid) (cmeier)
- * [Clint Harrison](https://github.com/Clinteger) (clinteger)
- * [David Davis](https://github.com/daviddavis) (daviddavis)
- * [Devin Walters](https://github.com/devn) (devn)
- * [Michael Kohl](https://github.com/citizen428) (citizen428)
+* [Alan Malloy](https://github.com/amalloy) (amalloy)
+* [Anthony Grimes](https://github.com/Raynes) (raynes)
+* [Carin Meier](https://github.com/gigasquid) (cmeier)
+* [Clint Harrison](https://github.com/Clinteger) (clinteger)
+* [David Davis](https://github.com/daviddavis) (daviddavis)
+* [Devin Walters](https://github.com/devn) (devn)
+* [Michael Kohl](https://github.com/citizen428) (citizen428)
Problem sources:
View
@@ -1,4 +1,4 @@
-(defproject foreclojure "1.0.3"
+(defproject foreclojure "1.0.5"
:description "4clojure - a website for lisp beginners"
:dependencies [[clojure "1.2.1"]
[clojure-contrib "1.2.0"]
@@ -9,6 +9,7 @@
[org.clojars.christophermaier/congomongo "0.1.4-SNAPSHOT"]
[org.jasypt/jasypt "1.7"]
[amalloy/utils "[0.3.7,)"]
+ [amalloy/ring-gzip-middleware "[0.1.0,)"]
[clj-github "1.0.1"]
[ring "0.3.7"]
[clj-config "0.1.0"]
View
@@ -1,16 +1,15 @@
(ns foreclojure.core
(:use compojure.core
- [foreclojure static problems login register golf
+ [foreclojure static problems login register golf ring
users config social version graphs mongo utils]
ring.adapter.jetty
somnium.congomongo
(ring.middleware (reload :only [wrap-reload])
- (stacktrace :only [wrap-stacktrace])))
+ (stacktrace :only [wrap-stacktrace])
+ [file-info :only [wrap-file-info]]
+ [gzip :only [wrap-gzip]]))
(:require [compojure [route :as route] [handler :as handler]]
- [sandbar.stateful-session :as session]
- [ring.util.response :as response]))
-
-(prepare-mongo)
+ [sandbar.stateful-session :as session]))
(defroutes main-routes
(GET "/" [] (welcome-page))
@@ -23,7 +22,9 @@
version-routes
graph-routes
golf-routes
- (route/resources "/")
+ (-> (resources "/*")
+ (wrap-url-as-file)
+ (wrap-file-info))
(route/not-found "Page not found"))
(def app (-> #'main-routes
@@ -32,9 +33,11 @@
identity))
session/wrap-stateful-session
handler/site
- wrap-uri-binding))
+ wrap-uri-binding
+ wrap-gzip))
(defn run []
+ (prepare-mongo)
(run-jetty (var app) {:join? false :port 8080}))
(defn -main [& args]
View
@@ -1,14 +1,30 @@
(ns foreclojure.golf
(:use hiccup.form-helpers
hiccup.page-helpers
- [foreclojure utils config]
+ [foreclojure utils config users]
compojure.core
somnium.congomongo)
- (:require [ring.util.response :as response]))
+ (:require [ring.util.response :as response]
+ [sandbar.stateful-session :as session]))
(def-page golfer-page []
"Your preferences have been saved.")
+(def-page opt-in-page []
+ (with-user [user-obj]
+ [:div
+ [:h2 "League sign-up"]
+ [:div#explain "While the primary purpose of 4clojure.com is to teach Clojure \"by doing\", you may also choose to compete for the shortest solution. This is affectionately known as " (link-to "http://lbrandy.com/blog/2008/09/what-code-golf-taught-me-about-python/" "code golf") ": the lower your score the better, get it? If you choose to participate, we'll score your correct solutions based on the number of non-whitespace characters (and some more metrics in the future). We'll also provide a chart showing how you stack up compared to everyone else on the site."]
+ [:table
+ (form-to [:post "/golf/opt-in"]
+ [:tr
+ [:td
+ (check-box :opt-in
+ (golfer? user-obj))
+ [:label {:for "opt-in"}
+ "I want to join the golf league and compete to find the shortest solutions"]]]
+ [:tr [:td [:button {:type "submit"} "Update"]]])]]))
+
(defn set-golfer [opt-in]
(with-user [{:keys [_id]}]
(update! :users
@@ -20,4 +36,15 @@
(POST "/golf/opt-in" [opt-in]
(set-golfer opt-in))
(GET "/golf/opt-in" []
- (golfer-page)))
+ (golfer-page))
+
+ (GET "/league" []
+ (comment ;; be smarter somehow in future. not sure what the right UI is, atm
+ (if-let [username (session/session-get :user)]
+ (let [user-obj (get-user username)]
+ (if-not (golfer? user-obj)
+ (response/redirect "/leag")))))
+ (opt-in-page))
+
+ (GET "/league/opt-in" []
+ (opt-in-page)))
View
@@ -58,19 +58,7 @@
[password-field :pwd "New password"]
[password-field :repeat-pwd "Repeat password"]])
[:tr
- [:td [:button {:type "submit"} "Reset now"]]])]]
- (when (:golfing-active config)
- [:div#golf-opt-in
- [:h2 "Code golf!"]
- [:table
- (form-to [:post "/golf/opt-in"]
- [:tr
- [:td
- (check-box :opt-in
- (golfer? user-obj))
- [:label {:for "opt-in"}
- "I want to join the golf league and compete to find the shortest solutions"]]]
- [:tr [:td [:button {:type "submit"} "Update"]]])]])]))
+ [:td [:button {:type "submit"} "Reset now"]]])]]]))
(defn do-update-password! [old-pwd new-pwd repeat-pwd]
(with-user [{:keys [user pwd]}]
View
@@ -21,10 +21,10 @@
(defn prepare-seqs []
(update! :seqs
{:_id "problems"}
- {:$set {:seq (inc (apply max
- (map :_id
- (fetch :problems
- :only [:_id]))))}}))
+ {:$set {:seq (->> (fetch :problems :only [:_id])
+ (map :_id)
+ (apply max)
+ (inc))}}))
;; make it easier to get off the ground by marking contributors automatically
;; useful since some "in-development" features aren't enabled for all users
@@ -44,21 +44,16 @@
(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."
[]
- (send
- total-solved +
- (let [problems (get-problem-list)]
- (reduce
- #(do
- (update! :problems
- {:_id (first %2)}
- {:$set {:times-solved (last %2)}})
- (+ %1 (last %2)))
- 0
- (reduce #(update-in %1 [%2] inc)
- (reduce #(conj %1 [%2 0])
- {}
- (map :_id problems))
- (mapcat :solved (get-users)))))))
+ (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))))
(defn prepare-mongo []
(connect-to-db)
@@ -326,6 +326,16 @@
{:_id "problems"}
{:$inc {:seq 1}})))]
+ (when (empty? author) ; newly submitted, not a moderator tweak
+ (send-email
+ {:from "team@4clojure.com"
+ :to ["team@4clojure.com"]
+ :subject (str "User submission: " title)
+ :body (html [:h3 (link-to (str "https://4clojure.com/problem/edit/"
+ id)
+ title)]
+ [:div description])}))
+
(update! :problems
{:_id prob-id}
{:_id prob-id
@@ -12,10 +12,10 @@
(form-to [:post "/register"]
[:table
(map form-row
- [[text-field :user "Username (4-13 chars.)"]
+ [[text-field :user "Username (4-13 chars.)" (session/flash-get :user)]
[password-field :pwd "Password (7+ chars.)"]
[password-field :repeat-pwd "Repeat Password"]
- [text-field :email "Email"]])
+ [text-field :email "Email" (session/flash-get :email)]])
[:tr
[:td [:button {:type "submit"} "Register"]]]]))
@@ -41,7 +41,10 @@
:email email})
(session/session-put! :user lower-user)
(response/redirect "/"))
- (flash-error why "/register"))))
+ (do
+ (session/flash-put! :user user)
+ (session/flash-put! :email email)
+ (flash-error why "/register")))))
(defroutes register-routes
(GET "/register" [] (register-page))
View
@@ -0,0 +1,24 @@
+(ns foreclojure.ring
+ (:use [compojure.core :only [GET]]
+ [ring.util.response :only [response]])
+ (:require [clojure.java.io :as io])
+ (:import (java.net URL)))
+
+;; copied from compojure.route, modified to use File instead of Stream
+(defn resources
+ "A route for serving resources on the classpath. Accepts the following
+ keys:
+ :root - the root prefix to get the resources from. Defaults to 'public'."
+ [path & [options]]
+ (-> (GET path {{resource-path :*} :route-params}
+ (let [root (:root options "public")]
+ (when-let [res (io/resource (str root "/" resource-path))]
+ (response (io/as-file res)))))))
+
+(defn wrap-url-as-file [handler]
+ (fn [request]
+ (when-let [{body :body :as resp} (handler request)]
+ (if (and (instance? URL body)
+ (= "file" (.getProtocol ^URL body)))
+ (update-in resp [:body] io/as-file)
+ resp))))
@@ -90,10 +90,10 @@
~@body)
[:span.error "You must " (login-link) " to do this."]))
-(defn form-row [[type name info]]
+(defn form-row [[type name info value]]
[:tr
[:td (label name info)]
- [:td (type name)]])
+ [:td (type name value)]])
(defn row-class [x]
{:class (if (even? x)
@@ -125,7 +125,7 @@
[:link {:rel "alternate" :type "application/atom+xml" :title "Atom" :href "http://4clojure.com/problems/rss"}]
[:link {:rel "shortcut icon" :href "/favicon.ico"}]
(include-js "/vendor/script/jquery-1.5.2.min.js" "/vendor/script/jquery.dataTables.min.js")
- (include-js "/vendor/script/foreclojure.js")
+ (include-js "/script/foreclojure.js")
(include-js "/vendor/script/xregexp.js" "/vendor/script/shCore.js" "/vendor/script/shBrushClojure.js")
(include-js "/vendor/script/ace/ace.js" "/vendor/script/ace/mode-clojure.js")
(include-css "/css/style.css" "/css/demo_table.css" "/css/shCore.css" "/css/shThemeDefault.css")
@@ -162,7 +162,7 @@
(link-to "/login/update" "Account Settings")]
(when (:golfing-active config)
[:span ; deserves its own page, but just make it discoverable for now
- (link-to "/login/update" "Leagues")])
+ (link-to "/league" "Leagues")])
(when (approver? user)
[:span
(link-to "/problems/unapproved" "View Unapproved Problems")])
@@ -3,10 +3,16 @@
compojure.core
[clojure.java.shell :only [sh]]))
+;; fetch this at load time rather than on demand, so that it's accurate even
+;; if someone checks out a different revision to poke at without restarting
+;; the server (eg to diagnose bugs in a release)
+(def sha (not-empty (:out (sh "git" "rev-parse" "--verify" "HEAD"))))
+
(def-page version []
- (let [sha (:out (sh "git" "rev-parse" "--verify" "HEAD"))]
+ (if sha
[:p "SHA: "
- [:a {:href (str "http://github.com/dbyrne/4clojure/commit/" sha)} sha]]))
+ [:a {:href (str "http://github.com/dbyrne/4clojure/commit/" sha)} sha]]
+ [:p "No git repository found"]))
(defroutes version-routes
- (GET ["/about/version"] [] (version)))
+ (GET ["/about/version"] [] (version)))

0 comments on commit dedc8ba

Please sign in to comment.