Skip to content


Subversion checkout URL

You can clone with
Download ZIP
Fetching contributors…
Cannot retrieve contributors at this time
187 lines (166 sloc) 6.35 KB
(ns foreclojure.utils
(:use (hiccup [core :only [html]]
[page-helpers :only [doctype include-css
javascript-tag link-to include-js]]
[form-helpers :only [label]])
[amalloy.utils.transform :only [transform-if]]
(:require [sandbar.stateful-session :as session]
(ring.util [response :as response])
[clojure.walk :as walk])
(def ^{:dynamic true} *url* nil)
(defn wrap-uri-binding [handler]
(fn [req]
(binding [*url* (:uri req)]
(handler req))))
(defmacro dbg [x]
`(let [x# ~x] (println '~x "=" x#) x#))
(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
each test succeeds, then body is evaluated. Otherwise, fail-expr is
evaluated with the symbol 'why bound to the failure value associated
with the failing test."
[[& clauses] body & [fail-expr]]
`(if-let [[~'why]
~@(mapcat (fn [[test fail-value]]
[`(not ~test) [fail-value]])
(partition 2 clauses)))]
(defn login-url
([] (login-url *url*))
(str "/login?location=" (URLEncoder/encode location))))
(defn login-link
([] (login-link "Log in" *url*))
([text] (login-link text *url*))
([text location]
(link-to (login-url location)
;; Assuming that it will always need SSL. Will make it more flexible later.
(defn send-email [{:keys [from to subject body]}]
(let [{:keys [host port user pass]} config
base (doto (SimpleEmail.)
(.setHostName host)
(.setSSL true)
(.setFrom from)
(.setSubject subject)
(.setMsg body)
(.setAuthentication user pass))]
(doseq [person to] (.addTo base person))
(.send base)))
(defn flash-fn [type]
(fn [msg url]
(session/flash-put! type msg)
(response/redirect url)))
(def flash-error (flash-fn :error))
(def flash-msg (flash-fn :message))
(defmacro def-page [page-name [& args] & code]
`(defn ~page-name [~@args]
(defn from-mongo [data]
(walk/postwalk (transform-if float? int)
(defn get-user [username]
(fetch-one :users :where {:user username})))
(defmacro with-user [[user-binding] & body]
`(if-let [username# (session/session-get :user)]
(let [~user-binding (get-user username#)]
[:span.error "You must " (login-link) " to do this."]))
(defn form-row [[type name info value]]
[:td (label name info)]
[:td (type name value)]])
(defn row-class [x]
{:class (if (even? x)
(defn user-attribute [attr]
(fn [username]
(attr (from-mongo
(fetch-one :users
:where {:user username}
:only [attr])))))
(def get-solved (comp set (user-attribute :solved)))
(def approver? (user-attribute :approver))
(defn can-submit? [username]
(and (:problem-submission config)
(>= (count (get-solved username))
(:advanced-user-count config))))
(defn html-doc [& body]
(let [user (session/session-get :user)]
(doctype :html5)
[:title "4Clojure"]
[:link {:rel "alternate" :type "application/atom+xml" :title "Atom" :href ""}]
[: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 "/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")
[:style {:type "text/css"}
".syntaxhighlighter { overflow-y: hidden !important; }"]]
[:script {:type "text/javascript"} "SyntaxHighlighter.all()"]
(link-to "/" [:img#logo {:src "/images/logo.png"}])]
(for [[link text & [tabbed]]
[["/" "Main Page"]
["/problems" "Problem List"]
["/users" "Top Users"]
["/directions" "Getting Started"]
["" "REPL" true]
["" "Docs" true]]]
[ (assoc (when tabbed {:target "_blank"})
:href link)
(if user
[:span#username (str "Logged in as " user)]
[:a#logout {:href "/logout"} "Logout"]]
[:a#login {:href (login-url)} "Login"]
[:a#register {:href "/register"} "Register"]])]]
(when user
(link-to "/login/update" "Account Settings")]
(when (:golfing-active config)
[:span ; deserves its own page, but just make it discoverable for now
(link-to "/league" "Leagues")])
(when (approver? user)
(link-to "/problems/unapproved" "View Unapproved Problems")])
(when (can-submit? user)
[:span (link-to "/problems/submit" "Submit a Problem")])])
[:div#content_body body]
"The content on is available under the EPL v 1.0 license."
[:a#contact {:href ""} "Contact us!"]]
" var _gaq = _gaq || [];
_gaq.push(['_setAccount', 'UA-22844856-1']);
(function() {
var ga = document.createElement('script'); ga.type = 'text/javascript'; ga.async = true;
ga.src = ('https:' == document.location.protocol ? 'https://ssl' : 'http://www') + '';
var s = document.getElementsByTagName('script')[0]; s.parentNode.insertBefore(ga, s);
Jump to Line
Something went wrong with that request. Please try again.