dependencies

org.clojure/clojure		1.6.0
org.clojure/clojurescript		0.0-2322
org.clojure/core.async		0.1.338.0-5c5012-alpha
environ		1.0.0
ring/ring-core		1.3.1
ring/ring-defaults		0.1.1
javax.servlet/servlet-api		2.5
http-kit		2.1.18
com.taoensso/sente		1.1.0
org.clojure/java.jdbc		0.3.5
postgresql/postgresql		8.4-702.jdbc4
compojure		1.1.9
om		0.7.3
secretary		1.2.1
sablono		0.2.22
geo-clj		0.3.15

(this space intentionally left almost blank)

pi.handlers.chsk

toc

(ns pi.handlers.chsk
  (:require [taoensso.sente     :as s]
            [clojure.core.async :refer [<! <!! chan go go-loop thread]]))

(defn- now [] (quot (System/currentTimeMillis) 1000))

(let [max-id (atom 0)]
  (defn next-id []
    (swap! max-id inc)))

(defonce all-msgs (ref [{:id (next-id)
                         :time (now)
                         :msg "woah! I can talk!"
                         :author "dr. seuss"
                         :location {:latitude 90 :longitude 0}}]))

(let [{:keys [ch-recv
              send-fn
              ajax-post-fn
              ajax-get-or-ws-handshake-fn
              connected-uids]}
      (s/make-channel-socket! {})]
  (def ring-ajax-post   ajax-post-fn)
  (def ring-ajax-get-ws ajax-get-or-ws-handshake-fn)
  (def ch-chsk          ch-recv)
  (def chsk-send!       send-fn)
  (def connected-uids   connected-uids))

(defmulti event-msg-handler :id)
(defn     event-msg-handler* [{:as ev-msg :keys [id ?data event]}]
  (println "Event:" event)
  (event-msg-handler ev-msg))

(defmethod event-msg-handler :default
  [{:as ev-msg :keys [event id ?data ring-req ?reply-fn send-fn]}]
  (let [session (:session ring-req)
        uid     (:uid     session)]
    (println "Unhandled event:" event)
    (when-not (:dummy-reply-fn (meta ?reply-fn))
      (?reply-fn {:umatched-event-as-echoed-from-from-server event}))))

(defmethod event-msg-handler :chsk/uidport-open [ev-msg] nil)
(defmethod event-msg-handler :chsk/uidport-close [ev-msg] nil)
(defmethod event-msg-handler :chsk/ws-ping [ev-msg] nil)

(defn in-radius? [user loc msg]
  (println loc msg)
  true)

TODO not sure if this is working right

(defmethod event-msg-handler :init/messages
  [{:as ev-msg :keys [event id ?data ring-req ?reply-fn send-fn]}]
  (if-let [uid (-> ring-req :session :uid)]
    (let [{:keys [username location]} (last event)
          msgs (filter #(in-radius? username location %) @all-msgs)]
      (map #(chsk-send! uid %) msgs))
    (println "what, why?")))

(defmethod event-msg-handler :submit/post
  [{:as ev-msg :keys [event id ?data ring-req ?reply-fn send-fn]}]
  (let [{:keys [msg author location] :as post} (last event)]
    (when msg
      (let [data (merge post {:time (now) :id (next-id)})]
        (dosync
         (ref-set all-msgs (conj @all-msgs data)))
        (doseq [uid (:any @connected-uids)]
          (chsk-send! uid [:new/post data]))))))

(defonce    router_ (atom nil))
(defn  stop-router! [] (when-let [stop-f @router_] (stop-f)))
(defn start-router! []
  (stop-router!)
  (reset! router_ (s/start-chsk-router! ch-chsk event-msg-handler*)))

pi.handlers.http

toc

(ns pi.handlers.http
  (:require [org.httpkit.server           :as kit]
            [ring.middleware.defaults]
            [ring.middleware.anti-forgery :as ring-anti-forgery]
            [environ.core                 :refer [env]]
            (compojure [core              :refer [defroutes GET POST]]
                       [route             :as route])
            [pi.views.layout              :as layout]
            [pi.handlers.chsk :refer [ring-ajax-get-ws ring-ajax-post]]
            [hiccup.core                  :refer :all]))

(defn login! [ring-request]
  (let [{:keys [session params]} ring-request
        {:keys [user-id]} params]
    {:status 200 :session (assoc session :uid user-id)}))

(defn landing-page [req]
  (layout/common
    [:p "Hello world!"]))

(defroutes routes
  (GET  "/"        req (layout/app))
  (GET  "/ext"     req (landing-page req))
  (POST "/login"   req (login! req))
  ;; These two connect the http and chsk servers.
  (GET  "/chsk"    req (#'ring-ajax-get-ws req))
  (POST "/chsk"    req (#'ring-ajax-post req))
  (route/files  {:root "resources/public"})
  (route/not-found "<p>Page not found.</p>"))

(def my-ring-handler
  (let [ring-defaults-config
        (assoc-in ring.middleware.defaults/site-defaults
          [:security :anti-forgery]
          {:read-token (fn [req] (-> req :params :csrf-token))})]
   (ring.middleware.defaults/wrap-defaults routes
                                           ring-defaults-config)))

(defonce server_ (atom nil))
(defn stop-server! []
  (when-let [stop-f @server_]
    (stop-f :timeout 100)))

(defn start-server! []
  (stop-server!)
  (let [port (read-string (or (env :port) "9899"))
        s    (kit/run-server (var my-ring-handler) {:port port})]
    (reset! server_ s)
    (println "Http-kit server is running on port" port)))

pi.main

toc

(ns pi.main
  (:gen-class)
  (:require [pi.handlers.http :as http]
            [pi.handlers.chsk :as chsk]))

(defn start! []
  (chsk/start-router!)
  (http/start-server!))

(defn -main [& args]

(start!))

pi.models.db

toc

(ns pi.models.db
  (:require [environ.core :refer [env]]
            [clojure.java.jdbc :as sql]))

(def db (or (env :database-url)

"postgresql://localhost:5432/pi"))

(sql/with-db-connection [con db]
  (println (sql/query con
                      "select nspname from pg_catalog.pg_namespace;")))

(defn init [] (sql/db-do-commands db (sql/create-table-ddl :users) ) )

pi.routes.landing

toc

(ns pi.routes.landing
  (:require [pi.views.layout :as layout]
            [hiccup.core]))

(defn landing-page [req]
  (layout/common
    (println req)))

(defn app-page [req]

(layout/common))

pi.views.layout

toc

(ns pi.views.layout

(:require [hiccup.page :refer [html5 include-css include-js]]))

(defn- head []
  [:head
   [:meta {:charset "utf-8"
           :http-equiv "X-UA-Compatible"
           :content "width=device-width, initial-scale=1
                    maximum-scale=1, use-scalable=no"}]
   [:title "pi"]
   [:link {:rel "icon"
           :type "image/png"
           :href="/favicon.png"}]
   (include-css "/css/main.css"
                "//maxcdn.bootstrapcdn.com/bootstrap/3.2.0/css/bootstrap.min.css")])

(defn common [& body]
  (html5
    (head)
    [:body body]))

(defn app []
  (html5
    (head)
    [:body
     [:div#app-container
      (include-js "http://fb.me/react-0.11.1.js"
                  "js/out/goog/base.js"
                  "js/main.js")
      [:script {:type "text/javascript"} "goog.require(\"pi.main\");"]]]))

pi.components.core

toc

(ns pi.components.core
  (:require-macros
            [cljs.core.async.macros :as asyncm :refer [go go-loop]])
  (:require [pi.models.state :refer [app-state]]
            [pi.handlers.chsk :refer [chsk chsk-send! chsk-state]]
            [pi.util :as util]
            ;;don't like sente here. result of using ajax with callback :(
            [taoensso.sente :as s]
            [secretary.core :as secretary]
            [om.core         :as om
                             :include-macros true]
            [om.dom          :as dom
                             :include-macros true]
            [cljs.core.async :as async :refer [put! chan <! >!
                                     sliding-buffer]]))

(defn login [app owner]
  (let [username (-> (om/get-node owner "login-username") .-value)]
    (s/ajax-call "/login"
      {:method :post
       :params {:user-id username
                :csrf-token (:csrf-token @chsk-state)}}
      ;; handle response callback
      (fn [{:keys [?status] :as ajax-resp}]
        (if (= ?status 200)
          (do
            (om/transact! app :username (fn [_] username))
            (s/chsk-reconnect! chsk)
            (secretary/dispatch! "/app")
            ;; TODO doesn't work very well)
          (println "failed to login:" ajax-resp))))))

(defn handle-change [e owner {:keys [post]}]

(om/set-state! owner :post (.. e -target -value)))

(defn locateMe [locate]
  (if (.hasOwnProperty js/navigator "geolocation")
    (.getCurrentPosition js/navigator.geolocation
                         #(put! locate (util/parse-location %)))))

(defn submit-post [app owner]
  (let [msg (-> (om/get-node owner "new-post") .-value)
        author (:username @app)
        loc (:location @app)
        post {:msg msg :author author :location loc}]
    (when post
      ;; not adding to state b/c must first get ID from server
      ;; might be worth doing something different to make it feel
      ;; more responsive
      (chsk-send! [:submit/post post])
      (om/set-state! owner :post ))))

(defn landing-view [app owner]
  (reify
    om/IRenderState
    (render-state [this state]
      (dom/div nil
        (dom/h1 nil "Landing page"))
      (dom/div #js {:className "form-horizontal"
                     :role "form"}
        (dom/div #js {:className "form-group"}
          (dom/label #js {:htmlFor "inputEmail3"
                          :className "col-sm-2 control-label"}
                     "Username")
          (dom/div #js {:className "col-sm-10"}
            (dom/input #js {:type "text"
                            :ref "login-username"
                            :className "form-control"
                            :value (:username state)
                            :onKeyDown #(when (= (.-key %) "Enter")
                                          (login app owner))
                            :placeholder "Username"})))
        (dom/div #js {:className "form-group"}
          (dom/div #js {:className "col-sm-offset-2 col-sm-10"}
            (dom/button #js {:type "button"
                             :className "btn btn-primary"
                             :onTouch #(login app owner)
                             :onClick #(login app owner)}
                        "Submit")))))))

(defn message-view [message owner]
  (reify
    om/IRenderState
    (render-state [this _]
      (dom/div #js {:className "row message"}
        (dom/div #js {:className "row"}
          (dom/div #js {:className "col-md-4"} (:msg message)))
        (dom/div #js {:className "row"}
          (dom/div #js {:className "col-md-2"} (:author message))
          (dom/div #js {:className "col-md-2 col-md-offset-8"}
                   (:distance message)))))))

(defn messages-view [app owner]
  (reify
    om/IInitState
    (init-state [_]
      {:post
       :locate (chan (sliding-buffer 3))})
    om/IWillMount
    (will-mount [_]
      (let [locate (om/get-state owner :locate)]
        (go (loop []
              (let [location (<! locate)]
                (om/transact! app :location #(merge % location))
                (when (and (not (:initialized @app))
                           (:username @app))
                  (chsk-send! [:init/messages
                               {:username (:username @app)
                                :location (:location @app)}])
                  (om/transact! app :initialized (fn [_] true)))
              (recur)))))
      (let [locate (om/get-state owner :locate)]
        (locateMe locate) ;; init
        ;; refresh every minute
        (js/setInterval #(locateMe locate) 60000)))
    om/IRenderState
    (render-state [this state]
      (dom/div #js {:className "container"}
        (dom/h2 nil (util/display-location (:location app)))
        (dom/div nil
          (dom/textarea #js {:ref "new-post"
                             :className "form-control"
                             :placeholder "What's happening?"
                             :rows "3"
                             :value (:post state)
                             :onChange #(handle-change % owner state)})
          (dom/div #js {:className "row"}
            (dom/div #js {:className "col-md-2"} (:username app))
            (dom/div #js {:className "col-md-2 col-md-offset-8"}
              (dom/button #js {:type "button"
                               :className "btn btn-primary"
                               :onTouch #(submit-post app owner)
                               :onClick #(submit-post app owner)}
                          "Submit"))))
        (apply dom/div #js {:className "message-list"}
               (om/build-all message-view  (:messages app)
                             {:init-state state}))))))

(comment
(defn local-view [app owner]
  (reify
    omIRenderState
    (render-state [this state]
      (dom/div nil
        (om/build header-view app {:init-state state})
        (om/build messages-view app {:init-state state})
        (om/build footer-view app {:init-state state}))))))

TODO should these be in the routes namespace?

(def app-container (. js/document (getElementById "app-container")))

(defn render-page [component state target]

(om/root component state {:target target}))

Do these have to be separate functions? Useful if I switch up app-state, but idk if that's necessary.

(defn page [component]

(render-page component app-state app-container))

pi.handlers.chsk

toc

(ns pi.handlers.chsk
  (:require [pi.models.state :refer [app-state]]
            [pi.util :as util]
            [taoensso.sente  :as s]))

setup web socket handlers

(let [{:keys [chsk ch-recv send-fn state]}
      (s/make-channel-socket! "/chsk" {:type :auto})]
  (def chsk       chsk)
  (def ch-chsk    ch-recv)
  (def chsk-send! send-fn)
  (def chsk-state state))

(defmulti event-msg-handler
  (fn [{:as ev-msg :keys [?data]}]
    (first ?data)))

wrapper for logging and such

(defn event-msg-handler* [{:as ev-msg :keys [id ?data event]}]
  (println "Event:" event)
  (event-msg-handler ev-msg))

(defmethod event-msg-handler :default
  [{:as ev-msg :keys [event ?data]}]
  nil)

TODO refactor to take list of posts

(defmethod event-msg-handler :new/post
  [{:as ev-msg :keys [event ?data]}]
  (let [d (last ?data)
        post (assoc d :distance (util/distance (:location d)
                                             (:location @app-state)))]
    ;(println post)
    (if (> (:id post) (:max-id @app-state))
      (swap! app-state assoc :messages
             (conj (:messages @app-state) post)))))

INIT

(def        router_ (atom nil))
(defn  stop-router! [] (when-let [stop-f @router_] (stop-f)))
(defn start-router! []
  (stop-router!)
  (reset! router_ (s/start-chsk-router! ch-chsk event-msg-handler*)))

pi.main

toc

(ns pi.main
  (:require [pi.components.core :refer [page landing-view messages-view]]
            [pi.handlers.chsk :refer [start-router!]]
            [secretary.core  :as secretary
                             :include-macros true
                             :refer [defroute]]
            [goog.events     :as events]
            [goog.history.EventType :as EventType])
  (:import goog.History))

(enable-console-print!)

(secretary/set-config! :prefix "#")

Routing

/#/

(defroute "/" [] (page landing-view))

/#/app

(defroute "/app" [] (page messages-view))

(let [h (History.)]
    (goog.events/listen h EventType/NAVIGATE
                        #(secretary/dispatch! (.-token %)))
    (doto h (.setEnabled true)))

(defn start! []

(start-router!))

(start!)

pi.models.state

toc

(ns pi.models.state)

(def app-state (atom {:max-id 0
                      :initialized false
                      :location {:latitude 90
                                 :longitude 0}
                      :post
                      :username
                      :messages [{:msg  "I can talk!"
                                  :author "Duudilus"
                                  :location {:latitude 90
                                             :longitude 0}
                                  :distance "0km"}]}))

pi.util

toc

(ns pi.util

(:require [geo.core :as geo]))

TODO I don't know if these numbers are correct. What's the 4326 all about? TODO make sure both locs come in as clojure maps (or parse em)

(defn distance
  [msg-loc my-loc]
 ;; TODO make sure coordinates are valid using geo helper fn
  ;{:pre [(and msg-log my-loc)]}
  (let [pt1 (geo/point 4326 (:latitude my-loc) (:longitude my-loc))
        pt2 (geo/point 4326 (:latitude msg-loc) (:longitude msg-loc))
        dist (geo/distance-to pt1 pt2)]
    (str dist "km")))

(defn display-location [{:keys [latitude longitude]}]

(str "lat: " latitude ", long: " longitude))

(defn parse-location [x]
  {:latitude js/x.coords.latitude
   :longitude js/x.coords.longitude})

pi

0.1.0-SNAPSHOT

dependencies

namespaces

pi.handlers.chsk

pi.handlers.http

pi.main

pi.models.db

pi.routes.landing

pi.views.layout

pi.components.core

pi.handlers.chsk

pi.main

pi.models.state

pi.util