Routing with compojure

handler.clj

(defroutes app-routes
  (GET "/" [] (render-page :status-page))
  (GET "/pages/:page"  [page] (render-page (keyword page)))
  (context "/create" []
           (POST "/metric" {params :params} (new-metric params))
           (POST "/server" {params :params} (new-server params)))
  (context "/response" [] 
           (GET "/up/:id" [id] (views/up-file id))
           (GET "/down/:id" [id] (views/down-file id)))
  (route/resources "/")
  (route/not-found "Not Found"))

views.clj

(ns qos-bot.views
  (:use [hiccup core page form element]
        [qos-bot.database :as db]
        [qos-bot.config :as config]
        [clojure.contrib.duck-streams :only [slurp* file-str] :as ds]))

(defn render-metric [metric-data]
  (html 
   [:tr {:class "success"}
    (form-to [:get (str "/delete/metric/" (metric-data :id)) ]
             [:td (:name metric-data)]
             [:td (link-to (str "/response/up/" (metric-data :id)) "View file")]
             [:td (link-to (str "/response/down/" (metric-data :id)) "View file")]
             [:td (submit-button "Delete")])]))       

(defn render-server [server-data]
  (let [row-class (if (= 1 (server-data :state))
                    "success"
                    "warning")
        metric (db/metric-name (server-data :metric))
        state-str (if (= 1 (server-data :state))
                    "Up"
                    "Down")]
    (html
     [:tr {:class row-class}
      (form-to [:get (str "/delete/server" (server-data :id))]
               [:td (server-data :name)]
               [:td metric]
               [:td state-str]          ; Later we'll setup some pretty bootstrap for this.
               [:td (submit-button "Delete")])])))

(defn status-page []
  (html [:p "Status page"]))

(defn metrics-page []
  (html [:h2 "Defined metrics"]
        [:table {:class "table"}
         [:thead 
          [:th "Metric name"]
          [:th "Up response"]
          [:th "Down response"]
          [:th ""]]
         [:tbody
          [:tr {:class "info"}
           (form-to {:enctype "multipart/form-data"} 
                    [:post "/create/metric"] 
                    [:td  (text-field "name")]
                    [:td (file-upload "up-response")]
                    [:td (file-upload "down-response")]
                    [:td (submit-button "Add metric")])]
          (map render-metric (db/metrics))]]))

(defn servers-page []
  (html [:h2 "Defined servers"]
        [:table {:class "table"}
         [:thead
          [:th "Server name"]
          [:th "Metric"]
          [:th "Current state"]]
         [:tbody
          [:tr {:class "info"}
           (form-to [:post "/create/server"]
                    [:td (text-field "name")]
                    [:td (drop-down "metric" (into [] (map #(% :name) (db/metrics))))]
                    [:td]
                    [:td (submit-button "Add server")])]
          (map render-server (db/servers))
          ]]))


(def pages {:status (status-page) :metrics (metrics-page) :servers (servers-page)})

(defn render-nav [active-elem]
  (let [elems (map (fn [s]  (subs (str s) 1)) (keys pages))]
    (html 
     [:ul {:class "nav nav-pills"}
      (map (fn [elem] [:li (if (= 0 (compare active-elem elem))
                             {:class "active"}
                             nil)
                       (link-to (str "/pages/" elem) elem)])
           elems)
      ])))

(defn render-header []
  (html
   [:head
    [:title "QoS bot monitor"]
    (include-css "/bootstrap/css/bootstrap.css")
    (include-js "/bootstrap/js/bootstrap.js")
    (include-js "/jquery-latest.js")]))

(defn render-body [body]
  (html
   [:body 
    [:div {:class "container"} 
     (render-nav (subs (str body) 1))
     (body pages)]]))

(defn render-page [page]
  (do
    (str (render-header)
         (render-body page))))

   

(defn index-page []
  (str (render-header)
        (render-body (status-page))))

(defn get-response [id file]
  (html
   [:p [:h2 "Response code for metric " (db/metric-name id)]]
   [:p (ds/slurp* (ds/file-str config/srv-root "resources/responses/" id "/" file))]))

(defn up-file [id]
  (get-response id "up"))

(defn down-file [id]
  (get-response id "down"))