dependencies
| (this space intentionally left almost blank) | ||||||||||||||||||||||||||||||||||||||||||||||||
(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*))) | |||||||||||||||||||||||||||||||||||||||||||||||||
(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))) | |||||||||||||||||||||||||||||||||||||||||||||||||
(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!)) | |||||||||||||||||||||||||||||||||||||||||||||||||
(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) ) ) | |||||||||||||||||||||||||||||||||||||||||||||||||
(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)) | |||||||||||||||||||||||||||||||||||||||||||||||||
(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\");"]]])) | |||||||||||||||||||||||||||||||||||||||||||||||||
(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)) | ||||||||||||||||||||||||||||||||||||||||||||||||
(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*))) | ||||||||||||||||||||||||||||||||||||||||||||||||
(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!) | |||||||||||||||||||||||||||||||||||||||||||||||||
(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"}]})) | |||||||||||||||||||||||||||||||||||||||||||||||||
(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}) | |||||||||||||||||||||||||||||||||||||||||||||||||