(ns uruk.core-test
  (:require [clojure.test :refer :all]
            [uruk.core :refer :all])
  (:import [java.util.logging Logger]
           [com.marklogic.xcc RequestOptions]))

;; FIXME You'll have to fill in database credentials that work for
;; your system:
(def db {:uri "xdbc://localhost:8383/"
         :user "rest-admin" :password "x"
         :content-base "TutorialDB"})

(deftest session-parms-1
  (testing "Create session with just URI"
    (is (= "Hello world"
           (let [session (create-session db)]
             (-> session
                 (.submitRequest (.newAdhocQuery session
                                                 "\"Hello world\""))
                 .asString))))))

(deftest session-parms-2
  (testing "Create session with URI and content-base"
    (is (= "Hello world"
           (let [session (create-session db)]
             (-> session
                 (.submitRequest (.newAdhocQuery session
                                                 "\"Hello world\""))
                 .asString))))))

(deftest session-parms-3
  (testing "Create session with URI, username, password"
    (is (= "Hello world"
           (let [session (create-session db)]
             (-> session
                 (.submitRequest (.newAdhocQuery session
                                                 "\"Hello world\""))
                 .asString))))))

(deftest session-parms-4
  (testing "Create session with all non-options parameters"
    (is (= "Hello world"
           (let [session (create-session db)]
             (-> session
                 (.submitRequest (.newAdhocQuery session
                                                 "\"Hello world\""))
                 .asString))))))

;;;; Request options

;; TODO check that (request-options {:cache-result nil}) doesn't silently get ignored just because the answer might be false!

;; (deftest default-request-options
;;   (testing "A Request with no explicitly-set options must have default options"
;;     (let [req-opts (request-options {})]
;;       (describe-request-options req-opts))))

(deftest sample-request-options
  (testing "Set sample option on request"
    (is (= 6000
           (.getTimeoutMillis (request-options {:timeout-millis 6000}))))))

(deftest accept-only-valid-request-options
  (testing "Options that don't exist must raise an error"
    (is (thrown? java.lang.IllegalArgumentException
                 (with-open [sess (create-session db)]
                   (execute-xquery sess "\"hello world\"" {:options {:reuqest-time-limt 500}}))))))

;; TODO a full end-to-end test of all request options

;;;; Session options
(deftest default-session-options
  (testing "A session with no explicitly-set options must have default options"
    (let [sess-opts (session-options (create-session db))]
      (and (is (instance? RequestOptions (:default-request-options sess-opts)))
           (is (instance? RequestOptions (:effective-request-options sess-opts)))
           (is (instance? Logger (:logger sess-opts)))
           (is (nil? (:user-object sess-opts)))
           (is (= 0 (:transaction-timeout sess-opts)))
           (is (nil? (:transaction-mode sess-opts)))))))

(deftest set-session-options
  (testing "A session with explicitly-set options must reflect those options"
    (let [sess-opts (session-options
                     (create-session db
                                     {:default-request-options {:timeout-millis 75}
                                      ;; TODO test user-object
                                      ;; TODO test Logger more deeply
                                      ;; TODO test default Req Opts more?
                                      ;; TODO test effective Req Opts more?
                                      :transaction-timeout 56
                                      :transaction-mode :query}))]
      (and (is (= 75
                  (.getTimeoutMillis (:default-request-options sess-opts))
                  (.getTimeoutMillis (:effective-request-options sess-opts))))
           (is (instance? Logger (:logger sess-opts)))
           (is (empty? (:user-object sess-opts)))
           (is (= 56 (:transaction-timeout sess-opts)))
           (is (= :query (:transaction-mode sess-opts)))))))

;; TODO accept-only-valid-session-options

;;;; Content creation options

;; TODO content creation options default

(deftest content-options-roundtrip
  (testing "Round-trip options through creation and description"
    (is (let [opts {:buffer-size 400
                    :collections ["my-collection" "another-collection"]
                    :encoding "ASCII"
                    :format :text
                    :graph "my-graph"
                    :language "fr"
                    ;; :locale
                    :namespace "my-ns"
                    :permissions [{"such-and-such-role" :insert}
                                  {"such-and-such-role" :update}]
                    ;; :placement-keys
                    :quality 20
                    :repair-level :full
                    :resolve-buffer-size 20
                    :resolve-entities true
                    :temporal-collection "my-temp"}]
          (= opts
             (describe-content-creation-options (content-creation-options opts)))))))

;; TODO accept-only-valid-content-options

;;;; Variables

(deftest non-string-variables
  (testing "Non-string variables passed to request object are not converted to strings"
    (is (instance? com.marklogic.xcc.types.impl.DocumentImpl
                   (-> (with-open [session (create-session db)]
                         (.getVariables (#'uruk.core/request-obj (.newAdhocQuery session "hello world")
                                                                 nil {:derp {:value "<foo/>"
                                                                             :type :document}})))
                       first
                       .getValue)))))

(deftest as-is-boolean-variable
  (testing "Clojure booleans automatically convert to correct XdmVariable type"
    (is (false? (with-open [session (create-session db)]
                  (execute-xquery session "xquery version \"1.0-ml\";
                                declare variable $my-variable as boolean-node() external;
                                $my-variable"
                                  {:variables {"my-variable" {:value false
                                                              :type :boolean-node}}
                                   :shape :single!}))))))

;; TODO more variable testing

;;;; TODO Type conversion

;;;; Invalid query

(deftest error-on-invalid-query
  (testing "An error must be thrown if MarkLogic is passed an invalid query."
    (is (thrown? java.lang.Exception
                 ;; FIXME I'd love to get the original error type
                 ;; here, e.g. XqueryException
                 (with-open [sess (create-session db)]
                   (execute-xquery sess "let $uri := xdmp:get-request-field(\"uri\")returnif"))))))

;;;; TODO Shape

;;;; TODO Transactions

;;;; TODO element insertion

(ns uruk.core-test
  (:require [clojure.test :refer :all]
            [uruk.core :refer :all])
  (:import [java.util.logging Logger]
           [java.util Locale]
           [com.marklogic.xcc RequestOptions]))

;; FIXME You'll have to fill in database credentials that work for
;; your system:
(def db {:uri "xdbc://localhost:8383/"
         :user "rest-admin" :password "x"
         :content-base "TutorialDB"})

(deftest session-parms-1
  (testing "Create session with just URI"
    (is (= "Hello world"
           (let [session (create-session db)]
             (-> session
                 (.submitRequest (.newAdhocQuery session
                                                 "\"Hello world\""))
                 .asString))))))

(deftest session-parms-2
  (testing "Create session with URI and content-base"
    (is (= "Hello world"
           (let [session (create-session db)]
             (-> session
                 (.submitRequest (.newAdhocQuery session
                                                 "\"Hello world\""))
                 .asString))))))

(deftest session-parms-3
  (testing "Create session with URI, username, password"
    (is (= "Hello world"
           (let [session (create-session db)]
             (-> session
                 (.submitRequest (.newAdhocQuery session
                                                 "\"Hello world\""))
                 .asString))))))

(deftest session-parms-4
  (testing "Create session with all non-options parameters"
    (is (= "Hello world"
           (let [session (create-session db)]
             (-> session
                 (.submitRequest (.newAdhocQuery session
                                                 "\"Hello world\""))
                 .asString))))))

;;;; Request options

;; TODO check that (request-options {:cache-result nil}) doesn't silently get ignored just because the answer might be false!

;; (deftest default-request-options
;;   (testing "A Request with no explicitly-set options must have default options"
;;     (let [req-opts (request-options {})]
;;       (describe-request-options req-opts))))

(deftest sample-request-options
  (testing "Set sample option on request"
    (is (= 6000
           (.getTimeoutMillis (request-options {:timeout-millis 6000}))))))

(deftest accept-only-valid-request-options
  (testing "Options that don't exist must raise an error"
    (is (thrown? java.lang.IllegalArgumentException
                 (with-open [sess (create-session db)]
                   (execute-xquery sess "\"hello world\"" {:options {:reuqest-time-limt 500}}))))))

;; TODO a full end-to-end test of all request options

;;;; Session options
(deftest default-session-options
  (testing "A session with no explicitly-set options must have default options"
    (let [sess-opts (session-options (create-session db))]
      (and (is (instance? RequestOptions (:default-request-options sess-opts)))
           (is (instance? RequestOptions (:effective-request-options sess-opts)))
           (is (instance? Logger (:logger sess-opts)))
           (is (nil? (:user-object sess-opts)))
           (is (= 0 (:transaction-timeout sess-opts)))
           (is (nil? (:transaction-mode sess-opts)))))))

(deftest set-session-options
  (testing "A session with explicitly-set options must reflect those options"
    (let [sess-opts (session-options
                     (create-session db
                                     {:default-request-options {:timeout-millis 75}
                                      ;; TODO test user-object
                                      ;; TODO test Logger more deeply
                                      ;; TODO test default Req Opts more?
                                      ;; TODO test effective Req Opts more?
                                      :transaction-timeout 56
                                      :transaction-mode :query}))]
      (and (is (= 75
                  (.getTimeoutMillis (:default-request-options sess-opts))
                  (.getTimeoutMillis (:effective-request-options sess-opts))))
           (is (instance? Logger (:logger sess-opts)))
           (is (empty? (:user-object sess-opts)))
           (is (= 56 (:transaction-timeout sess-opts)))
           (is (= :query (:transaction-mode sess-opts)))))))

;; TODO accept-only-valid-session-options

;;;; Content creation options

;; TODO content creation options default

(deftest content-options-roundtrip
  (testing "Round-trip options through creation and description"
    (is (let [opts {:buffer-size 400
                    :collections ["my-collection" "another-collection"]
                    :encoding "ASCII"
                    :format :text
                    :graph "my-graph"
                    :language "fr"
                    :locale (Locale. "ru")
                    :namespace "my-ns"
                    :permissions [{"such-and-such-role" :insert}
                                  {"such-and-such-role" :update}]
                    ;; :placement-keys
                    :quality 20
                    :repair-level :full
                    :resolve-buffer-size 20
                    :resolve-entities true
                    :temporal-collection "my-temp"}]
          (= opts
             (describe-content-creation-options (content-creation-options opts)))))))

;; TODO accept-only-valid-content-options

;;;; Variables

(deftest non-string-variables
  (testing "Non-string variables passed to request object are not converted to strings"
    (is (instance? com.marklogic.xcc.types.impl.DocumentImpl
                   (-> (with-open [session (create-session db)]
                         (.getVariables (#'uruk.core/request-obj (.newAdhocQuery session "hello world")
                                                                 nil {:derp {:value "<foo/>"
                                                                             :type :document}})))
                       first
                       .getValue)))))

(deftest as-is-boolean-variable
  (testing "Clojure booleans automatically convert to correct XdmVariable type"
    (is (false? (with-open [session (create-session db)]
                  (execute-xquery session "xquery version \"1.0-ml\";
                                declare variable $my-variable as boolean-node() external;
                                $my-variable"
                                  {:variables {"my-variable" {:value false
                                                              :type :boolean-node}}
                                   :shape :single!}))))))

;; TODO more variable testing

;;;; TODO Type conversion

;;;; Invalid query

(deftest error-on-invalid-query
  (testing "An error must be thrown if MarkLogic is passed an invalid query."
    (is (thrown? java.lang.Exception
                 ;; FIXME I'd love to get the original error type
                 ;; here, e.g. XqueryException
                 (with-open [sess (create-session db)]
                   (execute-xquery sess "let $uri := xdmp:get-request-field(\"uri\")returnif"))))))

;;;; TODO Shape

;;;; TODO Transactions

;;;; TODO element insertion

Fix failed test: add locale to content options


(ns hu.ssh.github-changelog.formatters.markdown
  (:require
    [hu.ssh.github-changelog.util :refer [str-map]]
    [hu.ssh.github-changelog.schema :refer [Tag Change ChangeType]]
    [hu.ssh.github-changelog.markdown :as markdown]
    [schema.core :as s]))

(def type-name-map
  {:fix "Bug Fixes"
   :chore "Chores"
   :feat "Features"})

(s/defn translate-type :- s/Str
  [type :- s/Str]
  (get type-name-map (keyword type) type))

(s/defn format-change :- s/Str
  [change :- Change]
  (str (markdown/emphasis (:scope change))
       " "
       (:subject change)
       (let [issues (:issues change)]
         (if (not (empty? issues))
           (str ", closes " (str-map (partial apply markdown/link) issues)))))

(s/defn format-changes :- s/Str
  [[type changes :- [Change]]]
  (str (markdown/h4 (translate-type type))
       (markdown/ul (map format-change changes))))

(s/defn format-tag :- s/Str
  [tag :- Tag]
  (str (markdown/h3 (:name tag))
       (str-map format-changes (group-by :type (:changes tag)))))

(s/defn format-tags :- s/Str
  "Generates a markdown version from the changes"
  [tags :- [Tag]]
  (str-map format-tag tags))

(ns hu.ssh.github-changelog.formatters.markdown
  (:require
    [hu.ssh.github-changelog.util :refer [str-map]]
    [hu.ssh.github-changelog.schema :refer [Tag Change ChangeType]]
    [hu.ssh.github-changelog.markdown :as markdown]
    [schema.core :as s]))

(def type-name-map
  {:fix "Bug Fixes"
   :chore "Chores"
   :feat "Features"})

(s/defn translate-type :- s/Str
  [type :- s/Str]
  (get type-name-map (keyword type) type))

(s/defn format-change :- s/Str
  [change :- Change]
  (str (markdown/emphasis (:scope change))
       " "
       (:subject change)
       (let [issues (:issues change)]
         (if (not (empty? issues))
           (str ", closes " (str-map (partial apply markdown/link) issues))))
       (let [pr (:pull-request change)]
         (str " " (markdown/link (str "#" (:number pr)) (:html_url pr))))))

(s/defn format-changes :- s/Str
  [[type changes :- [Change]]]
  (str (markdown/h4 (translate-type type))
       (markdown/ul (map format-change changes))))

(s/defn format-tag :- s/Str
  [tag :- Tag]
  (str (markdown/h3 (:name tag))
       (str-map format-changes (group-by :type (:changes tag)))))

(s/defn format-tags :- s/Str
  "Generates a markdown version from the changes"
  [tags :- [Tag]]
  (str-map format-tag tags))

add link to PR

add link to PR


(ns wombats-web-client.components.countdown-timer
  (:require [cljs-time.core :as t]
            [cljs-time.format :as f]
            [reagent.core :as reagent]))

(defn- seconds-until
  [time]
  (t/in-seconds (t/interval (t/now) time)))

(defn- format-time
  [time]
  (let [total-seconds (seconds-until time)
        seconds (mod total-seconds 60)
        minutes (/ (- total-seconds seconds) 60)
        seconds-display (if (< seconds 10) (str "0" seconds) seconds)]
    (str minutes ":" seconds-display)))

(defn countdown-timer
  [start-time]

  (let [cmpnt-state (reagent/atom {:interval-fn nil})]
    (reagent/create-class
     {:component-will-mount
      (fn []
        ;; Force timer to redraw every second
        (swap! cmpnt-state
               assoc
               :interval-fn
               (.setInterval js/window
                             #(reagent/force-update-all)
                             1000)))

      :component-will-unmount
      (fn []
        (.clearInterval js/window
                        (:interval-fn @cmpnt-state)))

      :reagent-render
      (fn []
        [:span {:class-name "countdown-timer"}
         (format-time start-time)])})))

(ns wombats-web-client.components.countdown-timer
  (:require [cljs-time.core :as t]
            [cljs-time.format :as f]
            [reagent.core :as reagent]))

(defn- seconds-until
  [time]
  (t/in-seconds (t/interval (t/now) time)))

(defn- format-time
  [time]
  (let [total-seconds (seconds-until time)
        seconds (mod total-seconds 60)
        minutes (/ (- total-seconds seconds) 60)
        seconds-formatted (if (< seconds 10) (str "0" seconds) seconds)]
    (if (< seconds 0)
      "0:00"
      (str minutes ":" seconds-formatted))))

(defn countdown-timer
  [start-time]

  (let [cmpnt-state (reagent/atom {:interval-fn nil})]
    (reagent/create-class
     {:component-will-mount
      (fn []
        ;; Force timer to redraw every second
        (swap! cmpnt-state
               assoc
               :interval-fn
               (.setInterval js/window
                             #(reagent/force-update-all)
                             1000)))

      :component-will-unmount
      (fn []
        (.clearInterval js/window
                        (:interval-fn @cmpnt-state)))

      :reagent-render
      (fn []
        [:span {:class-name "countdown-timer"}
         (format-time start-time)])})))

Handle less than 0 seconds.

Handle less than 0 seconds.


(ns leiningen.new
  "Create a new project skeleton.
lein new [group-id/]artifact-id [project-dir]
Group-id is optional. Project-dir defaults to artifact-id if not given.
Neither group-id nor artifact-id may contain slashes."
  (:use [leiningen.core :only [ns->path]]
        [clojure.java.io :only [file]]
        [clojure.contrib.string :only [join]]))

(defn new
  "Create a new project skeleton.
lein new [group-id/]artifact-id [project-dir]
Group-id is optional. Project-dir defaults to artifact-id if not given.
Neither group-id nor artifact-id may contain slashes."
  ([project-name project-dir]
     (when (re-find #"(?<!clo)jure" project-name)
       (throw (IllegalArgumentException. "*jure names are no longer allowed.")))
     (let [project-name (symbol project-name)
           group-id (namespace project-name)
           artifact-id (name project-name)]
       (.mkdirs (file project-dir))
       (spit (file project-dir "project.clj")
             (str "(defproject " project-name " \"1.0.0-SNAPSHOT\"\n"
                  "  :description \"FIXME: write\"\n"
                  "  :dependencies [[org.clojure/clojure \"1.2.0-beta1\"]\n"
                  "                 [org.clojure/clojure-contrib \"1.2.0-beta1\"]])"))
       (let [prefix (.replace (str project-name) "/" ".")
             project-ns (str prefix ".core")
             test-ns (str prefix ".test.core")
             project-clj (ns->path project-ns)
             test-clj (ns->path test-ns)]
         (.mkdirs (file project-dir "test"))
         (.mkdirs (.getParentFile (file project-dir "src" project-clj)))
         (spit (file project-dir "src" project-clj)
               (str "(ns " project-ns ")\n"))
         (.mkdirs (.getParentFile (file project-dir "test" test-clj)))
         (spit (file project-dir "test" test-clj)
               (str "(ns " (str test-ns)
                    "\n  (:use [" project-ns "] :reload-all)"
                    "\n  (:use [clojure.test]))\n\n"
                    "(deftest replace-me ;; FIXME: write\n  (is false "
                    "\"No tests have been written.\"))\n"))
         (spit (file project-dir ".gitignore")
               (join "\n" ["pom.xml" "*jar" "lib" "classes"]))
         (spit (file project-dir "README")
               (join "\n\n" [(str "# " artifact-id)
                                 "FIXME: write description"
                                 "## Usage" "FIXME: write"
                                 "## Installation" "FIXME: write"
                                 "## License" "Copyright (C) 2010 FIXME"
                                 (str "Distributed under the Eclipse Public"
                                      " License, the same as Clojure.\n")]))
         (println "Created new project in:" project-dir))))
  ([project-name] (leiningen.new/new project-name
                                     (name (symbol project-name)))))

(ns leiningen.new
  "Create a new project skeleton.
lein new [group-id/]artifact-id [project-dir]
Group-id is optional. Project-dir defaults to artifact-id if not given.
Neither group-id nor artifact-id may contain slashes."
  (:use [leiningen.core :only [ns->path]]
        [clojure.java.io :only [file]]
        [clojure.contrib.string :only [join]]))

(defn write-project [project-dir project-name]
  (.mkdirs (file project-dir))
  (spit (file project-dir "project.clj")
        (str "(defproject " project-name " \"1.0.0-SNAPSHOT\"\n"
             "  :description \"FIXME: write\"\n"
             "  :dependencies [[org.clojure/clojure \"1.2.0-beta1\"]\n  "
             "               [org.clojure/clojure-contrib \"1.2.0-beta1\"]])")))

(defn write-implementation [project-dir project-clj project-ns]
  (.mkdirs (.getParentFile (file project-dir "src" project-clj)))
  (spit (file project-dir "src" project-clj)
        (str "(ns " project-ns ")\n")))

(defn write-test [project-dir test-ns project-ns]
  (.mkdirs (.getParentFile (file project-dir "test" (ns->path test-ns))))
  (spit (file project-dir "test" (ns->path test-ns))
        (str "(ns " (str test-ns)
             "\n  (:use [" project-ns "] :reload-all)"
             "\n  (:use [clojure.test]))\n\n"
             "(deftest replace-me ;; FIXME: write\n  (is false "
             "\"No tests have been written.\"))\n")))

(defn write-readme [project-dir artifact-id]
  (spit (file project-dir "README")
        (join "\n\n" [(str "# " artifact-id)
                      "FIXME: write description"
                      "## Usage" "FIXME: write"
                      "## Installation" "FIXME: write"
                      "## License" "Copyright (C) 2010 FIXME"
                      (str "Distributed under the Eclipse Public"
                           " License, the same as Clojure.\n")])))

(defn new
  "Create a new project skeleton.
lein new [group-id/]artifact-id [project-dir]
Group-id is optional. Project-dir defaults to artifact-id if not given.
Neither group-id nor artifact-id may contain slashes."
  ([project-name project-dir]
     (when (re-find #"(?<!clo)jure" project-name)
       (throw (IllegalArgumentException. "*jure names are no longer allowed.")))
     (let [project-name (symbol project-name)
           group-id (namespace project-name)
           artifact-id (name project-name)]
       (write-project project-dir project-name)
       (let [prefix (.replace (str project-name) "/" ".")
             project-ns (str prefix ".core")
             test-ns (str prefix ".test.core")
             project-clj (ns->path project-ns)]
         (spit (file project-dir ".gitignore")
               (join "\n" ["pom.xml" "*jar" "lib" "classes"]))
         (write-implementation project-dir project-clj project-ns)
         (write-test project-dir test-ns project-ns)
         (write-readme project-dir artifact-id)
         (println "Created new project in:" project-dir))))
  ([project-name] (leiningen.new/new project-name
                                     (name (symbol project-name)))))

Refactor new task.

Refactor new task.


(ns clinicico.worker.consumer
  (:gen-class)
  (:require [taoensso.nippy :as nippy]
            [zeromq.zmq :as zmq]
            [clinicico.common.zeromq :as q]
            [clinicico.common.util :refer [insert]]
            [clojure.tools.logging :as log])
  (:import [org.zeromq ZLoop]))

(def ^:const heartbeat-interval 1000)
(def ^:const heartbeat-liveness 3)

(def ^:const interval-init 1000)
(def ^:const interval-max 32000)

(defprotocol Protocol
  (send! [this socket messages]))

(defrecord MessageProtocol [method]
  Protocol
  (send! [this socket messages]
    (apply (partial q/send-frame-delim socket) (insert messages 1 (.getBytes (get this :method))))))

(defn- create-reconnecter
  [consumer]
  (let [interval (atom interval-init)
        reconnect (q/zloop-handler
                   (fn []
                     (do
                       (reset! interval (min (* 2 @interval) interval-max))
                       ((@consumer :initialize))
                       (swap! consumer assoc :liveness heartbeat-liveness)) 0))]
    (fn []
      (log/warn "[consumer] connection to router lost; reconnecting in" @interval)
      (.close (@consumer :socket))
      (swap! consumer dissoc :socket)
      (.removePoller (@consumer :zloop) (.getItem (@consumer :poller) 0))
      (.addTimer (@consumer :zloop) @interval 1 reconnect (Object.)))))

(defn- with-heartbeat
  [consumer]
  (let [reconnecter (atom (create-reconnecter consumer))
        pong (fn [_] (do (reset! reconnecter (create-reconnecter consumer))
                        (swap! consumer assoc :liveness heartbeat-liveness)))
        ping #(do (send! (@consumer :protocol) (@consumer :socket) [q/MSG-PING]))
        heartbeat (fn []
                    (when (contains? @consumer :socket)
                      (let [next-liveness (dec (get @consumer :liveness (inc heartbeat-liveness)))]
                        (swap! consumer assoc :liveness next-liveness)
                        (if (> next-liveness 0)
                          (ping)
                          (@reconnecter)))))]
    (swap! consumer assoc :handlers (merge (@consumer :handlers) {q/MSG-PONG pong}))
    (.addTimer (@consumer :zloop) heartbeat-interval 0
               (q/zloop-handler #(do (heartbeat) 0)) (Object.))))

(defn- handle-request
  [consumer handler]
  (fn [_]
    (let [protocol (@consumer :protocol)
          socket (@consumer :socket)
          [address request] (q/receive-more socket [String zmq/bytes-type])
          response (handler (nippy/thaw request))]
      (send! protocol socket [q/MSG-REP address (nippy/freeze response)])
      (send! protocol socket [q/MSG-READY]))))

(defn- handle-incoming
  [consumer]
  (fn []
    (let [socket (@consumer :socket)
          [msg-type] (q/receive-more socket [Byte])]
      (doall
        (map (fn [[type handler]]
               (when (= msg-type type) (handler consumer)))
             (@consumer :handlers))))))

(defn create-consumer
  [method handler]
  (let [protocol (MessageProtocol. method)
        context (zmq/context)
        zloop (ZLoop.)
        consumer (atom {:handlers  {}
                        :protocol protocol
                        :zloop zloop
                        :consumer (agent 0)
                        :socket nil})
        initialize #(let [poller (zmq/poller context 1)
                          socket (q/create-connected-socket
                                  context :dealer "tcp://localhost:7740")]
                      (swap! consumer assoc :socket socket :poller poller)
                      (zmq/register poller socket :pollin)
                      (.addPoller (@consumer :zloop)
                                  (.getItem poller 0)
                                  (q/zloop-handler (fn [] ((handle-incoming consumer)) (int 0)))
                                  (Object.))
                      (send! protocol socket [q/MSG-READY]))]
    (log/info "[consumer] started consumer for" method)
    (swap! consumer assoc
           :handlers {q/MSG-REQ (handle-request consumer handler)}
           :initialize initialize)
    ((@consumer :initialize))
    (send (@consumer :consumer) (fn [_] (.start zloop)))
    consumer))

(defn start
  [method handler]
  (with-heartbeat (create-consumer method handler)))

(ns clinicico.worker.consumer
  (:gen-class)
  (:require [taoensso.nippy :as nippy]
            [zeromq.zmq :as zmq]
            [clinicico.common.zeromq :as q]
            [clinicico.common.util :refer [insert]]
            [clojure.tools.logging :as log])
  (:import [org.zeromq ZLoop]))

(def ^:const heartbeat-interval 1000)
(def ^:const heartbeat-liveness 3)

(def ^:const interval-init 1000)
(def ^:const interval-max 32000)

(defprotocol Protocol
  (send! [this socket messages]))

(defrecord MessageProtocol [method]
  Protocol
  (send! [this socket messages]
    (apply (partial q/send-frame-delim socket) (insert messages 1 (.getBytes (get this :method))))))

(defn- create-reconnecter
  [consumer]
  (let [interval (atom interval-init)
        reconnect (q/zloop-handler
                   (fn []
                     (do
                       (reset! interval (min (* 2 @interval) interval-max))
                       ((@consumer :initialize))
                       (swap! consumer assoc :liveness heartbeat-liveness)) 0))]
    (fn []
      (log/warn "[consumer] connection to router lost; reconnecting in" @interval)
      (.close (@consumer :socket))
      (swap! consumer dissoc :socket)
      (.removePoller (@consumer :zloop) (.getItem (@consumer :poller) 0))
      (.addTimer (@consumer :zloop) @interval 1 reconnect (Object.)))))

(defn- with-heartbeat
  [consumer]
  (let [reconnecter (atom (create-reconnecter consumer))
        pong (fn [_] (do (reset! reconnecter (create-reconnecter consumer))
                        (swap! consumer assoc :liveness heartbeat-liveness)))
        ping #(do (send! (@consumer :protocol) (@consumer :socket) [q/MSG-PING]))
        heartbeat (fn []
                    (when (contains? @consumer :socket)
                      (let [next-liveness (dec (get @consumer :liveness heartbeat-liveness))]
                        (swap! consumer assoc :liveness next-liveness)
                        (if (> next-liveness 0)
                          (ping)
                          (@reconnecter)))))]
    (swap! consumer assoc :handlers (merge (@consumer :handlers) {q/MSG-PONG pong}))
    (.addTimer (@consumer :zloop) heartbeat-interval 0
               (q/zloop-handler #(do (heartbeat) 0)) {})))

(defn- handle-request
  [consumer handler]
  (fn [_]
    (let [protocol (@consumer :protocol)
          socket (@consumer :socket)
          [address request] (q/receive-more socket [String zmq/bytes-type])
          response (handler (nippy/thaw request))]
      (send! protocol socket [q/MSG-REP address (nippy/freeze response)])
      (send! protocol socket [q/MSG-READY]))))

(defn- handle-incoming
  [consumer]
  (fn []
    (let [socket (@consumer :socket)
          [msg-type] (q/receive-more socket [Byte])]
      (doall
        (map (fn [[type handler]]
               (when (= msg-type type) (handler consumer)))
             (@consumer :handlers))))))

(defn create-consumer
  [method handler]
  (let [protocol (MessageProtocol. method)
        context (zmq/context)
        zloop (ZLoop.)
        consumer (atom {:handlers  {}
                        :protocol protocol
                        :zloop zloop
                        :socket nil})
        initialize #(let [poller (zmq/poller context 1)
                          socket (q/create-connected-socket
                                  context :dealer "tcp://localhost:7740")]
                      (swap! consumer assoc :socket socket :poller poller)
                      (zmq/register poller socket :pollin)
                      (.addPoller (@consumer :zloop)
                                  (.getItem poller 0)
                                  (q/zloop-handler (fn [] ((handle-incoming consumer)) (int 0)))
                                  {})
                      (send! protocol socket [q/MSG-READY]))]
    (log/info "[consumer] started consumer for" method)
    (swap! consumer assoc
           :handlers {q/MSG-REQ (handle-request consumer handler)}
           :initialize initialize)
    ((@consumer :initialize))
    ; mysterious hack required to start the zloop
    (.addTimer zloop 1000 0 (q/zloop-handler #(do (Thread/sleep 1) 0)) {})

    (.start (Thread. #(.start zloop)))
    consumer))

(defn start
  [method handler]
  (with-heartbeat (create-consumer method handler)))

Add dummy loop to start the first worker as well

- Will figure out how this works eventually


(ns braid.base.api
  (:require
    [braid.core.common.util :as util]
    #?@(:cljs
         [[braid.base.client.events]
          [braid.base.client.subs]
          [braid.base.client.pages]
          [braid.base.client.styles]
          [braid.base.client.state]
          [braid.base.client.remote-handlers]
          [braid.base.client.root-view]]
         :clj
         [[braid.base.conf]
          [braid.base.server.jobs]
          [braid.base.server.seed]
          [braid.base.server.cqrs]
          [braid.base.server.http-api-routes]
          [braid.base.server.initial-data]
          [braid.base.server.spa]
          [braid.base.server.schema]
          [braid.base.server.ws-handler]])))

#?(:cljs
   (do
     (defn register-initial-user-data-handler!
       "Add a handler that will run with the initial db & user-info recieved from the server. See `:register-initial-user-data` under `:clj`"
       [f]
       {:pre [(fn? f)]}
       (swap! braid.base.client.events/initial-user-data-handlers conj f))

     (defn register-state!
       "Add a key and initial value to the default app state, plus an associated spec."
       [state spec]
       {:pre [(map? state)
              (map? spec)]}
       (braid.base.client.state/register-state! state spec))

     (defn register-incoming-socket-message-handlers!
       "Registers multiple client-side socket message handlers.

       Expects map of event-keys and handler-fns.
       Handler fn will be called with user-id and data arguments"
       [handler-map]
       {:pre [(map? handler-map)
              (every? keyword? (keys handler-map))
              (every? fn? (vals handler-map))]}
       (swap! braid.base.client.remote-handlers/incoming-socket-message-handlers merge handler-map))

     (defn register-events!
       "Registers multiple re-frame event handlers, as if passed to reg-event-fx.

       Expects a map of event-keys to event-handler-fns."
       [event-map]
       {:pre [(map? event-map)
              (every? keyword? (keys event-map))
              (every? fn? (vals event-map))]}
       (braid.base.client.events/register-events! event-map))

     (defn register-event-listener!
       "Register a function to intercept re-frame events."
       [f]
       {:pre [(fn? f)]}
       (swap! braid.base.client.events/event-listeners conj f))

     (defn register-subs!
       "Registers multiple re-frame subscription handlers, as if passed to reg-sub.

       Expects a map of sub-keys to sub-handler-fns."
       [sub-map]
       {:pre [(map? sub-map)
              (every? keyword? (keys sub-map))
              (every? fn? (vals sub-map))]}
       (braid.base.client.subs/register-subs! sub-map))

     (defn register-subs-raw!
       "Registers multiple re-frame subscription handlers, as if passed to reg-sub-raw.

       Expects a map of sub-keys to sub-handler-fns."
       [sub-map]
       {:pre [(map? sub-map)
              (every? keyword? (keys sub-map))
              (every? fn? (vals sub-map))]}
       (braid.base.client.subs/register-subs-raw! sub-map))

     (defn register-root-view!
       "Add a new view to the app (when user is logged in).
       Will be put under body > #app > .app > .main >"
       [view]
       {:pre [(fn? view)]}
       (swap! braid.base.client.root-view/root-views conj view))

     (defn register-styles!
       "Add Garden CSS styles to the page styles"
       [styles]
       {:pre [(util/valid? braid.base.client.styles/style-dataspec styles)]}
       (swap! braid.base.client.styles/module-styles conj styles))

     (defn register-system-page!
       "Registers a system page with its own URL.

       Expects a map with the following keys:
         :key      keyword
         :on-load  (optional) function to call
                   when page is navigated to
         :on-exit  (optional) function to call
                   when page is navigated away from
         :view   reagent view fn
         :styles  (optional) garden styles for the page

       Link for page can be generated using:
        (braid.core.client.routes/system-page-path
             {:page-id __})"
       [page]
       {:pre [(util/valid? braid.base.client.pages/page-dataspec page)]}
       (swap! braid.base.client.pages/pages assoc (page :key) page)
       (when (page :styles)
         (register-styles!
           [:#app>.app>.main
            (page :styles)]))))

   :clj
   (do

     (defn register-initial-user-data!
       "Add a map of key -> fn for getting the initial user data to be sent to the client. `fn` will recieve the user-id as its argument. See `:register-initial-user-data-handler` under `:cljs`"
       [f]
       {:pre [(fn? f)]}
       (swap! braid.base.server.initial-data/initial-user-data conj f))

     (defn register-additional-script!
       "Add a javascript script tag to client html. Values can be a map with a `:src` or `:body` key or a function with no arguments, returing the same."
       [tag]
       {:pre [(util/valid? braid.base.server.spa/additional-script-dataspec tag)]}
       (swap! braid.base.server.spa/additional-scripts conj tag))

     (defn register-db-schema!
       "Add new datoms to the db schema"
       [schema]
       {:pre [(vector? schema)
              (every? (partial util/valid? braid.base.server.schema/rule-dataspec) schema)]}
       (swap! braid.base.server.schema/schema into schema))

     (defn register-db-seed-fn!
       "Will register function to call when base.server.seed/seed! is called"
       [f]
       {:pre [(fn? f)]}
       (swap! braid.base.server.seed/seed-fns conj f))

     (defn register-config-var!
       "Add a keyword to be read from `env` and added to the `config` state"
         [k required-or-optional schema]
       {:pre [(keyword? k)
              (#{:required :optional} required-or-optional)
              ;; TODO use malli internals to check schema
              ]}
       (swap! braid.base.conf/config-vars conj
              {:key k
               :required? (case required-or-optional
                            :required true
                            :optional false)
               :schema schema}))

     (defn register-server-message-handlers!
       "Add a map of websocket-event-name -> event-handler-fn to handle events from the client"
       [handler-defs]
       {:pre [(map? handler-defs)
              (every? keyword? (keys handler-defs))
              (every? fn? (vals handler-defs))]}
       (swap! braid.base.server.ws-handler/message-handlers merge handler-defs))

     (defn register-commands!
       "Add a command, which also exposes a websocket server-handler for a message of the same name."
       [commands]
       (swap! braid.base.server.cqrs/commands
              concat commands)

       (braid.base.server.cqrs/update-registry!)

       (register-server-message-handlers!
         (->> commands
              (map (fn [command]
                     [(:id command)
                      (braid.base.server.cqrs/->ws-handler command)]))
              (into {}))))

    (defn register-public-http-route!
       "Add a public HTTP route.
        Expects a route defined as:
        [:method \"pattern\" handler-fn]

        handler-fn will be passed a ring request object (with query-params and body-params in :params key)
        handler-fn should return a ring-compatible response (if it is a clojure data structure, it will be converted to edn or transit-json, based on the accepts header)
        ex.
        [:get \"/foo/:bar\" (fn [request]
                              {:status 200
                               :body (get-in request [:params :bar])})]"
       [route]
       {:pre [(util/valid? braid.base.server.http-api-routes/route? route)]}
       (swap! braid.base.server.http-api-routes/module-public-http-routes conj route))

     (defn register-private-http-route!
       "Add a private HTTP route (one that requires a user to be logged in).
        Expects a route defined as:
        [:method \"pattern\" handler-fn]

        handler-fn will be passed a ring request object (with query-params and body-params in :params key)
        handler-fn should return a ring-compatible response (if it is a clojure data structure, it will be converted to edn or transit-json, based on the accepts header)
        ex.
        [:get \"/foo/:bar\" (fn [request]
                              {:status 200
                               :body (get-in request [:params :bar])})]"
       [route]
       {:pre [(util/valid? braid.base.server.http-api-routes/route? route)]}
       (swap! braid.base.server.http-api-routes/module-private-http-routes conj route))

     (defn register-raw-http-handler!
       "Add an HTTP handler that expects to handle all its own middleware
        Expects a ring handler function

        handler-fn will be passed a ring request object (with query-params and body-params in :params key)
        handler-fn should return a ring-compatible response "
       [handler]
       (swap! braid.base.server.http-api-routes/module-raw-http-routes conj handler))

     (defn register-daily-job!
       "Add a recurring job that will run once a day. Expects a zero-arity function."
       [job-fn]
       {:pre [(fn? job-fn)]}
       (braid.base.server.jobs/register-daily-job! job-fn))))

(ns braid.base.api
  (:require
    [braid.core.common.util :as util]
    #?@(:cljs
         [[braid.base.client.events]
          [braid.base.client.subs]
          [braid.base.client.pages]
          [braid.base.client.styles]
          [braid.base.client.state]
          [braid.base.client.remote-handlers]
          [braid.base.client.root-view]]
         :clj
         [[braid.base.conf]
          [braid.base.server.jobs]
          [braid.base.server.seed]
          [braid.base.server.cqrs]
          [braid.base.server.http-api-routes]
          [braid.base.server.initial-data]
          [braid.base.server.spa]
          [braid.base.server.schema]
          [braid.base.server.ws-handler]])))

#?(:cljs
   (do
     (defn register-initial-user-data-handler!
       "Add a handler that will run with the initial db & user-info recieved from the server. See `:register-initial-user-data` under `:clj`"
       [f]
       {:pre [(fn? f)]}
       (swap! braid.base.client.events/initial-user-data-handlers conj f))

     (defn register-state!
       "Add a key and initial value to the default app state, plus an associated spec."
       [state spec]
       {:pre [(map? state)
              (map? spec)]}
       (braid.base.client.state/register-state! state spec))

     (defn register-incoming-socket-message-handlers!
       "Registers multiple client-side socket message handlers.

       Expects map of event-keys and handler-fns.
       Handler fn will be called with user-id and data arguments"
       [handler-map]
       {:pre [(map? handler-map)
              (every? keyword? (keys handler-map))
              (every? fn? (vals handler-map))]}
       (swap! braid.base.client.remote-handlers/incoming-socket-message-handlers merge handler-map))

     (defn register-events!
       "Registers multiple re-frame event handlers, as if passed to reg-event-fx.

       Expects a map of event-keys to event-handler-fns."
       [event-map]
       {:pre [(map? event-map)
              (every? keyword? (keys event-map))
              (every? fn? (vals event-map))]}
       (braid.base.client.events/register-events! event-map))

     (defn register-event-listener!
       "Register a function to intercept re-frame events."
       [f]
       {:pre [(fn? f)]}
       (swap! braid.base.client.events/event-listeners conj f))

     (defn register-subs!
       "Registers multiple re-frame subscription handlers, as if passed to reg-sub.

       Expects a map of sub-keys to sub-handler-fns."
       [sub-map]
       {:pre [(map? sub-map)
              (every? keyword? (keys sub-map))
              (every? fn? (vals sub-map))]}
       (braid.base.client.subs/register-subs! sub-map))

     (defn register-subs-raw!
       "Registers multiple re-frame subscription handlers, as if passed to reg-sub-raw.

       Expects a map of sub-keys to sub-handler-fns."
       [sub-map]
       {:pre [(map? sub-map)
              (every? keyword? (keys sub-map))
              (every? fn? (vals sub-map))]}
       (braid.base.client.subs/register-subs-raw! sub-map))

     (defn register-root-view!
       "Add a new view to the app (when user is logged in).
       Will be put under body > #app > .app > .main >"
       [view]
       {:pre [(fn? view)]}
       (swap! braid.base.client.root-view/root-views conj view))

     (defn register-styles!
       "Add Garden CSS styles to the page styles"
       [styles]
       {:pre [(util/valid? braid.base.client.styles/style-dataspec styles)]}
       (swap! braid.base.client.styles/module-styles conj styles))

     (defn register-system-page!
       "Registers a system page with its own URL.

       Expects a map with the following keys:
         :key      keyword
         :on-load  (optional) function to call
                   when page is navigated to
         :on-exit  (optional) function to call
                   when page is navigated away from
         :view   reagent view fn
         :styles  (optional) garden styles for the page

       Link for page can be generated using:
        (braid.core.client.routes/system-page-path
             {:page-id __})"
       [page]
       {:pre [(util/valid? braid.base.client.pages/page-dataspec page)]}
       (swap! braid.base.client.pages/pages assoc (page :key) page)
       (when (page :styles)
         (register-styles!
           [:#app>.app>.main
            (page :styles)]))))

   :clj
   (do

     (defn register-initial-user-data!
       "Add a map of key -> fn for getting the initial user data to be sent to the client. `fn` will recieve the user-id as its argument. See `:register-initial-user-data-handler` under `:cljs`"
       [f]
       {:pre [(fn? f)]}
       (swap! braid.base.server.initial-data/initial-user-data conj f))

     (defn register-additional-script!
       "Add a javascript script tag to client html. Values can be a map with a `:src` or `:body` key or a function with no arguments, returing the same."
       [tag]
       {:pre [(util/valid? braid.base.server.spa/additional-script-dataspec tag)]}
       (swap! braid.base.server.spa/additional-scripts conj tag))

     (defn register-db-schema!
       "Add new datoms to the db schema"
       [schema]
       {:pre [(vector? schema)
              (every? (partial util/valid? braid.base.server.schema/rule-dataspec) schema)]}
       (swap! braid.base.server.schema/schema into schema))

     (defn register-db-seed-fn!
       "Will register function to call when base.server.seed/seed! is called"
       [f]
       {:pre [(fn? f)]}
       (swap! braid.base.server.seed/seed-fns conj f))

     (defn register-config-var!
       "Add a keyword to be read from `env` and added to the `config` state"
         [k required-or-optional schema]
       {:pre [(keyword? k)
              (#{:required :optional} required-or-optional)
              ;; TODO use malli internals to check schema
              ]}
       (swap! braid.base.conf/config-vars conj
              {:key k
               :required? (case required-or-optional
                            :required true
                            :optional false)
               :schema (if (= :optional required-or-optional)
                         [:or schema nil?]
                         schema)}))

     (defn register-server-message-handlers!
       "Add a map of websocket-event-name -> event-handler-fn to handle events from the client"
       [handler-defs]
       {:pre [(map? handler-defs)
              (every? keyword? (keys handler-defs))
              (every? fn? (vals handler-defs))]}
       (swap! braid.base.server.ws-handler/message-handlers merge handler-defs))

     (defn register-commands!
       "Add a command, which also exposes a websocket server-handler for a message of the same name."
       [commands]
       (swap! braid.base.server.cqrs/commands
              concat commands)

       (braid.base.server.cqrs/update-registry!)

       (register-server-message-handlers!
         (->> commands
              (map (fn [command]
                     [(:id command)
                      (braid.base.server.cqrs/->ws-handler command)]))
              (into {}))))

    (defn register-public-http-route!
       "Add a public HTTP route.
        Expects a route defined as:
        [:method \"pattern\" handler-fn]

        handler-fn will be passed a ring request object (with query-params and body-params in :params key)
        handler-fn should return a ring-compatible response (if it is a clojure data structure, it will be converted to edn or transit-json, based on the accepts header)
        ex.
        [:get \"/foo/:bar\" (fn [request]
                              {:status 200
                               :body (get-in request [:params :bar])})]"
       [route]
       {:pre [(util/valid? braid.base.server.http-api-routes/route? route)]}
       (swap! braid.base.server.http-api-routes/module-public-http-routes conj route))

     (defn register-private-http-route!
       "Add a private HTTP route (one that requires a user to be logged in).
        Expects a route defined as:
        [:method \"pattern\" handler-fn]

        handler-fn will be passed a ring request object (with query-params and body-params in :params key)
        handler-fn should return a ring-compatible response (if it is a clojure data structure, it will be converted to edn or transit-json, based on the accepts header)
        ex.
        [:get \"/foo/:bar\" (fn [request]
                              {:status 200
                               :body (get-in request [:params :bar])})]"
       [route]
       {:pre [(util/valid? braid.base.server.http-api-routes/route? route)]}
       (swap! braid.base.server.http-api-routes/module-private-http-routes conj route))

     (defn register-raw-http-handler!
       "Add an HTTP handler that expects to handle all its own middleware
        Expects a ring handler function

        handler-fn will be passed a ring request object (with query-params and body-params in :params key)
        handler-fn should return a ring-compatible response "
       [handler]
       (swap! braid.base.server.http-api-routes/module-raw-http-routes conj handler))

     (defn register-daily-job!
       "Add a recurring job that will run once a day. Expects a zero-arity function."
       [job-fn]
       {:pre [(fn? job-fn)]}
       (braid.base.server.jobs/register-daily-job! job-fn))))

Make optional spec allow nil

[base] Make optional spec allow nil

Otherwise optional just means that the key can be missing, but doesn't
allow for the key to be there with a nil value


(ns braid.server.db
  (:require
    [braid.server.conf :refer [config]]
    [braid.server.schema :refer [schema]]
    [datomic.api :as d]
    [datomic.db]
    [mount.core :refer [defstate]]))

(defn install-schema! [db-url]
 (d/transact (d/connect db-url)
                 (concat
                   ; partition for our data
                   [{:db/ident :entities
                     :db/id #db/id [:db.part/db]
                     :db.install/_partition :db.part/db}]
                   schema)))

(defn init!
  "set up schema"
  [db-url]
  (when (d/create-database db-url)
    @(install-schema! db-url)))

(defn connect [{:keys [db-url]}]
  (init! db-url)
  (d/connect db-url))

(defstate conn
  :start (connect config))

(defn db [] (d/db conn))

(defn uuid
  []
  (d/squuid))

(defn run-txns!
  "Execute given transactions. Transactions may be annotated with metadata.
  If the metadata map contains a function under the key
  `:braid.server.db/return`, that function will be called with the transaction
  result and the return value added to the seq of return values
  If the metadata map contains a function under the key
  `:braid.server.db/check`, that function will be called with the transaction
  result and if it fails an assert, the transaction will be aborted & an error
  bubbled up via ex-info, with the assertion failure message under the key
  `:braid.server.db/error`."
  [txns]
  (let [[returns checks] ((juxt (partial keep ::return)
                                (partial keep ::check))
                          (map meta txns))]
    (when (seq checks)
      (let [test-db (d/with (db) txns)]
        (try
          (doseq [check checks]
            (check test-db))
          (catch AssertionError e
            (throw (ex-info "Transaction Failed"
                            {::error (.getMessage e)}))))))
    (let [tx-result @(d/transact conn txns)]
      (map #(% tx-result) returns))))

Fix db connection issue caused by parinfer


(ns shadow.cljs.devtools.server.nrepl-impl
  (:refer-clojure :exclude (send))
  (:require [shadow.cljs.devtools.api :as api]
            [clojure.core.async :as async :refer (go <! >! alt!)]
            [shadow.jvm-log :as log]
            [shadow.cljs.devtools.server.repl-impl :as repl-impl]
            [shadow.build.warnings :as warnings]
            [shadow.cljs.devtools.errors :as errors]
            [shadow.cljs.repl :as repl]
            [shadow.cljs.devtools.server.worker :as worker]
            [shadow.cljs.devtools.config :as config]
            [nrepl.transport :as transport]
            [cider.piggieback :as piggieback])
  (:import [java.io StringReader]
           [clojure.lang Var]))

(def ^:dynamic repl-state-ref nil)

(defn send [{:keys [transport session id] :as req} {:keys [status] :as msg}]
  (let [res
        (-> msg
            (cond->
              id
              (assoc :id id)
              session
              (assoc :session (-> session meta :id))
              (and (some? status)
                   (not (coll? status)))
              (assoc :status #{status})))]

    (log/debug ::send res)
    (transport/send transport res)))

(defn do-repl-quit [state-ref session]
  (let [{:keys [clj-ns watch-chan]} @state-ref]

    (reset! state-ref {})
    (async/close! watch-chan)

    (swap! session dissoc #'repl-state-ref)
    (swap! session assoc
      #'*ns* clj-ns
      #'cider.piggieback/*cljs-compiler-env* nil)))

(defn worker-exit [state-ref session msg]
  (do-repl-quit state-ref session)

  ;; replying with msg id that started the REPL, not the last msg
  (send msg {:err "\nThe REPL worker has stopped.\n"})
  (send msg {:value ":cljs/quit"
             :printed-value 1
             :ns (-> *ns* ns-name str)}))

(defn handle-repl-result [worker {:keys [session] :as msg} result]
  (log/debug ::eval-result {:result result})

  (let [build-state (repl-impl/worker-build-state worker)
        repl-ns (-> build-state :repl-state :current-ns)]

    (case (:type result)
      :repl/results
      (let [{:keys [results]} result]
        (doseq [{:keys [warnings result] :as action} results]
          (binding [warnings/*color* false]
            (doseq [warning warnings]
              (send msg {:err (with-out-str (warnings/print-short-warning warning))})))

          (case (:type result)
            :repl/result
            (send msg {:value (:value result)
                       :printed-value 1
                       :ns (pr-str repl-ns)})

            :repl/set-ns-complete
            (send msg {:value (pr-str repl-ns)
                       :printed-value 1
                       :ns (pr-str repl-ns)})

            (:repl/invoke-error
              :repl/require-error)
            (send msg {:err (or (:stack result)
                                (:error result))})

            :repl/require-complete
            (send msg {:value "nil"
                       :printed-value 1
                       :ns (pr-str repl-ns)})

            :repl/error
            (send msg {:err (errors/error-format (:ex result))})

            ;; :else
            (send msg {:err (pr-str [:FIXME action])}))))

      :repl/interrupt
      nil

      :repl/timeout
      (send msg {:err "REPL command timed out.\n"})

      :repl/no-runtime-connected
      (send msg {:err "No application has connected to the REPL server. Make sure your JS environment has loaded your compiled ClojureScript code.\n"})

      :repl/too-many-runtimes
      (send msg {:err "There are too many JS runtimes, don't know which to eval in.\n"})

      :repl/error
      (send msg {:err (errors/error-format (:ex result))})

      :repl/worker-stop
      :already-handled ;; in go created in repl-init

      ;; :else
      (send msg {:err (pr-str [:FIXME result])}))))

(defn do-cljs-eval [{::keys [state-ref worker] :keys [ns session code runtime-id] :as msg}]
  (let [reader (StringReader. code)

        session-id
        (-> session meta :id str)]

    ;; :last-msg is used by the print loop started by repl-init
    ;; to ensure that all prints use the latest message id when sending it out
    (swap! state-ref assoc :last-msg msg)

    (loop []
      (when-let [build-state (repl-impl/worker-build-state worker)]

        ;; need the repl state to properly support reading ::alias/foo
        (let [read-opts
              (-> {}
                  (cond->
                    (seq ns)
                    (assoc :ns (symbol ns))))

              {:keys [eof? error? ex form] :as read-result}
              (repl/read-one build-state reader read-opts)]

          (cond
            eof?
            :eof

            error?
            (do (send msg {:err (str "Failed to read input: " ex)})
                (recur))

            (nil? form)
            (recur)

            (= :repl/quit form)
            (do (do-repl-quit state-ref session)
                (send msg {:value ":repl/quit"
                           :printed-value 1
                           :ns (-> *ns* ns-name str)}))

            (= :cljs/quit form)
            (do (do-repl-quit state-ref session)
                (send msg {:value ":cljs/quit"
                           :printed-value 1
                           :ns (-> *ns* ns-name str)}))

            ;; Cursive supports
            ;; {:status :eval-error :ex <exception name/message> :root-ex <root exception name/message>}
            ;; {:err string} prints to stderr
            :else
            (when-some [result (worker/repl-eval worker session-id runtime-id read-result)]
              (handle-repl-result worker msg result)
              (recur))
            ))))

    (send msg {:status :done})
    ))

;; this runs in an eval context and therefore cannot modify session directly
;; must use set! as they are captured AFTER eval finished and would overwrite
;; what we did in here. reading is fine though.
(defn repl-init
  [{:keys [session] :as msg}
   {:keys [proc-stop build-id] :as worker}
   opts]

  (let [watch-chan
        (-> (async/sliding-buffer 100)
            (async/chan))

        state-ref
        (get @session #'repl-state-ref)]

    (reset! state-ref
      {:init-msg msg
       :last-msg msg
       :session session
       :watch-chan watch-chan
       :worker worker
       :build-id build-id
       :opts opts
       :clj-ns *ns*})

    ;; doing this to make cider prompt not show "user" as prompt after calling this
    (let [repl-ns (some-> worker :state-ref deref :build-state :repl-state :current :ns)]
      (set! *ns* (create-ns (or repl-ns 'cljs.user))))

    ;; cleanup if worker exits
    (go (<! proc-stop)
        (async/close! watch-chan)
        (worker-exit state-ref session msg))

    ;; watch worker for specific messages (ie. out/err)
    ;; send :err/:out with latest msg id to make tools happy
    ;; technically this can lead to wrong ids in async code
    ;; but better than always using the first msg id maybe?
    (go (try
          (loop []
            (when-some [{:keys [type text] :as msg} (<! watch-chan)]
              (case type
                :repl/out
                (send (:last-msg @state-ref) {:out (str text "\n")})

                :repl/err
                (send (:last-msg @state-ref) {:err (str text "\n")})

                ;; not interested in any other message for now
                :ignored)
              (recur)))

          (catch Exception e
            (log/debug-ex e ::nrepl-print-loop-ex)
            (async/close! watch-chan))))

    (worker/watch worker watch-chan true)

    ;; make tools happy, we do not use it
    ;; its private for some reason so we can't set! it directly
    (let [pvar #'piggieback/*cljs-compiler-env*]
      (when (thread-bound? pvar)
        (.set pvar
          (reify
            clojure.lang.IDeref
            (deref [_]
              (some-> @state-ref :worker :state-ref deref :build-state :compiler-env))))))))

(defn set-worker [{:keys [session] :as msg}]
  ;; re-create this for every message so we know exactly which msg started a REPL
  (swap! session assoc #'api/*nrepl-init* #(repl-init msg %1 %2))

  ;; can only store vars in a session, always put one in though
  (when-not (contains? @session #'repl-state-ref)
    (swap! session assoc #'repl-state-ref (atom {})))

  (let [state-ref (get @session #'repl-state-ref)
        {:keys [build-id worker]} @state-ref]
    (if-not build-id
      msg
      (assoc msg ::state-ref state-ref ::worker worker ::build-id build-id))))

(defn do-cljs-load-file [{::keys [worker] :keys [file file-path] :as msg}]
  (when-some [result (worker/load-file worker {:file-path file-path :source file})]
    (handle-repl-result worker msg result))
  (send msg {:status :done}))

(defn shadow-init-ns!
  [{:keys [session] :as msg}]
  (let [config
        (config/load-cljs-edn)

        init-ns
        (or (get-in config [:nrepl :init-ns])
            (get-in config [:repl :init-ns])
            'shadow.user)]

    (try
      (require init-ns)
      (swap! session assoc #'*ns* (find-ns init-ns))
      (catch Exception e
        (log/warn-ex e ::init-ns-ex {:init-ns init-ns})))))

(defn handle [{:keys [session op] :as msg} next]
  (let [{::keys [worker] :as msg} (set-worker msg)]
    (log/debug ::handle {:session-id (-> session meta :id)
                         :msg-op op
                         :worker (some? worker)
                         :code (when-some [code (:code msg)]
                                 (subs code 0 (min (count code) 100)))})
    (cond
      (and worker (= op "eval"))
      (do-cljs-eval msg)

      (and worker (= op "load-file"))
      (do-cljs-load-file msg)

      :else
      (next msg))))

(ns shadow.cljs.devtools.server.nrepl-impl
  (:refer-clojure :exclude (send))
  (:require [shadow.cljs.devtools.api :as api]
            [clojure.core.async :as async :refer (go <! >! alt!)]
            [shadow.jvm-log :as log]
            [shadow.cljs.devtools.server.repl-impl :as repl-impl]
            [shadow.build.warnings :as warnings]
            [shadow.cljs.devtools.errors :as errors]
            [shadow.cljs.repl :as repl]
            [shadow.cljs.devtools.server.worker :as worker]
            [shadow.cljs.devtools.config :as config]
            [nrepl.transport :as transport]
            [cider.piggieback :as piggieback])
  (:import [java.io StringReader]
           [clojure.lang Var]))

(def ^:dynamic repl-state-ref nil)

(defn send [{:keys [transport session id] :as req} {:keys [status] :as msg}]
  (let [res
        (-> msg
            (cond->
              id
              (assoc :id id)
              session
              (assoc :session (-> session meta :id))
              (and (some? status)
                   (not (coll? status)))
              (assoc :status #{status})))]

    (log/debug ::send res)
    (transport/send transport res)))

(defn do-repl-quit [state-ref session]
  (let [session-id (-> session meta :id)
        {:keys [clj-ns watch-chan]} (get @state-ref session-id)]

    (swap! state-ref dissoc session-id)
    (async/close! watch-chan)

    (swap! session assoc
      #'*ns* clj-ns
      #'cider.piggieback/*cljs-compiler-env* nil)))

(defn worker-exit [state-ref session msg]
  (do-repl-quit state-ref session)

  ;; replying with msg id that started the REPL, not the last msg
  (send msg {:err "\nThe REPL worker has stopped.\n"})
  (send msg {:value ":cljs/quit"
             :printed-value 1
             :ns (-> *ns* ns-name str)}))

(defn handle-repl-result [worker {:keys [session] :as msg} result]
  (log/debug ::eval-result {:result result})

  (let [build-state (repl-impl/worker-build-state worker)
        repl-ns (-> build-state :repl-state :current-ns)]

    (case (:type result)
      :repl/results
      (let [{:keys [results]} result]
        (doseq [{:keys [warnings result] :as action} results]
          (binding [warnings/*color* false]
            (doseq [warning warnings]
              (send msg {:err (with-out-str (warnings/print-short-warning warning))})))

          (case (:type result)
            :repl/result
            (send msg {:value (:value result)
                       :printed-value 1
                       :ns (pr-str repl-ns)})

            :repl/set-ns-complete
            (send msg {:value (pr-str repl-ns)
                       :printed-value 1
                       :ns (pr-str repl-ns)})

            (:repl/invoke-error
              :repl/require-error)
            (send msg {:err (or (:stack result)
                                (:error result))})

            :repl/require-complete
            (send msg {:value "nil"
                       :printed-value 1
                       :ns (pr-str repl-ns)})

            :repl/error
            (send msg {:err (errors/error-format (:ex result))})

            ;; :else
            (send msg {:err (pr-str [:FIXME action])}))))

      :repl/interrupt
      nil

      :repl/timeout
      (send msg {:err "REPL command timed out.\n"})

      :repl/no-runtime-connected
      (send msg {:err "No application has connected to the REPL server. Make sure your JS environment has loaded your compiled ClojureScript code.\n"})

      :repl/too-many-runtimes
      (send msg {:err "There are too many JS runtimes, don't know which to eval in.\n"})

      :repl/error
      (send msg {:err (errors/error-format (:ex result))})

      :repl/worker-stop
      :already-handled ;; in go created in repl-init

      ;; :else
      (send msg {:err (pr-str [:FIXME result])}))))

(defn do-cljs-eval [{::keys [state-ref worker] :keys [ns session code runtime-id] :as msg}]
  (let [reader (StringReader. code)

        session-id
        (-> session meta :id str)]

    ;; :last-msg is used by the print loop started by repl-init
    ;; to ensure that all prints use the latest message id when sending it out
    (swap! state-ref assoc :last-msg msg)

    (loop []
      (when-let [build-state (repl-impl/worker-build-state worker)]

        ;; need the repl state to properly support reading ::alias/foo
        (let [read-opts
              (-> {}
                  (cond->
                    (seq ns)
                    (assoc :ns (symbol ns))))

              {:keys [eof? error? ex form] :as read-result}
              (repl/read-one build-state reader read-opts)]

          (cond
            eof?
            :eof

            error?
            (do (send msg {:err (str "Failed to read input: " ex)})
                (recur))

            (nil? form)
            (recur)

            (= :repl/quit form)
            (do (do-repl-quit state-ref session)
                (send msg {:value ":repl/quit"
                           :printed-value 1
                           :ns (-> *ns* ns-name str)}))

            (= :cljs/quit form)
            (do (do-repl-quit state-ref session)
                (send msg {:value ":cljs/quit"
                           :printed-value 1
                           :ns (-> *ns* ns-name str)}))

            ;; Cursive supports
            ;; {:status :eval-error :ex <exception name/message> :root-ex <root exception name/message>}
            ;; {:err string} prints to stderr
            :else
            (when-some [result (worker/repl-eval worker session-id runtime-id read-result)]
              (handle-repl-result worker msg result)
              (recur))
            ))))

    (send msg {:status :done})
    ))

;; this runs in an eval context and therefore cannot modify session directly
;; must use set! as they are captured AFTER eval finished and would overwrite
;; what we did in here. reading is fine though.
(defn repl-init
  [{:keys [session] :as msg}
   {:keys [proc-stop build-id] :as worker}
   opts]

  (let [watch-chan
        (-> (async/sliding-buffer 100)
            (async/chan))

        session-id
        (-> session meta :id)

        state-ref
        (get @session #'repl-state-ref)]

    (swap! state-ref assoc session-id
      {:init-msg msg
       :last-msg msg
       :session session
       :watch-chan watch-chan
       :worker worker
       :build-id build-id
       :opts opts
       :clj-ns *ns*})

    ;; doing this to make cider prompt not show "user" as prompt after calling this
    (let [repl-ns (some-> worker :state-ref deref :build-state :repl-state :current :ns)]
      (set! *ns* (create-ns (or repl-ns 'cljs.user))))

    ;; cleanup if worker exits
    (go (<! proc-stop)
        (async/close! watch-chan)
        (worker-exit state-ref session msg))

    ;; watch worker for specific messages (ie. out/err)
    ;; send :err/:out with latest msg id to make tools happy
    ;; technically this can lead to wrong ids in async code
    ;; but better than always using the first msg id maybe?
    (go (try
          (loop []
            (when-some [{:keys [type text] :as msg} (<! watch-chan)]
              (case type
                :repl/out
                (send (:last-msg @state-ref) {:out (str text "\n")})

                :repl/err
                (send (:last-msg @state-ref) {:err (str text "\n")})

                ;; not interested in any other message for now
                :ignored)
              (recur)))

          (catch Exception e
            (log/debug-ex e ::nrepl-print-loop-ex)
            (async/close! watch-chan))))

    (worker/watch worker watch-chan true)

    ;; make tools happy, we do not use it
    ;; its private for some reason so we can't set! it directly
    (let [pvar #'piggieback/*cljs-compiler-env*]
      (when (thread-bound? pvar)
        (.set pvar
          (reify
            clojure.lang.IDeref
            (deref [_]
              (some-> @state-ref :worker :state-ref deref :build-state :compiler-env))))))))

(defn set-worker [{:keys [session] :as msg}]
  ;; re-create this for every message so we know exactly which msg started a REPL
  (swap! session assoc #'api/*nrepl-init* #(repl-init msg %1 %2))

  ;; can only store vars in a session, always put one in though
  (when-not (contains? @session #'repl-state-ref)
    (swap! session assoc #'repl-state-ref (atom {})))

  (let [state-ref (get @session #'repl-state-ref)
        session-id (-> session meta :id)
        {:keys [build-id worker]} (get @state-ref session-id)]
    (if-not build-id
      msg
      (assoc msg ::state-ref state-ref ::worker worker ::build-id build-id))))

(defn do-cljs-load-file [{::keys [worker] :keys [file file-path] :as msg}]
  (when-some [result (worker/load-file worker {:file-path file-path :source file})]
    (handle-repl-result worker msg result))
  (send msg {:status :done}))

(defn shadow-init-ns!
  [{:keys [session] :as msg}]
  (let [config
        (config/load-cljs-edn)

        init-ns
        (or (get-in config [:nrepl :init-ns])
            (get-in config [:repl :init-ns])
            'shadow.user)]

    (try
      (require init-ns)
      (swap! session assoc #'*ns* (find-ns init-ns))
      (catch Exception e
        (log/warn-ex e ::init-ns-ex {:init-ns init-ns})))))

(defn handle [{:keys [session op] :as msg} next]
  (let [{::keys [worker] :as msg} (set-worker msg)]
    (log/debug ::handle {:session-id (-> session meta :id)
                         :msg-op op
                         :worker (some? worker)
                         :code (when-some [code (:code msg)]
                                 (subs code 0 (min (count code) 100)))})
    (cond
      (and worker (= op "eval"))
      (do-cljs-eval msg)

      (and worker (= op "load-file"))
      (do-cljs-load-file msg)

      :else
      (next msg))))

fix nrepl middleware related to clone

fix nrepl middleware related to clone

upgrading a clone'd session would end up upgrading all clones


(ns metabase.util
  "Common utility functions useful throughout the codebase."
  (:require [medley.core :refer :all]
            [clj-time.format :as time]
            [clj-time.coerce :as coerce]))

(defn contains-many? [m & ks]
  (every? true? (map #(contains? m %) ks)))

(defn select-non-nil-keys
  "Like `select-keys` but filters out key-value pairs whose value is nil."
  [m & keys]
  (->> (select-keys m keys)
       (filter-vals identity)))

(defmacro fn->
  "Returns a function that threads arguments to it through FORMS via `->`."
  [& forms]
  `(fn [x#]
     (-> x#
         ~@forms)))

(defmacro fn->>
  "Returns a function that threads arguments to it through FORMS via `->>`."
  [& forms]
  `(fn [x#]
     (->> x#
          ~@forms)))

(defn regex?
  "Is ARG a regular expression?"
  [arg]
  (= (type arg)
     java.util.regex.Pattern))

(defn regex=
  "Returns `true` if the literal string representations of REGEXES are exactly equal.

    (= #\"[0-9]+\" #\"[0-9]+\")           -> false
    (regex= #\"[0-9]+\" #\"[0-9]+\")      -> true
    (regex= #\"[0-9]+\" #\"[0-9][0-9]*\") -> false (although it's theoretically true)"
  [& regexes]
  (->> regexes
       (map #(.toString ^java.util.regex.Pattern %))
       (apply =)))

(defn self-mapping
  "Given a function F that takes a single arg, return a function that will call `(f arg)` when
  passed a non-sequential ARG, or `(map f arg)` when passed a sequential ARG.

    (def f (self-mapping (fn [x] (+ 1 x))))
    (f 2)       -> 3
    (f [1 2 3]) -> (2 3 4)"
  [f & args]
  (fn [arg]
    (if (sequential? arg) (map f arg)
        (f arg))))

;; looking for `apply-kwargs`?
;; turns out `medley.core/mapply` does the same thingx

(declare -assoc*)
(defmacro assoc*
  "Like `assoc`, but associations happen sequentially; i.e. each successive binding can build
   upon the result of the previous one using `<>`.

    (assoc* {}
            :a 100
            :b (+ 100 (:a <>)) ; -> {:a 100 :b 200}"
  [object & kvs]
  `((fn [~'<>]          ; wrap in a `fn` so this can be used in `->`/`->>` forms
      (-assoc* ~@kvs))
    ~object))

(defmacro -assoc* [k v & rest]
  `(let [~'<> (assoc ~'<> ~k ~v)]
        ~(if (empty? rest) `~'<>
             `(-assoc* ~@rest))))

(defn new-sql-date
  "`java.sql.Date` doesn't have an empty constructor so this is a convenience that lets you make one with the current date.
   (Some DBs like Postgres will get snippy if you don't use a `java.sql.Date`)."
  []
  (-> (java.util.Date.)
      .getTime
      (java.sql.Date.)))

(defn parse-iso8601
  "parse a string value expected in the iso8601 format into a `java.sql.Date`."
  [datetime]
  (when datetime
    (->> datetime
      (time/parse (time/formatters :date-time-no-ms))
      (coerce/to-long)
      (java.sql.Date.))))

(defn now-iso8601
  "format the current time as iso8601 date/time string."
  []
  (time/unparse (time/formatters :date-time-no-ms) (coerce/from-long (System/currentTimeMillis))))

add a function which makes it easy to get the current time formatted as iso8601 string.


(defproject tttclj "0.0.1-SNAPSHOT"
  :description "Cool new project to do things and stuff"
  :dependencies [[org.clojure/clojure "1.6.0"]
                 [org.clojure/core.async "0.1.303.0-886421-alpha"]
                 [org.clojure/clojurescript "0.0-2227"]
                 [http-kit "2.1.16"]
                 [quiescent "0.1.3"]
                 [jarohen/chord "0.4.1"]
                 [compojure "1.1.8" :exclusions [joda-time]]]
  :profiles {:dev {:dependencies [[midje "1.5.0" :exclusions [org.codehaus.plexus/plexus-utils org.clojure/tools.macro]]]
                   :plugins [[lein-cljsbuild "1.0.3"]]
                   :cljsbuild {:builds [{:source-paths ["src"]
                                         :compiler {:output-to "target/classes/public/app.js"
                                                    :optimizations :whitespace
                                                    :pretty-print true}}]}}}
  :main tttclj.web)

(defproject tttclj "0.0.1-SNAPSHOT"
  :description "Cool new project to do things and stuff"
  :dependencies [[org.clojure/clojure "1.6.0"]
                 [org.clojure/core.async "0.1.303.0-886421-alpha"]
                 [org.clojure/clojurescript "0.0-2227"]
                 [http-kit "2.1.16"]
                 [quiescent "0.1.3"]
                 [jarohen/chord "0.4.1"]
                 [compojure "1.1.8" :exclusions [joda-time]]]
  :profiles {:dev {:dependencies [[midje "1.6.3" :exclusions [org.codehaus.plexus/plexus-utils org.clojure/tools.macro]]]
                   :plugins [[lein-cljsbuild "1.0.3"]]
                   :cljsbuild {:builds [{:source-paths ["src"]
                                         :compiler {:output-to "target/classes/public/app.js"
                                                    :optimizations :whitespace
                                                    :pretty-print true}}]}}}
  :main tttclj.web)

Upgrade Midje

Upgrade Midje


;; Copyright (c) 2016 Maria Carrasco
;;
;; This file is part of mrunner.
;;
;; mrunner is free software: you can redistribute it and/or modify
;; it under the terms of the GNU Affero General Public License as
;; published by the Free Software Foundation, either version 3 of the
;; License, or (at your option) any later version.
;;
;; mrunner is distributed in the hope that it will be useful, but
;; WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
;; Affero General Public License for more details.
;;
;; You should have received a copy of the GNU Affero General Public
;; License along with Mittagessen.  If not, see
;; <http://www.gnu.org/licenses/>.

(ns mrunner.core
  (:require-macros [cljs.core.async.macros :refer [go]])
  (:require [reagent.core :as r]
            [cljs-http.client :as http]
            [cljs.core.async :refer [<! timeout]]
            [cljs.core.match :refer-macros [match]]
            [cljs.core.match]
            [clojure.string :as str]
            [goog.events :as events]
            [mrunner.routes :as routes]))

;;
;;  Application state
;;  =================
;;

(defonce app-state
  (r/atom {:data nil
           :game nil
           :view [:init]}))

(def initial-state
  {:key nil
   :pos-y 0
   :pos-x 0
   :speed-x 0.4
   :speed-y 0
   :cur-time nil
   :down false
   :obstacles []
   })

(def obstacle-types
  [{:type "normal" :width 32 :height 48 :pos-y 90 :pos-x nil}
   {:type "big" :width 40 :height 56 :pos-y 90 :pos-x nil}
   {:type "bird" :width 77 :height 66 :pos-y 150 :pos-x nil}
   {:type "bird-small" :width 42 :height 41 :pos-y 150 :pos-x nil}])

(defn dbg [x]
  (println x)
  x)

(def game-width 800)
(def jump-speed 1)
(def gravity -0.003)
(def runner-offset 215)

;; 37 left, 38 up, 39 right, 40 down
(defn handle-key [state key]
  (case (.-keyCode key)
    38 (when (= (:pos-y @state) 0)
         (swap! state assoc :speed-y jump-speed))
    40 (swap! state assoc :down true)
    nil))

(defn handle-key-up [state key]
  (case (.-keyCode key)
    40 (swap! state assoc :down false)
    nil))

(defn update-obstacles [{:keys [obstacles pos-x] :as state}]
  (if (< (count obstacles) 1)
    (update state :obstacles conj (assoc (rand-nth obstacle-types) :pos (+ pos-x game-width)))
    (update state :obstacles
            (fn [obstacles]
              (filter #(> (:pos %) (- pos-x (:width %))) obstacles)))))

(defn game-loop [state end]
  (let [{:keys [cur-time]} @state
        next-time (js/performance.now)
        delta (- next-time cur-time)]
    (when-not (nil? cur-time)
      (swap! state update :pos-x + (* (:speed-x @state) delta))
      (swap! state update :pos-y #(max 0 (+ % (* (:speed-y @state) delta))))
      (swap! state update :speed-y + (* gravity delta))
      (swap! state update-obstacles))
    (swap! state assoc :cur-time next-time))
  (when-not @end
    (js/requestAnimationFrame #(game-loop state end))))

(defn game-view [state]
  (r/with-let [end (atom false)
               keys [(events/listen js/window "keydown" #(handle-key state %))
                     (events/listen js/window "keyup" #(handle-key-up state %))]
               loop (js/requestAnimationFrame #(game-loop state end))]

    [:div.game
     "Welcome to mrunner"
     [:div.sky {:style {:background-position-x (/ (- (:pos-x @state )) 5)}}]
     [:div.road {:style {:background-position-x (- (:pos-x @state ))}}]
     [:div.runner {:class (when (:down @state) "down")
                   :style {:transform (str "translateY(-" (+ (:pos-y @state) floor-y) "px) "
                                           "translateX(" runner-offset "px)")}}]
     (when (count (:obstacles @state))
       (doall (for [obstacle (:obstacles @state)]
         ^{:key (:pos-x obstacle)}
         [:div.tree {:class (:type obstacle)
                     :style {:transform (str "translateX(" (- (:pos-x obstacle)
                                                              (:pos-x @state)) "px) "
                                             "translateY(-" (:pos-y obstacle) "px)")
                             :width (:width obstacle)
                             :height (:height obstacle)}}])))]
    (finally (dorun (map events/unlistenByKey keys))
             (reset! end true))))

(defn main-view [state]
  (r/with-let [game-state (r/cursor state [:game])]
    [:div.game-wrapper
     [:h1 "mRunner"]
     (if @game-state
       [game-view game-state]
       [:button {:on-click #(reset! game-state initial-state)} "start"])]))

(defn not-found-view []
  [:div#not-found
   [:h1 "Page not found!"]])

(defn root-view [state]
  (match [(:view @state)]
         [[:init]]  [:div]
         [[:main]]  [main-view state]
         :else      [not-found-view]))

(defn init-components! [app-state]
  (r/render-component
    [root-view app-state]
    (.getElementById js/document "components")))

;;
;; Application
;; ===========
;;

(defn init-app! []
  (enable-console-print!)
  (prn "mrunner app started!")
  (routes/init-router! app-state)
  (init-components! app-state))

(defn on-figwheel-reload! []
  (prn "Figwheel reloaded...")
  (swap! app-state update-in [:__figwheel_counter] inc))

(init-app!)

;; Copyright (c) 2016 Maria Carrasco
;;
;; This file is part of mrunner.
;;
;; mrunner is free software: you can redistribute it and/or modify
;; it under the terms of the GNU Affero General Public License as
;; published by the Free Software Foundation, either version 3 of the
;; License, or (at your option) any later version.
;;
;; mrunner is distributed in the hope that it will be useful, but
;; WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
;; Affero General Public License for more details.
;;
;; You should have received a copy of the GNU Affero General Public
;; License along with Mittagessen.  If not, see
;; <http://www.gnu.org/licenses/>.

(ns mrunner.core
  (:require-macros [cljs.core.async.macros :refer [go]])
  (:require [reagent.core :as r]
            [cljs-http.client :as http]
            [cljs.core.async :refer [<! timeout]]
            [cljs.core.match :refer-macros [match]]
            [cljs.core.match]
            [clojure.string :as str]
            [goog.events :as events]
            [mrunner.routes :as routes]))

;;
;;  Application state
;;  =================
;;

(defonce app-state
  (r/atom {:data nil
           :game nil
           :view [:init]}))

(def initial-state
  {:key nil
   :pos-y 0
   :pos-x 0
   :speed-x 0.4
   :speed-y 0
   :cur-time nil
   :down false
   :obstacles []
   :pause false
   })

(def obstacle-types
  [{:type "normal" :width 32 :height 48 :pos-y 90 :pos-x nil}
   {:type "big" :width 40 :height 56 :pos-y 90 :pos-x nil}
   {:type "bird" :width 77 :height 66 :pos-y 150 :pos-x nil}
   {:type "bird-small" :width 42 :height 41 :pos-y 150 :pos-x nil}])

(defn dbg [x]
  (println x)
  x)

(defn dbg- [x msg]
  (println msg x)
  x)

(def runner {:width 112 :height 72})
(def floor-y 85)
(def game-width 800)
(def jump-speed 1)
(def gravity -0.0038)
(def runner-offset 215)

;; 38 up, 40 down, 80 p
(defn handle-key [state key]
  (case (.-keyCode key)
    38 (when (= (:pos-y @state) 0)
         (swap! state assoc :speed-y jump-speed))
    40 (swap! state assoc :down true)
    80 (swap! state update :pause not)
    nil))

(defn handle-key-up [state key]
  (case (.-keyCode key)
    40 (swap! state assoc :down false)
    nil))

(defn update-obstacles [{:keys [obstacles pos-x] :as state}]
  (if (< (count obstacles) 1)
    (update state :obstacles conj (assoc (rand-nth obstacle-types) :pos-x (+ pos-x game-width)))
    (update state :obstacles
            (fn [obstacles]
              (filter #(> (:pos-x %) (- pos-x (:width %))) obstacles)))))

(defn in-segment? [x p0 p1]
  (and (<= x p1) (<= p0 x)))

(defn in-square? [x0 y0 x y w h]
  (and (in-segment? x0 x (+ x w))
       (in-segment? y0 y (+ y h))))

(defn square-intersect?-bad [x0 y0 w0 h0
                         x1 y1 w1 h1]
  (or (in-square? x0 y0 x1 y1 w1 h1)
      (in-square? x1 y1 x0 y0 w0 h0)))

(defn square-intersect? [x0 y0 w0 h0
                         x1 y1 w1 h1]
  (and (< x0 (+ x1 w1))
       (> (+ x0 w0) x1)
       (< y0 (+ y1 h1))
       (> (+ y0 h0) y1)))

(defn detect-collision [{:keys [obstacles pos-x pos-y down] :as state}]
  (let [obstacle (first obstacles)]
    (square-intersect? (+ pos-x runner-offset) (+ pos-y floor-y)
                       (:width runner) (if down 47 (:height runner))
                       (:pos-x obstacle) (:pos-y obstacle)
                       (:width obstacle) (:height obstacle))))

(defn game-loop [state end]
  (let [{:keys [cur-time]} @state
        next-time (js/performance.now)
        delta (- next-time cur-time)]
    (when-not (or (nil? cur-time) (:pause @state))
      (swap! state update :pos-x + (* (:speed-x @state) delta))
      (swap! state update :pos-y #(max 0 (+ % (* (:speed-y @state) delta))))
      (swap! state update :speed-y + (* gravity delta))
      (swap! state update-obstacles)
      (when (detect-collision @state) (println "ooooops")))
    (swap! state assoc :cur-time next-time))
  (when-not @end
    (js/requestAnimationFrame #(game-loop state end))))

(defn game-view [state]
  (r/with-let [end (atom false)
               keys [(events/listen js/window "keydown" #(handle-key state %))
                     (events/listen js/window "keyup" #(handle-key-up state %))]
               loop (js/requestAnimationFrame #(game-loop state end))]

    [:div.game
     "Welcome to mrunner"
     [:div.sky {:style {:background-position-x (/ (- (:pos-x @state )) 5)}}]
     [:div.road {:style {:background-position-x (- (:pos-x @state ))}}]
     [:div.runner {:class (when (:down @state) "down")
                   :style {:transform (str "translateY(-" (+ (:pos-y @state) floor-y) "px) "
                                           "translateX(" runner-offset "px)")}}]
     (when (count (:obstacles @state))
       (doall (for [obstacle (:obstacles @state)]
         ^{:key (:pos-x obstacle)}
         [:div.tree {:class (:type obstacle)
                     :style {:transform (str "translateX(" (- (:pos-x obstacle)
                                                              (:pos-x @state)) "px) "
                                             "translateY(-" (:pos-y obstacle) "px)")
                             :width (:width obstacle)
                             :height (:height obstacle)}}])))]
    (finally (dorun (map events/unlistenByKey keys))
             (reset! end true))))

(defn main-view [state]
  (r/with-let [game-state (r/cursor state [:game])]
    [:div.game-wrapper
     [:h1 "mRunner"]
     (if @game-state
       [game-view game-state]
       [:button {:on-click #(reset! game-state initial-state)} "start"])]))

(defn not-found-view []
  [:div#not-found
   [:h1 "Page not found!"]])

(defn root-view [state]
  (match [(:view @state)]
         [[:init]]  [:div]
         [[:main]]  [main-view state]
         :else      [not-found-view]))

(defn init-components! [app-state]
  (r/render-component
    [root-view app-state]
    (.getElementById js/document "components")))

;;
;; Application
;; ===========
;;

(defn init-app! []
  (enable-console-print!)
  (prn "mrunner app started!")
  (routes/init-router! app-state)
  (init-components! app-state))

(defn on-figwheel-reload! []
  (prn "Figwheel reloaded...")
  (swap! app-state update-in [:__figwheel_counter] inc))

(init-app!)

Implement collisions

Implement collisions

Now only printing out a message when a collision occurs