(ns onyx-jepsen.onyx-client
  "Tests for Onyx"
  (:require [clojure.core.async :as casync :refer [alts!! chan]]
            [clojure.tools.logging :refer :all]
            [com.stuartsierra.component :as component]
            [jepsen.client :as client]
            [jepsen.util :refer [timeout]]
            [onyx-jepsen.simple-job :as simple-job]
            [onyx.api]
            [onyx.plugin.bookkeeper]
            [onyx.compression.nippy :as nippy]
            [onyx.state.log.bookkeeper :as obk])
  (:import (org.apache.bookkeeper.client LedgerEntry LedgerHandle)))

(defn bookkeeper-client [env-config]
  (obk/bookkeeper env-config))

(defn read-ledger-entries [env-config ledger-id]
  (let [client (bookkeeper-client env-config)
        pwd (obk/password env-config)]
    (let [ledger-handle (obk/open-ledger client ledger-id obk/digest-type pwd)
          results (try
                    (let [last-confirmed (.getLastAddConfirmed ledger-handle)]
                      (info "last confirmed " last-confirmed " ledger-id " ledger-id)
                      (if-not (neg? last-confirmed)
                        (loop [results []
                               entries (.readEntries ledger-handle 0 last-confirmed)
                               element ^LedgerEntry (.nextElement entries)]
                          (let [new-results (conj results (nippy/zookeeper-decompress (.getEntry element)))]
                            (if (.hasMoreElements entries)
                              (recur new-results entries (.nextElement entries))
                              new-results)))
                        []))
                    (catch Throwable t
                      (throw
                        (ex-info (str t (.getCause t))
                                 {:ledger-id ledger-id :exception t})))
                    (finally
                      (.close client)
                      (.close ledger-handle)))]
      {:ledger-id ledger-id
       :results results})))

(defn get-written-ledgers [onyx-client job-data onyx-id task-name]
  (onyx.plugin.bookkeeper/read-ledgers-data (:log onyx-client)
                                            onyx-id
                                            (:job-id job-data)
                                            (get-in job-data [:task-ids task-name :id])))

(defn close-ledger-handles [ledger-handles]
  (mapv (fn [h]
          (try (.close h)
               (catch Throwable t
                 (info "Error closing handle" t))))
        ledger-handles))

(defn await-jobs-completions [peer-config jobs-data]
  (mapv (fn [[job-num job-data]]
          (onyx.api/await-job-completion peer-config (:job-id job-data)))
        jobs-data))

(defn assigned-ledgers [ledger-ids job-num n-jobs]
  (nth (partition-all (/ (count ledger-ids)
                         n-jobs)
                      ledger-ids)
       job-num))

(defn read-peer-log [log timeout-ms]
  (let [ch (chan 1000)]
    (onyx.extensions/subscribe-to-log log ch)
    (loop [entries []]
      (if-let [entry (first (alts!! [ch (casync/timeout timeout-ms)]))]
        (do (info "LOG ENTRY:" entry)
            (recur (conj entries entry)))
        entries))))

(defn read-task-ledgers [onyx-client env-config jobs onyx-id task-name]
  (into {}
        (map (fn [[job-num job-data]]
               (vector job-num
                       (mapv (partial read-ledger-entries env-config)
                             (get-written-ledgers onyx-client job-data onyx-id task-name))))
             jobs)))

;; TODO, merge jobs-data, ledger-handles, and ledger-ids atoms into one big atom map
(defrecord WriteLogClient [env-config peer-config client jobs-data ledger-handles ledger-handle ledger-ids onyx-client]
  client/Client
  (setup! [this test node]
    (let [client (bookkeeper-client env-config)
          lh (obk/new-ledger client env-config)
          onyx-client (component/start (onyx.system/onyx-client peer-config))]
      (swap! ledger-ids conj (.getId lh))
      (swap! ledger-handles conj lh)
      (assoc this :client client :ledger-handle lh :onyx-client onyx-client)))

  (invoke! [this test op]
    (let [zk-addr (:zookeeper/address env-config)
          onyx-id (:onyx/id env-config)]
      (case (:f op)
        :read-peer-log (timeout 1000000
                                (assoc op :type :info :value :timed-out)
                                (try
                                  (assoc op
                                         :type :ok
                                         :value (read-peer-log (:log onyx-client) (or (:timeout-ms op) 20000)))
                                  (catch Throwable t
                                    (assoc op :type :info :value t))))

        :close-ledgers-await-completion (timeout 2000000
                                                 (assoc op :type :info :value :timed-out)
                                                 (try
                                                   (assoc op
                                                          :type :ok
                                                          :value (do (close-ledger-handles @ledger-handles)
                                                                     (await-jobs-completions peer-config @jobs-data)
                                                                     ; to debug, nil to ensure it's serializable for now
                                                                     nil))
                                                   (catch Throwable t
                                                     (assoc op :type :info :value t))))

        :read-ledgers (timeout 1000000
                               (assoc op :type :info :value :timed-out)
                               (try
                                 (assoc op
                                        :type :ok
                                        :value (into {}
                                                     (map (fn [[job-num job-data]]
                                                            (vector job-num
                                                                    (mapv (partial read-ledger-entries env-config)
                                                                          (get-written-ledgers onyx-client job-data onyx-id (:task op)))))
                                                          @jobs-data))

                                        #_(read-task-ledgers onyx-client ))
                                 (catch Throwable t
                                   (assoc op :type :info :value t))))

        :gc-peer-log (timeout 10000
                              (assoc op :type :info :value :timed-out)
                              (try
                                (assoc op
                                       :type :ok
                                       :value (onyx.api/gc peer-config))
                                (catch Throwable t
                                  (assoc op :type :info :value t))))

        :submit-job (timeout 10000
                             (assoc op :type :info :value :timed-out)
                             (try
                               (assoc op
                                      :type :ok
                                      :value (let [{:keys [job-num n-jobs params]} op
                                                   ledgers (assigned-ledgers @ledger-ids job-num n-jobs)
                                                   built-job (case (:job-type op)
                                                               :window-state-job
                                                               (simple-job/build-window-state-job job-num
                                                                                params
                                                                                zk-addr
                                                                                (onyx.log.zookeeper/ledgers-path onyx-id)
                                                                                ledgers)
                                                               :simple-job
                                                               (simple-job/build-job job-num
                                                                                params
                                                                                zk-addr
                                                                                (onyx.log.zookeeper/ledgers-path onyx-id)
                                                                                ledgers))
                                                   job-data (onyx.api/submit-job peer-config built-job)]
                                               (swap! jobs-data assoc job-num job-data)
                                               job-data))
                               (catch Throwable t
                                 (assoc op :type :info :value t))))

        :add (timeout 5000
                      (assoc op :type :info :value :timed-out)
                      (try
                        (do
                          (.addEntry ledger-handle (nippy/zookeeper-compress (:value op)))
                          (assoc op :type :ok :ledger-id (.getId ledger-handle)))
                        (catch Throwable t
                          (assoc op :type :info :value (.getMessage t))))))))

  (teardown! [_ test]
    (.close client)
    (component/stop onyx-client)))

(defn write-log-client [env-config peer-config jobs-data ledger-handles ledger-ids]
  (map->WriteLogClient {:env-config env-config :peer-config peer-config
                        :jobs-data jobs-data :ledger-handles ledger-handles :ledger-ids ledger-ids}))

(ns onyx-jepsen.onyx-client
  "Tests for Onyx"
  (:require [clojure.core.async :as casync :refer [alts!! chan]]
            [clojure.tools.logging :refer :all]
            [com.stuartsierra.component :as component]
            [jepsen.client :as client]
            [jepsen.util :refer [timeout]]
            [onyx-jepsen.simple-job :as simple-job]
            [onyx.api]
            [onyx.plugin.bookkeeper]
            [onyx.compression.nippy :as nippy]
            [onyx.state.log.bookkeeper :as obk])
  (:import (org.apache.bookkeeper.client LedgerEntry LedgerHandle)))

(defn bookkeeper-client [env-config]
  (obk/bookkeeper env-config))

(defn read-ledger-entries [env-config ledger-id]
  (let [client (bookkeeper-client env-config)
        pwd (obk/password env-config)]
    (let [ledger-handle (obk/open-ledger client ledger-id obk/digest-type pwd)
          results (try
                    (let [last-confirmed (.getLastAddConfirmed ledger-handle)]
                      (info "last confirmed " last-confirmed " ledger-id " ledger-id)
                      (if-not (neg? last-confirmed)
                        (loop [results []
                               entries (.readEntries ledger-handle 0 last-confirmed)
                               element ^LedgerEntry (.nextElement entries)]
                          (let [new-results (conj results (nippy/zookeeper-decompress (.getEntry element)))]
                            (if (.hasMoreElements entries)
                              (recur new-results entries (.nextElement entries))
                              new-results)))
                        []))
                    (catch Throwable t
                      (throw
                        (ex-info (str t (.getCause t))
                                 {:ledger-id ledger-id :exception t})))
                    (finally
                      (.close client)
                      (.close ledger-handle)))]
      {:ledger-id ledger-id
       :results results})))

(defn get-written-ledgers [onyx-client job-data onyx-id task-name]
  (onyx.plugin.bookkeeper/read-ledgers-data (:log onyx-client)
                                            onyx-id
                                            (:job-id job-data)
                                            (get-in job-data [:task-ids task-name :id])))

(defn close-ledger-handles [ledger-handles]
  (mapv (fn [h]
          (try (.close h)
               (catch Throwable t
                 (info "Error closing handle" t))))
        ledger-handles))

(defn await-jobs-completions [peer-config jobs-data]
  (mapv (fn [[job-num job-data]]
          (onyx.api/await-job-completion peer-config (:job-id job-data)))
        jobs-data))

(defn assigned-ledgers [ledger-ids job-num n-jobs]
  (nth (partition-all (/ (count ledger-ids)
                         n-jobs)
                      ledger-ids)
       job-num))

(defn read-peer-log [log timeout-ms]
  (let [ch (chan 1000)]
    (onyx.extensions/subscribe-to-log log ch)
    (loop [entries []]
      (if-let [entry (first (alts!! [ch (casync/timeout timeout-ms)]))]
        (do (info "LOG ENTRY:" entry)
            (recur (conj entries entry)))
        entries))))

(defn read-task-ledgers [onyx-client env-config jobs onyx-id task-name]
  (into {}
        (map (fn [[job-num job-data]]
               (vector job-num
                       (mapv (partial read-ledger-entries env-config)
                             (get-written-ledgers onyx-client job-data onyx-id task-name))))
             jobs)))

;; TODO, merge jobs-data, ledger-handles, and ledger-ids atoms into one big atom map
(defrecord WriteLogClient [env-config peer-config client jobs-data ledger-handles ledger-handle ledger-ids onyx-client]
  client/Client
  (setup! [this test node]
    (let [client (bookkeeper-client env-config)
          lh (obk/new-ledger client env-config)
          onyx-client (component/start (onyx.system/onyx-client peer-config))]
      (swap! ledger-ids conj (.getId lh))
      (swap! ledger-handles conj lh)
      (assoc this :client client :ledger-handle lh :onyx-client onyx-client)))

  (invoke! [this test op]
    (let [zk-addr (:zookeeper/address env-config)
          onyx-id (:onyx/id env-config)]
      (case (:f op)
        :read-peer-log (timeout 1000000
                                (assoc op :type :info :value :timed-out)
                                (try
                                  (assoc op
                                         :type :ok
                                         :value (read-peer-log (:log onyx-client) (or (:timeout-ms op) 20000)))
                                  (catch Throwable t
                                    (assoc op :type :info :value t))))

        :close-ledgers-await-completion (timeout 1000000
                                                 (assoc op :type :info :value :timed-out)
                                                 (try
                                                   (assoc op
                                                          :type :ok
                                                          :value (do (close-ledger-handles @ledger-handles)
                                                                     (await-jobs-completions peer-config @jobs-data)
                                                                     ; to debug, nil to ensure it's serializable for now
                                                                     nil))
                                                   (catch Throwable t
                                                     (assoc op :type :info :value t))))

        :read-ledgers (timeout 1000000
                               (assoc op :type :info :value :timed-out)
                               (try
                                 (assoc op
                                        :type :ok
                                        :value (into {}
                                                     (map (fn [[job-num job-data]]
                                                            (vector job-num
                                                                    (mapv (partial read-ledger-entries env-config)
                                                                          (get-written-ledgers onyx-client job-data onyx-id (:task op)))))
                                                          @jobs-data))

                                        #_(read-task-ledgers onyx-client ))
                                 (catch Throwable t
                                   (assoc op :type :info :value t))))

        :gc-peer-log (timeout 10000
                              (assoc op :type :info :value :timed-out)
                              (try
                                (assoc op
                                       :type :ok
                                       :value (onyx.api/gc peer-config))
                                (catch Throwable t
                                  (assoc op :type :info :value t))))

        :submit-job (timeout 10000
                             (assoc op :type :info :value :timed-out)
                             (try
                               (assoc op
                                      :type :ok
                                      :value (let [{:keys [job-num n-jobs params]} op
                                                   ledgers (assigned-ledgers @ledger-ids job-num n-jobs)
                                                   built-job (case (:job-type op)
                                                               :window-state-job
                                                               (simple-job/build-window-state-job job-num
                                                                                params
                                                                                zk-addr
                                                                                (onyx.log.zookeeper/ledgers-path onyx-id)
                                                                                ledgers)
                                                               :simple-job
                                                               (simple-job/build-job job-num
                                                                                params
                                                                                zk-addr
                                                                                (onyx.log.zookeeper/ledgers-path onyx-id)
                                                                                ledgers))
                                                   job-data (onyx.api/submit-job peer-config built-job)]
                                               (swap! jobs-data assoc job-num job-data)
                                               job-data))
                               (catch Throwable t
                                 (assoc op :type :info :value t))))

        :add (timeout 5000
                      (assoc op :type :info :value :timed-out)
                      (try
                        (do
                          (.addEntry ledger-handle (nippy/zookeeper-compress (:value op)))
                          (assoc op :type :ok :ledger-id (.getId ledger-handle)))
                        (catch Throwable t
                          (assoc op :type :info :value (.getMessage t))))))))

  (teardown! [_ test]
    (.close client)
    (component/stop onyx-client)))

(defn write-log-client [env-config peer-config jobs-data ledger-handles ledger-ids]
  (map->WriteLogClient {:env-config env-config :peer-config peer-config
                        :jobs-data jobs-data :ledger-handles ledger-handles :ledger-ids ledger-ids}))

Reduce time allowed for job to finish to 20 mins


(defproject {{name}} "0.1.0-SNAPSHOT"
  :repositories [["clojars" {:url "https://clojars.org/repo"
                             :sign-releases false}]]
  :clean-targets ^{:protect false} ["target"]
  :dependencies [[org.clojure/clojure "1.10.1"]
                 [edna "1.6.0"]]
  ; on Mac OS, you need to uncomment this!
  ;:jvm-opts ["-XstartOnFirstThread"]
  :profiles {:dev {:main {{name}}.start-dev
                   :dependencies [[paravim "RELEASE"]
                                  [orchestra "2018.12.06-2"]
                                  [expound "0.7.2"]]}
             :uberjar {:main {{name}}.start
                       :aot [{{name}}.start]
                       :dependencies [[play-cljc "0.8.4"]
                                      [org.lwjgl/lwjgl "3.2.3"]
                                      [org.lwjgl/lwjgl-glfw "3.2.3"]
                                      [org.lwjgl/lwjgl-opengl "3.2.3"]
                                      [org.lwjgl/lwjgl-stb "3.2.3"]
                                      [org.lwjgl/lwjgl "3.2.3" :classifier "natives-linux"]
                                      [org.lwjgl/lwjgl-glfw "3.2.3" :classifier "natives-linux"]
                                      [org.lwjgl/lwjgl-opengl "3.2.3" :classifier "natives-linux"]
                                      [org.lwjgl/lwjgl-stb "3.2.3" :classifier "natives-linux"]
                                      [org.lwjgl/lwjgl "3.2.3" :classifier "natives-macos"]
                                      [org.lwjgl/lwjgl-glfw "3.2.3" :classifier "natives-macos"]
                                      [org.lwjgl/lwjgl-opengl "3.2.3" :classifier "natives-macos"]
                                      [org.lwjgl/lwjgl-stb "3.2.3" :classifier "natives-macos"]
                                      [org.lwjgl/lwjgl "3.2.3" :classifier "natives-windows"]
                                      [org.lwjgl/lwjgl-glfw "3.2.3" :classifier "natives-windows"]
                                      [org.lwjgl/lwjgl-opengl "3.2.3" :classifier "natives-windows"]
                                      [org.lwjgl/lwjgl-stb "3.2.3" :classifier "natives-windows"]]}})

(defproject {{name}} "0.1.0-SNAPSHOT"
  :repositories [["clojars" {:url "https://clojars.org/repo"
                             :sign-releases false}]]
  :clean-targets ^{:protect false} ["target"]
  :dependencies [[org.clojure/clojure "1.10.1"]
                 [edna "1.6.0"]]
  :jvm-opts ~(if (= "Mac OS X" (System/getProperty "os.name"))
               ["-XstartOnFirstThread"]
               [])
  :profiles {:dev {:main {{name}}.start-dev
                   :dependencies [[paravim "RELEASE"]
                                  [orchestra "2018.12.06-2"]
                                  [expound "0.7.2"]]}
             :uberjar {:main {{name}}.start
                       :aot [{{name}}.start]
                       :dependencies [[play-cljc "0.8.4"]
                                      [org.lwjgl/lwjgl "3.2.3"]
                                      [org.lwjgl/lwjgl-glfw "3.2.3"]
                                      [org.lwjgl/lwjgl-opengl "3.2.3"]
                                      [org.lwjgl/lwjgl-stb "3.2.3"]
                                      [org.lwjgl/lwjgl "3.2.3" :classifier "natives-linux"]
                                      [org.lwjgl/lwjgl-glfw "3.2.3" :classifier "natives-linux"]
                                      [org.lwjgl/lwjgl-opengl "3.2.3" :classifier "natives-linux"]
                                      [org.lwjgl/lwjgl-stb "3.2.3" :classifier "natives-linux"]
                                      [org.lwjgl/lwjgl "3.2.3" :classifier "natives-macos"]
                                      [org.lwjgl/lwjgl-glfw "3.2.3" :classifier "natives-macos"]
                                      [org.lwjgl/lwjgl-opengl "3.2.3" :classifier "natives-macos"]
                                      [org.lwjgl/lwjgl-stb "3.2.3" :classifier "natives-macos"]
                                      [org.lwjgl/lwjgl "3.2.3" :classifier "natives-windows"]
                                      [org.lwjgl/lwjgl-glfw "3.2.3" :classifier "natives-windows"]
                                      [org.lwjgl/lwjgl-opengl "3.2.3" :classifier "natives-windows"]
                                      [org.lwjgl/lwjgl-stb "3.2.3" :classifier "natives-windows"]]}})

Choose correct :jvm-opts automatically

Choose correct :jvm-opts automatically


; :mode=clojure:

(ns hello
    (:use
        [goog.dom :only [appendChild createDom createTextNode removeChildren]]
        [goog.events :only [listen]]
        [goog.events.EventType :only [CLICK]]
        [goog.graphics :only [createGraphics Stroke SolidFill]]
        [goog :only [Timer]]
        ))

(def my-code-url "https://github.com/pauldoo/scratch/blob/master/ClojureScript/hello.cljs")

(defn print-to-log [v]
    (.log js/console v))

(defn input-event [input-state-ref event]
    (swap! input-state-ref
        (fn [{keys :keys}]
            {:keys
                (cond
                    (= (.type event) goog.events.EventType/KEYUP)
                        (disj keys (.keyCode event))
                    (= (.type event) goog.events.EventType/KEYDOWN)
                        (conj keys (.keyCode event))
                    :else keys)})))

(defn tick [game-state-ref input-state]
    (swap! game-state-ref
        (fn [{[x y] :pos}]
            {:pos [(inc x) (* 50 (count (:keys input-state)))]})))

(defn rerender [canvas-element game-state]
    (let [{[x y] :pos} game-state
        graphics (goog.graphics/createGraphics 400 300)]
        (do
            (.drawCircle graphics x y 30 (Stroke. 2 "green") (SolidFill. "yellow"))
            (goog.dom/removeChildren canvas-element)
            (.render graphics canvas-element)
            )))

(defn ^:export main []
    (let [
        game-state-ref (atom {:pos [0 0]})
        input-state-ref (atom {:keys (set)})
        canvas (goog.dom/createDom "div" {} "")
        button (goog.dom/createDom "button" {} "Click!")
        tick-timer (Timer. 100)
        render-timer (Timer. 100)
        ]
        (do
            (. tick-timer (start))
            (. render-timer (start))
            (goog.events/listen button goog.events.EventType/CLICK (partial input-event input-state-ref))
            (goog.events/listen document.body goog.events.EventType/KEYDOWN (partial input-event input-state-ref) true)
            (goog.events/listen document.body goog.events.EventType/KEYUP (partial input-event input-state-ref) true)
            (goog.events/listen tick-timer goog.Timer/TICK #(tick game-state-ref (deref input-state-ref)))
            (goog.events/listen render-timer goog.Timer/TICK #(rerender canvas (deref game-state-ref)))
            (goog.dom/appendChild document.body (goog.dom/createDom "div" {}
                (goog.dom/createDom "h1" {} "Work in progress..")
                (goog.dom/createDom "div" {} "Try clicking the button, or pressing keys.")
                (goog.dom/createDom "div" {}
                    (goog.dom/createTextNode "My code lives here: ")
                    (goog.dom/createDom "a" (.strobj {"href" my-code-url}) my-code-url))
                button
                canvas)))))

; :mode=clojure:

(ns hello
    (:use
        [goog.dom :only [appendChild createDom createTextNode removeChildren]]
        [goog.events :only [listen]]
        [goog.events.EventType :only [CLICK]]
        [goog.graphics :only [createGraphics Stroke SolidFill]]
        [goog :only [Timer]]
        ))

(def my-code-url "https://github.com/pauldoo/scratch/blob/master/ClojureScript/hello.cljs")

(defn print-to-log [v]
    (.log js/console v))

(def vec- (partial map -))
(def vec+ (partial map +))
(defn vec* [v s] (map * v (repeat s)))
(def magnitude-squared (comp (partial apply +) (partial map #(* % %))))
(def magnitude (comp Math/sqrt magnitude-squared))
(def normalize (comp (partial apply vec*) (juxt identity (comp (partial / 1.0) magnitude))))

(defn calculate-force [node-a node-b rest-length strength]
    (let [a-b (vec- node-a node-b)
        pressure (* (- rest-length (magnitude a-b)) strength)
        force (vec* (normalize a-b) pressure)]
            force))

(defn calculate-node-forces [nodes springs]
    (loop [forces {} springs springs]
        (if (empty? springs) forces
            (let [
                [s & r] springs
                node-a-id (s :node-a)
                node-b-id (s :node-b)
                force (calculate-force (nodes node-a-id) (nodes node-b-id) (:rest-length s) (:strength s))]
                (recur
                    (assoc forces
                        node-a-id (vec+ (get forces node-a-id [0 0]) force)
                        node-b-id (vec- (get forces node-b-id [0 0]) force))
                    r)))))

(print-to-log
    (pr-str (calculate-node-forces {:t [1 1] :u [2 3] } [{:node-a :t :node-b :u :rest-length 2.0 :strength 5.0}] )))

(defn input-event [input-state-ref event]
    (swap! input-state-ref
        (fn [{keys :keys}]
            {:keys
                (cond
                    (= (.type event) goog.events.EventType/KEYUP)
                        (disj keys (.keyCode event))
                    (= (.type event) goog.events.EventType/KEYDOWN)
                        (conj keys (.keyCode event))
                    :else keys)})))

(defn tick [game-state-ref input-state]
    (swap! game-state-ref
        (fn [{[x y] :pos}]
            {:pos [(inc x) (* 50 (count (:keys input-state)))]})))

(defn rerender [canvas-element game-state]
    (let [{[x y] :pos} game-state
        graphics (goog.graphics/createGraphics 400 300)]
        (do
            (.drawCircle graphics x y 30 (Stroke. 2 "green") (SolidFill. "yellow"))
            (goog.dom/removeChildren canvas-element)
            (.render graphics canvas-element)
            )))

(defn ^:export main []
    (let [
        game-state-ref (atom {:pos [0 0]})
        input-state-ref (atom {:keys (set)})
        canvas (goog.dom/createDom "div" {} "")
        button (goog.dom/createDom "button" {} "Click!")
        tick-timer (Timer. 100)
        render-timer (Timer. 100)
        ]
        (do
            (. tick-timer (start))
            (. render-timer (start))
            (goog.events/listen button goog.events.EventType/CLICK (partial input-event input-state-ref))
            (goog.events/listen document.body goog.events.EventType/KEYDOWN (partial input-event input-state-ref) true)
            (goog.events/listen document.body goog.events.EventType/KEYUP (partial input-event input-state-ref) true)
            (goog.events/listen tick-timer goog.Timer/TICK #(tick game-state-ref (deref input-state-ref)))
            (goog.events/listen render-timer goog.Timer/TICK #(rerender canvas (deref game-state-ref)))
            (goog.dom/appendChild document.body (goog.dom/createDom "div" {}
                (goog.dom/createDom "h1" {} "Work in progress..")
                (goog.dom/createDom "div" {} "Try clicking the button, or pressing keys.")
                (goog.dom/createDom "div" {}
                    (goog.dom/createTextNode "My code lives here: ")
                    (goog.dom/createDom "a" (.strobj {"href" my-code-url}) my-code-url))
                button
                canvas)))))

Work in progress physics.

Work in progress physics.


(ns hsm.utils
  "Utility functions.
  TODO:
  - Separate HTTP related helpers into separate namespace
  - Write proper extensive tests which would make it easier to understand
  and would be pretty much self documenting."
  (:require
    [clojure.java.io :as io]
    [clojure.string :as str]
    [clojure.tools.logging :as log]
    [cheshire.core :refer :all]
    [ring.util.response :as resp]
    [clj-time.core :as t]
    [clj-time.format :as f]
    [clj-time.local :as l]
    [clj-time.coerce :as c])
  (:import [com.google.common.net InternetDomainName]))

(defn select-values
  "clojure.core contains select-keys
  but not select-values."
  [m ks]
  (reduce
    #(if-let [v (m %2)]
        (conj %1 v) %1)
    [] ks))

(defn epoch
  "Returns the millisecond representation
  the given datetime as epoch"
  ([d]
   (c/to-long d))
  ([d format]
   (if (= format :second)
     (/ (c/to-long d) 1000)
     (epoch d))))

(defn now->ep
  "Returns the microsecond representation of epoch of now."
  []
  (epoch (t/now)))

(defn body-as-string
  "In a given request context (or hash-map contains the body key),
  returns the body if string, else tries to read input
  string using Java.io and slurp"
  [ctx]
  (if-let [body (:body ctx)]
    (condp instance? body
      java.lang.String body
      (slurp (io/reader body)))))

(defn mapkeyw
  [data]
  (apply merge
    (map
      #(hash-map (keyword %) (get data %))
      (keys data))))

(def zero (fn[& args] 0))
(def idseq (atom 0))
(def start (hsm.utils/epoch (t/date-time 2014 1 1)))

(defn id-generate
  "Generate a new ID. Very raw right now.
  TODO: Replace with a proper ID generator.
  Like Twitter Snowflake or simirlar"
  [& args]
  (let [time (-> (- (hsm.utils/now->ep) start) (bit-shift-left 23))
        worker (-> 1 (bit-shift-left 10))
        sequence (swap! idseq inc)]
        (if (> sequence 4095) (swap! idseq zero))
        (bit-or time worker sequence)))

(defn host-of
  "Finds the host header of the request"
  [request]
  (get-in request [:headers "host"]))

(def domains ["pythonhackers.com" "hackersome.com" "sweet.io"])

(defn domain-of
  [request]
  (let [domain (InternetDomainName/from (host-of request))]
    (.parts domain)))

(defn ^:private connect-parts
  [parts]
  (clojure.string/join "." parts)
  )

(defn fqdn
  [request]
  (let [parts (domain-of request)]
    (if (= (count parts) 3)
      (connect-parts parts)
      (connect-parts (concat ["www"] (vec parts))))))

(defn id-of
  "Finds the ID of the request. E.g
  - /link/:id
  - /post/:id
  - /user/:id"
  [request]
  (get-in request [:route-params :id]))

(defn body-of
  "Reads the JSON body of the request"
  [request]
  (parse-string
    (body-as-string request)))

(defn whois
  "Temporary user finder.. Returns a static User ID"
  [request]
  (log/debug (get-in request [:headers "x-auth-token"]))
  243975551163827208)

(defn byte-array->str
  "Convert byte array into String"
  [bytes]
  (apply str (map char bytes)))

(defn !nil? [x] (not (nil? x)))
(defn   !blank? [x] (not (str/blank? x)))
(defn     !neg? [x] (not (neg? x)))
(defn  pos-int? [x] (and (integer? x) (pos? x)))
(defn !neg-int? [x] (and (integer? x) (!neg? x)))
(defn   nvec? [n x] (and (vector?  x) (= (count x) n)))
(defn vec2? [x] (nvec? 2 x))
(defn vec3? [x] (nvec? 3 x))
(defn nnil=
  ([x y]        (and (nnil? x) (= x y)))
  ([x y & more] (and (nnil? x) (apply = x y more))))

(ns hsm.utils
  "Utility functions.
  TODO:
  - Separate HTTP related helpers into separate namespace
  - Write proper extensive tests which would make it easier to understand
  and would be pretty much self documenting."
  (:require
    [clojure.java.io :as io]
    [clojure.string :as str]
    [clojure.tools.logging :as log]
    [cheshire.core :refer :all]
    [ring.util.response :as resp]
    [clj-time.core :as t]
    [clj-time.format :as f]
    [clj-time.local :as l]
    [clj-time.coerce :as c])
  (:import [com.google.common.net InternetDomainName]))

(defn select-values
  "clojure.core contains select-keys
  but not select-values."
  [m ks]
  (reduce
    #(if-let [v (m %2)]
        (conj %1 v) %1)
    [] ks))

(defn epoch
  "Returns the millisecond representation
  the given datetime as epoch"
  ([d]
   (c/to-long d))
  ([d format]
   (if (= format :second)
     (/ (c/to-long d) 1000)
     (epoch d))))

(defn now->ep
  "Returns the microsecond representation of epoch of now."
  []
  (epoch (t/now)))

(defn body-as-string
  "In a given request context (or hash-map contains the body key),
  returns the body if string, else tries to read input
  string using Java.io and slurp"
  [ctx]
  (if-let [body (:body ctx)]
    (condp instance? body
      java.lang.String body
      (slurp (io/reader body)))))

(defn mapkeyw
  [data]
  (apply merge
    (map
      #(hash-map (keyword %) (get data %))
      (keys data))))

(def zero (fn[& args] 0))
(def idseq (atom 0))
(def start (hsm.utils/epoch (t/date-time 2014 1 1)))

(defn id-generate
  "Generate a new ID. Very raw right now.
  TODO: Replace with a proper ID generator.
  Like Twitter Snowflake or simirlar"
  [& args]
  (let [time (-> (- (hsm.utils/now->ep) start) (bit-shift-left 23))
        worker (-> 1 (bit-shift-left 10))
        sequence (swap! idseq inc)]
        (if (> sequence 4095) (swap! idseq zero))
        (bit-or time worker sequence)))

(defn host-of
  "Finds the host header of the request"
  [request]
  (get-in request [:headers "host"]))

(def domains ["pythonhackers.com" "hackersome.com" "sweet.io"])

(defn domain-of
  [request]
  (let [domain (InternetDomainName/from (host-of request))]
    (.parts domain)))

(defn ^:private connect-parts
  [parts]
  (clojure.string/join "." parts)
  )

(defn fqdn
  [request]
  (let [parts (domain-of request)]
    (if (= (count parts) 3)
      (connect-parts parts)
      (connect-parts (concat ["www"] (vec parts))))))

(defn id-of
  "Finds the ID of the request. E.g
  - /link/:id
  - /post/:id
  - /user/:id"
  [request]
  (get-in request [:route-params :id]))

(defn body-of
  "Reads the JSON body of the request"
  [request]
  (parse-string
    (body-as-string request)))

(defn whois
  "Temporary user finder.. Returns a static User ID"
  [request]
  (log/debug (get-in request [:headers "x-auth-token"]))
  243975551163827208)

(defn byte-array->str
  "Convert byte array into String"
  [bytes]
  (apply str (map char bytes)))

(defn !nil? [x] (not (nil? x)))
(defn   !blank? [x] (not (str/blank? x)))
(defn     !neg? [x] (not (neg? x)))
(defn  pos-int? [x] (and (integer? x) (pos? x)))
(defn !neg-int? [x] (and (integer? x) (!neg? x)))
(defn   nvec? [n x] (and (vector?  x) (= (count x) n)))
(defn vec2? [x] (nvec? 2 x))
(defn vec3? [x] (nvec? 3 x))
(defn nnil=
  ([x y]        (and (!nil? x) (= x y)))
  ([x y & more] (and (!nil? x) (apply = x y more))))

fix compile error

fix compile error


(ns mdr2.dtb
  "Functions to query [DAISY Talking
  Books](http://www.daisy.org/daisypedia/daisy-digital-talking-book)"
  (:require [clojure.java.io :refer [file]]
            [clojure.string :as s]
            [pantomime.mime :refer [mime-type-of]])
  (:import javax.sound.sampled.AudioSystem))

(defn wav-file?
  "Is the given `file` a wav file?"
  [file]
  (= (mime-type-of file) "audio/x-wav"))

(defn- audio-file?
  "Is the given `file` an audio file, i.e. any of the valid audio file
  formats for a DAISY Talking Book namely *MPEG-4 AAC audio*, *MPEG-1/2
  Layer III (MP3) audio* and *Linear PCM - RIFF WAVE format audio*?"
  [file]
  (#{"audio/mpeg" "audio/x-wav" "audio/mp4"} (mime-type-of file)))

(defn- text-file?
  "Is the given `file` a text file, i.e. any of the valid text file
  formats for a DAISY Talking Book namely DTBook XML?"
  [file]
  (#{"application/xml"} (mime-type-of file)))

(defn- image-file?
  "Is the given `file` an image file, i.e. any of the valid image file
  formats for a DAISY Talking Book namely png and jpeg?"
  [file]
  (#{"image/png" "image/jpeg"} (mime-type-of file)))

(defn- ncx-file?
  "Is the given `file` an ncx file?"
  [file]
  (and (.isFile file) (.endsWith (.getName file) ".ncx")))

(defn- has-type? [type-pred path]
  (some type-pred (file-seq (file path))))

(defn- has-audio? [dtb] (has-type? audio-file? dtb))
(defn- has-text? [dtb] (has-type? text-file? dtb))
(defn- has-image? [dtb] (has-type? image-file? dtb))
(defn- has-ncx? [dtb] (has-type? ncx-file? dtb))

(defn- audio-content [dtb] (when (has-audio? dtb) "audio"))
(defn- text-content [dtb] (when (has-text? dtb) "text"))
(defn- image-content [dtb] (when (has-image? dtb) "image"))

(defn multimedia-content
  "Return the multimedia content for a given DAISY Talking Book"
  [dtb]
  (->> [audio-content text-content image-content]
       (map #(%1 dtb))
       (remove nil?)
       (s/join ",")))

(defn multimedia-type
  "Return the multimedia type for a given DAISY Talking Book"
  [dtb]
  (let [has-audio (has-audio? dtb)
        has-text (has-text? dtb)
        has-ncx (has-ncx? dtb)]
    (cond
     (and has-audio has-text) "audioFullText"
     (and has-audio has-ncx) "audioNCX"
     (and has-text has-ncx?) "textNCX"
     has-audio "audioOnly"
     :else "")))

(defn audio-format
  "Return the format in which the audio files in the DTB file set are
  written for a given DAISY Talking Book"
  [dtb]
  (let [mime-types (->> (file-seq (file dtb))
                        (filter audio-file?)
                        (remove #(= (.getName %) "tpbnarrator_res.mp3"))
                        (map mime-type-of))]
    (cond
     (every? #{"audio/mp4"} mime-types) "MP4-AAC"
     (every? #{"audio/mpeg"} mime-types) "MP3"
     (every? #{"audio/x-wav"} mime-types) "WAV"
     :else "")))

(defn- file-audio-length
  "Get the length of the audio in seconds for a given audio `file`"
  [file]
  ;; see http://stackoverflow.com/questions/3009908/how-do-i-get-a-sound-files-total-time-in-java
  (let [stream (AudioSystem/getAudioInputStream file)
        format (.getFormat stream)
        frameRate (.getFrameRate format)
        frames (.getFrameLength stream)
        durationInSeconds (/ frames frameRate)]
    durationInSeconds))

(defn audio-length
  "Return the audio legth for a given DAISY Talking Book in seconds"
  [dtb]
  ;; unfortunatelly getting the audio length of an mp3 file doesn't
  ;; seem to be supported at the moment. You need to have the proper
  ;; providers. Maybe this is a problem of openjdk? So just use wav
  ;; files for the calculation.
  (let [audio-files (filter wav-file? (file-seq (file dtb)))]
    (reduce + (map file-audio-length audio-files))))

(defn- file-audio-channels
  "Return the number of audio channels for a given audio `file`"
  [file]
  (let [stream (AudioSystem/getAudioInputStream file)
        format (.getFormat stream)]
    (.getChannels format)))

(defn audio-channels
  "Return the number of audio channels for a given DAISY Talking Book"
  [dtb]
  (let [audio-files (filter wav-file? (file-seq (file dtb)))
        channels (map file-audio-channels audio-files)]
    ;; if not all files are mono we assume the whole book is stereo
    (if (every? #(= 1 %) channels) 1 2)))

(defn mono?
  "Return true if a DAISY Talking Book is mono"
  [dtb]
  (= (audio-channels dtb) 1))

(defn file-sampling-rate
  "Return the sample rate for a given audio `file`"
  [file]
  (let [stream (AudioSystem/getAudioInputStream file)
        format (.getFormat stream)]
    (.getSampleRate format)))

(defn sampling-rate
  "Return the sample rate for a given DAISY Talking Book. If there is
  a mix of sampling rates used the most frequently used is returned"
  [dtb]
  (let [audio-files (filter wav-file? (file-seq (file dtb)))
        sampling-rates (map file-sampling-rate audio-files)]
    (ffirst (sort-by val (frequencies sampling-rates)))))

(defn meta-data
  "Return a map containing all queried meta data for a given DAISY Talking Book"
  [dtb]
  (let [keys [:multimedia_type :audio_format :audio_length]
        fns [multimedia-type audio-format audio-length]]
    ;; of course we could look up the fn using (ns-resolve ns (symbol
    ;; (name kw))) but there is a balance between readybility and
    ;; cleverness
    (zipmap keys (map #(% dtb) fns))))

(ns mdr2.dtb
  "Functions to query [DAISY Talking
  Books](http://www.daisy.org/daisypedia/daisy-digital-talking-book)"
  (:require [clojure.java.io :refer [file]]
            [clojure.string :as s]
            [pantomime.mime :refer [mime-type-of]])
  (:import javax.sound.sampled.AudioSystem))

(defn wav-file?
  "Is the given `file` a wav file?"
  [file]
  (= (mime-type-of file) "audio/x-wav"))

(defn- audio-file?
  "Is the given `file` an audio file, i.e. any of the valid audio file
  formats for a DAISY Talking Book namely *MPEG-4 AAC audio*, *MPEG-1/2
  Layer III (MP3) audio* and *Linear PCM - RIFF WAVE format audio*?"
  [file]
  (#{"audio/mpeg" "audio/x-wav" "audio/mp4"} (mime-type-of file)))

(defn- text-file?
  "Is the given `file` a text file, i.e. any of the valid text file
  formats for a DAISY Talking Book namely DTBook XML?"
  [file]
  (#{"application/xml"} (mime-type-of file)))

(defn- image-file?
  "Is the given `file` an image file, i.e. any of the valid image file
  formats for a DAISY Talking Book namely png and jpeg?"
  [file]
  (#{"image/png" "image/jpeg"} (mime-type-of file)))

(defn- ncx-file?
  "Is the given `file` an ncx file?"
  [file]
  (and (.isFile file) (.endsWith (.getName file) ".ncx")))

(defn- has-type? [type-pred path]
  (some type-pred (file-seq (file path))))

(defn- has-audio? [dtb] (has-type? audio-file? dtb))
(defn- has-text? [dtb] (has-type? text-file? dtb))
(defn- has-image? [dtb] (has-type? image-file? dtb))
(defn- has-ncx? [dtb] (has-type? ncx-file? dtb))

(defn- audio-content [dtb] (when (has-audio? dtb) "audio"))
(defn- text-content [dtb] (when (has-text? dtb) "text"))
(defn- image-content [dtb] (when (has-image? dtb) "image"))

(defn multimedia-content
  "Return the multimedia content for a given DAISY Talking Book"
  [dtb]
  (->> [audio-content text-content image-content]
       (map #(%1 dtb))
       (remove nil?)
       (s/join ",")))

(defn multimedia-type
  "Return the multimedia type for a given DAISY Talking Book"
  [dtb]
  (let [has-audio (has-audio? dtb)
        has-text (has-text? dtb)
        has-ncx (has-ncx? dtb)]
    (cond
     (and has-audio has-text) "audioFullText"
     (and has-audio has-ncx) "audioNCX"
     (and has-text has-ncx?) "textNCX"
     has-audio "audioOnly"
     :else "")))

(defn audio-format
  "Return the format in which the audio files in the DTB file set are
  written for a given DAISY Talking Book"
  [dtb]
  (let [mime-types (->> (file-seq (file dtb))
                        (filter audio-file?)
                        (remove #(= (.getName %) "tpbnarrator_res.mp3"))
                        (map mime-type-of))]
    (cond
     (every? #{"audio/mp4"} mime-types) "MP4-AAC"
     (every? #{"audio/mpeg"} mime-types) "MP3"
     (every? #{"audio/x-wav"} mime-types) "WAV"
     :else "")))

(defn- file-audio-length
  "Get the length of the audio in seconds for a given audio `file`"
  [file]
  ;; see http://stackoverflow.com/questions/3009908/how-do-i-get-a-sound-files-total-time-in-java
  (let [stream (AudioSystem/getAudioInputStream file)
        format (.getFormat stream)
        frameRate (.getFrameRate format)
        frames (.getFrameLength stream)
        durationInSeconds (/ frames frameRate)]
    durationInSeconds))

(defn audio-length
  "Return the audio length for a given DAISY Talking Book in seconds"
  [dtb]
  ;; unfortunatelly getting the audio length of an mp3 file doesn't
  ;; seem to be supported at the moment. You need to have the proper
  ;; providers. Maybe this is a problem of openjdk? So just use wav
  ;; files for the calculation.
  (let [audio-files (filter wav-file? (file-seq (file dtb)))]
    (reduce + (map file-audio-length audio-files))))

(defn- file-audio-channels
  "Return the number of audio channels for a given audio `file`"
  [file]
  (let [stream (AudioSystem/getAudioInputStream file)
        format (.getFormat stream)]
    (.getChannels format)))

(defn audio-channels
  "Return the number of audio channels for a given DAISY Talking Book"
  [dtb]
  (let [audio-files (filter wav-file? (file-seq (file dtb)))
        channels (map file-audio-channels audio-files)]
    ;; if not all files are mono we assume the whole book is stereo
    (if (every? #(= 1 %) channels) 1 2)))

(defn mono?
  "Return true if a DAISY Talking Book is mono"
  [dtb]
  (= (audio-channels dtb) 1))

(defn file-sampling-rate
  "Return the sample rate for a given audio `file`"
  [file]
  (let [stream (AudioSystem/getAudioInputStream file)
        format (.getFormat stream)]
    (.getSampleRate format)))

(defn sampling-rate
  "Return the sample rate for a given DAISY Talking Book. If there is
  a mix of sampling rates used the most frequently used is returned"
  [dtb]
  (let [audio-files (filter wav-file? (file-seq (file dtb)))
        sampling-rates (map file-sampling-rate audio-files)]
    (ffirst (sort-by val (frequencies sampling-rates)))))

(defn meta-data
  "Return a map containing all queried meta data for a given DAISY Talking Book"
  [dtb]
  (let [keys [:multimedia_type :audio_format :audio_length]
        fns [multimedia-type audio-format audio-length]]
    ;; of course we could look up the fn using (ns-resolve ns (symbol
    ;; (name kw))) but there is a balance between readybility and
    ;; cleverness
    (zipmap keys (map #(% dtb) fns))))

Fix a comment typo

Fix a comment typo


(ns nml.core
  (:require [clojure.string    :as string])
  (:require [instaparse.core   :as insta ])
  (:require [clojure.tools.cli :as cli   ])
  (:gen-class))

(declare nk nkv nmlget nmlname nmlset nmlstr)

(def debug false)

(def parse (insta/parser (clojure.java.io/resource "grammar")))

(defn exe [tree commands]
  (if (empty? commands)
    tree
    (let [cmd (first  commands)
          arg (second commands)
          rst (drop 2 commands)]
      (case cmd
        "--get" (let [[nml key    ] (nk  arg)] (exe (nmlget tree nml key)     rst))
        "--set" (let [[nml key val] (nkv arg)] (exe (nmlset tree nml key val) rst))))))

(defn fail [& msg]
  (if msg (println (apply str msg)))
  (System/exit 1))

(defn nk [x]
  (string/split x #":" 2))

(defn nkv [x]
  (let [[nmlkey val] (string/split x #"=" 2)
        [nml key] (nk nmlkey)]
    [nml key val]))

(defn nmlget [tree nml key]
  (let [stmt     (last (filter #(= (nmlname %) nml) (rest tree)))
        nvsubseq (last (filter #(= (nmlname %) key) (rest (last stmt))))
        values   (last nvsubseq)
        value    (if (nil? values) "" (nmlstr values))]
    (println (str nml ":" key "=" value))
    tree))

(defn nmlname [x]
  (nmlstr (second x)))

(defn nmlset [tree nml key val & sub]
  (let [child (if sub :nvsubseq :stmt)
        match (if sub key nml)
        vnew  (if sub (fn [tree] (parse val :start :values)) #(nmlset % nml key val true))
        f     (fn [k v] [child k (if (= (nmlstr k) match) (vnew v) v)])]
    (insta/transform {child f} tree)))

(defn nmlstr [x]
  (let [k (first x)
        v (rest  x)
        cjoin    #(string/join "," %)
        delegate #(map nmlstr %)
        ds       (fn [v] (delegate (sort-by #(nmlname %) v)))
        list2str #(apply str (map nmlstr %))
        sf       #(nmlstr (first %))
        sl       #(nmlstr (last %))]
    (if debug (println (str "k=" k " v=" v)))
    (apply str (case k
                 :s        (ds v)
                 :array    [(sf v) (sl v)]
                 :c        (sf v)
                 :colon    ":"
                 :comma    ","
                 :comment  ""
                 :complex  ["(" (cjoin (delegate v)) ")"]
                 :dataref  (delegate v)
                 :dec      (delegate v)
                 :dot      "."
                 :exp      [(first v) (sl v)]
                 :false    "f"
                 :int      (delegate v)
                 :junk     ""
                 :logical  (sf v)
                 :name     (map string/lower-case v)
                 :nvseq    (ds v)
                 :nvsubseq ["  " (sf v) "=" (sl v) "\n"]
                 :partref  (sf v)
                 :percent  "%"
                 :r        (sf v)
                 :real     (delegate v)
                 :sect     ["(" (list2str v) ")"]
                 :sep      v
                 :sign     v
                 :slash    v
                 :star     "*"
                 :stmt     ["&" (sf v) "\n" (list2str (rest v)) "/\n"]
                 :string   v
                 :true     "t"
                 :uint     v
                 :value    (delegate v)
                 :values   (cjoin (delegate v))
                 :ws       ""
                 :wsopt    ""))))

(defn nmltree [fname]
  (try (parse (slurp fname))
       (catch Exception e (fail "Could not open namelist file '" fname "'"))))

(defn assoc-get [m k v]
  (let [gets (:get m [])]
    (assoc m :get (into gets [v]))))

(defn assoc-set [m k v]
  (let [sets (:set m [])]
    (assoc m :set (into sets [v]))))

(def cliopts
  [["-g" "--get n:k"   "get value of key 'k' in namelist 'n'"        :assoc-fn assoc-get :parse-fn nk ]
   ["-s" "--set n:k=v" "set value of key 'k' in namelist 'n' to 'v'" :assoc-fn assoc-set :parse-fn nkv]])

(defn -main [& args]
  (alter-var-root #'*read-eval* (constantly false))
  (let [{:keys [options arguments summary]} (cli/parse-opts args cliopts)
        filename (first arguments)
        tree (nmltree filename)]
    (println (str "### options " options))
    (println (str "### arguments " arguments))
    (println (str "### summary " summary))
    (println (nmlstr tree))))

(ns nml.core
  (:require [clojure.string    :as string])
  (:require [instaparse.core   :as insta ])
  (:require [clojure.tools.cli :as cli   ])
  (:gen-class))

(declare nmlget nmlname nmlset nmlstr)

; defs

(def debug false)

(def parse (insta/parser (clojure.java.io/resource "grammar")))

;; defns

;;(defn exe [tree commands]
;; (if (empty? commands)
;;   tree
;;   (let [cmd (first  commands)
;;         arg (second commands)
;;         rst (drop 2 commands)]
;;     (case cmd
;;       "--get" (let [[nml key    ] (parse-get arg)] (exe (nmlget tree nml key)     rst))
;;       "--set" (let [[nml key val] (parse-set arg)] (exe (nmlset tree nml key val) rst))))))

(defn fail [& msg]
  (if msg (println (apply str msg)))
  (System/exit 1))

(defn nmlget [tree nml key]
  (let [stmt     (last (filter #(= (nmlname %) nml) (rest tree)))
        nvsubseq (last (filter #(= (nmlname %) key) (rest (last stmt))))
        values   (last nvsubseq)
        value    (if (nil? values) "" (nmlstr values))]
    (println (str nml ":" key "=" value))
    tree))

(defn nmlname [x]
  (nmlstr (second x)))

(defn nmlset [tree nml key val & sub]
  (let [child (if sub :nvsubseq :stmt)
        match (if sub key nml)
        vnew  (if sub (fn [tree] (parse val :start :values)) #(nmlset % nml key val true))
        f     (fn [k v] [child k (if (= (nmlstr k) match) (vnew v) v)])]
    (insta/transform {child f} tree)))

(defn nmlstr [x]
  (let [k (first x)
        v (rest  x)
        cjoin    #(string/join "," %)
        delegate #(map nmlstr %)
        ds       (fn [v] (delegate (sort-by #(nmlname %) v)))
        list2str #(apply str (map nmlstr %))
        sf       #(nmlstr (first %))
        sl       #(nmlstr (last %))]
    (if debug (println (str "k=" k " v=" v)))
    (apply str (case k
                 :s        (ds v)
                 :array    [(sf v) (sl v)]
                 :c        (sf v)
                 :colon    ":"
                 :comma    ","
                 :comment  ""
                 :complex  ["(" (cjoin (delegate v)) ")"]
                 :dataref  (delegate v)
                 :dec      (delegate v)
                 :dot      "."
                 :exp      [(first v) (sl v)]
                 :false    "f"
                 :int      (delegate v)
                 :junk     ""
                 :logical  (sf v)
                 :name     (map string/lower-case v)
                 :nvseq    (ds v)
                 :nvsubseq ["  " (sf v) "=" (sl v) "\n"]
                 :partref  (sf v)
                 :percent  "%"
                 :r        (sf v)
                 :real     (delegate v)
                 :sect     ["(" (list2str v) ")"]
                 :sep      v
                 :sign     v
                 :slash    v
                 :star     "*"
                 :stmt     ["&" (sf v) "\n" (list2str (rest v)) "/\n"]
                 :string   v
                 :true     "t"
                 :uint     v
                 :value    (delegate v)
                 :values   (cjoin (delegate v))
                 :ws       ""
                 :wsopt    ""))))

(defn nmltree [fname]
  (try (parse (slurp fname))
       (catch Exception e (fail "Could not open namelist file '" fname "'"))))

;; cli

(defn assoc-get [m k v]
  (let [gets (:get m [])]
    (assoc m :get (into gets [v]))))

(defn assoc-set [m k v]
  (let [sets (:set m [])]
    (assoc m :set (into sets [v]))))

(defn parse-get [x]
  (string/split x #":" 2))

(defn parse-set [x]
  (let [[nmlkey val] (string/split x #"=" 2)
        [nml key] (parse-get nmlkey)]
    [nml key val]))

(def cliopts
  [["-g" "--get n:k"   "get value of key 'k' in namelist 'n'"        :assoc-fn assoc-get :parse-fn parse-get ]
   ["-s" "--set n:k=v" "set value of key 'k' in namelist 'n' to 'v'" :assoc-fn assoc-set :parse-fn parse-set]])

;; main

(defn -main [& args]
  (alter-var-root #'*read-eval* (constantly false))
  (let [{:keys [options arguments summary]} (cli/parse-opts args cliopts)
        filename (first arguments)
        tree (nmltree filename)]
    (println (str "### options " options))
    (println (str "### arguments " arguments))
    (println (str "### summary " summary))
    (println (nmlstr tree))))

work on options parsing

work on options parsing


(ns haystack.repo
  (:require [clojurewerkz.elastisch.rest :as esr] ;; for connect
            [haystack.query :as query]
            ))

;; (def srv "http://192.168.0.220:9201")
;; (def srv "http://192.168.0.220:9200")
;; (def srv "http://gandalf-the-white:9200")
(def srv (or (System/getenv "ELASTICSEARCH_URL") "http://127.0.0.1:9200"))

(def index-name "searchecommerce")

(def repo (esr/connect srv
                       {:cluster.name "ek"
                        :connection-manager (clj-http.conn-mgr/make-reusable-conn-manager
                                             {:timeout 10})}))

(ns haystack.repo
  (:require [clojurewerkz.elastisch.rest :as esr] ;; for connect
            [haystack.query :as query]
            ))

;; (def srv "http://192.168.0.220:9201")
;; (def srv "http://192.168.0.220:9200")
;; (def srv "http://gandalf-the-white:9200")
(def srv (or (System/getenv "ELASTICSEARCH_URL") "http://127.0.0.1:9200"))

(def index-name "searchecommerce")

(def repo (esr/connect srv
                       {; :cluster.name "ek"
                        :connection-manager (clj-http.conn-mgr/make-reusable-conn-manager
                                             {:timeout 10})}))

Remove cluster name in repo connection.

Remove cluster name in repo connection.


(ns ^:figwheel-always discuss.core
  "Entrypoint to this application. Loads all requirements, and bootstraps the application."
  (:require [om.core :as om :include-macros true]
            [discuss.auth :as auth]
            [discuss.communication :as com]
            [discuss.debug :as debug]
            [discuss.references.integration]
            [discuss.utils.extensions]
            [discuss.utils.common :as lib]
            [discuss.tooltip :as tooltip]
            [discuss.views :as views]))

(enable-console-print!)

;; Initialization
(defn main []
  (com/init!))
;(main)

;; Register
(om/root views/main-view lib/app-state
         {:target (.getElementById js/document (lib/prefix-name "main"))})

(om/root views/sidebar-view lib/app-state
         {:target (.getElementById js/document (lib/prefix-name "sidebar"))})

(om/root tooltip/view {}
         {:target (.getElementById js/document (lib/prefix-name "tooltip"))})

(om/root debug/debug-view lib/app-state
         {:target (.getElementById js/document "debug")})

(defn on-js-reload []
  ;; optionally touch your app-state to force rerendering depending on
  ;; your application
  ;; (swap! app-state update-in [:__figwheel_counter] inc)
  )

(ns ^:figwheel-always discuss.core
  "Entrypoint to this application. Loads all requirements, and bootstraps the application."
  (:require [om.core :as om :include-macros true]
            [discuss.auth :as auth]
            [discuss.communication :as com]
            [discuss.debug :as debug]
            [discuss.references.integration]
            [discuss.utils.extensions]
            [discuss.utils.common :as lib]
            [discuss.tooltip :as tooltip]
            [discuss.views :as views]))

(enable-console-print!)

;; Initialization
(defn main []
  (com/init!))
(main)

;; Register
(om/root views/main-view lib/app-state
         {:target (.getElementById js/document (lib/prefix-name "main"))})

(om/root views/sidebar-view lib/app-state
         {:target (.getElementById js/document (lib/prefix-name "sidebar"))})

(om/root tooltip/view {}
         {:target (.getElementById js/document (lib/prefix-name "tooltip"))})

(om/root debug/debug-view lib/app-state
         {:target (.getElementById js/document "debug")})

(defn on-js-reload []
  ;; optionally touch your app-state to force rerendering depending on
  ;; your application
  ;; (swap! app-state update-in [:__figwheel_counter] inc)
  )

Enable mainfunction on start

Enable mainfunction on start


(ns leiningen.git
  (:require [leiningen.utils :as u]
            [clojure.java.shell :as sh]
            [leiningen.core.main :as m]
            [leiningen.table-pretty-print :as pp]
            [clojure.string :as str]
            [leiningen.namespaces :as ns]))

(def output-length 120)

(defn remove-git-change-status-from [path]
  (-> path
      (str/replace #"M\s" "")
      (str/replace #"A\s" "")
      (str/replace #"D\s" "")
      (str/replace #"R\s" "")
      (str/replace #"C\s" "")
      (str/replace #"U\s" "")
      (str/replace #"\?\?\s" "")
      (str/replace #"\s" "")))

(defn log-git-status [status & args]
  (pp/print-table status)
  (apply m/info args)
  (m/info "\n"))

(defn status-failed []
  (str "==> " :failed))

(defn get-changed-files []
  (let [result (sh/sh "git" "ls-files" "--others" "--exclude-standard")]
    (if (u/is-success? result)
      (->> result
           (u/split-output-of)
           (remove empty?))
      [])))

(defn get-untracked-files []
  (let [result (sh/sh "git" "diff" "--name-only")]
    (if (u/is-success? result)
      (->> result
           (u/split-output-of)
           (remove empty?))
      [])))

(defn add [path]
  (let [result (sh/sh "git" "add" path)]
    (if (u/is-success? result)
      {:status :added}
      {:status :failed})))

(defn unpushed-commit-changes []
  (let [unpushed-changes (-> (sh/sh "git" "diff" "origin/master..HEAD" "--name-only")
                             (u/output-of " "))]
    {:unpushed-changes (if (empty? unpushed-changes)
                         :no-change unpushed-changes)}))

(defn reset-project! [project]
  (if (u/is-success? (sh/sh "git" "checkout" "."))
    {:project project :status :resetted}
    {:project project :status (status-failed)}))

(defn pull-rebase! [project]
  (let [pull-result (sh/sh "git" "pull" "-r")]
    (if (u/is-success? pull-result)
      {:project project
       :status  :pulled
       :details (u/sub-str (u/output-of pull-result " ") output-length)}
      {:project project
       :status  (status-failed)
       :cause   (u/sub-str (u/error-of pull-result " ") output-length)})))

(defn push! [project]
  (let [push-result (sh/sh "git" "push" "origin")]
    (if (u/is-success? push-result)
      {:project project
       :status  :pushed
       :details (u/sub-str (u/output-of push-result " ") output-length)}
      {:project project
       :status  (status-failed)
       :cause   (u/sub-str (u/error-of push-result " ") output-length)})))

(defn changes-empty? [unpushed-commit-changes]
  (= :no-change (:unpushed-changes unpushed-commit-changes)))

(defn check-and-push! [project]
  (if (changes-empty? (unpushed-commit-changes))
    {:project project
     :status  :skipped
     :cause   "Nothing to push on"}
    (if (= "y" (-> (str "\n* Are you sure to push on " project "? (y/n)")
                   (u/ask-user u/yes-or-no)))
      (push! project))))

(defn get-details-status [status-lines projects-desc]
  (let [synchronized-resources (->> status-lines
                                    (filter #(ns/sync-resources?
                                              projects-desc
                                              (remove-git-change-status-from %))))
        other-resources (->> status-lines
                             (filter #(not (u/lazy-contains? synchronized-resources %))))]
    {:sync-relevant-changes (if (empty? synchronized-resources)
                              :no-change
                              (str/join " " synchronized-resources))
     :other-changes         (if (empty? other-resources)
                              :no-change
                              (str/join " " other-resources))}))

(defn details-status [project projects-desc]
  (let [status-result (sh/sh "git" "status" "--short")]
    (if (u/is-success? status-result)
      (merge {:project project}
             (unpushed-commit-changes)
             (get-details-status (u/split-output-of status-result) projects-desc))
      {:project project
       :status  (status-failed)})))

(defn commit! [project commit-msg]
  (let [commit-result (sh/sh "git" "commit" "-m" commit-msg)]
    (if (u/is-success? commit-result)
      {:project        project
       :status         :commited
       :commit-message commit-msg}
      {:project        project
       :status         (status-failed)
       :commit-message commit-msg
       :cause          (u/sub-str (u/error-of commit-result " ") output-length)})))

(defn sync-resources-of [changed-files untracked-files projects-desc]
  (->> (concat changed-files untracked-files)
       (filter #(ns/sync-resources? projects-desc %))))

(defn commit-project! [project commit-msg projects-desc]
  (let [resources-to-add (sync-resources-of
                          (get-changed-files)
                          (get-untracked-files)
                          projects-desc)
        add-status (map add resources-to-add)
        failed-add-actions (filter #(= % :failed) add-status)]
    (cond
      (zero? (count add-status)) {:project        project
                                  :status         :skipped
                                  :commit-message commit-msg
                                  :cause          "No change to commit"}
      (not (zero? (count failed-add-actions))) {:project        project
                                                :status         :skipped
                                                :commit-message commit-msg
                                                :cause          add-status}
      :else (commit! project commit-msg))))

(ns leiningen.git
  (:require [leiningen.utils :as u]
            [clojure.java.shell :as sh]
            [leiningen.core.main :as m]
            [leiningen.table-pretty-print :as pp]
            [clojure.string :as str]
            [leiningen.namespaces :as ns]))

(def output-length 120)

(defn remove-git-change-status-from [path]
  (-> path
      (str/replace #"M\s" "")
      (str/replace #"A\s" "")
      (str/replace #"D\s" "")
      (str/replace #"R\s" "")
      (str/replace #"C\s" "")
      (str/replace #"U\s" "")
      (str/replace #"\?\?\s" "")
      (str/replace #"\s" "")))

(defn log-git-status [status & args]
  (pp/print-table status)
  (apply m/info args)
  (m/info "\n"))

(defn status-failed []
  (str "==> " :failed))

(defn get-changed-files []
  (let [result (sh/sh "git" "ls-files" "--others" "--exclude-standard")]
    (if (u/is-success? result)
      (->> result
           (u/split-output-of)
           (remove empty?))
      [])))

(defn get-untracked-files []
  (let [result (sh/sh "git" "diff" "--name-only")]
    (if (u/is-success? result)
      (->> result
           (u/split-output-of)
           (remove empty?))
      [])))

(defn add [path]
  (let [result (sh/sh "git" "add" path)]
    (if (u/is-success? result)
      {:status :added}
      {:status :failed})))

(defn unpushed-commit-changes []
  (let [unpushed-changes (-> (sh/sh "git" "diff" "origin/master..HEAD" "--name-only")
                             (u/output-of " "))]
    {:unpushed-changes (if (empty? unpushed-changes)
                         :no-change unpushed-changes)}))

(defn reset-project! [project]
  (if (u/is-success? (sh/sh "git" "checkout" "."))
    {:project project :status :resetted}
    {:project project :status (status-failed)}))

(defn pull-rebase! [project]
  (let [pull-result (sh/sh "git" "pull" "-r")]
    (if (u/is-success? pull-result)
      {:project project
       :status  :pulled
       :details (u/sub-str (u/output-of pull-result " ") output-length)}
      {:project project
       :status  (status-failed)
       :cause   (u/sub-str (u/error-of pull-result " ") output-length)})))

(defn push! [project]
  (let [push-result (sh/sh "git" "push" "origin")]
    (if (u/is-success? push-result)
      {:project project
       :status  :pushed
       :details (u/sub-str (u/output-of push-result " ") output-length)}
      {:project project
       :status  (status-failed)
       :cause   (u/sub-str (u/error-of push-result " ") output-length)})))

(defn changes-empty? [unpushed-commit-changes]
  (= :no-change (:unpushed-changes unpushed-commit-changes)))

(defn check-and-push! [project]
  (if (changes-empty? (unpushed-commit-changes))
    {:project project
     :status  :skipped
     :cause   "Nothing to push on"}
    (if (= "y" (-> (str "\n* Are you sure to push on " project "? (y/n)")
                   (u/ask-user u/yes-or-no)))
      (push! project))))

(defn get-details-status [status-lines projects-desc]
  (let [synchronized-resources (->> status-lines
                                    (filter #(ns/sync-resources?
                                              projects-desc
                                              (remove-git-change-status-from %))))
        other-resources (->> status-lines
                             (filter #(not (u/lazy-contains? synchronized-resources %))))]
    {:sync-relevant-changes (if (empty? synchronized-resources)
                              :no-change
                              (str/join " " synchronized-resources))
     :other-changes         (if (empty? other-resources)
                              :no-change
                              (str/join " " other-resources))}))

(defn details-status [project projects-desc]
  (let [status-result (sh/sh "git" "status" "--short")]
    (if (u/is-success? status-result)
      (merge {:project project}
             (unpushed-commit-changes)
             (get-details-status (u/split-output-of status-result) projects-desc))
      {:project project
       :status  (status-failed)})))

(defn commit! [project commit-msg]
  (let [commit-result (sh/sh "git" "commit" "-m" commit-msg)]
    (if (u/is-success? commit-result)
      {:project        project
       :status         :commited
       :commit-message commit-msg}
      {:project        project
       :status         (status-failed)
       :commit-message commit-msg
       :cause          (u/sub-str (u/error-of commit-result " ") output-length)})))

(defn sync-resources-of [changed-files untracked-files projects-desc]
  (->> (concat changed-files untracked-files)
       (filter #(ns/sync-resources? projects-desc %))))

(defn commit-project! [project commit-msg projects-desc]
  (let [add-status (->> projects-desc
                        (sync-resources-of (get-changed-files) (get-untracked-files))
                        (map add))
        failed-add-actions (filter #(= % :failed) add-status)]
    (cond
      (zero? (count add-status)) {:project        project
                                  :status         :skipped
                                  :commit-message commit-msg
                                  :cause          "No change to commit"}
      (not (zero? (count failed-add-actions))) {:project        project
                                                :status         :skipped
                                                :commit-message commit-msg
                                                :cause          add-status}
      :else (commit! project commit-msg))))

clean up

clean up


(ns euler.004-test
  (:require [clojure.test :refer :all]
            [euler.004 :refer :all]))

(deftest euler-003
  (testing "palindromic-number?"
    (is (false? (palindromic-number? 10)))
    (is (false? (palindromic-number? 102)))
    (is (false? (palindromic-number? 9008)))
    (is (true? (palindromic-number? 1)))
    (is (true? (palindromic-number? 11)))
    (is (true? (palindromic-number? 101)))
    (is (true? (palindromic-number? 9009))))

  (testing "solution"
    (is (= 906609 largest-palindromic-product))))

(ns euler.004-test
  (:require [clojure.test :refer :all]
            [euler.004 :refer :all]))

(deftest euler-004
  (testing "palindromic-number?"
    (is (false? (palindromic-number? 10)))
    (is (false? (palindromic-number? 102)))
    (is (false? (palindromic-number? 9008)))
    (is (true? (palindromic-number? 1)))
    (is (true? (palindromic-number? 11)))
    (is (true? (palindromic-number? 101)))
    (is (true? (palindromic-number? 9009))))

  (testing "solution"
    (is (= 906609 largest-palindromic-product))))

Fix incorrect test numbering

Fix incorrect test numbering


(ns espdig.system
  (:require [com.stuartsierra.component :as component]
            [environ.core :refer [env]]
            [taoensso.timbre :as log]
            [clojure.java.io :as io]
            [aero.core :refer [read-config]]
            ;;
            [espdig.components.db :refer [make-db]]
            [espdig.components.aws :refer [make-aws-connection]]
            [espdig.components.youtube-downloader :refer [make-youtube-downloader]]
            [espdig.components.youtube-feeds :refer [make-youtube-feeds-checker]]
            [espdig.components.json-dumper :refer [make-json-dumper]]))

(def youtube-feeds
  [{:feed/channel   "Thooorin"
    :feed/rss       "https://www.youtube.com/feeds/videos.xml?channel_id=UCfeeUuW7edMxF3M_cyxGT8Q"
    :feed/title-rgx [".*"]}
   {:feed/channel   "Drop The Bomb TV"
    :feed/rss       "https://www.youtube.com/feeds/videos.xml?channel_id=UC-SmMElbXYS91yuDR1N0RIg"
    :feed/title-rgx [".*"]}
   {:feed/channel   "Richard Lewis"
    :feed/rss      "https://www.youtube.com/feeds/videos.xml?channel_id=UCEOQ9pSmMEIqfhtCDa2JORw"
    :feed/title-rgx [".*"]}
   {:feed/channel   "Monte Cristo"
    :feed/rss      "https://www.youtube.com/feeds/videos.xml?channel_id=UCZ26xCMrmYnUWYFtZr7cWCg"
    :feed/title-rgx [".*"]}
   {:feed/channel   "Insight on Esports"
    :feed/rss      "https://www.youtube.com/feeds/videos.xml?channel_id=UC4AGeYoOM9lRH6-L7wNFgTQ"
    :feed/title-rgx [".*"]}])

(defn new-system
  [profile]
  (let [config (read-config (io/resource "config.edn") {:profile profile})]
    (if (and (= profile :production)
             (or (not (get-in config [:aws :aws-access-key]))
                 (not (get-in config [:aws :aws-secret-key]))))
      (log/error "Credentials missing!")
      (do
        (log/merge-config! (:log config))
        (component/system-map
         :db    (make-db (:db config))
         :aws   (make-aws-connection (:aws config))
         :feeds (component/using
                 (make-youtube-feeds-checker youtube-feeds (:media config))
                 [:db])
         :yt-dl (component/using
                 (make-youtube-downloader (:media config))
                 [:aws :db])
         :json (component/using
                (make-json-dumper (assoc (:json config)
                                         :tbl-name (get-in config [:media :tbl-name])))
                [:aws :db]))))))

(ns espdig.system
  (:require [com.stuartsierra.component :as component]
            [environ.core :refer [env]]
            [taoensso.timbre :as log]
            [clojure.java.io :as io]
            [aero.core :refer [read-config]]
            ;;
            [espdig.components.db :refer [make-db]]
            [espdig.components.aws :refer [make-aws-connection]]
            [espdig.components.youtube-downloader :refer [make-youtube-downloader]]
            [espdig.components.youtube-feeds :refer [make-youtube-feeds-checker]]
            [espdig.components.json-dumper :refer [make-json-dumper]]))

(def youtube-feeds
  [{:feed/channel   "Thooorin"
    :feed/rss       "https://www.youtube.com/feeds/videos.xml?channel_id=UCfeeUuW7edMxF3M_cyxGT8Q"
    :feed/title-rgx [".*"]}
   {:feed/channel   "Drop The Bomb TV"
    :feed/rss       "https://www.youtube.com/feeds/videos.xml?channel_id=UC-SmMElbXYS91yuDR1N0RIg"
    :feed/title-rgx [".*"]}
   {:feed/channel   "Richard Lewis"
    :feed/rss      "https://www.youtube.com/feeds/videos.xml?channel_id=UCEOQ9pSmMEIqfhtCDa2JORw"
    :feed/title-rgx [".*"]}
   {:feed/channel   "Monte Cristo"
    :feed/rss      "https://www.youtube.com/feeds/videos.xml?channel_id=UCZ26xCMrmYnUWYFtZr7cWCg"
    :feed/title-rgx [".*"]}
   {:feed/channel   "Insight on Esports"
    :feed/rss      "https://www.youtube.com/feeds/videos.xml?channel_id=UC4AGeYoOM9lRH6-L7wNFgTQ"
    :feed/title-rgx [".*"]}
   {:feed/channel   "Thorin's Side"
    :feed/rss      "https://www.youtube.com/feeds/videos.xml?channel_id=UC4rma8fFU0UmxiiVzH8RHDA"
    :feed/title-rgx [".*"]}])

(defn new-system
  [profile]
  (let [config (read-config (io/resource "config.edn") {:profile profile})]
    (if (and (= profile :production)
             (or (not (get-in config [:aws :aws-access-key]))
                 (not (get-in config [:aws :aws-secret-key]))))
      (log/error "Credentials missing!")
      (do
        (log/merge-config! (:log config))
        (component/system-map
         :db    (make-db (:db config))
         :aws   (make-aws-connection (:aws config))
         :feeds (component/using
                 (make-youtube-feeds-checker youtube-feeds (:media config))
                 [:db])
         :yt-dl (component/using
                 (make-youtube-downloader (:media config))
                 [:aws :db])
         :json (component/using
                (make-json-dumper (assoc (:json config)
                                         :tbl-name (get-in config [:media :tbl-name])))
                [:aws :db]))))))

Add Thorin's Side

Add Thorin's Side