(ns yetibot.core.models.users
  (:require
    [taoensso.timbre :refer [info warn error]]
    [clj-time.core :refer [now]]))

(def config {:active-threshold-milliseconds (* 15 60 1000)})

(defonce ^{:private true
          :doc
  "key: {:adapter adapter, :id user-id
  value: user with keys: adapter, username, id, active?,
  last-active, rooms e.g.
  {:adapter :slack :id 1} {:adapter :slack, :username \"yetibot\", :id 1,
     :active? true, :last-active <DateTime>,
     :rooms #{{:adapter :slack :room \"C123\"}}}"}
  users (atom {}))

(defn create-user
  "Build a data structure representing a user in common adapter-agnostic format.
   Ensures a consistent data structure when creating users from multiple chat
   sources.

   `active?` can be determined by any criteria. In Slack it's managed by
   presence detection. In IRC and Campfire it could be managed by being offline,
   or have an activity timeout. If ommitted, it defaults to true."
  ([username user-info] (create-user username true user-info))
  ([username active? {:keys [id] :as user-info}]
   (let [id (str (or id username))
         mention-name username] ; mention name breaks pure-text representation of user
     (merge user-info {:username username
                       :name username ; alias for backward compat
                       :mention-name mention-name
                       :active? active?
                       :id id
                       :last-active (now)}))))

(defn add-user-merge
  "Knows how to merge a new user with an existing user by combining the set of
   rooms"
  [chat-source]
  (partial
    merge-with
    (fn [existing-user new-user]
      (update-in existing-user [:rooms] conj chat-source))))

(defn add-user-without-room
  [adapter {:keys [id] :as user}]
  "Added for Slack, where we might know about users but don't know the rooms
   that they are in because yetibot is not in those rooms."
  (let [user-key {:adapter adapter :id id}]
    (swap! users assoc user-key user)))

(defn add-user
  "Add a user according to chat-source. If the user already exists, its rooms
   will be merged via `add-user-merge` but all other user properties will remain
   unchanged."
  [chat-source {:keys [id] :as user}]
  (let [user-key {:adapter (:adapter chat-source) :id id}]
    (swap! users (add-user-merge chat-source)
           {user-key (merge user {:rooms #{chat-source}})})))

(defn update-user [source id attrs]
  (info "update-user" source id attrs)
  (let [user-key {:adapter (:adapter source) :id id}]
    ; ensure user exists
    (or (get @users user-key)
        ; the user might not exist if an event came through for a channel that
        ; yetibot wasn't in, since yetibot only builds user models for users it
        ; can listen to in the channels that it's in.
        (throw
          (ex-info (str "User " user-key " doesn't exist")
                   {:causes user-key})))
    (swap! users update-in [user-key] merge attrs)))

(defn remove-user
  "Removes chat-source from the user's :rooms set"
  [chat-source id]
  (let [user-key {:adapter (:adapter chat-source) :id id}]
    (swap! users update-in [user-key :rooms] disj chat-source)))

(defn add-chat-source-to-user
  [chat-source id]
  (let [user-key {:adapter (:adapter chat-source) :id id}]
    (swap! users update-in [user-key :rooms] conj chat-source)))

(defn get-users
  "Returns active users for a given chat source"
  [source]
  (->> @users
       vals
       (filter (fn [u] (and (:active? u) (:rooms u) ((:rooms u) source))))))

(defn get-user [source id]
  (@users {:adapter (:adapter source) :id id}))

(defn find-user-like [chat-source name]
  (let [us (filter (fn [[k user]] (= (:adapter k) (:adapter chat-source)))
                   @users)
        patt (re-pattern (str "(?i)" name))]
    (some (fn [[k v]] (when (re-find patt (or (:name v) "")) v)) us)))

; (def campfire-date-pattern "yyyy/MM/dd HH:mm:ss Z")
; (def date-formatter (doto (new SimpleDateFormat campfire-date-pattern) (.setTimeZone (java.util.TimeZone/getTimeZone "GreenwichEtc"))))

; (defn get-refreshed-user
;   "Returns an already existing user from the atom if available, otherwise a new user with a last_active timestamp"
;   [user]
;   (let [id (:id user)]
;     ))

    ; (get @users id (assoc user :last_active (.format date-formatter (new Date))))))

; (defn get-user-ms [user] (.getTime (.parse date-formatter (:last_active user))))

(defn is-active? [user] (:active? user))

  ; (if (contains? user :last_active)
  ;   (let [current-ms (.getTime (new Date))
  ;         ms-since-active (- current-ms (get-user-ms user))]
  ;     (< ms-since-active active-threshold-milliseconds))
  ;   false))

(defn is-yetibot? [user] false)

(defn get-active-users [] (filter is-active? (vals @users)))

(defn get-active-humans [] (remove is-yetibot? (get-active-users)))

; (defn get-updated-user [id last_active]
;   (assoc (get-user id) :last_active last_active))

; (defn update-active-timestamp [{id :user_id last_active :created_at}]
;   (do
;     (swap! users conj {id (get-updated-user id last_active)})
;     (info @users)))

(ns yetibot.core.models.users
  (:require
    [taoensso.timbre :refer [info debug warn error]]
    [clj-time.core :refer [now]]))

(def config {:active-threshold-milliseconds (* 15 60 1000)})

(defonce ^{:private true
          :doc
  "key: {:adapter adapter, :id user-id
  value: user with keys: adapter, username, id, active?,
  last-active, rooms e.g.
  {:adapter :slack :id 1} {:adapter :slack, :username \"yetibot\", :id 1,
     :active? true, :last-active <DateTime>,
     :rooms #{{:adapter :slack :room \"C123\"}}}"}
  users (atom {}))

(defn create-user
  "Build a data structure representing a user in common adapter-agnostic format.
   Ensures a consistent data structure when creating users from multiple chat
   sources.

   `active?` can be determined by any criteria. In Slack it's managed by
   presence detection. In IRC and Campfire it could be managed by being offline,
   or have an activity timeout. If ommitted, it defaults to true."
  ([username user-info] (create-user username true user-info))
  ([username active? {:keys [id] :as user-info}]
   (let [id (str (or id username))
         mention-name username] ; mention name breaks pure-text representation of user
     (merge user-info {:username username
                       :name username ; alias for backward compat
                       :mention-name mention-name
                       :active? active?
                       :id id
                       :last-active (now)}))))

(defn add-user-merge
  "Knows how to merge a new user with an existing user by combining the set of
   rooms"
  [chat-source]
  (partial
    merge-with
    (fn [existing-user new-user]
      (update-in existing-user [:rooms] conj chat-source))))

(defn add-user-without-room
  [adapter {:keys [id] :as user}]
  "Added for Slack, where we might know about users but don't know the rooms
   that they are in because yetibot is not in those rooms."
  (let [user-key {:adapter adapter :id id}]
    (swap! users assoc user-key user)))

(defn add-user
  "Add a user according to chat-source. If the user already exists, its rooms
   will be merged via `add-user-merge` but all other user properties will remain
   unchanged."
  [chat-source {:keys [id] :as user}]
  (let [user-key {:adapter (:adapter chat-source) :id id}]
    (swap! users (add-user-merge chat-source)
           {user-key (merge user {:rooms #{chat-source}})})))

(defn update-user [source id attrs]
  (debug "update-user" source id attrs)
  (let [user-key {:adapter (:adapter source) :id id}]
    ; ensure user exists
    (or (get @users user-key)
        ; the user might not exist if an event came through for a channel that
        ; yetibot wasn't in, since yetibot only builds user models for users it
        ; can listen to in the channels that it's in.
        (throw
          (ex-info (str "User " user-key " doesn't exist")
                   {:causes user-key})))
    (swap! users update-in [user-key] merge attrs)))

(defn remove-user
  "Removes chat-source from the user's :rooms set"
  [chat-source id]
  (let [user-key {:adapter (:adapter chat-source) :id id}]
    (swap! users update-in [user-key :rooms] disj chat-source)))

(defn add-chat-source-to-user
  [chat-source id]
  (let [user-key {:adapter (:adapter chat-source) :id id}]
    (swap! users update-in [user-key :rooms] conj chat-source)))

(defn get-users
  "Returns active users for a given chat source"
  [source]
  (->> @users
       vals
       (filter (fn [u] (and (:active? u) (:rooms u) ((:rooms u) source))))))

(defn get-user [source id]
  (@users {:adapter (:adapter source) :id id}))

(defn find-user-like [chat-source name]
  (let [us (filter (fn [[k user]] (= (:adapter k) (:adapter chat-source)))
                   @users)
        patt (re-pattern (str "(?i)" name))]
    (some (fn [[k v]] (when (re-find patt (or (:name v) "")) v)) us)))

; (def campfire-date-pattern "yyyy/MM/dd HH:mm:ss Z")
; (def date-formatter (doto (new SimpleDateFormat campfire-date-pattern) (.setTimeZone (java.util.TimeZone/getTimeZone "GreenwichEtc"))))

; (defn get-refreshed-user
;   "Returns an already existing user from the atom if available, otherwise a new user with a last_active timestamp"
;   [user]
;   (let [id (:id user)]
;     ))

    ; (get @users id (assoc user :last_active (.format date-formatter (new Date))))))

; (defn get-user-ms [user] (.getTime (.parse date-formatter (:last_active user))))

(defn is-active? [user] (:active? user))

  ; (if (contains? user :last_active)
  ;   (let [current-ms (.getTime (new Date))
  ;         ms-since-active (- current-ms (get-user-ms user))]
  ;     (< ms-since-active active-threshold-milliseconds))
  ;   false))

(defn is-yetibot? [user] false)

(defn get-active-users [] (filter is-active? (vals @users)))

(defn get-active-humans [] (remove is-yetibot? (get-active-users)))

; (defn get-updated-user [id last_active]
;   (assoc (get-user id) :last_active last_active))

; (defn update-active-timestamp [{id :user_id last_active :created_at}]
;   (do
;     (swap! users conj {id (get-updated-user id last_active)})
;     (info @users)))

Reduce logging in users model

Reduce logging in users model


(ns yambox.routes
  (:require
    [cemerick.friend :as friend]
    [clj-http.client :as http]
    [compojure.core :as c]
    [compojure.route :as route]
    [plumbing.core :as p]
    [schema.coerce :as coerce]
    [ring.util.response :as resp]
    [yambox.oauth :as oauth]
    [yambox.templates :as tpl]
    [yambox.widget :as widget]
    [yambox.database :as db]
    [yambox.schemas :as schemas])
  (:import
    [yambox.schemas Campaign]))

;;
;; Utils
;;

(def parse-campaign (coerce/coercer Campaign coerce/string-coercion-matcher))

;;
;; Handler functions
;;

(defn handle-campaign-change [create? req]
  (let [wallet-id (oauth/req->wallet-id req)
        known (if create? {} (db/get-campaign-by-wallet-id wallet-id))
        campaign (->> (:params req)
                      (merge known)
                      (schemas/fetch-campaign-data req)
                      schemas/map->Campaign
                      parse-campaign)]
    (if create?
      (db/add-campaign campaign)
      (db/update-campaign campaign))))

(defn get-campaign-page
  [req]
  (let [token (oauth/req->token req)
        resp (http/post
               "https://money.yandex.ru/api/operation-history"
               {:accept      :json
                :form-params {:records 100 :type "deposition"}
                :oauth-token token
                :as          :json})
        op (->>
             resp
             :body
             :operations
             (filter #(= (:status %) "success")))]
    (tpl/page-campaign req op)))

(defn get-widget-page
  [req]
  (let [slug (p/safe-get-in req [:params :slug])
        campaign (db/get-campaign-by-slug slug)]
    (widget/render campaign)))

;;
;; Routes
;;

(c/defroutes main
  (c/GET "/" req
    (if (oauth/req->token req)
      (resp/redirect "/management")
      (tpl/page-index)))
  (c/GET "/campaigns/:slug" req (get-campaign-page req))
  (c/GET "/campaigns/:slug/widget" req (get-widget-page req))
  (friend/logout (c/GET "/logout" request (resp/redirect "/"))))

(c/defroutes management
  (c/GET "/" req
   (let [wallet-id (oauth/req->wallet-id req)]
     (if (db/wallet-id-exists? wallet-id)
       (tpl/page-management req (db/get-campaign-by-wallet-id wallet-id))
       (tpl/page-management-create req))))
  (c/POST "/" req
    (let [create? (not (db/wallet-id-exists? (oauth/req->wallet-id req)))]
      (handle-campaign-change create? req)
      (resp/redirect "/management"))))

(ns yambox.routes
  (:require
    [cemerick.friend :as friend]
    [clj-http.client :as http]
    [compojure.core :as c]
    [compojure.route :as route]
    [plumbing.core :as p]
    [schema.coerce :as coerce]
    [ring.util.response :as resp]
    [yambox.oauth :as oauth]
    [yambox.templates :as tpl]
    [yambox.widget :as widget]
    [yambox.database :as db]
    [yambox.schemas :as schemas])
  (:import
    [yambox.schemas Campaign]))

;;
;; Utils
;;

(def parse-campaign (coerce/coercer Campaign coerce/string-coercion-matcher))

;;
;; Handler functions
;;

(defn handle-campaign-change [create? req]
  (let [wallet-id (oauth/req->wallet-id req)
        known (if create? {} (db/get-campaign-by-wallet-id wallet-id))
        campaign (->> (:params req)
                      (merge known)
                      (schemas/fetch-campaign-data req)
                      schemas/map->Campaign
                      parse-campaign)]
    (if create?
      (db/add-campaign campaign)
      (db/update-campaign campaign))))

(defn get-campaign-page
  [req]
  (let [token (oauth/req->token req)
        resp (http/post
               "https://money.yandex.ru/api/operation-history"
               {:accept      :json
                :form-params {:records 100 :type "deposition"}
                :oauth-token token
                :as          :json})
        op (->>
             resp
             :body
             :operations
             (filter #(= (:status %) "success")))]
    (tpl/page-campaign req op)))

(defn get-widget-page
  [req]
  (let [slug (p/safe-get-in req [:params :slug])
        campaign (db/get-campaign-by-slug slug)]
    (widget/render campaign)))

;;
;; Routes
;;

(c/defroutes main
  (c/GET "/" req
    (if (oauth/req->token req)
      (resp/redirect "/management")
      (tpl/page-index)))
  (c/GET "/campaigns/:slug" req (get-campaign-page req))
  (c/GET "/campaigns/:slug/widget" req (get-widget-page req))
  (friend/logout (c/GET "/logout" request (resp/redirect "/"))))

(c/defroutes management
  (c/GET "/" req
   (let [wallet-id (oauth/req->wallet-id req)]
     (if (db/wallet-id-exists? wallet-id)
       (do
         (handle-campaign-change false req)
         (tpl/page-management req (db/get-campaign-by-wallet-id wallet-id)))
       (tpl/page-management-create req))))
  (c/POST "/" req
    (let [create? (not (db/wallet-id-exists? (oauth/req->wallet-id req)))]
      (handle-campaign-change create? req)
      (resp/redirect "/management"))))

update campaign on login if it already exists


(ns quil.sketch
  (:require [clojure.browser.dom  :as dom]
            [quil.util :refer [no-fn resolve-constant-key]])
  (:use-macros [quil.sketch :only [with-sketch]]
               [quil.helpers.tools :only [bind-handlers]]
               [quil.util :only [generate-quil-constants]]))

(def ^:dynamic
  *applet* nil)

(defn current-applet [] *applet*)

(generate-quil-constants
  rendering-modes (:java2d :p2d :p3d :opengl))

(defn resolve-renderer [mode]
  (resolve-constant-key mode rendering-modes))

(defn
  size
  ([width height]
    (.size (current-applet) (int width) (int height)))

  ([width height mode]
    (.size (current-applet) (int width) (int height) (resolve-constant-key mode rendering-modes))))

(defn make-sketch [opts]
  (let [draw-fn         (or (:draw opts) no-fn)
        setup-fn        (or (:setup opts) no-fn)

        sketch-size     (or (:size opts) [200 200])
        renderer        (:renderer opts)

        key-pressed     (or (:key-pressed opts) no-fn)
        key-released    (or (:key-released opts) no-fn)
        key-typed       (or (:key-typed opts) no-fn)

        mouse-clicked   (or (:mouse-clicked opts) no-fn)
        mouse-dragged   (or (:mouse-dragged opts) no-fn)
        mouse-moved     (or (:mouse-moved opts) no-fn)
        mouse-pressed   (or (:mouse-pressed opts) no-fn)
        mouse-released  (or (:mouse-released opts) no-fn)
        mouse-out       (or (:mouse-out opts) no-fn)
        mouse-over      (or (:mouse-over opts) no-fn)]
    (fn [prc]
      (bind-handlers prc
                     .-setup  (do
                                (apply size (concat sketch-size (if renderer [renderer] [])))
                                (setup-fn))
                     .-draw draw-fn

                     .-keyPressed key-pressed
                     .-keyReleased key-released
                     .-keyTyped key-typed

                     .-mouseClicked mouse-clicked
                     .-mouseDragged mouse-dragged
                     .-mouseMoved mouse-moved
                     .-mousePressed mouse-pressed
                     .-mouseReleased mouse-released
                     .-mouseOut mouse-out
                     .-mouseOver mouse-over
                     ))))

(defn ^:export sketch
  [app-name & opts]
  (let [opts-map (apply hash-map opts)]
    (let [host-elem (dom/get-element (:host opts-map))
          processing-fn (make-sketch opts-map)]
      (when host-elem
        (js/Processing. host-elem processing-fn)))))

(def sketch-init-list (atom (list )))

(defn ^:export add-js-event [event fun]
  (if (.-addEventListener js/window)
      (.addEventListener js/window event fun false)
      (if (.-attachEvent js/window)
          (.attachEvent js/window (str "on" event) fun))))

(defn ^:export check-empty-body []
  (let [child (.-childNodes (.-body js/document))]
    (= 1 (.-length child))))

(defn init-sketches []
  (doseq [sk @sketch-init-list]
    (sk)))

(defn add-sketch-to-init-list [sk]
  (swap! sketch-init-list conj sk))

(add-js-event "load" init-sketches)

(ns quil.sketch
  (:require [clojure.browser.dom  :as dom]
            [quil.util :refer [no-fn resolve-constant-key]])
  (:use-macros [quil.sketch :only [with-sketch]]
               [quil.helpers.tools :only [bind-handlers]]
               [quil.util :only [generate-quil-constants]]))

(def ^:dynamic
  *applet* nil)

(defn current-applet [] *applet*)

(generate-quil-constants
  rendering-modes (:java2d :p2d :p3d :opengl))

(defn resolve-renderer [mode]
  (resolve-constant-key mode rendering-modes))

(defn
  size
  ([width height]
    (.size (current-applet) (int width) (int height)))

  ([width height mode]
    (.size (current-applet) (int width) (int height) (resolve-constant-key mode rendering-modes))))

(defn make-sketch [opts]
  (let [draw-fn         (or (:draw opts) no-fn)
        setup-fn        (or (:setup opts) no-fn)

        sketch-size     (or (:size opts) [200 200])
        renderer        (:renderer opts)

        key-pressed     (or (:key-pressed opts) no-fn)
        key-released    (or (:key-released opts) no-fn)
        key-typed       (or (:key-typed opts) no-fn)

        mouse-clicked   (or (:mouse-clicked opts) no-fn)
        mouse-dragged   (or (:mouse-dragged opts) no-fn)
        mouse-moved     (or (:mouse-moved opts) no-fn)
        mouse-pressed   (or (:mouse-pressed opts) no-fn)
        mouse-released  (or (:mouse-released opts) no-fn)
        mouse-out       (or (:mouse-out opts) no-fn)
        mouse-over      (or (:mouse-over opts) no-fn)]
    (fn [prc]
      (bind-handlers prc
                     .-setup  (do
                                (apply size (concat sketch-size (if renderer [renderer] [])))
                                (setup-fn))
                     .-draw draw-fn

                     .-keyPressed key-pressed
                     .-keyReleased key-released
                     .-keyTyped key-typed

                     .-mouseClicked mouse-clicked
                     .-mouseDragged mouse-dragged
                     .-mouseMoved mouse-moved
                     .-mousePressed mouse-pressed
                     .-mouseReleased mouse-released
                     .-mouseOut mouse-out
                     .-mouseOver mouse-over
                     ))))

(defn ^:export sketch
  [app-name & opts]
  (let [opts-map (apply hash-map opts)]
    (let [host-elem (dom/get-element (:host opts-map))
          processing-fn (make-sketch opts-map)]
      (when host-elem
        (js/Processing. host-elem processing-fn)))))

(def sketch-init-list (atom (list )))

(defn ^:export add-js-event [event fun]
  (if (.-addEventListener js/window)
      (.addEventListener js/window event fun false)
      (if (.-attachEvent js/window)
          (.attachEvent js/window (str "on" event) fun))))

(defn empty-body? []
  (let [child (.-childNodes (.-body js/document))]
    (= 1 (.-length child))))

(defn init-sketches []
  (doseq [sk @sketch-init-list]
    (sk)))

(defn add-sketch-to-init-list [sk]
  (swap! sketch-init-list conj sk))

(add-js-event "load" init-sketches)

Fix name and visibility check-empty-body function.


(ns github-changelog.conventional-test
  (:require [clojure.test :refer :all]
            [github-changelog
             [conventional :as conventional]
             [schema-generators :as g]]
            [clojure.test.check.generators :as gen]))

(def repo-url "https://github.company.com/user/repo")
(def jira-url "http://dev.clojure.org/jira/")
(def config (g/complete-config {:jira jira-url}))

(deftest parse-issue
  (testing "with a JIRA issue"
    (let [pull (g/complete-pull {:body "Fixes JIRA-1"})
          jira-issue-url "http://dev.clojure.org/jira/browse/JIRA-1"]
      (is (= [["JIRA-1" jira-issue-url]] (conventional/parse-issues config pull)))))
  (testing "with a GitHub issue"
    (let [pull (g/complete-pull {:body "Fixes #1" :base {:repo {:html_url repo-url}}})]
      (is (= [["#1" (str repo-url "/issues/1")]] (conventional/parse-issues config pull))))))

(defn revert-pull [{:keys [user repo]} pull-id]
  (g/complete-revert-pull {:body (format "Reverts %s/%s#%d" user repo pull-id)}))

(deftest parse-pull
  (testing "with a revert"
    (are [pull-id] (= pull-id (:revert-pull (conventional/parse-pull config (revert-pull config pull-id))))
      1
      2
      5))
  (testing "with a correct formats"
    (are [title] (not= nil (conventional/parse-pull config (g/complete-pull {:title title})))
      "feat(scope): enhance this and that"
      "fix(scope): do not fail on invalid input"
      "chore: clean up the codebase"))
  (testing "with invalid formats"
    (are [title] (nil? (conventional/parse-pull config (g/complete-pull {:title title})))
      "this is just a PR"
      "does not follow the rules"))
  (testing "with a full test"
    (let [pull (g/complete-pull {:title "feat(the scope): subject line" :body "Fixes #1, Closes JIRA-2"})
          change (conventional/parse-pull config pull)]
      (is (= "feat" (:type change)))
      (is (= "the scope" (:scope change)))
      (is (= "subject line" (:subject change)))
      (is (= pull (:pull-request change)))
      (is (= 2 (count (:issues change)))))))

(def pulls (map #(g/complete-valid-pull {:number %}) (range 1 5)))

(defn revert [pulls]
  (let [pull-ids (map :number pulls)]
    (map #(assoc (revert-pull config %) :number (* 10 %)) pull-ids)))

(deftest parse-changes
  (are [pulls expected] (= expected (count (:changes (conventional/parse-changes config (g/complete-tag {:pulls pulls})))))
    pulls 4
    (concat (revert pulls) pulls) 0
    (concat (revert (drop 1 pulls)) pulls) 1
    (concat (revert (revert (take 1 pulls))) (revert pulls) pulls) 1))

Remove unnecessary newline

Remove unnecessary newline


(ns caesium.randombytes-test
  (:require [caesium.randombytes :as r]
            [clojure.test :refer [deftest is]]
            [caesium.byte-bufs :as bb])
  (:import (java.nio ByteBuffer)))

(deftest randombytes-test
  (let [buf (r/randombytes 10)]
    (is (= 10 (bb/buflen buf)))))

(deftest random-to-buf!-test
  (let [buf (bb/alloc 30)]
    (is (= #{0} (set (seq (bb/->bytes buf)))))
    (r/random-to-buf! buf)
    (is (not= #{0} (set (seq (bb/->bytes buf))))))
  (let [buf (bb/alloc 20)]
    (r/random-to-buf! buf 10)
    (let [s (seq (bb/->bytes buf))
          head (take 10 s)
          tail (drop 10 s)]
      (is (not= (repeat 10 0) head))
      (is (= (repeat 10 0) tail)))))

(ns caesium.randombytes-test
  (:require [caesium.randombytes :as r]
            [clojure.test :refer [deftest is]]
            [caesium.byte-bufs :as bb])
  (:import (java.nio ByteBuffer)))

(deftest randombytes-test
  (let [buf (r/randombytes 10)]
    (is (= 10 (bb/buflen buf)))))

(defn all-zero?
  [buf]
  (every? #{0} (bb/->bytes buf)))

(deftest random-to-buf!-test
  (let [buf (bb/alloc 30)]
    (is (all-zero? buf))
    (r/random-to-buf! buf)
    (is (not (all-zero? buf))))
  (let [buf (bb/alloc 20)]
    (r/random-to-buf! buf 10)
    (let [s (seq (bb/->bytes buf))
          head (take 10 s)
          tail (drop 10 s)]
      (is (not= (repeat 10 0) head))
      (is (= (repeat 10 0) tail)))))

Refactor all-zero? out

Refactor all-zero? out


(ns db-quiz-prep.core
  (:gen-class)
  (:require [db-quiz-prep.mustache :as mustache]
            [db-quiz-prep.util :refer [join-lines]]
            [db-quiz-prep.prepare :as prepare]
            [clojure.tools.cli :refer [parse-opts]]
            [clojure.edn :as edn]
            [schema.core :as s]
            [schema-contrib.core :as sc]))

; ----- Schemata -----

(def ^:private positive-number (s/both s/Int (s/pred pos? 'pos?)))

(def ^:private degree (s/both positive-number (s/pred (partial >= 180) 'degree?)))

(def ^:private Config
  {:sparql-endpoint {:url sc/URI
                     :username s/Str
                     :password s/Str
                     :page-size positive-number}
   :data {:selector {:p sc/URI
                     :o sc/Str}
          :surface-forms [sc/URI]
          :source-graph sc/URI
          :target-graph sc/URI}
   :split-angles {:easy degree
                  :normal degree}
   (s/optional-key :start-from) positive-number})

; ----- Private functions -----

(defn- error-msg
  [errors]
  (str "The following errors occurred while parsing your command:\n\n"
       (join-lines errors)))

(defn- exit
  "Exit with @status and message `msg`.
  `status` 0 is OK, `status` 1 indicates error."
  [^Integer status
   ^String msg]
  {:pre [(#{0 1} status)]}
  (println msg)
  (System/exit status))

(defn- usage
  "Wrap usage `summary` in a description of the program."
  [summary]
  (join-lines ["DB-quiz data pre-processing tool"
               "Options:\n"
               summary]))

(def ^:private validate-config
  "Validate configuration `config` according to its schema."
  (let [expected-structure (s/explain Config)]
    (fn [config]
      (try (s/validate Config config) nil
           (catch RuntimeException e (join-lines ["Invalid configuration:"
                                                  (.getMessage e)
                                                  "The expected structure of configuration is:"
                                                  expected-structure]))))))

; ----- Private vars -----

(def ^:private cli-options
  [["-c" "--config CONFIG" "Path to configuration file in EDN"
    :parse-fn #(edn/read-string (slurp %))]
   ["-t" "--task TASK" "Task to execute. Either 'questions', 'difficulties' or 'delete-difficulties'."
    :validate [#{"questions" "difficulties" "delete-difficulties"}
               "Task to execute must be either 'questions', 'difficulties' or 'delete-difficulties'."]]
   ["-h" "--help" "Display help message"]])

; ----- Public functions -----

(defn -main
  [& args]
  (let [{{:keys [config help task]} :options
         :keys [errors summary]} (parse-opts args cli-options)]
    (cond help (exit 0 (usage summary))
          errors (exit 1 (error-msg errors))
          :else (if-let [error (validate-config config)]
                    (exit 1 error)
                    (prepare/execute config task)))))

(ns db-quiz-prep.core
  (:gen-class)
  (:require [db-quiz-prep.util :refer [join-lines]]
            [db-quiz-prep.prepare :as prepare]
            [clojure.tools.cli :refer [parse-opts]]
            [clojure.edn :as edn]
            [schema.core :as s]
            [schema-contrib.core :as sc]))

; ----- Schemata -----

(def ^:private positive-number (s/both s/Int (s/pred pos? 'pos?)))

(def ^:private degree (s/both positive-number (s/pred (partial >= 180) 'degree?)))

(def ^:private Config
  {:sparql-endpoint {:url sc/URI
                     :username s/Str
                     :password s/Str
                     :page-size positive-number}
   :data {:selector {:p sc/URI
                     :o s/Str}
          :surface-forms [sc/URI]
          :source-graph sc/URI
          :target-graph sc/URI}
   :split-angles {:easy degree
                  :normal degree}
   (s/optional-key :start-from) positive-number})

; ----- Private functions -----

(defn- error-msg
  [errors]
  (str "The following errors occurred while parsing your command:\n\n"
       (join-lines errors)))

(defn- exit
  "Exit with @status and message `msg`.
  `status` 0 is OK, `status` 1 indicates error."
  [^Integer status
   ^String msg]
  {:pre [(#{0 1} status)]}
  (println msg)
  (System/exit status))

(defn- usage
  "Wrap usage `summary` in a description of the program."
  [summary]
  (join-lines ["DB-quiz data pre-processing tool"
               "Options:\n"
               summary]))

(def ^:private validate-config
  "Validate configuration `config` according to its schema."
  (let [expected-structure (s/explain Config)]
    (fn [config]
      (try (s/validate Config config) nil
           (catch RuntimeException e (join-lines ["Invalid configuration:"
                                                  (.getMessage e)
                                                  "The expected structure of configuration is:"
                                                  expected-structure]))))))

; ----- Private vars -----

(def ^:private cli-options
  [["-c" "--config CONFIG" "Path to configuration file in EDN"
    :parse-fn #(edn/read-string (slurp %))]
   ["-t" "--task TASK" "Task to execute. Either 'questions', 'difficulties' or 'delete-difficulties'."
    :validate [#{"questions" "difficulties" "delete-difficulties"}
               "Task to execute must be either 'questions', 'difficulties' or 'delete-difficulties'."]]
   ["-h" "--help" "Display help message"]])

; ----- Public functions -----

(defn -main
  [& args]
  (let [{{:keys [config help task]} :options
         :keys [errors summary]} (parse-opts args cli-options)]
    (cond help (exit 0 (usage summary))
          errors (exit 1 (error-msg errors))
          :else (if-let [error (validate-config config)]
                    (exit 1 error)
                    (prepare/execute config task)))))

Remove missing references

Remove missing references


(ns sqls.ui.worksheet
  (:use [clojure.string :only (join split-lines trim)])
  (:require seesaw.chooser)
  (:require seesaw.core)
  (:require seesaw.keystroke)
  (:require seesaw.rsyntax)
  (:require seesaw.table)
  (:import javax.swing.JFrame)
  (:import javax.swing.JTable)
  (:import javax.swing.KeyStroke))

(defn create-worksheet-frame
  "Create worksheet frame.
  Frame contains following widgets:

  - :sql - text are with SQL statements,
  - :results-panel - container that contains results, which in turn contains table with :id :results,
    contents of this panel are meant to be replaced on each query execution.
  "
  []
  (let [query-text-area (seesaw.rsyntax/text-area :id :sql
                                                  :syntax :sql
                                                  :columns 80
                                                  :rows 25)
        results-panel (seesaw.core/vertical-panel :id :results-panel
                                                  :preferred-size [800 :by 400])
        log-text (seesaw.core/text :id :log :multi-line? true :editable? false)
        log-panel (seesaw.core/vertical-panel :id :log-panel
                                              :items [(seesaw.core/scrollable log-text
                                                                              :id :log-scrollable)])
        tabs-panel (seesaw.core/tabbed-panel :id :tabs
                                       :tabs [{:title "Results" :content results-panel}
                                              {:title "Log" :content log-panel}])
        menu-panel (seesaw.core/horizontal-panel :id :menu-panel
                                                 :items [
                                                         (seesaw.core/button :id :new
                                                                             :icon (seesaw.icon/icon "new.png"))
                                                         (seesaw.core/button :id :save
                                                                             :icon (seesaw.icon/icon "floppy.png"))
                                                         (seesaw.core/button :id :open
                                                                             :icon (seesaw.icon/icon "open.png"))
                                                         ; (seesaw.core/button :id :explain
                                                         ;                     :text "Explain plan")
                                                         (seesaw.core/button :id :execute
                                                                             :text "Execute")
                                                         (seesaw.core/button :id :commit
                                                                             :text "Commit")
                                                         (seesaw.core/button :id :rollback
                                                                             :text "Rollback")
                                                         ])
        center-panel (seesaw.core/vertical-panel :items [query-text-area tabs-panel])
        south-panel (seesaw.core/horizontal-panel :items [(seesaw.core/label :id :status-bar-text
                                                                             :text " ")])
        border-panel (seesaw.core/border-panel :north menu-panel
                                               :center center-panel
                                               :south south-panel)
        worksheet-frame (seesaw.core/frame
                          :title "SQL Worksheet"
                          :content border-panel)]
    (seesaw.core/pack! worksheet-frame)
    worksheet-frame
    )
)

(defn dispose-worksheet-frame!
  "Dispose worksheet frame."
  [frame]
  (seesaw.core/dispose! frame))

(defn on-key-press
  "Key press handler for sql text area. Calls first parameter (handler), meant to be curried."
  [handler keystroke e]
  (let [event-key-stroke (javax.swing.KeyStroke/getKeyStrokeForEvent e)]
    (if (= keystroke event-key-stroke)
      (handler))))

(defn set-ctrl-enter-handler
  "Set Ctrl-Enter handler on frame. Handler should expect no parameters (all needed parameters
  should be baked in using partial or similar means."
  [frame handler]
  (assert (not= frame nil))
  (let [ctrl-enter-keystroke (seesaw.keystroke/keystroke "control ENTER")
        sql-text-area (seesaw.core/select frame [:#sql])]
    (seesaw.core/listen sql-text-area :key-pressed (partial on-key-press handler ctrl-enter-keystroke))))

; (defn set-on-explain-handler
;   [frame handler]
;   (assert (not= frame nil))
;   (let [btn-explain (seesaw.core/select frame [:#explain])]
;     (assert (not= btn-explain nil))
;     (seesaw.core/listen btn-explain :action (fn [e] (handler)))))

(defn set-on-commit-handler
  [frame handler]
  (let [btn-commit (seesaw.core/select frame [:#commit])]
    (seesaw.core/listen btn-commit :action (fn [e] (handler)))))

(defn set-on-rollback-handler
  [frame handler]
  (let [btn-rollback (seesaw.core/select frame [:#rollback])]
    (seesaw.core/listen btn-rollback :action (fn [e] (handler)))))

(defn set-on-execute-handler
  "Set Execute button handler."
  [frame handler]
  (let [btn-execute (seesaw.core/select frame [:#execute])]
    (assert (not= btn-execute nil))
    (seesaw.core/listen btn-execute :action (fn [e] (handler)))))

(defn set-on-new-handler
  "Set New button handler."
  [frame handler]
  (let [btn-new (seesaw.core/select frame [:#new])]
    (assert (not= btn-new nil))
    (seesaw.core/listen btn-new :action (fn [e] (handler)))))

(defn set-on-save-handler
  "Set Save button handler."
  [frame handler]
  (let [btn-save (seesaw.core/select frame [:#save])]
    (assert (not= btn-save nil))
    (seesaw.core/listen btn-save :action (fn [e] (handler)))))

(defn set-on-open-handler
  [frame handler]
  (let [btn-open (seesaw.core/select frame [:#open])]
    (assert (not= btn-open nil))
    (seesaw.core/listen btn-open :action (fn [e] (handler)))))

(defn show!
  "Show worksheet frame."
  [frame]
  (seesaw.core/show! frame))

(defn extend-nonempty-lines-range
  "Return a range (that is, pair of line numbers) that include adjacent non-empty lines.

  First see if start can be decreased, and if it can, then return result of calling recursively with decreased start.
  Otherwise see if end can be increased, and again if it can, then return result of calling recursively with increased end.
  Finally if non of above worked, just return [start end].
  "
  [lines start end]
  (let [can-decrease-start (and
                             (> start 0)
                             (not= (trim (lines (dec start))) ""))]
    (if can-decrease-start
      (extend-nonempty-lines-range lines (dec start) end)
      (let [can-increase-end (and
                               (< end (dec (count lines)))
                               (not= (trim (lines (inc end))) ""))]
        (if can-increase-end
          (extend-nonempty-lines-range lines start (inc end))
          [start end])))))

(defn get-line-no
  "Get line number from text and index."
  [text position]
  (let [before-position-text (subs text 0 position)
        _ (println "text before position:" before-position-text)
        is-newline (fn [c] (= (str c) "\n"))]
    (count (filter is-newline before-position-text))))

(defn get-sql
  "Extract current SQL text from frame."
  ^String
  [frame]
  (let [all-text (seesaw.core/value (seesaw.core/select frame [:#sql]))
        caret-position (seesaw.core/config (seesaw.core/select frame [:#sql]) :caret-position)
        all-text-lines (split-lines all-text)
        line-no (get-line-no all-text caret-position)
        [start end] (extend-nonempty-lines-range all-text-lines line-no line-no)
        block-lines (subvec all-text-lines start (inc end))
        block-text (join "\n" block-lines)]
    block-text))

(defn get-contents
  "Get text from worksheet."
  ^String
  [^javax.swing.JFrame frame]
  (assert (not= frame nil))
  (-> (seesaw.core/select frame [:#sql])
      (seesaw.core/value)))

(defn set-on-scroll-handler
  "Add handler to fetch more results on scroll."
  [frame handler]
  (let [scrollable (seesaw.core/select frame [:#results-table-scrollable])
        viewport (.getViewport scrollable)]
    (seesaw.core/listen viewport :change handler)))

(defn get-scroll-position
  "Return scroll position as float."
  [viewport]
  (assert (not= viewport nil))
  (let [view-size (.getViewSize viewport)
        view-rect (.getViewRect viewport)
        view-rect-pos (float (.y view-rect))
        view-height (float (.height view-size))
        view-rect-height (float (.height view-rect))
        view-rect-pos-max (- view-height view-rect-height)
        view-scroll-position (if (<= view-rect-pos-max 0.0) 0.0 (/ view-rect-pos view-rect-pos-max))]
    view-scroll-position))

(defn append-row!
  [^javax.swing.JTable results-table row]
  (let [row-count (seesaw.table/row-count results-table)]
    (seesaw.table/insert-at! results-table row-count row)))

(defn append-rows!
  "Append rows to worksheet results table.

  Params:

  - new-rows is a seq of new rows to be appended."
  [worksheet new-rows]
  (println (format "appending %d rows to table" (count new-rows)))
  (let [frame (:frame @worksheet)
        _ (assert (not= frame nil))
        results-table (seesaw.core/select frame [:#results-table])
        _ (assert (not= results-table nil))]
    (doall (map (partial append-row! results-table) new-rows))))

(defn fetch-more-results!
  "Try to load more results from lazy sequence of results."
  [worksheet]
  (let [result (:result @worksheet)
        _ (assert (not= result nil))
        [strict-rows lazy-rows] (result :rows)
        strict-rows-count (count strict-rows)
        _ (println (format "strict-rows-count: %d" strict-rows-count))
        new-count (+ strict-rows-count 256)
        new-strict-rows (take new-count lazy-rows)
        _ (println (format "new-strict-rows count: %d" (count new-strict-rows)))
        _ (assert (>= (count new-strict-rows) (count strict-rows)))
        new-rows [new-strict-rows lazy-rows]
        new-result (assoc result :rows new-rows)]
    (swap! worksheet assoc :result new-result)
    (let [new-new-rows (nthrest new-strict-rows (count strict-rows))]
      (println (format "new-new-rows count: %d" (count new-new-rows)))
      (append-rows! worksheet new-new-rows))))

(defn on-results-table-scrolled
  [worksheet-atom e]
  (let [frame (:frame @worksheet-atom)
        _ (assert (not= frame nil))
        viewport (.getViewport (seesaw.core/select frame [:#results-table-scrollable]))
        scroll-pos (get-scroll-position viewport)]
    (if (> scroll-pos 0.75)
      (fetch-more-results! worksheet-atom))))

(defn show-results!
  "Display results inside results panel.
  This involves building results-table UI with accompanying controls.
  Parameters:

  - frame - worksheet frame,
  - columns - column names,
  - rows - a pair of semi strict and lazy sequences of rows do display.

  Scroll view is being configured so that if user scrolls close to the end of the table, new
  rows are fetched from second element of rows pair.
  "
  [worksheet-atom columns rows]
  (let [^javax.seing.JFrame frame (:frame @worksheet-atom)
        _ (assert (not= frame nil))
        [strict-rows lazy-rows] rows
        ^javax.swing.JTable results-table (seesaw.core/table :id :results-table
                                                             :auto-resize :off
                                                             :model [:columns columns
                                                                     :rows strict-rows])
        results-table-scrollable (seesaw.core/scrollable results-table :id :results-table-scrollable)
        ^javax.swing.JPanel results-panel (seesaw.core/select frame [:#results-panel])
        to-remove (seesaw.core/select frame [:#results-panel :> :*])]
    (doall (map (partial seesaw.core/remove! results-panel) to-remove))
    (seesaw.core/add! results-panel results-table-scrollable)
    (if (> (count strict-rows) 0)
      (let [table-column-model (.getColumnModel results-table)
            column-count (count columns)
            row-count (count strict-rows)
            max-column-widths (vec (for [column-index (range column-count)]
                                     (max 4
                                          (let [
                                                column-values (map str (map #(get % column-index) strict-rows))
                                                column-value-lengths (map count column-values)
                                                max-column-value-length (apply max column-value-lengths)]
                                            max-column-value-length))))
            ]
        (doall (for [column-index (range column-count)]
                 (let [table-column (.getColumn table-column-model column-index)
                       column-width (get max-column-widths column-index)]
                   (.setPreferredWidth table-column (* column-width 10)))))))
    (set-on-scroll-handler frame (partial on-results-table-scrolled worksheet-atom))))

(defn clear-results!
  "Clear results pane."
  [^javax.swing.JFrame frame]
  (assert (not= frame nil))
  (let [^javax.swing.JPanel results-panel (seesaw.core/select frame [:#results-panel])
        to-remove (seesaw.core/select frame [:#results-panel :> :*])]
    (doall (map (partial seesaw.core/remove! results-panel) to-remove))))

(defn choose-save-file
  "Show save dialog, return absolute path as string."
  [frame]
  (-> (seesaw.chooser/choose-file frame :type :save)
      (.getAbsolutePath)))

(defn show-explain-plan!
  "Show explain plan."
  [^javax.swing.JFrame frame
   ^String explain-plan]
  (println "displaying explain plan"))

(defn log
  "Add log message to status panel."
  [^javax.swing.JFrame frame
   ^String message]
  (let [^javax.swing.JContainer log-tab (seesaw.core/select frame [:#log-panel])
        ^javax.swing.JComponent log-text (seesaw.core/select log-tab [:#log])]
    (assert (not= log-tab nil))
    (assert (not= log-text nil))
    (let [^String old-text (seesaw.core/text log-text)
          ^String new-text (str old-text message)]
      (seesaw.core/text! log-text new-text))))

(defn status-text
  "Set status bar text."
  [^javax.swing.JFrame frame
   ^String message]
  (assert (not= frame nil))
  (assert (not= message nil))
  (let [status-bar-text (seesaw.core/select frame [:#status-bar-text])]
    (assert (not= status-bar-text nil))
    (seesaw.core/text! status-bar-text message)))

(ns sqls.ui.worksheet
  (:use [clojure.string :only (join split-lines trim)])
  (:require seesaw.chooser)
  (:require seesaw.core)
  (:require seesaw.keystroke)
  (:require seesaw.rsyntax)
  (:require seesaw.table)
  (:import javax.swing.JFrame)
  (:import javax.swing.JTable)
  (:import javax.swing.KeyStroke))

(defn create-worksheet-frame
  "Create worksheet frame.
  Frame contains following widgets:

  - :sql - text are with SQL statements,
  - :results-panel - container that contains results, which in turn contains table with :id :results,
    contents of this panel are meant to be replaced on each query execution.
  "
  []
  (let [query-text-area (seesaw.rsyntax/text-area :id :sql
                                                  :syntax :sql
                                                  :columns 80
                                                  :rows 25)
        results-panel (seesaw.core/vertical-panel :id :results-panel
                                                  :preferred-size [800 :by 400])
        log-text (seesaw.core/text :id :log :multi-line? true :editable? false)
        log-panel (seesaw.core/vertical-panel :id :log-panel
                                              :items [(seesaw.core/scrollable log-text
                                                                              :id :log-scrollable)])
        tabs-panel (seesaw.core/tabbed-panel :id :tabs
                                       :tabs [{:title "Results" :content results-panel}
                                              {:title "Log" :content log-panel}])
        menu-panel (seesaw.core/horizontal-panel :id :menu-panel
                                                 :items [
                                                         (seesaw.core/button :id :new
                                                                             :icon (seesaw.icon/icon "new.png"))
                                                         (seesaw.core/button :id :save
                                                                             :icon (seesaw.icon/icon "floppy.png"))
                                                         (seesaw.core/button :id :open
                                                                             :icon (seesaw.icon/icon "open.png"))
                                                         ; (seesaw.core/button :id :explain
                                                         ;                     :text "Explain plan")
                                                         (seesaw.core/button :id :execute
                                                                             :text "Execute")
                                                         (seesaw.core/button :id :commit
                                                                             :text "Commit")
                                                         (seesaw.core/button :id :rollback
                                                                             :text "Rollback")
                                                         ])
        center-panel (seesaw.core/vertical-panel :items [query-text-area tabs-panel])
        south-panel (seesaw.core/horizontal-panel :items [(seesaw.core/label :id :status-bar-text
                                                                             :text " ")])
        border-panel (seesaw.core/border-panel :north menu-panel
                                               :center center-panel
                                               :south south-panel)
        worksheet-frame (seesaw.core/frame
                          :title "SQL Worksheet"
                          :content border-panel)]
    (seesaw.core/pack! worksheet-frame)
    worksheet-frame
    )
)

(defn dispose-worksheet-frame!
  "Dispose worksheet frame."
  [frame]
  (seesaw.core/dispose! frame))

(defn on-key-press
  "Key press handler for sql text area. Calls first parameter (handler), meant to be curried."
  [handler keystroke e]
  (let [event-key-stroke (javax.swing.KeyStroke/getKeyStrokeForEvent e)]
    (if (= keystroke event-key-stroke)
      (handler))))

(defn set-ctrl-enter-handler
  "Set Ctrl-Enter handler on frame. Handler should expect no parameters (all needed parameters
  should be baked in using partial or similar means."
  [frame handler]
  (assert (not= frame nil))
  (let [ctrl-enter-keystroke (seesaw.keystroke/keystroke "control ENTER")
        sql-text-area (seesaw.core/select frame [:#sql])]
    (seesaw.core/listen sql-text-area :key-pressed (partial on-key-press handler ctrl-enter-keystroke))))

; (defn set-on-explain-handler
;   [frame handler]
;   (assert (not= frame nil))
;   (let [btn-explain (seesaw.core/select frame [:#explain])]
;     (assert (not= btn-explain nil))
;     (seesaw.core/listen btn-explain :action (fn [e] (handler)))))

(defn set-on-commit-handler
  [frame handler]
  (let [btn-commit (seesaw.core/select frame [:#commit])]
    (seesaw.core/listen btn-commit :action (fn [e] (handler)))))

(defn set-on-rollback-handler
  [frame handler]
  (let [btn-rollback (seesaw.core/select frame [:#rollback])]
    (seesaw.core/listen btn-rollback :action (fn [e] (handler)))))

(defn set-on-execute-handler
  "Set Execute button handler."
  [frame handler]
  (let [btn-execute (seesaw.core/select frame [:#execute])]
    (assert (not= btn-execute nil))
    (seesaw.core/listen btn-execute :action (fn [e] (handler)))))

(defn set-on-new-handler
  "Set New button handler."
  [frame handler]
  (let [btn-new (seesaw.core/select frame [:#new])]
    (assert (not= btn-new nil))
    (seesaw.core/listen btn-new :action (fn [e] (handler)))))

(defn set-on-save-handler
  "Set Save button handler."
  [frame handler]
  (let [btn-save (seesaw.core/select frame [:#save])]
    (assert (not= btn-save nil))
    (seesaw.core/listen btn-save :action (fn [e] (handler)))))

(defn set-on-open-handler
  [frame handler]
  (let [btn-open (seesaw.core/select frame [:#open])]
    (assert (not= btn-open nil))
    (seesaw.core/listen btn-open :action (fn [e] (handler)))))

(defn show!
  "Show worksheet frame."
  [frame]
  (seesaw.core/show! frame))

(defn extend-nonempty-lines-range
  "Return a range (that is, pair of line numbers) that include adjacent non-empty lines.

  First see if start can be decreased, and if it can, then return result of calling recursively with decreased start.
  Otherwise see if end can be increased, and again if it can, then return result of calling recursively with increased end.
  Finally if non of above worked, just return [start end].
  "
  [lines start end]
  (let [can-decrease-start (and
                             (> start 0)
                             (not= (trim (lines (dec start))) ""))]
    (if can-decrease-start
      (extend-nonempty-lines-range lines (dec start) end)
      (let [can-increase-end (and
                               (< end (dec (count lines)))
                               (not= (trim (lines (inc end))) ""))]
        (if can-increase-end
          (extend-nonempty-lines-range lines start (inc end))
          [start end])))))

(defn get-line-no
  "Get line number from text and index."
  [text position]
  (let [before-position-text (subs text 0 position)
        is-newline (fn [c] (= (str c) "\n"))]
    (count (filter is-newline before-position-text))))

(defn get-sql
  "Extract current SQL text from frame."
  ^String
  [frame]
  (let [all-text (seesaw.core/value (seesaw.core/select frame [:#sql]))
        caret-position (seesaw.core/config (seesaw.core/select frame [:#sql]) :caret-position)
        all-text-lines (split-lines all-text)
        line-no (get-line-no all-text caret-position)
        [start end] (extend-nonempty-lines-range all-text-lines line-no line-no)
        block-lines (subvec all-text-lines start (inc end))
        block-text (join "\n" block-lines)]
    block-text))

(defn get-contents
  "Get text from worksheet."
  ^String
  [^javax.swing.JFrame frame]
  (assert (not= frame nil))
  (-> (seesaw.core/select frame [:#sql])
      (seesaw.core/value)))

(defn set-on-scroll-handler
  "Add handler to fetch more results on scroll."
  [frame handler]
  (let [scrollable (seesaw.core/select frame [:#results-table-scrollable])
        viewport (.getViewport scrollable)]
    (seesaw.core/listen viewport :change handler)))

(defn get-scroll-position
  "Return scroll position as float."
  [viewport]
  (assert (not= viewport nil))
  (let [view-size (.getViewSize viewport)
        view-rect (.getViewRect viewport)
        view-rect-pos (float (.y view-rect))
        view-height (float (.height view-size))
        view-rect-height (float (.height view-rect))
        view-rect-pos-max (- view-height view-rect-height)
        view-scroll-position (if (<= view-rect-pos-max 0.0) 0.0 (/ view-rect-pos view-rect-pos-max))]
    view-scroll-position))

(defn append-row!
  [^javax.swing.JTable results-table row]
  (let [row-count (seesaw.table/row-count results-table)]
    (seesaw.table/insert-at! results-table row-count row)))

(defn append-rows!
  "Append rows to worksheet results table.

  Params:

  - new-rows is a seq of new rows to be appended."
  [worksheet new-rows]
  (println (format "appending %d rows to table" (count new-rows)))
  (let [frame (:frame @worksheet)
        _ (assert (not= frame nil))
        results-table (seesaw.core/select frame [:#results-table])
        _ (assert (not= results-table nil))]
    (doall (map (partial append-row! results-table) new-rows))))

(defn fetch-more-results!
  "Try to load more results from lazy sequence of results."
  [worksheet]
  (let [result (:result @worksheet)
        _ (assert (not= result nil))
        [strict-rows lazy-rows] (result :rows)
        strict-rows-count (count strict-rows)
        _ (println (format "strict-rows-count: %d" strict-rows-count))
        new-count (+ strict-rows-count 256)
        new-strict-rows (take new-count lazy-rows)
        _ (println (format "new-strict-rows count: %d" (count new-strict-rows)))
        _ (assert (>= (count new-strict-rows) (count strict-rows)))
        new-rows [new-strict-rows lazy-rows]
        new-result (assoc result :rows new-rows)]
    (swap! worksheet assoc :result new-result)
    (let [new-new-rows (nthrest new-strict-rows (count strict-rows))]
      (println (format "new-new-rows count: %d" (count new-new-rows)))
      (append-rows! worksheet new-new-rows))))

(defn on-results-table-scrolled
  [worksheet-atom e]
  (let [frame (:frame @worksheet-atom)
        _ (assert (not= frame nil))
        viewport (.getViewport (seesaw.core/select frame [:#results-table-scrollable]))
        scroll-pos (get-scroll-position viewport)]
    (if (> scroll-pos 0.75)
      (fetch-more-results! worksheet-atom))))

(defn show-results!
  "Display results inside results panel.
  This involves building results-table UI with accompanying controls.
  Parameters:

  - frame - worksheet frame,
  - columns - column names,
  - rows - a pair of semi strict and lazy sequences of rows do display.

  Scroll view is being configured so that if user scrolls close to the end of the table, new
  rows are fetched from second element of rows pair.
  "
  [worksheet-atom columns rows]
  (let [^javax.seing.JFrame frame (:frame @worksheet-atom)
        _ (assert (not= frame nil))
        [strict-rows lazy-rows] rows
        ^javax.swing.JTable results-table (seesaw.core/table :id :results-table
                                                             :auto-resize :off
                                                             :model [:columns columns
                                                                     :rows strict-rows])
        results-table-scrollable (seesaw.core/scrollable results-table :id :results-table-scrollable)
        ^javax.swing.JPanel results-panel (seesaw.core/select frame [:#results-panel])
        to-remove (seesaw.core/select frame [:#results-panel :> :*])]
    (doall (map (partial seesaw.core/remove! results-panel) to-remove))
    (seesaw.core/add! results-panel results-table-scrollable)
    (if (> (count strict-rows) 0)
      (let [table-column-model (.getColumnModel results-table)
            column-count (count columns)
            row-count (count strict-rows)
            max-column-widths (vec (for [column-index (range column-count)]
                                     (max 4
                                          (let [
                                                column-values (map str (map #(get % column-index) strict-rows))
                                                column-value-lengths (map count column-values)
                                                max-column-value-length (apply max column-value-lengths)]
                                            max-column-value-length))))
            ]
        (doall (for [column-index (range column-count)]
                 (let [table-column (.getColumn table-column-model column-index)
                       column-width (get max-column-widths column-index)]
                   (.setPreferredWidth table-column (* column-width 10)))))))
    (set-on-scroll-handler frame (partial on-results-table-scrolled worksheet-atom))))

(defn clear-results!
  "Clear results pane."
  [^javax.swing.JFrame frame]
  (assert (not= frame nil))
  (let [^javax.swing.JPanel results-panel (seesaw.core/select frame [:#results-panel])
        to-remove (seesaw.core/select frame [:#results-panel :> :*])]
    (doall (map (partial seesaw.core/remove! results-panel) to-remove))))

(defn choose-save-file
  "Show save dialog, return absolute path as string."
  [frame]
  (-> (seesaw.chooser/choose-file frame :type :save)
      (.getAbsolutePath)))

(defn show-explain-plan!
  "Show explain plan."
  [^javax.swing.JFrame frame
   ^String explain-plan]
  (println "displaying explain plan"))

(defn log
  "Add log message to status panel."
  [^javax.swing.JFrame frame
   ^String message]
  (let [^javax.swing.JContainer log-tab (seesaw.core/select frame [:#log-panel])
        ^javax.swing.JComponent log-text (seesaw.core/select log-tab [:#log])]
    (assert (not= log-tab nil))
    (assert (not= log-text nil))
    (let [^String old-text (seesaw.core/text log-text)
          ^String new-text (str old-text message)]
      (seesaw.core/text! log-text new-text))))

(defn status-text
  "Set status bar text."
  [^javax.swing.JFrame frame
   ^String message]
  (assert (not= frame nil))
  (assert (not= message nil))
  (let [status-bar-text (seesaw.core/select frame [:#status-bar-text])]
    (assert (not= status-bar-text nil))
    (seesaw.core/text! status-bar-text message)))

Remove whitespace and unneeded debug printf


(ns african-polyphony-and-polyrhythm.talk
  (:require [overtone.live :refer :all :exclude [stop scale]]
            [leipzig.melody :refer :all]
            [leipzig.scale :refer [scale high low from]]
            [leipzig.live :as live]
            [leipzig.live :refer [stop]]))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;
; Ostinato with variations ;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(defn target
  "Apply f to the note at time t."
  [t f]
  (fn [notes]
    (let [before? (fn [note] (-> note :time (< t)))
          before (->> notes (take-while before?))
          [note & after] (->> notes (drop-while before?))]
      (with before (f note) after))))

(defn split
  "Split a new note off the note at time t."
  [t duration]
  (letfn [(f [note]
            [(-> note (assoc :duration duration))
             (-> note (update :duration - duration) (update :time + duration))])]
    (target t f)))

(defn accent
  "Accent the pitch of the note at time t."
  [t]
  (letfn [(f [note] [(-> note (update :pitch dec))])]
    (target t f)))

(defn skip
  "Skip the note at time t."
  [t]
  (target t (constantly [])))

(defn rand-variations
  "Assemble an infinite random concatenation of variations."
  [variations]
  (let [variation (rand-nth variations)]
    (concat
      variation
      (lazy-seq
        (->> (rand-variations variations)
             (after (duration variation)))))))

(defn part
  "Generate version of the model using the variations fns."
  [instrument model & variations]
  (let [vary (apply juxt variations)]
    (->> model
         vary
         (map #(all :part instrument %)))))

(defn introduce-successively
  "Gradually introduce each part after t beats."
  [t parts]
  (->> parts
       (map after (range 0 (* (count parts) t) t))
       (reduce with)))

(defn big
  "Make a set of variations one pentatonic octave bigger."
  [notes]
  (->> notes
       (map #(where :pitch (from 5) %))))

(defn pan
  "Pan out an 18 piece orchestra to make individual parts more distinct."
  [{:keys [pitch] :as note}]
  (let [position (if (even? pitch)
                   (-> pitch (/ 18) dec)
                   (-> pitch (/ 18) dec -))]
    (assoc note :pan position)))

;;;;;;;;;;;;;;
; Aga Terumo ;
;;;;;;;;;;;;;;

(def child "First drum"
  (let [model (rhythm [2/5 3/5 5/5])
        a (comp (split 6/5 1/5) (split 5/5 1/5))
        b (comp (split 6/5 1/10) a)
        c (comp (split 17/15 2/15) (split 5/5 2/15) (split 5/5 2/5))
        d (comp (split 5/5 1/10) a)
        e identity]
    (part :child model a b c d e)))

(def mother "Second drum"
  (let [model (rhythm [2/5 2/5 4/5 2/5])
        b (skip 0)
        c (split 8/5 1/5)
        a (comp b c)
        d identity
        e (comp c #(->> (rhythm (repeat 5 2/5)) (then %)))]
    (part :mother model a b c d e)))

(def father "Third drum"
  (let [model (rhythm [2/5 1/5 2/5])
        a identity
        d (split 3/5 1/5)
        c (comp (split 3/5 1/10) d)
        e (split 2/5 3/10)
        f (skip 2/5)
        b (comp (split 0 1/5) f)
        g (comp b d)
        h (comp (split 1/10 1/10) e)
        i (split 0 1/5)]
    (part :father model a b c d e f g h i)))

(defn aga-terumo
  "Banda-Linda ritual music - page 299"
  []
  (let [drums [child mother father]]
    (->> drums
         (map rand-variations)
         (introduce-successively 4)
         (tempo (bpm 90)))))

(comment
  (live/play (aga-terumo)))

;;;;;;;;;;;;;;;;;;
; Clapping Music ;
;;;;;;;;;;;;;;;;;;

(defn clapping-music
  "Steve Reich's 'Clapping Music'"
  []
  (let [african-bell-pattern (rhythm [1/8 1/8 1/4 1/8 1/4 1/4 1/8 1/4])
        ostinato #(rand-variations [%])]
    (with
      (->> african-bell-pattern
           ostinato
           (all :part :mother))
      (->> african-bell-pattern
           (times 4)
           (then (rhythm [1/8]))
           ostinato
           (all :part :child)))))

(comment
  (live/play (clapping-music)))

;;;;;;;;;;;;;;;;;;
; Natural scales ;
;;;;;;;;;;;;;;;;;;

; Natural numbers
(def natural-numbers (range 0 8))

; Raw frequencies
(comment
  (->> (phrase (repeat 1/4) [440.0 493.9 554.4 587.3 659.3 740.0 830.6 880.0])
       live/play))

; Midi
(comment

  (midi->hz 69) ; 440.0
  (midi->hz 71) ; 493.9

  (->> (phrase (repeat 1/4) [69 71 73 74 76 78 80 81])
       (where :pitch midi->hz)
       live/play))

; Keys
(defn A [relative-midi] (+ relative-midi 69))
(defn B [relative-midi] (+ relative-midi 71))
(defn C [relative-midi] (+ relative-midi 72))

(comment
  (->> (phrase (repeat 1/4) [0 2 4 5 7 9 11 12])
       (where :pitch (comp midi->hz A))
       live/play))

; Scales
(def major (scale [2 2 1 2 2 2 1]))
(def minor (scale [2 1 2 2 1 2 2]))
(def pentatonic (scale [2 3 2 2 3]))

(comment
  (->> (phrase (repeat 1/4) (range 0 8))
       (where :pitch (comp midi->hz A major))
       live/play))

; Little-endian
(def little-endian-pentatonic
  "In Central African music, we play scales from small sounds to big ones."
  (comp pentatonic -))

(comment
  (map (comp A little-endian-pentatonic) (range 0 6))

  (->> (phrase (repeat 1/4) (range 0 6))
       (where :pitch (comp midi->hz A little-endian-pentatonic))
       live/play))

;;;;;;;;;;;;;;;;;;;;;
; Ndereje Balendoro ;
;;;;;;;;;;;;;;;;;;;;;

(def tete
  (let [model (phrase [8/4 3/4 5/4] (repeat 0))
        a (split 0 1/4)
        b (comp (split 1/4 1/4) a)
        c (comp (accent 2/4) (split 2/4 1/4) b)
        d (comp (skip 0/4) c)]
    (part :horn model a b c d)))

(def ta
  (let [model (->> (phrase [5/4 3/4 4/4] (repeat 1)) (after 4/4))
        a (split 9/4 1/4)
        b (comp (split 10/4 1/4) a)
        c (comp (accent 11/4) (split 11/4 1/8) b)
        d (split 4/4 1/4)
        e (comp (skip 10/4) c)]
    (part :horn model a b c d e)))

(def ha
  (let [model (->> (phrase [12/4 2/4] (repeat 2)) (after 2/4))
        a (comp (split 2/4 1/4) (split 0 1/4))
        b (comp (split 6/4 1/4))
        c (comp (split 0 1/4) b)
        d (comp a b)]
    (part :horn model a b c d)))

(def tulule
  (let [model (phrase [8/4 8/4] (repeat 3))
        a (comp (split 8/4 2/4) (split 0 2/4))
        b (comp (split 0 1/4) (split 2/4 1/4) a)
        c (comp (accent 7/8) (split 3/4 1/8) b)]
    (part :horn model a b c)))

(def bongo
  (let [model (->> (phrase [3/4 7/4] (repeat 4)) (after 6/4))
        a (split 9/4 5/4)
        b (comp (split 6/4 1/4) a)
        c (comp (split 14/4 1/4) b)
        d (comp (accent 10/4) (split 9/4 1/4) b)]
    (part :horn model a b c d)))

(defn ndereje-balendoro
  "Linda horn music - page 316"
  []
  (->> [tete ;ta ha tulule bongo
        ;(big tete) (big ta) (big ha) (big tulule) (big bongo)
        ;(big (big tete)) (big (big ta)) (big (big ha)) (big (big tulule)) (big (big bongo))
        ;(big (big (big tete))) (big (big (big ta))) (big (big (big ha)))
        ]
       (map rand-variations)
       (introduce-successively 4)
       (map pan)
       (where :pitch (comp midi->hz high A little-endian-pentatonic))
       (tempo (bpm 120))))

(comment
  (live/play (ndereje-balendoro)))

;;;;;;;;;;;;;;;
; Instruments ;
;;;;;;;;;;;;;;;

(definst drum [freq 110 vol 0.5 pan 0]
  (-> (* 2/3 (brown-noise))
      (+ (* 1/2 (sin-osc (* 3 freq))))
      (+ (* 1/5 (sin-osc (* 5 freq))))
      (clip2 0.8)
      (rlpf (line:kr freq (* 7 freq) 0.02))
      (* (env-gen (adsr 0.02 0.4 0.15 0.2) (line:kr 1 0 0.1) :action FREE))
      (pan2 pan)
      (* vol)))

(defmethod live/play-note :child [_]
  (drum 225 :pan 0.75))

(defmethod live/play-note :mother [_]
  (drum 150 :pan -0.75))

(defmethod live/play-note :father [_]
  (drum 75 :pan 0 :vol 1.0))

(definst whistle [freq 880 vol 0.5 pan 0 dur 0.2]
  (-> (sin-osc freq)
      (+ (* 1/2 (sin-osc 3) (sin-osc (* 3.01 freq))))
      (+ (* 1/5 (sin-osc (* 2 freq))))
      (+ (* 1/8 (sin-osc (* 4.99 freq))))
      (+ (* 1/8 (sin-osc (* 7.01 freq))))
      (clip2 0.8)
      (rlpf (line:kr (* 2 freq) (* 7 freq) 0.8))
      (* (env-gen (adsr 0.1 0.1 0.35 0.05) (line:kr 1 0 dur) :action FREE))
      (pan2 pan)
      (* vol)))

(defmethod live/play-note :horn [{:keys [pitch pan duration]}]
  (whistle :freq pitch :pan (or pan 0) :dur (min duration 0.2))
  ;(drum :freq (* 1/2 pitch) :pan (or pan 0) :dur (min duration 0.2))
  )

(defmethod live/play-note :default [{:keys [pitch duration]}]
  (whistle :freq pitch :dur duration))

(ns african-polyphony-and-polyrhythm.talk
  (:require [overtone.live :refer :all :exclude [stop scale]]
            [leipzig.melody :refer :all]
            [leipzig.scale :refer [scale high low from]]
            [leipzig.live :as live]
            [leipzig.live :refer [stop]]))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;
; Ostinato with variations ;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(defn target
  "Apply f to the note at time t."
  [t f]
  (fn [notes]
    (let [before? (fn [note] (-> note :time (< t)))
          before (->> notes (take-while before?))
          [note & after] (->> notes (drop-while before?))]
      (with before (f note) after))))

(defn split
  "Split a new note off the note at time t."
  [t duration]
  (letfn [(f [note]
            [(-> note (assoc :duration duration))
             (-> note (update :duration - duration) (update :time + duration))])]
    (target t f)))

(defn accent
  "Accent the pitch of the note at time t."
  [t]
  (letfn [(f [note] [(-> note (update :pitch dec))])]
    (target t f)))

(defn skip
  "Skip the note at time t."
  [t]
  (target t (constantly [])))

(defn rand-variations
  "Assemble an infinite random concatenation of variations."
  [variations]
  (let [variation (rand-nth variations)]
    (concat
      variation
      (lazy-seq
        (->> (rand-variations variations)
             (after (duration variation)))))))

(defn part
  "Generate version of the model using the variations fns."
  [instrument model & variations]
  (let [vary (apply juxt variations)]
    (->> model
         vary
         (map #(all :part instrument %)))))

(defn introduce-successively
  "Gradually introduce each part after t beats."
  [t parts]
  (->> parts
       (map after (range 0 (* (count parts) t) t))
       (reduce with)))

(defn big
  "Make a set of variations one pentatonic octave bigger."
  [notes]
  (->> notes
       (map #(where :pitch (from 5) %))))

(defn pan
  "Pan out an 18 piece orchestra to make individual parts more distinct."
  [{:keys [pitch] :as note}]
  (let [position (if (even? pitch)
                   (-> pitch (/ 18) dec)
                   (-> pitch (/ 18) dec -))]
    (assoc note :pan position)))

;;;;;;;;;;;;;;
; Aga Terumo ;
;;;;;;;;;;;;;;

(def child "First drum"
  (let [model (rhythm [2/5 3/5 5/5])
        a (comp (split 6/5 1/5) (split 5/5 1/5))
        b (comp (split 6/5 1/10) a)
        c (comp (split 17/15 2/15) (split 5/5 2/15) (split 5/5 2/5))
        d (comp (split 5/5 1/10) a)
        e identity]
    (part :child model a b c d e)))

(def mother "Second drum"
  (let [model (rhythm [2/5 2/5 4/5 2/5])
        b (skip 0)
        c (split 8/5 1/5)
        a (comp b c)
        d identity
        e (comp c #(->> (rhythm (repeat 5 2/5)) (then %)))]
    (part :mother model a b c d e)))

(def father "Third drum"
  (let [model (rhythm [2/5 1/5 2/5])
        a identity
        d (split 3/5 1/5)
        c (comp (split 3/5 1/10) d)
        e (split 2/5 3/10)
        f (skip 2/5)
        b (comp (split 0 1/5) f)
        g (comp b d)
        h (comp (split 1/10 1/10) e)
        i (split 0 1/5)]
    (part :father model a b c d e f g h i)))

(defn aga-terumo
  "Banda-Linda ritual music - page 299"
  []
  (let [drums [child mother father]]
    (->> drums
         (map rand-variations)
         (introduce-successively 4)
         (tempo (bpm 90)))))

(comment
  (live/play (aga-terumo)))

;;;;;;;;;;;;;;;;;;
; Clapping Music ;
;;;;;;;;;;;;;;;;;;

(defn clapping-music
  "Steve Reich's 'Clapping Music'"
  []
  (let [african-bell-pattern (rhythm [1/8 1/8 1/4 1/8 1/4 1/4 1/8 1/4])
        ostinato #(rand-variations [%])]
    (with
      (->> african-bell-pattern
           ostinato
           (all :part :mother))
      (->> african-bell-pattern
           (times 4)
           (then (rhythm [1/8]))
           ostinato
           (all :part :child)))))

(comment
  (live/play (clapping-music)))

;;;;;;;;;;;;;;;;;;
; Natural scales ;
;;;;;;;;;;;;;;;;;;

; Natural numbers
(def natural-numbers (range 0 8))

; Raw frequencies
(comment
  (->> (phrase (repeat 1/4) [440.0 493.9 554.4 587.3 659.3 740.0 830.6 880.0])
       live/play))

; Midi
(comment

  (midi->hz 69) ; 440.0
  (midi->hz 71) ; 493.9

  (->> (phrase (repeat 1/4) [69 71 73 74 76 78 80 81])
       (where :pitch midi->hz)
       live/play))

; Keys
(defn A [relative-midi] (+ relative-midi 69))
(defn B [relative-midi] (+ relative-midi 71))
(defn C [relative-midi] (+ relative-midi 72))

(comment
  (->> (phrase (repeat 1/4) [0 2 4 5 7 9 11 12])
       (where :pitch (comp midi->hz A))
       live/play))

; Scales
(def major (scale [2 2 1 2 2 2 1]))
(def minor (scale [2 1 2 2 1 2 2]))

(comment
  (->> (phrase (repeat 1/4) (range 0 8))
       (where :pitch (comp midi->hz A major))
       live/play))

; Little-endian pentatonic
(def pentatonic (scale [2 3 2 2 3]))
(def little-endian -)

(comment
  (map (comp A pentatonic) (range 0 6))
  (map (comp A little-endian pentatonic) (range 0 6))

  (->> (phrase (repeat 1/4) (range 0 6))
       (where :pitch (comp midi->hz A pentatonic))
       live/play)

  (->> (phrase (repeat 1/4) (range 0 6))
       (where :pitch (comp midi->hz A little-endian pentatonic))
       live/play))

;;;;;;;;;;;;;;;;;;;;;
; Ndereje Balendoro ;
;;;;;;;;;;;;;;;;;;;;;

(def tete
  (let [model (phrase [8/4 3/4 5/4] (repeat 0))
        a (split 0 1/4)
        b (comp (split 1/4 1/4) a)
        c (comp (accent 2/4) (split 2/4 1/4) b)
        d (comp (skip 0/4) c)]
    (part :horn model a b c d)))

(def ta
  (let [model (->> (phrase [5/4 3/4 4/4] (repeat 1)) (after 4/4))
        a (split 9/4 1/4)
        b (comp (split 10/4 1/4) a)
        c (comp (accent 11/4) (split 11/4 1/8) b)
        d (split 4/4 1/4)
        e (comp (skip 10/4) c)]
    (part :horn model a b c d e)))

(def ha
  (let [model (->> (phrase [12/4 2/4] (repeat 2)) (after 2/4))
        a (comp (split 2/4 1/4) (split 0 1/4))
        b (comp (split 6/4 1/4))
        c (comp (split 0 1/4) b)
        d (comp a b)]
    (part :horn model a b c d)))

(def tulule
  (let [model (phrase [8/4 8/4] (repeat 3))
        a (comp (split 8/4 2/4) (split 0 2/4))
        b (comp (split 0 1/4) (split 2/4 1/4) a)
        c (comp (accent 7/8) (split 3/4 1/8) b)]
    (part :horn model a b c)))

(def bongo
  (let [model (->> (phrase [3/4 7/4] (repeat 4)) (after 6/4))
        a (split 9/4 5/4)
        b (comp (split 6/4 1/4) a)
        c (comp (split 14/4 1/4) b)
        d (comp (accent 10/4) (split 9/4 1/4) b)]
    (part :horn model a b c d)))

(defn ndereje-balendoro
  "Linda horn music - page 316"
  []
  (->> [tete ;ta ha tulule bongo
        ;(big tete) (big ta) (big ha) (big tulule) (big bongo)
        ;(big (big tete)) (big (big ta)) (big (big ha)) (big (big tulule)) (big (big bongo))
        ;(big (big (big tete))) (big (big (big ta))) (big (big (big ha)))
        ]
       (map rand-variations)
       (introduce-successively 4)
       (map pan)
       (where :pitch (comp midi->hz high A little-endian pentatonic))
       (tempo (bpm 120))))

(comment
  (live/play (ndereje-balendoro)))

;;;;;;;;;;;;;;;
; Instruments ;
;;;;;;;;;;;;;;;

(definst drum [freq 110 vol 0.5 pan 0]
  (-> (* 2/3 (brown-noise))
      (+ (* 1/2 (sin-osc (* 3 freq))))
      (+ (* 1/5 (sin-osc (* 5 freq))))
      (clip2 0.8)
      (rlpf (line:kr freq (* 7 freq) 0.02))
      (* (env-gen (adsr 0.02 0.4 0.15 0.2) (line:kr 1 0 0.1) :action FREE))
      (pan2 pan)
      (* vol)))

(defmethod live/play-note :child [_]
  (drum 225 :pan 0.75))

(defmethod live/play-note :mother [_]
  (drum 150 :pan -0.75))

(defmethod live/play-note :father [_]
  (drum 75 :pan 0 :vol 1.0))

(definst whistle [freq 880 vol 0.5 pan 0 dur 0.2]
  (-> (sin-osc freq)
      (+ (* 1/2 (sin-osc 3) (sin-osc (* 3.01 freq))))
      (+ (* 1/5 (sin-osc (* 2 freq))))
      (+ (* 1/8 (sin-osc (* 4.99 freq))))
      (+ (* 1/8 (sin-osc (* 7.01 freq))))
      (clip2 0.8)
      (rlpf (line:kr (* 2 freq) (* 7 freq) 0.8))
      (* (env-gen (adsr 0.1 0.1 0.35 0.05) (line:kr 1 0 dur) :action FREE))
      (pan2 pan)
      (* vol)))

(defmethod live/play-note :horn [{:keys [pitch pan duration]}]
  (whistle :freq pitch :pan (or pan 0) :dur (min duration 0.2))
  ;(drum :freq (* 1/2 pitch) :pan (or pan 0) :dur (min duration 0.2))
  )

(defmethod live/play-note :default [{:keys [pitch duration]}]
  (whistle :freq pitch :dur duration))

Introduce pentatonic as part of CA music.


;; ## Benchmark suite
;;
;; This command-line utility will simulate catalog submission for a
;; population. It requires that a separate, running instance of
;; PuppetDB for it to submit catalogs to.
;;
;; Aspects of a population this tool currently models:
;;
;; * Number of nodes
;; * Run interval
;; * How often a host's catalog changes
;; * A starting catalog
;;
;; We attempt to approximate a number of hosts submitting catalogs at
;; the specified runinterval with the specified rate-of-churn in
;; catalog content.
;;
;; The list of nodes is modeled in the tool as a set of Clojure
;; agents, with one agent per host. Each agent has the following
;; state:
;;
;;     {:host    ;; the host's name
;;      :lastrun ;; when the host last sent a catalog
;;      :catalog ;; the last catalog sent}
;;
;; When a host needs to submit a new catalog, we determine if the new
;; catalog should be different than the previous one (based on a
;; user-specified threshold) and send the resulting catalog to
;; PuppetDB.
;;
;; ### Main loop
;;
;; The main loop is written in the form of a wall-clock
;; simulator. Each run through the main loop, we send each agent an
;; `update` message with the current wall-clock. Each agent decides
;; independently whether or not to submit a catalog during that clock
;; tick.
;;
(ns com.puppetlabs.puppetdb.cli.benchmark
  (:import (java.io File))
  (:require [clojure.tools.logging :as log]
            [com.puppetlabs.puppetdb.catalog :as cat]
            [com.puppetlabs.puppetdb.catalog.utils :as catutils]
            [com.puppetlabs.puppetdb.command :as command]
            [cheshire.core :as json]
            [clj-http.client :as client]
            [clj-http.util :as util]
            [fs.core :as fs])
  (:use [com.puppetlabs.utils :only (cli! inis-to-map configure-logging! utf8-string->sha1)]
        [com.puppetlabs.puppetdb.scf.migrate :only [migrate!]]))

(def cli-description "Development-only benchmarking tool")

(def hosts nil)
(def hostname nil)
(def port nil)
(def runinterval nil)
(def rand-percentage 0)

(defn submit-catalog
  "Send the given wire-format catalog (associated with `host`) to a
  command-processing endpoint."
  [host catalog]
  (let [result (command/submit-command-via-http! hostname port "replace catalog" 1 catalog)]
    (if (not= pl-http/status-ok (:status result))
      (log/error result))))

(defn tweak-catalog
  "Slightly tweak the given catalog, returning a new catalog"
  [catalog]
  (catutils/add-random-resource-to-wire-catalog catalog))

(defn update-host
  "Send a new _clock tick_ to a host

  On each tick, a host:

  * Determines if its time to submit a new catalog (by looking at the
    time it last sent one, and comparing that to the desired
    `runinterval`

  * If we need to submit a catalog, optionally tweak the catalog (a
    hosts catalog changes in accordance to the users preference)

  * Submit the resulting catalog"
  [{:keys [host lastrun catalog] :as state} clock]
  (if (> (- clock lastrun) runinterval)
    (let [catalog (if (< (rand 100) rand-percentage)
                    (tweak-catalog catalog)
                    catalog)]
      ;; Submit the catalog in a separate thread, so as to not disturb
      ;; the world-loop and otherwise distort the space-time
      ;; continuum.
      (future
        (log/info (format "[%s] submitting catalog" host))
        (submit-catalog host catalog))
      (assoc state :lastrun clock :catalog catalog))
    state))

(defn world-loop
  "Sends out new _clock tick_ messages to all agents.

  This function never terminates.

  The time resolution of this loop is 10ms."
  []
  (loop [last-time (System/currentTimeMillis)]
    (let [curr-time (System/currentTimeMillis)]

      ;; Send out updated ticks to each agent
      (doseq [host hosts]
        (send host update-host curr-time))

      (Thread/sleep 10)
      (recur curr-time))))

(defn associate-catalog-with-host
  "Takes the given catalog and transforms it to appear related to
  `hostname`"
  [hostname catalog]
  (-> catalog
      (assoc-in ["data" "name"] hostname)
      (assoc-in ["data" "resources"] (for [resource (get-in catalog ["data" "resources"])]
                                       (assoc resource "tags" (conj (resource "tags") hostname))))))
(defn -main
  [& args]
  (let [[options _] (cli! args
                          ["-d" "--dir" "Path to a directory containing sample JSON catalogs (files must end with .json)"]
                          ["-i" "--runinterval" "What runinterval (in minutes) to use during simulation"]
                          ["-n" "--numhosts" "How many hosts to use during simulation"]
                          ["-rp" "--rand-perc" "What percentage of submitted catalogs are tweaked (int between 0 and 100)"])

        config      (-> options
                        :config
                        (inis-to-map)
                        (configure-logging!))

        dir         (:dir options)
        catalogs    (->> (for [file (fs/glob (fs/file dir "*.json"))]
                           (try
                             (json/parse-string (slurp file))
                             (catch Exception e
                               (log/error (format "Error parsing %s; skipping" file)))))
                         (remove nil?)
                         (vec))

        nhosts      (:numhosts options)
        hostnames   (set (map #(str "host-" %) (range 1 (Integer/parseInt nhosts))))]

    (def hostname (get-in config [:jetty :host] "localhost"))
    (def port (get-in config [:jetty :port] 8080))
    (def rand-percentage (Integer/parseInt (:rand-perc options)))
    (def runinterval (* 60 1000 (Integer/parseInt (:runinterval options))))

    ;; Create an agent for each host
    (def hosts
      (vec (map #(agent {:host    %,
                         :lastrun (- (System/currentTimeMillis) (rand-int runinterval)),
                         :catalog (associate-catalog-with-host % (rand-nth catalogs))})
                hostnames)))

    ;; Loop forever
    (world-loop)))

;; ## Benchmark suite
;;
;; This command-line utility will simulate catalog submission for a
;; population. It requires that a separate, running instance of
;; PuppetDB for it to submit catalogs to.
;;
;; Aspects of a population this tool currently models:
;;
;; * Number of nodes
;; * Run interval
;; * How often a host's catalog changes
;; * A starting catalog
;;
;; We attempt to approximate a number of hosts submitting catalogs at
;; the specified runinterval with the specified rate-of-churn in
;; catalog content.
;;
;; The list of nodes is modeled in the tool as a set of Clojure
;; agents, with one agent per host. Each agent has the following
;; state:
;;
;;     {:host    ;; the host's name
;;      :lastrun ;; when the host last sent a catalog
;;      :catalog ;; the last catalog sent}
;;
;; When a host needs to submit a new catalog, we determine if the new
;; catalog should be different than the previous one (based on a
;; user-specified threshold) and send the resulting catalog to
;; PuppetDB.
;;
;; ### Main loop
;;
;; The main loop is written in the form of a wall-clock
;; simulator. Each run through the main loop, we send each agent an
;; `update` message with the current wall-clock. Each agent decides
;; independently whether or not to submit a catalog during that clock
;; tick.
;;
(ns com.puppetlabs.puppetdb.cli.benchmark
  (:import (java.io File))
  (:require [clojure.tools.logging :as log]
            [com.puppetlabs.puppetdb.catalog :as cat]
            [com.puppetlabs.puppetdb.catalog.utils :as catutils]
            [com.puppetlabs.puppetdb.command :as command]
            [com.puppetlabs.http :as pl-http]
            [cheshire.core :as json]
            [clj-http.client :as client]
            [clj-http.util :as util]
            [fs.core :as fs])
  (:use [com.puppetlabs.utils :only (cli! inis-to-map configure-logging! utf8-string->sha1)]
        [com.puppetlabs.puppetdb.scf.migrate :only [migrate!]]))

(def cli-description "Development-only benchmarking tool")

(def hosts nil)
(def hostname nil)
(def port nil)
(def runinterval nil)
(def rand-percentage 0)

(defn submit-catalog
  "Send the given wire-format catalog (associated with `host`) to a
  command-processing endpoint."
  [host catalog]
  (let [result (command/submit-command-via-http! hostname port "replace catalog" 1 catalog)]
    (if (not= pl-http/status-ok (:status result))
      (log/error result))))

(defn tweak-catalog
  "Slightly tweak the given catalog, returning a new catalog"
  [catalog]
  (catutils/add-random-resource-to-wire-catalog catalog))

(defn update-host
  "Send a new _clock tick_ to a host

  On each tick, a host:

  * Determines if its time to submit a new catalog (by looking at the
    time it last sent one, and comparing that to the desired
    `runinterval`

  * If we need to submit a catalog, optionally tweak the catalog (a
    hosts catalog changes in accordance to the users preference)

  * Submit the resulting catalog"
  [{:keys [host lastrun catalog] :as state} clock]
  (if (> (- clock lastrun) runinterval)
    (let [catalog (if (< (rand 100) rand-percentage)
                    (tweak-catalog catalog)
                    catalog)]
      ;; Submit the catalog in a separate thread, so as to not disturb
      ;; the world-loop and otherwise distort the space-time
      ;; continuum.
      (future
        (log/info (format "[%s] submitting catalog" host))
        (submit-catalog host catalog))
      (assoc state :lastrun clock :catalog catalog))
    state))

(defn world-loop
  "Sends out new _clock tick_ messages to all agents.

  This function never terminates.

  The time resolution of this loop is 10ms."
  []
  (loop [last-time (System/currentTimeMillis)]
    (let [curr-time (System/currentTimeMillis)]

      ;; Send out updated ticks to each agent
      (doseq [host hosts]
        (send host update-host curr-time))

      (Thread/sleep 10)
      (recur curr-time))))

(defn associate-catalog-with-host
  "Takes the given catalog and transforms it to appear related to
  `hostname`"
  [hostname catalog]
  (-> catalog
      (assoc-in ["data" "name"] hostname)
      (assoc-in ["data" "resources"] (for [resource (get-in catalog ["data" "resources"])]
                                       (assoc resource "tags" (conj (resource "tags") hostname))))))
(defn -main
  [& args]
  (let [[options _] (cli! args
                          ["-d" "--dir" "Path to a directory containing sample JSON catalogs (files must end with .json)"]
                          ["-i" "--runinterval" "What runinterval (in minutes) to use during simulation"]
                          ["-n" "--numhosts" "How many hosts to use during simulation"]
                          ["-rp" "--rand-perc" "What percentage of submitted catalogs are tweaked (int between 0 and 100)"])

        config      (-> options
                        :config
                        (inis-to-map)
                        (configure-logging!))

        dir         (:dir options)
        catalogs    (->> (for [file (fs/glob (fs/file dir "*.json"))]
                           (try
                             (json/parse-string (slurp file))
                             (catch Exception e
                               (log/error (format "Error parsing %s; skipping" file)))))
                         (remove nil?)
                         (vec))

        nhosts      (:numhosts options)
        hostnames   (set (map #(str "host-" %) (range 1 (Integer/parseInt nhosts))))]

    (def hostname (get-in config [:jetty :host] "localhost"))
    (def port (get-in config [:jetty :port] 8080))
    (def rand-percentage (Integer/parseInt (:rand-perc options)))
    (def runinterval (* 60 1000 (Integer/parseInt (:runinterval options))))

    ;; Create an agent for each host
    (def hosts
      (vec (map #(agent {:host    %,
                         :lastrun (- (System/currentTimeMillis) (rand-int runinterval)),
                         :catalog (associate-catalog-with-host % (rand-nth catalogs))})
                hostnames)))

    ;; Loop forever
    (world-loop)))

Fix missing namespace in benchmark.clj

Fix missing namespace in benchmark.clj

Signed-off-by: Deepak Giridharagopal <d11186354d1ef01ca06ae37d7e23e827da13e85f@puppetlabs.com>