(ns duratom.core-test
  (:require [clojure.test :refer :all]
            [duratom.core :refer :all]
            [duratom.utils :as ut]
            [taoensso.nippy :as nippy]
            [clojure.java
             [shell :as shell]
             [io :as io]]
            [clojure.string :as str])
  (:import (clojure.lang Agent)))

(defonce docker-default-machine-ip
  ;; `localhost` which works on Ubuntu simply won't work on MacOS.
  ;; we need the public IP of the docker-machine - `default` in this case.
  ;; this tends to be 192.168.99.100, but we can easily check via `docker-machine ip default`
  (delay
    (or (try
          (some-> (shell/sh "docker-machine" "ip" "default")
                  :out
                  str/trim-newline
                  not-empty)
          (catch Throwable _))
        ;; per https://devilbox.readthedocs.io/en/latest/howto/docker-toolbox/find-docker-toolbox-ip-address.html
        "192.168.99.100")))

(defn- common*
  [dura exists? async?]
  (let [sleep-time 200
        [f atom?] (if (instance? Agent dura)
                    [send-off false]
                    [swap! true])]
    (-> dura ;; init = {:x 1 :y 2}
        (doto (f assoc :z 3))
        (doto (f dissoc :x)))

    (when async?
      (Thread/sleep sleep-time))

    (is (= {:z 3 :y 2} @dura))
    (is (= (backend-snapshot dura) @dura))

    (-> dura
        (doto (f  (constantly [1 2 3])))
        (doto (f  (comp vec rest))))

    (when async?
      (Thread/sleep sleep-time))

    (is (= [2 3] @dura))
    (is (= (backend-snapshot dura) @dura))

    (when async?
      (Thread/sleep sleep-time))

    (if atom?
      (is (= [[2 3] [1 2 3]]
             (reset-vals! dura [1 2 3])))
      ;; don't break the assertions below
      (f dura (constantly [1 2 3])))

    (when async?
      (Thread/sleep sleep-time))

    (if atom?
      (is (= [[1 2 3] [2 3]]
            (swap-vals! dura rest)))
      (f dura rest))

    (f dura (partial into (sorted-set)))

    (when async?
      (Thread/sleep sleep-time))

    (is (sorted? @dura))
    (is (= (sorted-set 2 3) (backend-snapshot dura) @dura))

    (f dura #(with-meta % {:a 1 :b 2}))

    (when async?
      (Thread/sleep sleep-time))

    (is (= (sorted-set 2 3) (backend-snapshot dura) @dura))
    (is (= {:a 1 :b 2} (meta (backend-snapshot dura)) (meta @dura)))

    (when async?
      (Thread/sleep sleep-time))

    (destroy dura)

    (when async?
      (Thread/sleep sleep-time))

    (is (sorted? @dura))
    (is (= #{2 3} @dura))
    (when atom? ;; this exception is swallowed inside the agent's error handler
      (is (thrown? IllegalStateException (f dura conj 4))))
    (is (false? (exists?)) "Storage resource was NOT cleaned-up!!!")
    )
  )

(defn- file-backed-tests*
  [async?]
  (let [rel-path "data_temp.txt"
        _ (when (.exists (io/file rel-path))
            (io/delete-file rel-path)) ;; proper cleanup before testing
        init {:x 1 :y 2}
        dura (add-watch
               (duratom :local-file
                        :file-path rel-path
                        :init init
                        :rw (cond-> default-file-rw
                                    (not async?) (assoc :commit-mode :sync)))
               :log (fn [k r old-state new-state]
                      (println "Transitioning from" (ut/pr-str-fully true old-state)
                               "to" (ut/pr-str-fully true new-state) "...")))]

    ;; empty file first
    (common* dura #(.exists (io/file rel-path)) async?)
    ;; with-contents thereafter
    (spit rel-path (pr-str init))
    (common* (add-watch
               (duratom :local-file
                        :file-path rel-path
                        :init init
                        :rw (cond-> default-file-rw
                                    (not async?) (assoc :commit-mode :sync)))
               :log (fn [k r old-state new-state]
                      (println "Transitioning from" (ut/pr-str-fully true old-state)
                               "to" (ut/pr-str-fully true new-state) "...")))
             #(.exists (io/file rel-path))
             async?)

    ;; duragent version
    (when async?
      (common* (duragent :local-file
                         :file-path rel-path
                         :init init)
               #(.exists (io/file rel-path))
               async?))
    )
  )

(deftest file-backed-tests
  (println "File-backed atom/agent with async commit...")
  (file-backed-tests* true)
  (println "File-backed atom with sync commit...")
  (file-backed-tests* false)
  )

(defn- postgres-backed-tests*
  [async?]
  (let [ip @docker-default-machine-ip
        db-spec {:classname   "org.postgresql.Driver"
                 :subprotocol "postgresql"
                 :subname     (str "//"  ip ":5432/atomDB") ;; localhost won't work on the mac
                 :user        "dimitris"
                 :password    "secret"}
        table-name "atom_state"
        _ (ut/delete-relevant-row! db-spec table-name 0)
        init {:x 1 :y 2}
        dura (add-watch
               (duratom :postgres-db
                        :db-config db-spec
                        :table-name table-name
                        :row-id 0
                        :init init
                        :rw (cond-> default-postgres-rw
                                    (not async?) (assoc :commit-mode :sync)))
               :log (fn [k, r, old-state, new-state]
                      (println "Transitioning from" (ut/pr-str-fully true old-state)
                               "to" (ut/pr-str-fully true new-state) "...")))]

    ;; empty row first
    (common* dura
             #(some? (ut/get-pgsql-value db-spec table-name 0 ut/read-edn-string))
             async?)
    ;; with-contents thereafter
    (ut/update-or-insert! db-spec table-name {:id 0 :value (pr-str init)} ["id = ?" 0])
    (common* (add-watch
               (duratom :postgres-db
                        :db-config db-spec
                        :table-name table-name
                        :row-id 0
                        :init init
                        :rw (cond-> default-postgres-rw
                                    (not async?) (assoc :commit-mode :sync)))
               :log (fn [k, r, old-state, new-state]
                      (println "Transitioning from" (ut/pr-str-fully true old-state)
                               "to" (ut/pr-str-fully true new-state) "...")))
             #(some? (ut/get-pgsql-value db-spec table-name 0 ut/read-edn-string))
             async?)

    ;; duragent version
    (when async?
      (common* (duragent :postgres-db
                         :db-config db-spec
                         :table-name table-name
                         :row-id 0
                         :init init)
               #(some? (ut/get-pgsql-value db-spec table-name 0 ut/read-edn-string))
               async?))
    )
  )

(deftest postgres-backed-tests
  (println "PGSQL-backed atom/agent with async commit...")
  (postgres-backed-tests* true)
  (println "PGSQL-backed atom with sync commit...")
  (postgres-backed-tests* false)
  )

(defn- redis-backed-tests*
  [async?]
  (let [ip @docker-default-machine-ip
        db-config  {:pool {}
                    :spec {:uri (str "redis://" ip ":6379/")}} ;; localhost won't work on the mac
        key-name "atom:state"
        init {:x 1 :y 2}
        key-exists? #(ut/redis-key-exists? db-config key-name)
        _ (ut/redis-del db-config key-name)
        dura (duratom :redis-db
                      :db-config db-config
                      :key-name key-name
                      :init init
                      :rw (cond-> default-redis-rw
                            (not async?) (assoc :commit-mode :sync)))]
    ;; empty key first
    (common* dura key-exists? async?)
    ;; with contents
    (ut/redis-set db-config key-name (pr-str init))
    (common* (duratom :redis-db
                      :db-config db-config
                      :key-name key-name
                      :init init
                      :rw (cond-> default-redis-rw
                            (not async?) (assoc :commit-mode :sync)))
             key-exists?
             async?)

    ;; duragent version
    (when async?
      (common* (duragent :redis-db
                         :db-config db-config
                         :key-name key-name
                         :init init)
               key-exists?
               async?))

    ))

(deftest redis-backed-tests
  (println "Redis-backed atom with async commit...")
  (redis-backed-tests* true)
  (println "Redis-backed atom with sync commit...")
  (redis-backed-tests* false)
  )

(deftest custom-rw-tests

  (testing "File-backed atom containing `nippy` bytes..."
    (let [rel-path "data_temp.txt"
          _ (when (.exists (io/file rel-path))
              (io/delete-file rel-path)) ;; proper cleanup before testing
          init {:x 1 :y 2}
          dura (add-watch
                 (duratom :local-file
                          :file-path rel-path
                          :init init
                          :rw {:read  nippy/thaw-from-file
                               :write nippy/freeze-to-file})
                 :log (fn [k r old-state new-state]
                        (println "Transitioning from" old-state "to" new-state "...")))]

      ;; empty file first
      (common* dura #(.exists (io/file rel-path)) true)
      ;; with-contents thereafter
      (nippy/freeze-to-file rel-path init)
      (common* (add-watch
                 (duratom :local-file
                          :file-path rel-path
                          :rw {:read  nippy/thaw-from-file
                               :write nippy/freeze-to-file})
                 :log (fn [k r old-state new-state]
                        (println "Transitioning from" old-state "to" new-state "...")))
               #(.exists (io/file rel-path))
               true)
      )
    )

  (testing "PostgresDB-backed atom containing `nippy` bytes..."
    (let [db-spec {:classname   "org.postgresql.Driver"
                   :subprotocol "postgresql"
                   :subname     "//localhost:5432/atomDB"
                   :user        "dimitris"
                   :password    "secret"}
          table-name "atom_state_bytes"
          init {:x 1 :y 2}
          dura (add-watch
                 (duratom :postgres-db
                          :db-config db-spec
                          :table-name table-name
                          :row-id 0
                          :init init
                          :rw {:read  nippy/thaw
                               :write nippy/freeze
                               :column-type :bytea})
                 :log (fn [k, r, old-state, new-state]
                        (println "Transitioning from" old-state "to" new-state "...")))]

      ;; empty row first
      (common* dura
               #(some? (ut/get-pgsql-value db-spec table-name 0 nippy/thaw))
               true)
      ;; with-contents thereafter
      (ut/update-or-insert! db-spec table-name {:id 0 :value (nippy/freeze init)} ["id = ?" 0])
      (common* (add-watch
                 (duratom :postgres-db
                          :db-config db-spec
                          :table-name table-name
                          :row-id 0
                          :rw {:read  nippy/thaw
                               :write nippy/freeze
                               :column-type :bytea})
                 :log (fn [k, r, old-state, new-state]
                        (println "Transitioning from" old-state "to" new-state "...")))
               #(some? (ut/get-pgsql-value db-spec table-name 0 nippy/thaw))
               true)
      )
    )

  (testing "Redis DB-backed atom containing `nippy` bytes..."
    (let [db-config  {:pool {} :spec {:uri "redis://localhost/"}}
          key-name "atom:state:bytes"
          key-exists? #(ut/redis-key-exists? db-config key-name)
          init {:x 1 :y 2}
          dura (duratom :redis-db
                        :db-config db-config
                        :key-name key-name
                        :init init
                        :rw {:read  identity
                             :write identity})]

      ;; empty row first
      (common* dura
               key-exists?
               true)
      ;; with-contents thereafter
      (ut/redis-set db-config key-name init)
      (common* (duratom :redis-db
                        :db-config db-config
                        :key-name key-name
                        :init init
                        :rw {:read  identity
                             :write identity})
               key-exists?
               true)
      )
    )
)

(ns duratom.core-test
  (:require [clojure.test :refer :all]
            [duratom.core :refer :all]
            [duratom.utils :as ut]
            [taoensso.nippy :as nippy]
            [clojure.java
             [shell :as shell]
             [io :as io]]
            [clojure.string :as str])
  (:import (clojure.lang Agent)))
;====================================
;; start the `default` VM:
;$ docker-machine start default

;; switch to `default` when using any docker commands
;$ eval $(docker-machine env default)

;; start up the specified containers
;$ docker-compose up -d

;; run tests
; lein test OR selectively in repl

;; shutdown the containers
;$ docker-compose down
;====================================

(defonce docker-default-machine-ip
  ;; `localhost` which works on Ubuntu simply won't work on MacOS.
  ;; we need the public IP of the docker-machine - `default` in this case.
  ;; this tends to be 192.168.99.100, but we can easily check via `docker-machine ip default`
  (delay
    (or (try
          (some-> (shell/sh "docker-machine" "ip" "default")
                  :out
                  str/trim-newline
                  not-empty)
          (catch Throwable _))
        ;; perhaps docker-machine is not involved
        "localhost")))

(defn- common*
  [dura exists? async?]
  (let [sleep-time 200
        [f atom?] (if (instance? Agent dura)
                    [send-off false]
                    [swap! true])]
    (-> dura ;; init = {:x 1 :y 2}
        (doto (f assoc :z 3))
        (doto (f dissoc :x)))

    (when async?
      (Thread/sleep sleep-time))

    (is (= {:z 3 :y 2} @dura))
    (is (= (backend-snapshot dura) @dura))

    (-> dura
        (doto (f  (constantly [1 2 3])))
        (doto (f  (comp vec rest))))

    (when async?
      (Thread/sleep sleep-time))

    (is (= [2 3] @dura))
    (is (= (backend-snapshot dura) @dura))

    (when async?
      (Thread/sleep sleep-time))

    (if atom?
      (is (= [[2 3] [1 2 3]]
             (reset-vals! dura [1 2 3])))
      ;; don't break the assertions below
      (f dura (constantly [1 2 3])))

    (when async?
      (Thread/sleep sleep-time))

    (if atom?
      (is (= [[1 2 3] [2 3]]
            (swap-vals! dura rest)))
      (f dura rest))

    (f dura (partial into (sorted-set)))

    (when async?
      (Thread/sleep sleep-time))

    (is (sorted? @dura))
    (is (= (sorted-set 2 3) (backend-snapshot dura) @dura))

    (f dura #(with-meta % {:a 1 :b 2}))

    (when async?
      (Thread/sleep sleep-time))

    (is (= (sorted-set 2 3) (backend-snapshot dura) @dura))
    (is (= {:a 1 :b 2} (meta (backend-snapshot dura)) (meta @dura)))

    (when async?
      (Thread/sleep sleep-time))

    (destroy dura)

    (when async?
      (Thread/sleep sleep-time))

    (is (sorted? @dura))
    (is (= #{2 3} @dura))
    (when atom? ;; this exception is swallowed inside the agent's error handler
      (is (thrown? IllegalStateException (f dura conj 4))))
    (is (false? (exists?)) "Storage resource was NOT cleaned-up!!!")
    )
  )

(defn- file-backed-tests*
  [async?]
  (let [rel-path "data_temp.txt"
        _ (when (.exists (io/file rel-path))
            (io/delete-file rel-path)) ;; proper cleanup before testing
        init {:x 1 :y 2}
        dura (add-watch
               (duratom :local-file
                        :file-path rel-path
                        :init init
                        :rw (cond-> default-file-rw
                                    (not async?) (assoc :commit-mode :sync)))
               :log (fn [k r old-state new-state]
                      (println "Transitioning from" (ut/pr-str-fully true old-state)
                               "to" (ut/pr-str-fully true new-state) "...")))]

    ;; empty file first
    (common* dura #(.exists (io/file rel-path)) async?)
    ;; with-contents thereafter
    (spit rel-path (pr-str init))
    (common* (add-watch
               (duratom :local-file
                        :file-path rel-path
                        :init init
                        :rw (cond-> default-file-rw
                                    (not async?) (assoc :commit-mode :sync)))
               :log (fn [k r old-state new-state]
                      (println "Transitioning from" (ut/pr-str-fully true old-state)
                               "to" (ut/pr-str-fully true new-state) "...")))
             #(.exists (io/file rel-path))
             async?)

    ;; duragent version
    (when async?
      (common* (duragent :local-file
                         :file-path rel-path
                         :init init)
               #(.exists (io/file rel-path))
               async?))
    )
  )

(deftest file-backed-tests
  (println "File-backed atom/agent with async commit...")
  (file-backed-tests* true)
  (println "File-backed atom with sync commit...")
  (file-backed-tests* false)
  )

(defn- postgres-backed-tests*
  [async?]
  (let [ip @docker-default-machine-ip
        db-spec {:classname   "org.postgresql.Driver"
                 :subprotocol "postgresql"
                 :subname     (str "//"  ip ":5432/atomDB") ;; localhost won't work on the mac
                 :user        "dimitris"
                 :password    "secret"}
        table-name "atom_state"
        _ (ut/delete-relevant-row! db-spec table-name 0)
        init {:x 1 :y 2}
        dura (add-watch
               (duratom :postgres-db
                        :db-config db-spec
                        :table-name table-name
                        :row-id 0
                        :init init
                        :rw (cond-> default-postgres-rw
                                    (not async?) (assoc :commit-mode :sync)))
               :log (fn [k, r, old-state, new-state]
                      (println "Transitioning from" (ut/pr-str-fully true old-state)
                               "to" (ut/pr-str-fully true new-state) "...")))]

    ;; empty row first
    (common* dura
             #(some? (ut/get-pgsql-value db-spec table-name 0 ut/read-edn-string))
             async?)
    ;; with-contents thereafter
    (ut/update-or-insert! db-spec table-name {:id 0 :value (pr-str init)} ["id = ?" 0])
    (common* (add-watch
               (duratom :postgres-db
                        :db-config db-spec
                        :table-name table-name
                        :row-id 0
                        :init init
                        :rw (cond-> default-postgres-rw
                                    (not async?) (assoc :commit-mode :sync)))
               :log (fn [k, r, old-state, new-state]
                      (println "Transitioning from" (ut/pr-str-fully true old-state)
                               "to" (ut/pr-str-fully true new-state) "...")))
             #(some? (ut/get-pgsql-value db-spec table-name 0 ut/read-edn-string))
             async?)

    ;; duragent version
    (when async?
      (common* (duragent :postgres-db
                         :db-config db-spec
                         :table-name table-name
                         :row-id 0
                         :init init)
               #(some? (ut/get-pgsql-value db-spec table-name 0 ut/read-edn-string))
               async?))
    )
  )

(deftest postgres-backed-tests
  (println "PGSQL-backed atom/agent with async commit...")
  (postgres-backed-tests* true)
  (println "PGSQL-backed atom with sync commit...")
  (postgres-backed-tests* false)
  )

(defn- redis-backed-tests*
  [async?]
  (let [ip @docker-default-machine-ip
        db-config  {:pool {}
                    :spec {:uri (str "redis://" ip ":6379/")}} ;; localhost won't work on the mac
        key-name "atom:state"
        init {:x 1 :y 2}
        key-exists? #(ut/redis-key-exists? db-config key-name)
        _ (ut/redis-del db-config key-name)
        dura (duratom :redis-db
                      :db-config db-config
                      :key-name key-name
                      :init init
                      :rw (cond-> default-redis-rw
                            (not async?) (assoc :commit-mode :sync)))]
    ;; empty key first
    (common* dura key-exists? async?)
    ;; with contents
    (ut/redis-set db-config key-name (pr-str init))
    (common* (duratom :redis-db
                      :db-config db-config
                      :key-name key-name
                      :init init
                      :rw (cond-> default-redis-rw
                            (not async?) (assoc :commit-mode :sync)))
             key-exists?
             async?)

    ;; duragent version
    (when async?
      (common* (duragent :redis-db
                         :db-config db-config
                         :key-name key-name
                         :init init)
               key-exists?
               async?))

    ))

(deftest redis-backed-tests
  (println "Redis-backed atom with async commit...")
  (redis-backed-tests* true)
  (println "Redis-backed atom with sync commit...")
  (redis-backed-tests* false)
  )

(deftest custom-rw-tests

  (testing "File-backed atom containing `nippy` bytes..."
    (let [rel-path "data_temp.txt"
          _ (when (.exists (io/file rel-path))
              (io/delete-file rel-path)) ;; proper cleanup before testing
          init {:x 1 :y 2}
          dura (add-watch
                 (duratom :local-file
                          :file-path rel-path
                          :init init
                          :rw {:read  nippy/thaw-from-file
                               :write nippy/freeze-to-file})
                 :log (fn [k r old-state new-state]
                        (println "Transitioning from" old-state "to" new-state "...")))]

      ;; empty file first
      (common* dura #(.exists (io/file rel-path)) true)
      ;; with-contents thereafter
      (nippy/freeze-to-file rel-path init)
      (common* (add-watch
                 (duratom :local-file
                          :file-path rel-path
                          :rw {:read  nippy/thaw-from-file
                               :write nippy/freeze-to-file})
                 :log (fn [k r old-state new-state]
                        (println "Transitioning from" old-state "to" new-state "...")))
               #(.exists (io/file rel-path))
               true)
      )
    )

  (testing "PostgresDB-backed atom containing `nippy` bytes..."
    (let [db-spec {:classname   "org.postgresql.Driver"
                   :subprotocol "postgresql"
                   :subname     "//localhost:5432/atomDB"
                   :user        "dimitris"
                   :password    "secret"}
          table-name "atom_state_bytes"
          init {:x 1 :y 2}
          dura (add-watch
                 (duratom :postgres-db
                          :db-config db-spec
                          :table-name table-name
                          :row-id 0
                          :init init
                          :rw {:read  nippy/thaw
                               :write nippy/freeze
                               :column-type :bytea})
                 :log (fn [k, r, old-state, new-state]
                        (println "Transitioning from" old-state "to" new-state "...")))]

      ;; empty row first
      (common* dura
               #(some? (ut/get-pgsql-value db-spec table-name 0 nippy/thaw))
               true)
      ;; with-contents thereafter
      (ut/update-or-insert! db-spec table-name {:id 0 :value (nippy/freeze init)} ["id = ?" 0])
      (common* (add-watch
                 (duratom :postgres-db
                          :db-config db-spec
                          :table-name table-name
                          :row-id 0
                          :rw {:read  nippy/thaw
                               :write nippy/freeze
                               :column-type :bytea})
                 :log (fn [k, r, old-state, new-state]
                        (println "Transitioning from" old-state "to" new-state "...")))
               #(some? (ut/get-pgsql-value db-spec table-name 0 nippy/thaw))
               true)
      )
    )

  (testing "Redis DB-backed atom containing `nippy` bytes..."
    (let [db-config  {:pool {} :spec {:uri "redis://localhost/"}}
          key-name "atom:state:bytes"
          key-exists? #(ut/redis-key-exists? db-config key-name)
          init {:x 1 :y 2}
          dura (duratom :redis-db
                        :db-config db-config
                        :key-name key-name
                        :init init
                        :rw {:read  identity
                             :write identity})]

      ;; empty row first
      (common* dura
               key-exists?
               true)
      ;; with-contents thereafter
      (ut/redis-set db-config key-name init)
      (common* (duratom :redis-db
                        :db-config db-config
                        :key-name key-name
                        :init init
                        :rw {:read  identity
                             :write identity})
               key-exists?
               true)
      )
    )
)

add running instructions in the form of comments in core_test.clj


(ns broadfcui.page.method-repo.method.exporter
  (:require
   [dmohs.react :as react]
   [broadfcui.common :as common]
   [broadfcui.common.components :as comps]
   [broadfcui.common.flex-utils :as flex]
   [broadfcui.common.icons :as icons]
   [broadfcui.common.input :as input]
   [broadfcui.common.links :as links]
   [broadfcui.common.style :as style]
   [broadfcui.common.table :refer [Table]]
   [broadfcui.components.buttons :as buttons]
   [broadfcui.components.modals :as modals]
   [broadfcui.components.split-pane :refer [SplitPane]]
   [broadfcui.components.workspace-selector :refer [WorkspaceSelector]]
   [broadfcui.endpoints :as endpoints]
   [broadfcui.page.method-repo.method.common :as method-common]
   [broadfcui.page.workspace.workspace-common :as ws-common]
   [broadfcui.net :as net]
   [broadfcui.utils :as utils]
   ))

(react/defc- Preview
  {:render
   (fn [{:keys [state]}]
     (let [{:keys [config config-error]} @state]
       (cond config-error (style/create-server-error-message config-error)
             config [:div {:style {:padding "0.5rem 1rem" :background-color "white"}}
                     (method-common/render-config-details config)]
             :else [comps/Spinner {:text "Loading Configuration Details..."}])))
   :component-did-mount
   (fn [{:keys [props this]}]
     (this :-load (:preview-config props)))
   :component-will-receive-props
   (fn [{:keys [props next-props this]}]
     (when (not= (:preview-config props) (:preview-config next-props))
       (this :-load (:preview-config next-props))))
   :-load
   (fn [{:keys [state]} config]
     (swap! state dissoc :config :config-error)
     (let [{:keys [namespace name snapshotId]} config]
       (endpoints/call-ajax-orch
        {:endpoint (endpoints/get-configuration namespace name snapshotId true)
         :on-done (net/handle-ajax-response
                   (fn [{:keys [success? parsed-response]}]
                     (if success?
                       (swap! state assoc :config parsed-response)
                       (swap! state assoc :config-error (:message parsed-response)))))})))})

(defn- config->id+snapshot [config]
  (assoc (select-keys config [:namespace :name]) :snapshotId (int (:snapshotId config))))

(react/defc MethodExporter
  {:get-initial-state
   (fn [{:keys [props]}]
     {:preview-config (some-> (:initial-config props) config->id+snapshot)})
   :render
   (fn [{:keys [props state this]}]
     (let [{:keys [method-name dismiss]} props
           {:keys [configs configs-error selected-config banner]} @state]
       [modals/OKCancelForm
        {:header (str "Export " method-name " to Workspace")
         :content
         (react/create-element
          [:div {}
           (when banner
             [comps/Blocker {:banner banner}])
           (cond configs-error (style/create-server-error-message configs-error)
                 selected-config (this :-render-export-page)
                 configs (this :-render-config-selector)
                 :else [comps/Spinner {:text "Loading Method Configurations..."}])])
         :button-bar (cond selected-config (this :-render-export-page-buttons)
                           configs (this :-render-config-selector-buttons))
         :show-cancel? false
         :dismiss dismiss}]))
   :component-did-mount
   (fn [{:keys [props state]}]
     (endpoints/call-ajax-orch
      {:endpoint (endpoints/get-agora-compatible-configs (assoc (:method-id props) :snapshot-id (:selected-snapshot-id props)))
       :on-done (net/handle-ajax-response
                 (fn [{:keys [success? parsed-response]}]
                   (if success?
                     (let [configs (map #(assoc % :payload (utils/parse-json-string (:payload %) true)) parsed-response)]
                       (swap! state assoc :configs configs))
                     (swap! state assoc :configs-error (:message parsed-response)))))}))
   :-render-config-selector
   (fn [{:keys [state]}]
     (let [{:keys [configs preview-config]} @state]
       [:div {:style {:width "80vw" :maxHeight 600 :overflow "hidden"}}
        [:div {:style {:fontSize "120%" :marginBottom "0.5rem"}}
         "Select Method Configuration"]
        [SplitPane
         {:left (method-common/render-config-table
                 {:configs configs
                  :style {:body-row (fn [{:keys [row]}]
                                      {:borderTop style/standard-line :alignItems "baseline"
                                       :background-color (when (= preview-config (config->id+snapshot row))
                                                           (:tag-background style/colors))})}
                  :make-config-link-props
                  (fn [config]
                    {:onClick #(swap! state assoc :preview-config (config->id+snapshot config))})})
          :right (if preview-config
                   [Preview {:preview-config preview-config}]
                   [:div {:style {:position "relative" :backgroundColor "white" :height "100%"}}
                    (style/center {:style {:textAlign "center"}} "Select a Configuration to Preview")])
          :initial-slider-position 800
          :slider-padding "0.5rem"}]]))
   :-render-config-selector-buttons
   (fn [{:keys [state]}]
     (let [{:keys [preview-config]} @state]
       (flex/box
        {}
        flex/spring
        [buttons/Button {:type :secondary :text "Use Blank Configuration"
                         :onClick #(swap! state assoc :selected-config :blank)}]
        (flex/strut "1rem")
        [buttons/Button {:text "Use Selected Configuration"
                         :disabled? (when-not preview-config "Select a configuration first")
                         :onClick #(swap! state assoc :selected-config preview-config)}])))
   :-render-export-page
   (fn [{:keys [props state locals]}]
     (let [{:keys [method-name]} props
           {:keys [selected-config]} @state]
       [:div {:style {:width 550}}
        (style/create-form-label "Name")
        [input/TextField {:ref "name-field"
                          :style {:width "100%"}
                          :defaultValue (if (= selected-config :blank)
                                          method-name
                                          (:name selected-config))
                          :predicates [(input/nonempty "Name")]}]
        (when (= selected-config :blank)
          (list
           (style/create-form-label "Root Entity Type")
           (style/create-identity-select {:ref "root-entity-type"}
                                         common/root-entity-types)))
        (style/create-form-label "Destination Workspace")
        [WorkspaceSelector {:style {:width "100%"}
                            :filter #(common/access-greater-than-equal-to? (:accessLevel %) "WRITER")
                            :on-select #(swap! locals assoc :selected-workspace-id (ws-common/workspace->id %))}]
        [:div {:style {:padding "0.5rem"}}] ;; select2 is eating any padding/margin I give to WorkspaceSelector
        (style/create-validation-error-message (:validation-errors @state))
        [comps/ErrorViewer {:error (:server-error @state)}]]))
   :-render-export-page-buttons
   (fn [{:keys [state this]}]
     (flex/box
      {:style {:alignItems "center"}}
      (links/create-internal
        {:onClick #(swap! state dissoc :selected-config)}
        (flex/box
         {:style {:alignItems "center"}}
         (icons/icon {:style {:fontSize "150%" :marginRight "0.5rem"}} :angle-left)
         "Choose Another Configuration"))
      flex/spring
      [buttons/Button {:text "Export to Workspace"
                       :onClick #(this :-export)}]))
   :-export
   (fn [{:keys [props state refs this]}]
     (swap! state assoc :validation-errors nil :banner "Resolving...")
     (let [[name & errors] (input/get-and-validate refs "name-field")
           new-id (assoc (select-keys (:method-id props) [:namespace])
                    :name name)
           {:keys [selected-config]} @state]
       (cond errors (swap! state assoc :validation-errors errors)
             (= :blank selected-config) (this :-create-template new-id)
             :else (this :-export-loaded-config (merge (:payloadObject selected-config) new-id)))))
   :-create-template
   (fn [{:keys [props state refs this]} new-id]
     (swap! state assoc :banner "Creating template...")
     (let [{:keys [method-id selected-snapshot-id]} props
           dest-ret (.-value (@refs "root-entity-type"))]
       (endpoints/call-ajax-orch
        {:endpoint endpoints/create-template
         :payload {:methodNamespace (:namespace method-id)
                   :methodName (:name method-id)
                   :methodVersion (int selected-snapshot-id)}
         :headers utils/content-type=json
         :on-done (fn [{:keys [success? get-parsed-response]}]
                    (if success?
                      (this :-export-loaded-config
                            (merge (get-parsed-response) new-id {:rootEntityType dest-ret}))
                      (swap! state assoc :banner nil :server-error (get-parsed-response false))))})))
   :-export-loaded-config
   (fn [{:keys [props state locals]} config]
     (swap! state assoc :banner "Exporting...")
     (let [{:keys [selected-workspace-id]} @locals]
       (endpoints/call-ajax-orch
        {:endpoint (endpoints/post-workspace-method-config selected-workspace-id)
         :payload config
         :headers utils/content-type=json
         :on-done (fn [{:keys [success? get-parsed-response]}]
                    (if success?
                      ((:on-export props) selected-workspace-id (ws-common/config->id config))
                      (swap! state assoc :banner nil :server-error (get-parsed-response false))))})))})

(ns broadfcui.page.method-repo.method.exporter
  (:require
   [dmohs.react :as react]
   [broadfcui.common :as common]
   [broadfcui.common.components :as comps]
   [broadfcui.common.flex-utils :as flex]
   [broadfcui.common.icons :as icons]
   [broadfcui.common.input :as input]
   [broadfcui.common.links :as links]
   [broadfcui.common.style :as style]
   [broadfcui.common.table :refer [Table]]
   [broadfcui.components.buttons :as buttons]
   [broadfcui.components.modals :as modals]
   [broadfcui.components.split-pane :refer [SplitPane]]
   [broadfcui.components.workspace-selector :refer [WorkspaceSelector]]
   [broadfcui.endpoints :as endpoints]
   [broadfcui.page.method-repo.method.common :as method-common]
   [broadfcui.page.workspace.workspace-common :as ws-common]
   [broadfcui.net :as net]
   [broadfcui.utils :as utils]
   ))

(react/defc- Preview
  {:render
   (fn [{:keys [state]}]
     (let [{:keys [config config-error]} @state]
       (cond config-error (style/create-server-error-message config-error)
             config [:div {:style {:padding "0.5rem 1rem" :background-color "white"}}
                     (method-common/render-config-details config)]
             :else [comps/Spinner {:text "Loading Configuration Details..."}])))
   :component-did-mount
   (fn [{:keys [props this]}]
     (this :-load (:preview-config props)))
   :component-will-receive-props
   (fn [{:keys [props next-props this]}]
     (when (not= (:preview-config props) (:preview-config next-props))
       (this :-load (:preview-config next-props))))
   :-load
   (fn [{:keys [state]} config]
     (swap! state dissoc :config :config-error)
     (let [{:keys [namespace name snapshotId]} config]
       (endpoints/call-ajax-orch
        {:endpoint (endpoints/get-configuration namespace name snapshotId true)
         :on-done (net/handle-ajax-response
                   (fn [{:keys [success? parsed-response]}]
                     (if success?
                       (swap! state assoc :config parsed-response)
                       (swap! state assoc :config-error (:message parsed-response)))))})))})

(defn- config->id+snapshot [config]
  (assoc (select-keys config [:namespace :name]) :snapshotId (int (:snapshotId config))))

(react/defc MethodExporter
  {:get-initial-state
   (fn [{:keys [props]}]
     {:preview-config (:initial-config props)})
   :render
   (fn [{:keys [props state this]}]
     (let [{:keys [method-name dismiss]} props
           {:keys [configs configs-error selected-config banner]} @state]
       [modals/OKCancelForm
        {:header (str "Export " method-name " to Workspace")
         :content
         (react/create-element
          [:div {}
           (when banner
             [comps/Blocker {:banner banner}])
           (cond configs-error (style/create-server-error-message configs-error)
                 selected-config (this :-render-export-page)
                 configs (this :-render-config-selector)
                 :else [comps/Spinner {:text "Loading Method Configurations..."}])])
         :button-bar (cond selected-config (this :-render-export-page-buttons)
                           configs (this :-render-config-selector-buttons))
         :show-cancel? false
         :dismiss dismiss}]))
   :component-did-mount
   (fn [{:keys [props state]}]
     (endpoints/call-ajax-orch
      {:endpoint (endpoints/get-agora-compatible-configs (assoc (:method-id props) :snapshot-id (:selected-snapshot-id props)))
       :on-done (net/handle-ajax-response
                 (fn [{:keys [success? parsed-response]}]
                   (if success?
                     (let [configs (map #(assoc % :payload (utils/parse-json-string (:payload %) true)) parsed-response)]
                       (swap! state assoc :configs configs))
                     (swap! state assoc :configs-error (:message parsed-response)))))}))
   :-render-config-selector
   (fn [{:keys [state]}]
     (let [{:keys [configs preview-config]} @state]
       [:div {:style {:width "80vw" :maxHeight 600 :overflow "hidden"}}
        [:div {:style {:fontSize "120%" :marginBottom "0.5rem"}}
         "Select Method Configuration"]
        [SplitPane
         {:left (method-common/render-config-table
                 {:configs configs
                  :style {:body-row (fn [{:keys [row]}]
                                      {:borderTop style/standard-line :alignItems "baseline"
                                       :background-color (when (= (config->id+snapshot preview-config) (config->id+snapshot row))
                                                           (:tag-background style/colors))})}
                  :make-config-link-props
                  (fn [config]
                    {:onClick #(swap! state assoc :preview-config config)})})
          :right (if preview-config
                   [Preview {:preview-config preview-config}]
                   [:div {:style {:position "relative" :backgroundColor "white" :height "100%"}}
                    (style/center {:style {:textAlign "center"}} "Select a Configuration to Preview")])
          :initial-slider-position 800
          :slider-padding "0.5rem"}]]))
   :-render-config-selector-buttons
   (fn [{:keys [state]}]
     (let [{:keys [preview-config]} @state]
       (flex/box
        {}
        flex/spring
        [buttons/Button {:type :secondary :text "Use Blank Configuration"
                         :onClick #(swap! state assoc :selected-config :blank)}]
        (flex/strut "1rem")
        [buttons/Button {:text "Use Selected Configuration"
                         :disabled? (when-not preview-config "Select a configuration first")
                         :onClick #(swap! state assoc :selected-config preview-config)}])))
   :-render-export-page
   (fn [{:keys [props state locals]}]
     (let [{:keys [method-name]} props
           {:keys [selected-config]} @state]
       [:div {:style {:width 550}}
        (style/create-form-label "Name")
        [input/TextField {:ref "name-field"
                          :style {:width "100%"}
                          :defaultValue (if (= selected-config :blank)
                                          method-name
                                          (:name selected-config))
                          :predicates [(input/nonempty "Name")]}]
        (when (= selected-config :blank)
          (list
           (style/create-form-label "Root Entity Type")
           (style/create-identity-select {:ref "root-entity-type"}
                                         common/root-entity-types)))
        (style/create-form-label "Destination Workspace")
        [WorkspaceSelector {:style {:width "100%"}
                            :filter #(common/access-greater-than-equal-to? (:accessLevel %) "WRITER")
                            :on-select #(swap! locals assoc :selected-workspace-id (ws-common/workspace->id %))}]
        [:div {:style {:padding "0.5rem"}}] ;; select2 is eating any padding/margin I give to WorkspaceSelector
        (style/create-validation-error-message (:validation-errors @state))
        [comps/ErrorViewer {:error (:server-error @state)}]]))
   :-render-export-page-buttons
   (fn [{:keys [state this]}]
     (flex/box
      {:style {:alignItems "center"}}
      (links/create-internal
        {:onClick #(swap! state dissoc :selected-config)}
        (flex/box
         {:style {:alignItems "center"}}
         (icons/icon {:style {:fontSize "150%" :marginRight "0.5rem"}} :angle-left)
         "Choose Another Configuration"))
      flex/spring
      [buttons/Button {:text "Export to Workspace"
                       :onClick #(this :-export)}]))
   :-export
   (fn [{:keys [props state refs this]}]
     (swap! state assoc :validation-errors nil :banner "Resolving...")
     (let [[name & errors] (input/get-and-validate refs "name-field")
           new-id (assoc (select-keys (:method-id props) [:namespace])
                    :name name)
           {:keys [selected-config]} @state]
       (cond errors (swap! state assoc :validation-errors errors)
             (= :blank selected-config) (this :-create-template new-id)
             :else (this :-export-loaded-config (merge (:payloadObject selected-config) new-id)))))
   :-create-template
   (fn [{:keys [props state refs this]} new-id]
     (swap! state assoc :banner "Creating template...")
     (let [{:keys [method-id selected-snapshot-id]} props
           dest-ret (.-value (@refs "root-entity-type"))]
       (endpoints/call-ajax-orch
        {:endpoint endpoints/create-template
         :payload {:methodNamespace (:namespace method-id)
                   :methodName (:name method-id)
                   :methodVersion (int selected-snapshot-id)}
         :headers utils/content-type=json
         :on-done (fn [{:keys [success? get-parsed-response]}]
                    (if success?
                      (this :-export-loaded-config
                            (merge (get-parsed-response) new-id {:rootEntityType dest-ret}))
                      (swap! state assoc :banner nil :server-error (get-parsed-response false))))})))
   :-export-loaded-config
   (fn [{:keys [props state locals]} config]
     (swap! state assoc :banner "Exporting...")
     (let [{:keys [selected-workspace-id]} @locals]
       (endpoints/call-ajax-orch
        {:endpoint (endpoints/post-workspace-method-config selected-workspace-id)
         :payload config
         :headers utils/content-type=json
         :on-done (fn [{:keys [success? get-parsed-response]}]
                    (if success?
                      ((:on-export props) selected-workspace-id (ws-common/config->id config))
                      (swap! state assoc :banner nil :server-error (get-parsed-response false))))})))})

Fix error when exporting non-blank config [GAWB-2667] (#981)


(ns jobs.cron
  (:use clojure.test
        jobs.helper)
  (:require [immutant.jobs      :as job]
            [immutant.messaging :as msg]))

(defmacro with-job [action & body]
  `(try
     (job/schedule "a-job" ~action "*/1 * * * * ?")
     ~@body
      (finally (job/unschedule "a-job"))))

(deftest jobs-should-work
  (let [q (random-queue)]
    (with-job #(msg/publish q "ping")
      (is (= ["ping" "ping" "ping"] (take 3 (msg/message-seq q)))))))

(deftest jobs-should-work-with-a-keyword-name
  (let [q (random-queue)]
    (try
      (job/schedule :kw-job #(msg/publish q "ping") "*/1 * * * * ?")
      (is (= ["ping" "ping" "ping"] (take 3 (msg/message-seq q))))
     (finally (job/unschedule :kw-job)))))

(deftest rescheduling
  (let [q1 (random-queue)
        q2 (random-queue)]
    (with-job #(msg/publish q1 "ping")
      (is (= ["ping" "ping"] (take 2 (msg/message-seq q1))))
      (with-job #(msg/publish q2 "pong")
        (is (= ["pong" "pong"] (take 2 (msg/message-seq q2))))
        (is (not (msg/receive q1 :timeout 10000)))))))

(deftest unschedule
  (let [q (random-queue)]
    (with-job #(msg/publish q "ping")
      (is (msg/receive q :timeout 10000))
      (job/unschedule "a-job")
      (is (not (msg/receive q :timeout 5000))))))

(deftest job-should-have-correct-CL
  (let [q (random-queue)]
      (with-job #(msg/publish q (.toString (.getContextClassLoader (Thread/currentThread))))
        (is (re-find #"ImmutantClassLoader.*deployment\..*\.clj"
                     (msg/receive q :timeout 10000))))))

(deftest job-should-have-the-context-set
  (let [q (random-queue)]
    (with-job #(msg/publish q (instance? org.quartz.JobExecutionContext job/*job-execution-context*))
      (is (msg/receive q :timeout 10000)))))

(deftest it-should-raise-when-spec-is-given-with-at-opts
  (doseq [o [:at :in :every :repeat :until]]
    (is (thrown? IllegalArgumentException (job/schedule "name" #() "spec" o 0)))))

(deftest singleton-false-and-true-should-coexist
  (let [q (random-queue)
        q2 (random-queue)]
    (try
      (job/schedule "singleton-false" #(msg/publish q "hi") "*/1 * * * * ?" :singleton false)
      (job/schedule "singleton-true" #(msg/publish q2 "hi") "*/1 * * * * ?" :singleton true)
      (is (msg/receive q :timeout 10000))
      (is (msg/receive q2 :timeout 10000))
      (finally (job/unschedule "singleton-false")
               (job/unschedule "singleton-true")))))

(deftest reloading-ns-should-not-break-unschedule
  (let [q (random-queue)]
    (with-job #(msg/publish q "ping")
      (is (msg/receive q :timeout 10000))
      (require '[immutant.jobs :as job] :reload-all)
      (job/unschedule "a-job")
      (is (not (msg/receive q :timeout 5000))))))

(ns jobs.cron
  (:use clojure.test
        jobs.helper)
  (:require [immutant.jobs      :as job]
            [immutant.messaging :as msg])
  (:import java.util.concurrent.atomic.AtomicInteger))

(defmacro with-job [action & body]
  `(try
     (job/schedule "a-job" ~action "*/1 * * * * ?")
     ~@body
      (finally (job/unschedule "a-job"))))

(deftest jobs-should-work
  (let [q (random-queue)]
    (with-job #(msg/publish q "ping")
      (is (= ["ping" "ping" "ping"] (take 3 (msg/message-seq q)))))))

(deftest jobs-should-work-with-a-keyword-name
  (let [q (random-queue)]
    (try
      (job/schedule :kw-job #(msg/publish q "ping") "*/1 * * * * ?")
      (is (= ["ping" "ping" "ping"] (take 3 (msg/message-seq q))))
     (finally (job/unschedule :kw-job)))))

(deftest rescheduling
  (let [q1 (random-queue)
        q2 (random-queue)]
    (with-job #(msg/publish q1 "ping")
      (is (= ["ping" "ping"] (take 2 (msg/message-seq q1))))
      (with-job #(msg/publish q2 "pong")
        (is (= ["pong" "pong"] (take 2 (msg/message-seq q2))))
        (is (not (msg/receive q1 :timeout 10000)))))))

(deftest unschedule
  (let [q (random-queue)]
    (with-job #(msg/publish q "ping")
      (is (msg/receive q :timeout 10000))
      (job/unschedule "a-job")
      (is (not (msg/receive q :timeout 5000))))))

(deftest job-should-have-correct-CL
  (let [q (random-queue)]
      (with-job #(msg/publish q (.toString (.getContextClassLoader (Thread/currentThread))))
        (is (re-find #"ImmutantClassLoader.*deployment\..*\.clj"
                     (msg/receive q :timeout 10000))))))

(deftest job-should-have-the-context-set
  (let [q (random-queue)]
    (with-job #(msg/publish q (instance? org.quartz.JobExecutionContext job/*job-execution-context*))
      (is (msg/receive q :timeout 10000)))))

(deftest it-should-raise-when-spec-is-given-with-at-opts
  (doseq [o [:at :in :every :repeat :until]]
    (is (thrown? IllegalArgumentException (job/schedule "name" #() "spec" o 0)))))

(deftest singleton-false-and-true-should-coexist
  (let [q (random-queue)
        q2 (random-queue)]
    (try
      (job/schedule "singleton-false" #(msg/publish q "hi") "*/1 * * * * ?" :singleton false)
      (job/schedule "singleton-true" #(msg/publish q2 "hi") "*/1 * * * * ?" :singleton true)
      (is (msg/receive q :timeout 10000))
      (is (msg/receive q2 :timeout 10000))
      (finally (job/unschedule "singleton-false")
               (job/unschedule "singleton-true")))))

(deftest reloading-ns-should-not-break-unschedule
  (let [q (random-queue)
        aint (AtomicInteger.)]
    (with-job (fn [] (msg/publish q "ping")
                (.incrementAndGet aint))
      (is (msg/receive q :timeout 10000))
      (require '[immutant.jobs :as job] :reload-all)
      (job/unschedule "a-job")
      (let [curval (.get aint)]
        (Thread/sleep 5000)
        (is (= curval (.get aint)))))))

Make this test a bit more robust to deal with the speed of CI.


(ns io.cyanite.input.carbon
  (:require [io.cyanite.engine     :as engine]
            [io.cyanite.input.tcp  :as tcp]
            [clojure.string        :refer [split]]
            [clojure.tools.logging :refer [info]])
  (:import io.netty.handler.codec.LineBasedFrameDecoder
           io.netty.handler.codec.string.StringDecoder
           io.netty.handler.timeout.ReadTimeoutHandler
           io.netty.util.CharsetUtil))

(defn parse-line
  [^String line]
  (let [[path metric time & garbage] (split line #"\s+")]
    (cond
      garbage
      (throw (ex-info "invalid carbon line: too many fields" {:line line})
             )
      (not (and (seq path) (seq metric) (seq time)))
      (throw (ex-info "invalid carbon line: missing fields" {:line line}))

      (re-find #"(?i)nan" metric)
      (throw (ex-info "invalid carbon line: NaN metric" {:line line})))
    (let [metric (try (Double. metric)
                      (catch NumberFormatException e
                        (throw (ex-info "invalid metric" {:metric metric}))))
          time   (try (Long. time)
                      (catch NumberFormatException e
                        (throw (ex-info "invalid time" {:time time}))))]
      {:path path :metric metric :time time})))

(defn pipeline
  [^Integer read-timeout engine]
  [#(LineBasedFrameDecoder. 2048)
   (StringDecoder. (CharsetUtil/UTF_8))
   #(ReadTimeoutHandler. read-timeout)
   (tcp/with-input input
     (when (seq input)
       (engine/accept! engine (parse-line input))))])

(ns io.cyanite.input.carbon
  (:require [io.cyanite.engine     :as engine]
            [io.cyanite.input.tcp  :as tcp]
            [clojure.string        :refer [split]]
            [clojure.tools.logging :refer [info]])
  (:import io.netty.handler.codec.LineBasedFrameDecoder
           io.netty.handler.codec.string.StringDecoder
           io.netty.handler.timeout.ReadTimeoutHandler
           io.netty.util.CharsetUtil))

(defn parse-line
  [^String line]
  (let [[path metric time & garbage] (split line #"\s+")]
    (cond
      garbage
      (throw (ex-info "invalid carbon line: too many fields" {:line line})
             )
      (not (and (seq path) (seq metric) (seq time)))
      (throw (ex-info "invalid carbon line: missing fields" {:line line}))

      (re-find #"(?i)nan" metric)
      (throw (ex-info (str "invalid carbon line: NaN metric for path:" path) {:line line})))
    (let [metric (try (Double. metric)
                      (catch NumberFormatException e
                        (throw (ex-info "invalid metric" {:metric metric}))))
          time   (try (Long. time)
                      (catch NumberFormatException e
                        (throw (ex-info "invalid time" {:time time}))))]
      {:path path :metric metric :time time})))

(defn pipeline
  [^Integer read-timeout engine]
  [#(LineBasedFrameDecoder. 2048)
   (StringDecoder. (CharsetUtil/UTF_8))
   #(ReadTimeoutHandler. read-timeout)
   (tcp/with-input input
     (when (seq input)
       (engine/accept! engine (parse-line input))))])

include path in NaN line exceptions

include path in NaN line exceptions


(defn euclid-sub [a b]
  (loop [i (Math/abs a) j (Math/abs b)]
	(if (= i j)
	    i
	  (if (> i j)
	      (recur (- i j) j)
	    (recur i (- j i))))))
(defn euclid-mod [a b]
  (loop [i (Math/abs a) j (Math/abs b)]
	(if (zero? j)
	    i
	  (recur j (% i j)))))

(print (euclid-sub (* 64 67)
		   (* 64 81))
       (euclid-mod (* 128 12)
		   (* 128 77)))

fix indentations (#66)

fix indentations (#66)

* add GCD in clojure

* add functionality for negative numbers

* add clojure implementation for euclidean subtraction method

* add clojure implementation for euclidean modular method

* clojure example code at the end of the page

* add clojure to bogo sort in fundamental algorithms

* Add clojure to book.json and update implemented chapters.

* fix typo

* fix indentation in euclidean algorithm in fundamental algorithms

used [this page](https://github.com/bbatsov/clojure-style-guide "clojure-style") as a guide for


(ns cjmt.core
  (:gen-class))

(set! *warn-on-reflection* true)
(set! *unchecked-math* true)

(def ^:const NUM_RECORDS (* 50 1000 444))

(definterface IMemTest
  (^Long gtradeId []) (^Long gclientId []) (^Long gvenueId []) (^Long ginstrumentCode []) (^Long gprice [])
  (^Long gquantity []) (^Character gside [])
  (stradeId [^Long v]) (sclientId [^Long v]) (svenueId [^Long v]) (sinstrumentCode [^Long v]) (sprice [^Long v])
  (squantity [^Long v]) (sside [^Character v]))

(deftype CJMemTest [^:unsynchronized-mutable ^Long tradeId ^:unsynchronized-mutable ^Long clientId ^:unsynchronized-mutable ^Long venueId
                   ^:unsynchronized-mutable ^Long instrumentCode ^:unsynchronized-mutable ^Long price ^:unsynchronized-mutable ^Long quantity
                   ^:unsynchronized-mutable ^Character side]
  IMemTest
  (gtradeId [_] tradeId)(gclientId [_] clientId)(gvenueId [_] venueId)(ginstrumentCode [_] instrumentCode)
  (gprice [_] price)(gquantity [_] quantity)(gside [_] side)
  (stradeId [this v] (set! tradeId v)) (sclientId [this v] (set! clientId v)) (svenueId [this v] (set! venueId v))
  (sinstrumentCode [this v] (set! instrumentCode v))
  (sprice [this v] (set! price v)) (squantity [this v] (set! quantity v))(sside [this v] (set! side v)))

(def trades ^"[Ljava.lang.Object;" (make-array Object NUM_RECORDS))

(defn init-trades []
    (dotimes [i NUM_RECORDS]
      (let [trade-ref ^CJMemTest (aget ^"[Ljava.lang.Object;" trades i)]
        (do (.stradeId trade-ref i)
               (.sclientId trade-ref 1)
               (.svenueId trade-ref 123)
               (.sinstrumentCode trade-ref 321)
               (.sprice trade-ref i)
               (.squantity trade-ref i)
               (if (odd? i)
                   (.sside trade-ref \S)
                   (.sside trade-ref \B))))))

(defn perform-run [^Long run-num]
  (let  [start-t (System/currentTimeMillis)]
    (do
      (def buy-cost (long 0))
      (def sell-cost (long 0))
      (init-trades)
      (dotimes [i NUM_RECORDS]
        (let [trade-ref ^CJMemTest (aget ^"[Ljava.lang.Object;" trades i)]
          (if (= (.gside trade-ref) \B)
              (def buy-cost (+' buy-cost (* (.gprice trade-ref) (.gquantity trade-ref))))
              (def sell-cost (+' sell-cost (* (.gprice trade-ref) (.gquantity trade-ref)))))))
      ;(printf "Run %d had duration %.6f seconds\n" run-num (- (System/currentTimeMillis) start-t) )
      (printf "Run %d had duration " run-num)
      (print (- (System/currentTimeMillis) start-t))
      (println "ms")
      (printf "buycost = %d sellCost = %d \n" (biginteger buy-cost) (biginteger sell-cost) ))))

(defn run []
  (dotimes [i NUM_RECORDS] (aset ^"[Ljava.lang.Object;" trades i (CJMemTest. 1 1 1 1 1 1 \a)))
  (dotimes [i 5] (perform-run i)))

(defn -main []
  (run))

(ns cjmt.core
  (:gen-class))

(set! *warn-on-reflection* true)
(set! *unchecked-math* true)

(def ^:const NUM_RECORDS (* 50 1000 444))

(definterface IMemTest
  (^long gtradeId [])
  (^long gclientId [])
  (^long gvenueId [])
  (^long ginstrumentCode [])
  (^long gprice [])
  (^long gquantity [])
  (^char gside [])
  (stradeId [^long v])
  (sclientId [^long v])
  (svenueId [^long v])
  (sinstrumentCode [^long v])
  (sprice [^long v])
  (squantity [^long v])
  (sside [^char v]))

(deftype CJMemTest [^:unsynchronized-mutable ^long tradeId
                    ^:unsynchronized-mutable ^long clientId
                    ^:unsynchronized-mutable ^long venueId
                    ^:unsynchronized-mutable ^long instrumentCode
                    ^:unsynchronized-mutable ^long price
                    ^:unsynchronized-mutable ^long quantity
                    ^:unsynchronized-mutable ^char side]
  IMemTest
  (gtradeId [_] tradeId)
  (gclientId [_] clientId)
  (gvenueId [_] venueId)
  (ginstrumentCode [_] instrumentCode)
  (gprice [_] price)
  (gquantity [_] quantity)
  (gside [_] side)
  (stradeId [this v] (set! tradeId v) nil)
  (sclientId [this v] (set! clientId v) nil)
  (svenueId [this v] (set! venueId v) nil)
  (sinstrumentCode [this v] (set! instrumentCode v) nil)
  (sprice [this v] (set! price v) nil)
  (squantity [this v] (set! quantity v) nil)
  (sside [this v] (set! side v) nil))

(def trades ^objects (make-array IMemTest NUM_RECORDS))

(defn init-trades []
  (let [trades ^objects trades]
    (loop [i 0]
      (when (< i NUM_RECORDS)
        (doto ^CJMemTest (aget trades i)
          (.stradeId i)
          (.sclientId i)
          (.svenueId 123)
          (.sinstrumentCode 321)
          (.sprice i)
          (.squantity i)
          (.sside (if (zero? (bit-and i 1)) \S \B)))
        (recur (inc i))))))

(defn perform-run [^long run-num]
  (let  [start-t (System/currentTimeMillis)
         trades ^objects trades
         tlen (alength trades)]
    (init-trades)
    (loop [idx 0
           buy-cost (bigint 0)
           sell-cost (bigint 0)]
      (if (< idx tlen)
        (let [trade-ref ^CJMemTest (aget trades idx)]
          (if (= \B (.gside trade-ref))
            (recur (inc idx) (+ buy-cost (* (.gprice trade-ref) (.gquantity trade-ref))) sell-cost)
            (recur (inc idx) buy-cost (+ sell-cost (* (.gprice trade-ref) (.gquantity trade-ref))))))
        (do
          (printf "Run %d had duration " run-num)
          (print (- (System/currentTimeMillis) start-t))
          (println "ms")
          (printf "buycost = %d sellCost = %d \n" (biginteger buy-cost) (biginteger sell-cost)))))))

(defn run []
  (dotimes [i NUM_RECORDS] (aset ^objects trades i (CJMemTest. 1 1 1 1 1 1 \a)))
  (dotimes [i 5] (System/gc) (perform-run i)))

(defn -main []
  (run))

clean up and improve performance of clojure version


(ns twentyfortyeight.logic
  (:require [cljs.spec.alpha :as s]
            [twentyfortyeight.db :as d]
            [cljs.spec.gen.alpha :as gen]
            [orchestra-cljs.spec.test :as st]
            [twentyfortyeight.db :as db]))

(s/fdef position
  :args (s/cat :axis ::d/axis :tile ::d/tile)
  :ret ::d/within-board-size)

(defn- position
  [axis tile]
  (get-in tile [:position axis]))

(s/fdef sort-tiles-by-priority
        :args (s/cat :direction ::d/direction :tiles (s/coll-of ::d/tile))
        :ret (s/coll-of ::d/tile))

(defn- sort-tiles-by-priority
  [direction tiles]
  (let [descending #(> %1 %2)]
    (case direction
      :up (sort-by #(position :y %) tiles)
      :down (sort-by #(position :y %) descending tiles)
      :left (sort-by #(position :x %) tiles)
      :right (sort-by #(position :x %) descending tiles))))

(s/def ::tiles-to-move (s/coll-of (s/coll-of ::d/tile)))

(s/fdef rows-in-direction
        :args (s/cat :direction ::d/direction :board ::d/game-board)
        :ret ::tiles-to-move)

(defn- rows-in-direction
  [direction board]
    (cond
     (#{:up :down} direction) (vals (group-by #(position :x %) board))
     (#{:left :right} direction) (vals (group-by #(position :y %) board))))

(defn- join-tiles
  [first-tile second-tile]
  {:id (:id first-tile)
   :value (+ (:value first-tile) (:value second-tile))
   :position (or (:position second-tile) (:position first-tile))})

(defn- join-group
  [group]
  (map (fn [[f s]] (join-tiles f s)) (partition-all 2 group)))

(s/fdef join-first
  :args (s/cat :tiles (s/coll-of ::d/tile :into []))
  :ret (s/coll-of ::d/tile)
  :fn #(>= (count (-> % :args :tiles)) (count (-> % :ret))))

(defn- join-first
  [tiles]
  (reduce (fn [acc group] (if (= 1 (count group))
                                   (concat acc group)
                                   (concat acc (join-group group))))
          '() (partition-by :value tiles)))

(defn- is-stacked-from-top-to-bottom?
  [tiles]
  (let [y-positions (into #{} (map #(-> % :position :y)) tiles)
        expected-positions (set (range (count y-positions)))]
    (= y-positions expected-positions)))

(s/fdef stack-top-to-bottom
        :args (s/cat :tiles (s/coll-of ::d/tile))
        :ret (s/coll-of ::d/tile)
        :fn #(is-stacked-from-top-to-bottom? (:ret %)))

(defn- stack-top-to-bottom
  [tiles]
  (map-indexed (fn [i t] (assoc-in t [:position :y] i)) tiles))

(defn- stack-bottom-to-top
  [tiles]
  (map-indexed (fn [i t] (assoc-in t [:position :y] (- (dec d/board-size) i)))  tiles))

(defn- stack-left-to-right
  [tiles]
  (map-indexed (fn [i t] (assoc-in t [:position :x] i)) tiles))

(defn- stack-right-to-left
  [tiles]
  (map-indexed (fn [i t] (assoc-in t [:position :x] (- (dec d/board-size) i)))  tiles))

(s/fdef stack-tiles
        :args (s/cat :direction ::d/direction :tiles (s/and (s/coll-of ::d/tile)))
        :ret (s/coll-of ::d/tile))

(defn- stack-tiles
  [direction tiles]
  (case direction
    :up (stack-top-to-bottom tiles)
    :down (stack-bottom-to-top tiles)
    :right (stack-right-to-left tiles)
    :left (stack-left-to-right tiles)))

(s/fdef random-open-position
        :args (s/cat :board ::d/game-board)
        :ret ::d/position)

(defn- random-open-position
  [board]
  (let [occupied-positions (into #{} (map :position) board)
        free-positions (filter (complement occupied-positions) d/all-positions)]
    (rand-nth free-positions)))

(defn- random-tile-value
  []
  (rand-nth d/tile-frequencies))

(defn- same-board?
  [b1 b2]
  (= (set b1) (set b2)))

(defn- is-board-full?
  [board]
  (= d/max-tiles (count board)))

(s/fdef maybe-insert-new-random-tile
        :args (s/cat :last-board ::d/game-board :new-board ::d/game-board)
        :ret ::d/game-board)

(defn- maybe-insert-new-random-tile
  [last-board new-board]
  (if-not (or (same-board? last-board new-board) (is-board-full? new-board))
    (conj new-board {:id (str (random-uuid))
                     :position (random-open-position new-board)
                     :value (random-tile-value)})
    new-board))

(s/fdef move-direction
        :args (s/cat :board ::d/game-board :direction ::d/direction)
        :ret ::d/game-board)

(defn move-and-join
  [board direction]
  (->> (rows-in-direction direction board)
       (map (partial sort-tiles-by-priority direction))
       (map join-first)
       (mapcat (partial stack-tiles direction))))

(defn move-direction
  [board direction]
  (->>
   (move-and-join board direction)
   (maybe-insert-new-random-tile board)))

(ns twentyfortyeight.logic
  (:require [cljs.spec.alpha :as s]
            [twentyfortyeight.db :as d]
            [cljs.spec.gen.alpha :as gen]
            [orchestra-cljs.spec.test :as st]
            [twentyfortyeight.db :as db]))

(s/fdef position
  :args (s/cat :axis ::d/axis :tile ::d/tile)
  :ret ::d/within-board-size)

(defn- position
  [axis tile]
  (get-in tile [:position axis]))

(s/fdef sort-tiles-by-priority
        :args (s/cat :direction ::d/direction :tiles (s/coll-of ::d/tile))
        :ret (s/coll-of ::d/tile))

(defn- sort-tiles-by-priority
  [direction tiles]
  (let [descending #(> %1 %2)]
    (case direction
      :up (sort-by #(position :y %) tiles)
      :down (sort-by #(position :y %) descending tiles)
      :left (sort-by #(position :x %) tiles)
      :right (sort-by #(position :x %) descending tiles))))

(s/def ::tiles-to-move (s/coll-of (s/coll-of ::d/tile)))

(s/fdef rows-in-direction
        :args (s/cat :direction ::d/direction :board ::d/game-board)
        :ret ::tiles-to-move)

(defn- rows-in-direction
  [direction board]
    (cond
     (#{:up :down} direction) (vals (group-by #(position :x %) board))
     (#{:left :right} direction) (vals (group-by #(position :y %) board))))

(defn- join-tiles
  [first-tile second-tile]
  {:id (or (:id second-tile)(:id first-tile))
   :value (+ (:value first-tile) (:value second-tile))
   :position (or (:position second-tile) (:position first-tile))})

(defn- join-group
  [group]
  (map (fn [[f s]] (join-tiles f s)) (partition-all 2 group)))

(s/fdef join-first
  :args (s/cat :tiles (s/coll-of ::d/tile :into []))
  :ret (s/coll-of ::d/tile)
  :fn #(>= (count (-> % :args :tiles)) (count (-> % :ret))))

(defn- join-first
  [tiles]
  (reduce (fn [acc group] (if (= 1 (count group))
                                   (concat acc group)
                                   (concat acc (join-group group))))
          '() (partition-by :value tiles)))

(defn- is-stacked-from-top-to-bottom?
  [tiles]
  (let [y-positions (into #{} (map #(-> % :position :y)) tiles)
        expected-positions (set (range (count y-positions)))]
    (= y-positions expected-positions)))

(s/fdef stack-top-to-bottom
        :args (s/cat :tiles (s/coll-of ::d/tile))
        :ret (s/coll-of ::d/tile)
        :fn #(is-stacked-from-top-to-bottom? (:ret %)))

(defn- stack-top-to-bottom
  [tiles]
  (map-indexed (fn [i t] (assoc-in t [:position :y] i)) tiles))

(defn- stack-bottom-to-top
  [tiles]
  (map-indexed (fn [i t] (assoc-in t [:position :y] (- (dec d/board-size) i)))  tiles))

(defn- stack-left-to-right
  [tiles]
  (map-indexed (fn [i t] (assoc-in t [:position :x] i)) tiles))

(defn- stack-right-to-left
  [tiles]
  (map-indexed (fn [i t] (assoc-in t [:position :x] (- (dec d/board-size) i)))  tiles))

(s/fdef stack-tiles
        :args (s/cat :direction ::d/direction :tiles (s/and (s/coll-of ::d/tile)))
        :ret (s/coll-of ::d/tile))

(defn- stack-tiles
  [direction tiles]
  (case direction
    :up (stack-top-to-bottom tiles)
    :down (stack-bottom-to-top tiles)
    :right (stack-right-to-left tiles)
    :left (stack-left-to-right tiles)))

(s/fdef random-open-position
        :args (s/cat :board ::d/game-board)
        :ret ::d/position)

(defn- random-open-position
  [board]
  (let [occupied-positions (into #{} (map :position) board)
        free-positions (filter (complement occupied-positions) d/all-positions)]
    (rand-nth free-positions)))

(defn- random-tile-value
  []
  (rand-nth d/tile-frequencies))

(defn- same-board?
  [b1 b2]
  (= (set b1) (set b2)))

(defn- is-board-full?
  [board]
  (= d/max-tiles (count board)))

(s/fdef maybe-insert-new-random-tile
        :args (s/cat :last-board ::d/game-board :new-board ::d/game-board)
        :ret ::d/game-board)

(defn- maybe-insert-new-random-tile
  [last-board new-board]
  (if-not (or (same-board? last-board new-board) (is-board-full? new-board))
    (conj new-board {:id (str (random-uuid))
                     :position (random-open-position new-board)
                     :value (random-tile-value)})
    new-board))

(s/fdef move-direction
        :args (s/cat :board ::d/game-board :direction ::d/direction)
        :ret ::d/game-board)

(defn move-and-join
  [board direction]
  (->> (rows-in-direction direction board)
       (map (partial sort-tiles-by-priority direction))
       (map join-first)
       (mapcat (partial stack-tiles direction))))

(defn move-direction
  [board direction]
  (->>
   (move-and-join board direction)
   (maybe-insert-new-random-tile board)))

Join animation

Join animation


;; Copyright © 2016-2018, JUXT LTD.

(ns tick.alpha.api.dates-test
  (:refer-clojure :exclude [dec < range <= min long int > extend - time / >= inc + max complement atom swap-vals! reset-vals! compare-and-set! reset! swap! second group-by])
  (:require
   [clojure.spec.alpha :as s]
   [clojure.test :refer :all]
   [tick.alpha.api :refer :all])
  (:import [java.time Clock LocalTime LocalDateTime]))

;; See doc/dates.adoc

(deftest time-construction-test
  (testing "(time)"
    (is (instance? LocalTime (time))))
  (testing "(time \"4pm\")"
    (is (instance? LocalTime (time "4pm")))
    (is (= "16:00" (str (time "4pm")))))
  (testing "(midnight)"
    (is (instance? LocalTime (midnight)))
    (is (= "00:00" (str (midnight)))))
  (testing "(noon)"
    (is (instance? LocalTime (noon)))
    (is (= "12:00" (str (noon))))))

(deftest date-construction-test
  (is (instance? LocalDateTime (noon (today))))
  (with-clock (-> (date "2018-02-14") (at "10:00"))
    (testing "(noon (today))"
      (is (= "2018-02-14T12:00" (str (noon (today))))))
    (testing "(noon (date))"
      (is (= "2018-02-14T12:00" (str (noon (date))))))))

;; TODO: Clock tests
;; Create with a value for a fixed clock. Value can be a time or a zone

(deftest clock-test
  (testing "clock"
    (with-clock (-> (date "2018-02-14") (at "10:00") (in "America/New_York"))
      (testing "(clock) return type"
        (is (instance? Clock (clock))))
      (testing "Time shifting the clock back by 2 hours"
        (is (= "2018-02-14T13:00:00Z" (str (instant (<< (clock) (hours 2)))))))))

  (testing "Creating a clock with a zone, and returning that zone"
    (is (= "America/New_York" (str (zone (clock (zone "America/New_York")))))))

  (testing "Creation of clock with fixed instant"
    (is (= "2017-10-31T16:00:00Z" (str (instant (clock "2017-10-31T16:00:00Z")))))))

;; TODO: tick function

;; TODO: Atomic clocks

;; Copyright © 2016-2018, JUXT LTD.

(ns tick.alpha.api.dates-test
  (:refer-clojure :exclude [dec < range <= min long int > extend - time / >= inc + max complement atom swap-vals! reset-vals! compare-and-set! reset! swap! second group-by conj])
  (:require
   [clojure.spec.alpha :as s]
   [clojure.test :refer :all]
   [tick.alpha.api :refer :all])
  (:import [java.time Clock LocalTime LocalDateTime]))

;; See doc/dates.adoc

(deftest time-construction-test
  (testing "(time)"
    (is (instance? LocalTime (time))))
  (testing "(time \"4pm\")"
    (is (instance? LocalTime (time "4pm")))
    (is (= "16:00" (str (time "4pm")))))
  (testing "(midnight)"
    (is (instance? LocalTime (midnight)))
    (is (= "00:00" (str (midnight)))))
  (testing "(noon)"
    (is (instance? LocalTime (noon)))
    (is (= "12:00" (str (noon))))))

(deftest date-construction-test
  (is (instance? LocalDateTime (noon (today))))
  (with-clock (-> (date "2018-02-14") (at "10:00"))
    (testing "(noon (today))"
      (is (= "2018-02-14T12:00" (str (noon (today))))))
    (testing "(noon (date))"
      (is (= "2018-02-14T12:00" (str (noon (date))))))))

;; TODO: Clock tests
;; Create with a value for a fixed clock. Value can be a time or a zone

(deftest clock-test
  (testing "clock"
    (with-clock (-> (date "2018-02-14") (at "10:00") (in "America/New_York"))
      (testing "(clock) return type"
        (is (instance? Clock (clock))))
      (testing "Time shifting the clock back by 2 hours"
        (is (= "2018-02-14T13:00:00Z" (str (instant (<< (clock) (hours 2)))))))))

  (testing "Creating a clock with a zone, and returning that zone"
    (is (= "America/New_York" (str (zone (clock (zone "America/New_York")))))))

  (testing "Creation of clock with fixed instant"
    (is (= "2017-10-31T16:00:00Z" (str (instant (clock "2017-10-31T16:00:00Z")))))))

;; TODO: tick function

;; TODO: Atomic clocks

Fix warning

Fix warning


(ns metabase.api.annotation
  "`/api/annotation` endpoints."
  (:require [korma.core :as korma]
            [compojure.core :refer [defroutes GET PUT POST DELETE]]
            [medley.core :refer [mapply]]
            [metabase.api.common :refer :all]
            [metabase.db :refer :all]
            [metabase.models.hydrate :refer :all]
            (metabase.models [annotation :refer [Annotation annotation-general annotation-description]]
                             [org :refer [Org]])
            [metabase.util :as util]))

;;; this is a remnant of the django app where the id in the database is keyed off an old django table :/
(def object-models {:table 33
                    :field 34})

(defannotation AnnotationObjectModel->ID
  "Check that param is a valid `object-models` key string (e.g., `\"table\"`), and return corresponding value (e.g., `33`)."
  [symb value :nillable]
  (-> (checkp-contains? (set (keys object-models)) symb (keyword value))
      object-models))

(defannotation AnnotationType [symb value :nillable]
  (annotation:IsInteger symb value)
  (checkp-contains? (set annotation-description annotation-general) symb value))

(defendpoint GET "/" [org object_model object_id]
  {org Required, object_model AnnotationObjectModel->ID}
  (read-check Org org)
  (-> (if (and object_model object_id)
        ;; caller wants annotations about a specific entity
        (sel :many Annotation :organization_id org :object_type_id object_model :object_id object_id (korma/order :start :DESC))
        ;; default is to return all annotations
        (sel :many Annotation :organization_id org (korma/order :start :DESC)))
      (hydrate :author)))

(defendpoint POST "/" [:as {{:keys [organization start end title body annotation_type object_model object_id]
                             :or {annotation_type annotation-general}
                             :as request-body} :body}]
  {organization    [Required IsInteger]
   start           [Required Date]
   end             [Required Date]
   body            [Required NonEmptyString]
   title           NonEmptyString
   annotation_type [Required AnnotationType]
   object_model    [Required AnnotationObjectModel->ID]
   object_id       [Required IsInteger]}
  ;; user only needs to be member of an organization (read perms) to be able to post annotations
  (read-check Org organization)
  (-> (ins Annotation
        :organization_id organization
        :author_id *current-user-id*
        :start start
        :end end
        :title title
        :body body
        :annotation_type annotation_type
        :object_type_id object_model
        :object_id object_id
        :edit_count 1)
    (hydrate :author)))

(defendpoint GET "/:id" [id]
  (let-404 [annotation (sel :one Annotation :id id)]
    (read-check Org (:organization_id annotation))
    (hydrate annotation :author)))

(defendpoint PUT "/:id" [id :as {{:keys [start end title body]} :body}]
  {start [Required Date]
   end   [Required Date]
   title [Required NonEmptyString]
   body  [Required NonEmptyString]}
  (let-404 [{:keys [edit_count] :as annotation} (sel :one Annotation :id id)]
    (read-check Org (:organization_id annotation))
    (check-500 (upd Annotation :id id
                    :start start
                    :end end
                    :title title
                    :body body
                    :edit_count (inc (or edit_count 0))))
    (sel :one Annotation :id id)))

(defendpoint DELETE "/:id" [id]
  (let-404 [annotation (sel :one Annotation :id id)]
    (read-check Org (:organization_id annotation))
    (del Annotation :id id)))

(define-routes)

(ns metabase.api.annotation
  "`/api/annotation` endpoints."
  (:require [korma.core :as korma]
            [compojure.core :refer [defroutes GET PUT POST DELETE]]
            [medley.core :refer [mapply]]
            [metabase.api.common :refer :all]
            [metabase.db :refer :all]
            [metabase.models.hydrate :refer :all]
            (metabase.models [annotation :refer [Annotation annotation-general annotation-description]]
                             [org :refer [Org]])
            [metabase.util :as util]))

;;; this is a remnant of the django app where the id in the database is keyed off an old django table :/
(def object-models {:table 33
                    :field 34})

(defannotation AnnotationObjectModel->ID
  "Check that param is a valid `object-models` key string (e.g., `\"table\"`), and return corresponding value (e.g., `33`)."
  [symb value :nillable]
  (-> (checkp-contains? (set (keys object-models)) symb (keyword value))
      object-models))

(defannotation AnnotationType [symb value :nillable]
  (annotation:IsInteger symb value)
  (checkp-contains? (set [annotation-description annotation-general]) symb value))

(defendpoint GET "/" [org object_model object_id]
  {org Required, object_model AnnotationObjectModel->ID}
  (read-check Org org)
  (-> (if (and object_model object_id)
        ;; caller wants annotations about a specific entity
        (sel :many Annotation :organization_id org :object_type_id object_model :object_id object_id (korma/order :start :DESC))
        ;; default is to return all annotations
        (sel :many Annotation :organization_id org (korma/order :start :DESC)))
      (hydrate :author)))

(defendpoint POST "/" [:as {{:keys [organization start end title body annotation_type object_model object_id]
                             :or {annotation_type annotation-general}
                             :as request-body} :body}]
  {organization    [Required IsInteger]
   start           [Required Date]
   end             [Required Date]
   body            [Required NonEmptyString]
   title           NonEmptyString
   annotation_type [Required AnnotationType]
   object_model    [Required AnnotationObjectModel->ID]
   object_id       [Required IsInteger]}
  ;; user only needs to be member of an organization (read perms) to be able to post annotations
  (read-check Org organization)
  (-> (ins Annotation
        :organization_id organization
        :author_id *current-user-id*
        :start start
        :end end
        :title title
        :body body
        :annotation_type annotation_type
        :object_type_id object_model
        :object_id object_id
        :edit_count 1)
    (hydrate :author)))

(defendpoint GET "/:id" [id]
  (let-404 [annotation (sel :one Annotation :id id)]
    (read-check Org (:organization_id annotation))
    (hydrate annotation :author)))

(defendpoint PUT "/:id" [id :as {{:keys [start end title body]} :body}]
  {start [Required Date]
   end   [Required Date]
   title [Required NonEmptyString]
   body  [Required NonEmptyString]}
  (let-404 [{:keys [edit_count] :as annotation} (sel :one Annotation :id id)]
    (read-check Org (:organization_id annotation))
    (check-500 (upd Annotation :id id
                    :start start
                    :end end
                    :title title
                    :body body
                    :edit_count (inc (or edit_count 0))))
    (sel :one Annotation :id id)))

(defendpoint DELETE "/:id" [id]
  (let-404 [annotation (sel :one Annotation :id id)]
    (read-check Org (:organization_id annotation))
    (del Annotation :id id)))

(define-routes)

fix typo

fix typo