Skip to content
Branch: master
Find file Copy path
Find file Copy path
Fetching contributors…
Cannot retrieve contributors at this time
354 lines (305 sloc) 13.6 KB
(ns refheap.views.paste
(:require [refheap.models.paste :as paste]
[refheap.models.users :as users]
[refheap.highlight :refer [lexers]]
[refheap.utilities :refer [to-booleany escape-string pluralize safe-parse-long]]
[noir.session :as session]
[noir.response :refer [redirect content-type]]
[stencil.core :as stencil]
[me.raynes.laser :refer [defragment] :as l]
[ :refer [resource]]
[compojure.core :refer [defroutes GET POST]]
[refheap.views.common :refer [layout avatar page-buttons static]]
[refheap.dates :refer [date-string]]
[clojure.string :refer [split join]]))
(defn paste-url [paste & [suffix]]
(if-let [version (:version paste)]
(str "/" (:paste-id paste) "/history/" version suffix)
(str "/" (:paste-id paste) suffix)))
(defn paste-username [paste]
(if-let [user (:user paste)]
(:username (users/get-user-by-id user))
(defragment paste-page-fragment (resource "refheap/views/templates/paste.html")
[lang & [old]]
(l/child-of (l/id= "language")
(l/negate (l/attr? :selected)))
(fn [node]
(for [lang (sort #(.compareToIgnoreCase % %2)
(keys (dissoc lexers lang)))]
(l/on node (l/attr :value lang) (l/content lang))))
(l/attr? :selected) (let [lang (or lang (:language old) (session/get :last-lang) "Clojure")]
(comp (l/attr :value lang)
(l/content lang)))
(l/element= :form) (l/attr :action (if old
(paste-url old "/edit")
(when (:private old)
[(l/attr= :name :private) (l/attr :checked "")])
(when old
[(l/element= :textarea) (l/content (:raw-contents old))])
(l/id= :submit-button) (l/attr :value (if old "Save!" "Paste!")))
(let [head (static "refheap/views/templates/createhead.html")]
(defn paste-page [lang & [old]]
(paste-page-fragment lang old)
(when old
(str "Editing paste " (:paste-id old)))
(def show-head (static "refheap/views/templates/showhead.html"))
(let [head (static "refheap/views/templates/head.html")
html (l/parse (resource "refheap/views/templates/fullscreen.html"))
fullscreen #(l/document html
(l/element= :head) (l/content [head show-head])
(l/class= :syntax) (l/content (l/unescaped %)))]
(defn fullscreen-paste [id]
(when-let [contents (:contents (paste/view-paste id))]
(fullscreen contents)))
(defn fullscreen-version [id version]
(when-let [contents (:contents (paste/get-version (paste/get-paste id) version))]
(fullscreen contents))))
(defragment show-paste-page-fragment (resource "refheap/views/templates/pasted.html")
[{:keys [lines private user contents language date fork views] :as paste} paste-user]
[user-id (:id (session/get :user))
forks (paste/count-forks paste)
history (paste/count-history paste)
current? (not (:version paste))]
(l/id= :language) (l/content language)
(l/id= :lines) (l/content (pluralize lines "line"))
(l/id= :views) (if current?
(l/content (pluralize views "view"))
(l/id= :forks) (if (and current? (pos? forks))
(l/content (l/node :a :attrs {:href (paste-url paste "/forks")}
:content (pluralize forks "fork")))
(l/id= :edits) (if (pos? history)
(l/content (l/node :a :attrs {:href (paste-url
(if current?
(dissoc paste :version))
:content (pluralize history "edit")))
(when-not private
[(l/class= :private) (l/remove)])
(l/id= :last) (l/content [(if fork "Forked by " "Pasted by ")
(if user
(l/node :a :attrs {:href (str "/users/" paste-user)} :content paste-user)
(when fork
(str " from "
(if-let [paste (:paste-id (paste/get-paste-by-id fork))]
(str "<a href=\"/" paste "\">" paste "</a>")
" on "
(date-string date)])
(l/id= :embed) (if current?
(l/attr :href (paste-url paste "/embed"))
(l/id= :raw) (l/attr :href (paste-url paste "/raw"))
(l/id= :fullscreen) (l/attr :href (paste-url paste "/fullscreen"))
(if (and current? (paste/same-user? (and user-id {:id user-id}) paste))
[(l/id= :owner) #(l/fragment (l/zip (:content %))
(l/id= "editb") (l/attr :href (paste-url paste "/edit"))
(l/id= "delete") (l/attr :href (paste-url paste "/delete")))]
[(l/id= :owner) (l/remove)])
(if (paste/same-user? (and user-id {:id user-id}) paste)
[(l/attr= :name :forkform) (l/remove)]
[(l/attr= :name :forkform) (l/attr :action (paste-url paste "/fork"))])
(l/id= :paste) (l/content (l/unescaped contents)))
(defn show-paste-page [id]
(when-let [paste (paste/view-paste id)]
(let [paste-user (paste-username paste)]
(show-paste-page-fragment paste paste-user)
(str paste-user "'s paste: " id)
(defn show-version-page [id version]
(let [current (paste/get-paste id)]
(when-let [paste (paste/get-version current version)]
(assoc paste :paste-id (:paste-id current)
:history (:history current))
(paste-username paste))
(str "Version " version " of paste: " id)
(defn paste-preview [node paste header]
(let [{:keys [lines summary date user private]} paste]
(l/at node
(l/class= :more) (l/insert :left (l/unescaped summary))
(if (> lines 5)
[(l/class= :more) (l/attr :href (paste-url paste))]
[(l/class= :more) (l/remove)])
(l/class= :syntax) (l/insert :left header))))
(defragment render-paste-previews (resource "refheap/views/templates/preview.html")
[pastes header-fn]
(l/class= :preview-header) #(for [paste pastes]
(paste-preview % paste (header-fn paste))))
(defragment embed-page-fragment (resource "refheap/views/templates/embed.html")
[id host scheme]
(l/id= :script) (l/content (str "<script src=\"" (name scheme) "://" host "/" id ".js\"></script>")))
(defn embed-page [paste host scheme]
(let [id (:paste-id paste)]
(layout (embed-page-fragment id host scheme)
(str "Embedding paste " id))))
(defn embed-paste [id host scheme lines?]
(when-let [paste (paste/get-paste id)]
{:id id
:content (escape-string (:contents paste))
:url (str (name scheme) "://" host "/css/embed.css")
:nolinenos (and lines? (not (to-booleany lines?)) {})}))))
(defragment paste-header (resource "refheap/views/templates/allheader.html")
[{:keys [paste-id date user]} paste]
(l/id= :id) (comp (l/attr :href (paste-url paste))
(l/content (str "Paste " paste-id)))
(l/class= :right) (l/content [(if-let [user (and user (:username (users/get-user-by-id user)))]
(l/node :a :attrs {:href (str "/users/" user)} :content user)
" on "
(date-string date)]))
(defn list-page [title url redirect-url list-count get-fn header-fn page]
(if (> page (paste/count-pages list-count 20))
(redirect redirect-url)
(l/node :div :attrs {:class "clearfix"}
:content (concat (render-paste-previews (get-fn page) header-fn)
(page-buttons url list-count 20 page)))
(defn all-pastes-page [page]
(list-page "All pastes"
(paste/count-pastes false)
(defn forks-page [id page]
(when-let [paste (paste/get-paste id)]
(list-page (str "Forks of paste: " id)
(paste-url paste "/forks")
(paste-url paste)
(paste/count-forks paste)
(partial paste/get-forks paste)
(defragment version-header (resource "refheap/views/templates/allheader.html")
[current paste]
[{:keys [version date]} paste]
(l/id= :id) (comp (l/attr :href
(paste-url (assoc paste :paste-id (:paste-id current))))
(l/content (if version
(str "Version " version)
(l/class= :right) (l/content (date-string date)))
(defn history-page [id page]
(when-let [current (paste/get-paste id)]
(list-page (str "History of paste: " id)
(paste-url current "/history")
(paste-url current)
(paste/count-history current)
(partial paste/get-history current)
(partial version-header current)
(defn fail [error]
(layout (l/node :p :attrs {:class "error"} :content error) "You broke it."))
(defn edit-paste-page [id]
(let [paste (paste/get-paste id)]
(when (paste/same-user? (session/get :user) paste)
(paste-page nil paste))))
(defn fork-paste-page [id & [version]]
(let [user (session/get :user)
paste (if version
(paste/get-version (paste/get-paste id) version)
(paste/get-paste id))]
(when (and paste (not (paste/same-user? user paste)))
(let [forked (paste/paste (:language paste)
(:raw-contents paste)
(:private paste)
(:id paste))]
(redirect (paste-url forked))))))
(defn delete-paste-page [id]
(if-let [user (:user (paste/get-paste id))]
(when (= user (session/get-in [:user :id]))
(paste/delete-paste id)
(redirect (str "/users/" (:username (session/get :user)))))
(when (some #{id} (session/get :anon-pastes))
(paste/delete-paste id)
(redirect "/pastes"))))
(defn edit-paste [{:keys [id paste language private]}]
(let [paste (paste/update-paste
(paste/get-paste id)
(session/get :user))]
(if (map? paste)
(redirect (paste-url paste))
(fail paste))))
(defn create-paste [{:keys [paste language private]} remote-addr]
(let [user (assoc (session/get :user) :remote-addr remote-addr)
paste (paste/paste language paste private user)]
(if (map? paste)
(redirect (paste-url paste))
(fail paste))))
(defroutes paste-routes
(GET "/" [lang]
(paste-page lang))
(GET "/pastes" [page]
(all-pastes-page (paste/proper-page (safe-parse-long page 1))))
(GET "/:id/forks" [id page]
(forks-page id (paste/proper-page (safe-parse-long page 1))))
(GET "/:id/history" [id page]
(history-page id (paste/proper-page (safe-parse-long page 1))))
(GET "/:id/fullscreen" [id]
(fullscreen-paste id))
(GET "/:id/edit" [id]
(edit-paste-page id))
(POST "/:id/fork" [id]
(fork-paste-page id))
(GET "/:id/delete" [id]
(delete-paste-page id))
(GET "/:id/raw" [id]
(when-let [content (:raw-contents (paste/get-paste id))]
(content-type "text/plain; charset=utf-8" content)))
(GET "/:id/embed" {{:keys [id]} :params
{host "host"} :headers
scheme :scheme}
(let [paste (paste/get-paste id)]
(embed-page paste host scheme)))
(GET "/:id.js" {{:keys [id linenumbers]} :params
{host "host"} :headers
scheme :scheme}
(embed-paste id host scheme linenumbers))
(GET "/:id" [id]
(show-paste-page id))
(GET "/:id/history/:version" [id version]
(show-version-page id (safe-parse-long version)))
(GET "/:id/history/:version/fullscreen" [id version]
(fullscreen-version id (safe-parse-long version)))
(GET "/:id/history/:version/raw" [id version]
(when-let [content (:raw-contents (paste/get-version
(paste/get-paste id)
(safe-parse-long version)))]
(content-type "text/plain; charset=utf-8" content)))
(GET "/:id/history/:version/fork" [id version]
(fork-paste-page id (safe-parse-long version)))
(POST "/:id/edit" {:keys [params]}
(edit-paste params))
(POST "/create" {:keys [params remote-addr headers]}
(create-paste params (or (get headers "x-forwarded-for") remote-addr)))
; Redirect legacy /paste/ prefixed URLs
(GET ["/paste/:uri", :uri #".*"] {{:keys [uri]} :params
query-string :query-string}
(redirect (apply str "/" uri (when query-string ["?" query-string]))))
(GET "/paste" {:keys [query-string]}
(redirect (if query-string (str "/?" query-string) "/"))))
You can’t perform that action at this time.