;;;
;;;   Copyright 2015-2021 Ruediger Gad
;;;
;;;   This software is released under the terms of the Eclipse Public License
;;;   (EPL) 1.0. You can find a copy of the EPL at:
;;;   http://opensource.org/licenses/eclipse-1.0.php
;;;

(ns
  ^{:author "Ruediger Gad",
    :doc "Tests for Unit Testing CLIs that are created with cli4clj."}
  cli4clj.test.cli-tests
  (:require
    (cli4clj
      [cli :as cli]
      [cli-tests :as cli-tests])
    (clj-assorted-utils [util :as utils])
    (clojure [test :as test]))
  (:import (java.io ByteArrayInputStream)
           (java.util ArrayList)))

(test/deftest cmd-vector-to-cmd-test-input-string-test
  (let [expected (str "foo" cli/*line-sep* "bar" cli/*line-sep*)
        cmd-vec ["foo" "bar"]]
    (test/is (= expected (cli-tests/cmd-vector-to-test-input-string cmd-vec)))))

(test/deftest expected-string-creation-single-line-test
  (let [in ["a"]
        out (cli-tests/expected-string in)]
    (test/is (= "a" out))))

(test/deftest expected-string-creation-multi-line-test
  (let [in ["a" "b" "c"]
        out (cli-tests/expected-string in)
        line-sep (System/getProperty "line.separator")]
    (test/is (= (str "a" line-sep "b" line-sep "c") out))))

(test/deftest expected-string-creation-custom-separator-test
  (let [in ["a" "b" "c"]
        out (cli-tests/expected-string in "foo")
        line-sep "foo"]
    (test/is (= (str "a" line-sep "b" line-sep "c") out))))

(test/deftest custom-test-cli-stdout-test
  (let [cli-opts {:cmds {:foo {:fn (fn [] (print "bar"))}}}
        test-cmd-input ["foo"]
        intercepted-data (atom nil)
        out-string (cli-tests/test-cli-stdout-cb
                     #(cli/start-cli cli-opts)
                     test-cmd-input
                     (fn [d]
                       (reset! intercepted-data d)))]
    (test/is (= (cli-tests/expected-string ["bar"]) out-string))
    (test/is (= "bar" @intercepted-data))))

(test/deftest custom-test-cli-stderr-test
  (let [cli-opts {:cmds {:foo {:fn (fn [] (utils/print-err "bar"))}}}
        test-cmd-input ["foo"]
        intercepted-data (atom nil)
        out-string (cli-tests/test-cli-stderr-cb
                     #(cli/start-cli cli-opts)
                     test-cmd-input
                     (fn [d]
                       (reset! intercepted-data d)))]
    (test/is (= (cli-tests/expected-string ["bar"]) out-string))
    (test/is (= "bar" @intercepted-data))))

(defn- async-test-fn
  []
  (println "Starting...")
  (let [tmp-out *out*]
    (doto
      (Thread.
        (fn []
          (binding [*out* tmp-out]
            (utils/sleep 500)
            (println "Finished."))))
      (.start)))
  (println "Started."))

(test/deftest async-cmd-not-finished-test
  (let [cli-opts {:cmds {:async-foo {:fn async-test-fn}}}
        test-cmd-input ["async-foo"]
        out-string (cli-tests/test-cli-stdout #(cli/start-cli cli-opts) test-cmd-input)]
    (test/is (= (cli-tests/expected-string ["Starting..." "Started."]) out-string))))

(test/deftest async-cmd-sleep-finished-test
  (let [cli-opts {:cmds {:async-foo {:fn async-test-fn}}}
        test-cmd-input ["async-foo" "_sleep 1000"]
        out-string (cli-tests/test-cli-stdout #(cli/start-cli cli-opts) test-cmd-input)]
    (test/is (= (cli-tests/expected-string ["Starting..." "Started." "Finished."]) out-string))))

(test/deftest async-cmd-string-latch-stdout-test
  (let [cli-opts {:cmds {:async-foo {:fn async-test-fn}}}
        test-cmd-input ["async-foo"]
        sl (cli-tests/string-latch ["Finished." cli/*line-sep*])
        out-string (cli-tests/test-cli-stdout #(cli/start-cli cli-opts) test-cmd-input sl)]
    (test/is (= ["Starting..." cli/*line-sep* "Started." cli/*line-sep* "Finished." cli/*line-sep*] (sl)))
    (test/is (= (cli-tests/expected-string ["Starting..." "Started." "Finished."]) out-string))))

(defn- async-test-stderr-fn
  []
  (utils/println-err "Starting...")
  (let [tmp-err *err*]
    (doto
      (Thread.
        (fn []
          (binding [*err* tmp-err]
            (utils/sleep 500)
            (utils/println-err "Finished."))))
      (.start)))
  (utils/println-err "Started."))

(test/deftest async-cmd-string-latch-stderr-test
  (let [cli-opts {:cmds {:async-foo {:fn async-test-stderr-fn}}}
        test-cmd-input ["async-foo"]
        sl (cli-tests/string-latch ["Finished." cli/*line-sep*])
        out-string (cli-tests/test-cli-stderr #(cli/start-cli cli-opts) test-cmd-input sl)]
    (test/is (= ["Starting..." cli/*line-sep* "Started." cli/*line-sep* "Finished." cli/*line-sep*] (sl)))
    (test/is (= (cli-tests/expected-string ["Starting..." "Started." "Finished."]) out-string))))

(test/deftest async-cmd-string-latch-stdout-with-callback-test
  (let [cli-opts {:cmds {:async-foo {:fn async-test-fn}}}
        test-cmd-input ["async-foo"]
        val-0 (atom nil)
        val-1 (atom nil)
        val-2 (atom nil)
        sl (cli-tests/string-latch [["Starting..." #(reset! val-0 %)]
                                    ["Started." (fn [v] (reset! val-1 v))]
                                    ["Finished." #(reset! val-2 %)]
                                    cli/*line-sep*])
        out-string (cli-tests/test-cli-stdout #(cli/start-cli cli-opts) test-cmd-input sl)]
    (test/is (= ["Starting..."] @val-0))
    (test/is (= ["Starting..." cli/*line-sep* "Started."] @val-1))
    (test/is (= ["Starting..." cli/*line-sep* "Started." cli/*line-sep* "Finished."] @val-2))
    (test/is (= (cli-tests/expected-string ["Starting..." "Started." "Finished."]) out-string))))

(test/deftest async-cmd-string-latch-stdout-with-mixed-callback-test
  (let [cli-opts {:cmds {:async-foo {:fn async-test-fn}}}
        test-cmd-input ["async-foo"]
        val-0 (atom nil)
        val-1 (atom nil)
        val-2 (atom nil)
        sl (cli-tests/string-latch ["Starting..."
                                    ["Started."]
                                    ["Finished." #(reset! val-2 %)]
                                    cli/*line-sep*])
        out-string (cli-tests/test-cli-stdout #(cli/start-cli cli-opts) test-cmd-input sl)]
    (test/is (= nil @val-0))
    (test/is (= nil @val-1))
    (test/is (= ["Starting..." cli/*line-sep* "Started." cli/*line-sep* "Finished."] @val-2))
    (test/is (= (cli-tests/expected-string ["Starting..." "Started." "Finished."]) out-string))))

(test/deftest simple-jline-input-stream-mock-test
  (let [in-string (str "a 1" cli/*line-sep* "b 2 3" cli/*line-sep* "q" cli/*line-sep*)
        out (binding [cli/*jline-input-stream* (ByteArrayInputStream. (.getBytes in-string))]
              (with-out-str
                (cli/start-cli {:cmds {:a {:fn (fn [arg] (inc arg))}
                                   :b {:fn (fn [summand1 summand2] (+ summand1 summand2))}}})))]
    (test/is (= (cli-tests/expected-string ["2" (str "5" cli/*line-sep*)]) out))))

(test/deftest clojure-repl-stdout-no-op-test
  (let [in-cmds [""]
        out (cli-tests/test-cli-stdout clojure.main/repl in-cmds)]
    (test/is (= (str *ns* "=> " *ns* "=>") out))))

(test/deftest clojure-repl-stderr-no-op-test
  (let [in-cmds [""]
        out (cli-tests/test-cli-stderr clojure.main/repl in-cmds)]
    (test/is (= "" out))))

(test/deftest clojure-repl-stdout-inc-test
  (let [in-cmds ["(inc 1)"]
        out (cli-tests/test-cli-stdout clojure.main/repl in-cmds)]
    (test/is (= (cli-tests/expected-string [(str *ns* "=> 2") (str *ns* "=>")]) out))))

(test/deftest clojure-repl-stdout-def-inc-println-test
  (let [in-cmds ["(def x 21)" "(inc x)" "(println x)"]
        out (cli-tests/test-cli-stdout clojure.main/repl in-cmds)]
    (test/is (= (cli-tests/expected-string [(str *ns*"=> #'" *ns* "/x") (str *ns* "=> 22") (str *ns* "=> 21") "nil" (str *ns* "=>")]) out))))

(test/deftest clojure-repl-stderr-div-zero-test
  (let [in-cmds ["(/ 1 0)"]
        out (cli-tests/test-cli-stderr clojure.main/repl in-cmds)]
    (test/is (.startsWith out "Execution error (ArithmeticException)"))))

(test/deftest clojure-repl-stdout-no-op-no-prompt-test
  (let [in-cmds [""]
        out (cli-tests/test-cli-stdout #(clojure.main/repl :prompt str) in-cmds)]
    (test/is (= "" out))))

(test/deftest clojure-repl-stdout-inc-no-prompt-test
  (let [in-cmds ["(inc 1)"]
        out (cli-tests/test-cli-stdout #(clojure.main/repl :prompt str) in-cmds)]
    (test/is (= "2" out))))

(test/deftest clojure-repl-stdout-def-inc-println-no-prompt-test
  (let [in-cmds ["(def x 21)" "(inc x)" "(println x)"]
        out (cli-tests/test-cli-stdout #(clojure.main/repl :prompt str) in-cmds)]
    (test/is (= (cli-tests/expected-string [(str "#'" *ns* "/x") "22" "21" "nil"]) out))))

(test/deftest clojure-repl-stdout-def-inc-println-no-prompt-string-latch-test
  (let [in-cmds ["(def x 21)" "(inc x)" "(println x)"]
        val-0 (atom nil)
        val-1 (atom nil)
        val-2 (atom nil)
        sl (cli-tests/string-latch [[(str "#'" *ns* "/x") #(reset! val-0 %)]
                                    ["22" #(reset! val-1 %)]
                                    ["21" #(reset! val-2 %)]
                                    "nil"])
        out (cli-tests/test-cli-stdout #(clojure.main/repl :prompt str) in-cmds sl)]
    (test/is (= [(str "#'" *ns* "/x")] @val-0))
    (test/is (= [(str "#'" *ns* "/x") cli/*line-sep* "22"] @val-1))
    (test/is (= [(str "#'" *ns* "/x") cli/*line-sep* "22" cli/*line-sep* "21"] @val-2))
    (test/is (= (cli-tests/expected-string [(str "#'" *ns* "/x") "22" "21" "nil"]) out))))

;;;
;;;   Copyright 2015-2021 Ruediger Gad
;;;
;;;   This software is released under the terms of the Eclipse Public License
;;;   (EPL) 1.0. You can find a copy of the EPL at:
;;;   http://opensource.org/licenses/eclipse-1.0.php
;;;

(ns
  ^{:author "Ruediger Gad",
    :doc "Tests for Unit Testing CLIs that are created with cli4clj."}
  cli4clj.test.cli-tests
  (:require
    (cli4clj
      [cli :as cli]
      [cli-tests :as cli-tests])
    (clj-assorted-utils [util :as utils])
    (clojure [test :as test]))
  (:import (java.io ByteArrayInputStream)
           (java.util ArrayList)))

(test/deftest cmd-vector-to-cmd-test-input-string-test
  (let [expected (str "foo" cli/*line-sep* "bar" cli/*line-sep*)
        cmd-vec ["foo" "bar"]]
    (test/is (= expected (cli-tests/cmd-vector-to-test-input-string cmd-vec)))))

(test/deftest expected-string-creation-single-line-test
  (let [in ["a"]
        out (cli-tests/expected-string in)]
    (test/is (= "a" out))))

(test/deftest expected-string-creation-multi-line-test
  (let [in ["a" "b" "c"]
        out (cli-tests/expected-string in)
        line-sep (System/getProperty "line.separator")]
    (test/is (= (str "a" line-sep "b" line-sep "c") out))))

(test/deftest expected-string-creation-custom-separator-test
  (let [in ["a" "b" "c"]
        out (cli-tests/expected-string in "foo")
        line-sep "foo"]
    (test/is (= (str "a" line-sep "b" line-sep "c") out))))

(test/deftest custom-test-cli-stdout-test
  (let [cli-opts {:cmds {:foo {:fn (fn [] (print "bar"))}}}
        test-cmd-input ["foo"]
        intercepted-data (atom nil)
        out-string (cli-tests/test-cli-stdout-cb
                     #(cli/start-cli cli-opts)
                     test-cmd-input
                     (fn [d]
                       (reset! intercepted-data d)))]
    (test/is (= (cli-tests/expected-string ["bar"]) out-string))
    (test/is (= "bar" @intercepted-data))))

(test/deftest custom-test-cli-stderr-test
  (let [cli-opts {:cmds {:foo {:fn (fn [] (utils/print-err "bar"))}}}
        test-cmd-input ["foo"]
        intercepted-data (atom nil)
        out-string (cli-tests/test-cli-stderr-cb
                     #(cli/start-cli cli-opts)
                     test-cmd-input
                     (fn [d]
                       (reset! intercepted-data d)))]
    (test/is (= (cli-tests/expected-string ["bar"]) out-string))
    (test/is (= "bar" @intercepted-data))))

(defn- async-test-fn
  []
  (println "Starting...")
  (let [tmp-out *out*]
    (doto
      (Thread.
        (fn []
          (binding [*out* tmp-out]
            (utils/sleep 500)
            (println "Finished."))))
      (.start)))
  (println "Started."))

(test/deftest async-cmd-not-finished-test
  (let [cli-opts {:cmds {:async-foo {:fn async-test-fn}}}
        test-cmd-input ["async-foo"]
        out-string (cli-tests/test-cli-stdout #(cli/start-cli cli-opts) test-cmd-input)]
    (test/is (= (cli-tests/expected-string ["Starting..." "Started."]) out-string))))

(test/deftest async-cmd-sleep-finished-test
  (let [cli-opts {:cmds {:async-foo {:fn async-test-fn}}}
        test-cmd-input ["async-foo" "_sleep 1000"]
        out-string (cli-tests/test-cli-stdout #(cli/start-cli cli-opts) test-cmd-input)]
    (test/is (= (cli-tests/expected-string ["Starting..." "Started." "Finished."]) out-string))))

(test/deftest async-cmd-string-latch-stdout-test
  (let [cli-opts {:cmds {:async-foo {:fn async-test-fn}}}
        test-cmd-input ["async-foo"]
        sl (cli-tests/string-latch ["Finished." cli/*line-sep*])
        out-string (cli-tests/test-cli-stdout #(cli/start-cli cli-opts) test-cmd-input sl)]
    (test/is (= ["Starting..." cli/*line-sep* "Started." cli/*line-sep* "Finished." cli/*line-sep*] (sl)))
    (test/is (= (cli-tests/expected-string ["Starting..." "Started." "Finished."]) out-string))))

(defn- async-test-stderr-fn
  []
  (utils/println-err "Starting...")
  (let [tmp-err *err*]
    (doto
      (Thread.
        (fn []
          (binding [*err* tmp-err]
            (utils/sleep 500)
            (utils/println-err "Finished."))))
      (.start)))
  (utils/println-err "Started."))

(test/deftest async-cmd-string-latch-stderr-test
  (let [cli-opts {:cmds {:async-foo {:fn async-test-stderr-fn}}}
        test-cmd-input ["async-foo"]
        sl (cli-tests/string-latch ["Finished." cli/*line-sep*])
        out-string (cli-tests/test-cli-stderr #(cli/start-cli cli-opts) test-cmd-input sl)]
    (test/is (= ["Starting..." cli/*line-sep* "Started." cli/*line-sep* "Finished." cli/*line-sep*] (sl)))
    (test/is (= (cli-tests/expected-string ["Starting..." "Started." "Finished."]) out-string))))

(test/deftest async-cmd-string-latch-stdout-with-callback-test
  (let [cli-opts {:cmds {:async-foo {:fn async-test-fn}}}
        test-cmd-input ["async-foo"]
        val-0 (atom nil)
        val-1 (atom nil)
        val-2 (atom nil)
        sl (cli-tests/string-latch [["Starting..." #(reset! val-0 %)]
                                    ["Started." (fn [v] (reset! val-1 v))]
                                    ["Finished." #(reset! val-2 %)]
                                    cli/*line-sep*])
        out-string (cli-tests/test-cli-stdout #(cli/start-cli cli-opts) test-cmd-input sl)]
    (test/is (= ["Starting..."] @val-0))
    (test/is (= ["Starting..." cli/*line-sep* "Started."] @val-1))
    (test/is (= ["Starting..." cli/*line-sep* "Started." cli/*line-sep* "Finished."] @val-2))
    (test/is (= (cli-tests/expected-string ["Starting..." "Started." "Finished."]) out-string))))

(test/deftest async-cmd-string-latch-stdout-with-mixed-callback-test
  (let [cli-opts {:cmds {:async-foo {:fn async-test-fn}}}
        test-cmd-input ["async-foo"]
        val-0 (atom nil)
        val-1 (atom nil)
        val-2 (atom nil)
        sl (cli-tests/string-latch ["Starting..."
                                    ["Started."]
                                    ["Finished." #(reset! val-2 %)]
                                    cli/*line-sep*])
        out-string (cli-tests/test-cli-stdout #(cli/start-cli cli-opts) test-cmd-input sl)]
    (test/is (= nil @val-0))
    (test/is (= nil @val-1))
    (test/is (= ["Starting..." cli/*line-sep* "Started." cli/*line-sep* "Finished."] @val-2))
    (test/is (= (cli-tests/expected-string ["Starting..." "Started." "Finished."]) out-string))))

(test/deftest simple-jline-input-stream-mock-test
  (let [in-string (str "a 1" cli/*line-sep* "b 2 3" cli/*line-sep* "q" cli/*line-sep*)
        out (binding [cli/*jline-input-stream* (ByteArrayInputStream. (.getBytes in-string))]
              (with-out-str
                (cli/start-cli {:cmds {:a {:fn (fn [arg] (inc arg))}
                                   :b {:fn (fn [summand1 summand2] (+ summand1 summand2))}}})))]
    (test/is (= (cli-tests/expected-string ["" "2" (str "5" cli/*line-sep*)]) out))))

(test/deftest clojure-repl-stdout-no-op-test
  (let [in-cmds [""]
        out (cli-tests/test-cli-stdout clojure.main/repl in-cmds)]
    (test/is (= (str *ns* "=> " *ns* "=>") out))))

(test/deftest clojure-repl-stderr-no-op-test
  (let [in-cmds [""]
        out (cli-tests/test-cli-stderr clojure.main/repl in-cmds)]
    (test/is (= "" out))))

(test/deftest clojure-repl-stdout-inc-test
  (let [in-cmds ["(inc 1)"]
        out (cli-tests/test-cli-stdout clojure.main/repl in-cmds)]
    (test/is (= (cli-tests/expected-string [(str *ns* "=> 2") (str *ns* "=>")]) out))))

(test/deftest clojure-repl-stdout-def-inc-println-test
  (let [in-cmds ["(def x 21)" "(inc x)" "(println x)"]
        out (cli-tests/test-cli-stdout clojure.main/repl in-cmds)]
    (test/is (= (cli-tests/expected-string [(str *ns*"=> #'" *ns* "/x") (str *ns* "=> 22") (str *ns* "=> 21") "nil" (str *ns* "=>")]) out))))

(test/deftest clojure-repl-stderr-div-zero-test
  (let [in-cmds ["(/ 1 0)"]
        out (cli-tests/test-cli-stderr clojure.main/repl in-cmds)]
    (test/is (.startsWith out "Execution error (ArithmeticException)"))))

(test/deftest clojure-repl-stdout-no-op-no-prompt-test
  (let [in-cmds [""]
        out (cli-tests/test-cli-stdout #(clojure.main/repl :prompt str) in-cmds)]
    (test/is (= "" out))))

(test/deftest clojure-repl-stdout-inc-no-prompt-test
  (let [in-cmds ["(inc 1)"]
        out (cli-tests/test-cli-stdout #(clojure.main/repl :prompt str) in-cmds)]
    (test/is (= "2" out))))

(test/deftest clojure-repl-stdout-def-inc-println-no-prompt-test
  (let [in-cmds ["(def x 21)" "(inc x)" "(println x)"]
        out (cli-tests/test-cli-stdout #(clojure.main/repl :prompt str) in-cmds)]
    (test/is (= (cli-tests/expected-string [(str "#'" *ns* "/x") "22" "21" "nil"]) out))))

(test/deftest clojure-repl-stdout-def-inc-println-no-prompt-string-latch-test
  (let [in-cmds ["(def x 21)" "(inc x)" "(println x)"]
        val-0 (atom nil)
        val-1 (atom nil)
        val-2 (atom nil)
        sl (cli-tests/string-latch [[(str "#'" *ns* "/x") #(reset! val-0 %)]
                                    ["22" #(reset! val-1 %)]
                                    ["21" #(reset! val-2 %)]
                                    "nil"])
        out (cli-tests/test-cli-stdout #(clojure.main/repl :prompt str) in-cmds sl)]
    (test/is (= [(str "#'" *ns* "/x")] @val-0))
    (test/is (= [(str "#'" *ns* "/x") cli/*line-sep* "22"] @val-1))
    (test/is (= [(str "#'" *ns* "/x") cli/*line-sep* "22" cli/*line-sep* "21"] @val-2))
    (test/is (= (cli-tests/expected-string [(str "#'" *ns* "/x") "22" "21" "nil"]) out))))

Fix test.

Fix test.


;; Functions for rendering state to screen
(ns zaffre.terminal
  (:require
   [taoensso.timbre :as log]))

(defprotocol Terminal
  "Methods suffixed with ! indicate a change of state within the terminal. refresh! and destroy! are not transaction-safe and must not be called from within a transaction."
  (args [this] "Returns the option arguments passed to create-terminal.")
  (groups [this] "Returns the groups argument passed to create-terminal.")
  (alter-group-pos! [this group-id pos-fn] "Change the [x y] position of a layer group. `x` and `y` are mesured in pixels from the upper left corner of the screen.")
  (alter-group-font! [this group-id font-fn] "Changes the font for a layer group. `font-fn` is a function that takes one argument: one of :linux :macosx or :windows, and returns a font.")
  (put-chars! [this layer-id characters] "Changes the characters in a layer. `characters` is a sequence where each element is a map and must have these keys: :c - a character or keyword, :x int, column, :y int row, :fg [r g b], :bg [r g b] where r,g,b are ints from 0-255.")
  (replace-chars! [this layer-id characters] "Replaces the characters in a layer. `characters is an array of arrays where each element is a map and must have these keys: :c - character or keyword, :fg [r g b] :bg [r g b] where r,g,b are ints from 0-355.")
  (set-fg! [this layer-id x y fg] "Changes the foreground color of a character in a layer.")
  (set-bg! [this layer-id x y bg] "Changes the background color of a character in a layer.")
  (assoc-shader-param! [this k v] "Changes the value of a uniform variable in the post-processing shader.")
  (pub [this] "Returns a clojure.core.async publication partitioned into these topics: :keypress :mouse-down :mouse-up :click :mouse-leave :mouse-enter :close.")
  (refresh! [this] "Uses group and layer information to draw to the screen.")
  (clear! [this]
          [this layer-id] "Clears all layers or just a specific layer.")
  (set-window-size! [this v] "Changes the terminal to fullscreen mode if v is a value returned by fullscreen-sizes. If false is supplied the terminal will revert to windowed mode.")
  (fullscreen-sizes [this] "Returns a list of fullscreen values.")
  (destroy! [this] "Stops the terminal, and closes the window.")
  (destroyed? [this] "True if destroy! cas been called or the window closed."))

(defmulti do-frame-clear type)

(defmacro time-val
  "Evaluates expr and returns the time it took.  Returns the value of
 [expr millis]."
  [expr]
  `(let [start# (. System (nanoTime))
         ret# ~expr
         dt# (/ (double (- (. System (nanoTime)) start#)) 1000000.0)]
     [ret# dt#]))

(defmacro do-frame
  ([t d & body]
    `(let [terminal# ~t
           sleep-time# ~d]
       (future
         (-> (Thread/currentThread) (.setName (str "render-thread-" sleep-time#)))
         (try
           (loop []
             (when-not (destroyed? terminal#)
               (let [dt# (second
                           (time-val
                             (dosync
							   (do-frame-clear terminal#)
							   ~@body
							   (refresh! terminal#))))
                     pause# (max 0 (- sleep-time# dt#))]
               (when (< 0 pause#)
                 (Thread/sleep pause#))
               (recur))))
           (log/info "finished do-frame loop")
           (catch Throwable th#
             (log/error th# "Error rendering")))))))

;; namespace with only a protocol gets optimized out, causing missing dependencies.
;; add a dummp def to prevent this ns from being optimized away.
#?(:cljs
(def x 1))

;; Functions for rendering state to screen
(ns zaffre.terminal
  (:require
   [taoensso.timbre :as log]))

(defprotocol Terminal
  "Methods suffixed with ! indicate a change of state within the terminal. refresh! and destroy! are not transaction-safe and must not be called from within a transaction."
  (args [this] "Returns the option arguments passed to create-terminal.")
  (groups [this] "Returns the groups argument passed to create-terminal.")
  (alter-group-pos! [this group-id pos-fn] "Change the [x y] position of a layer group. `x` and `y` are mesured in pixels from the upper left corner of the screen.")
  (alter-group-font! [this group-id font-fn] "Changes the font for a layer group. `font-fn` is a function that takes one argument: one of :linux :macosx or :windows, and returns a font.")
  (put-chars! [this layer-id characters] "Changes the characters in a layer. `characters` is a sequence where each element is a map and must have these keys: :c - a character or keyword, :x int, column, :y int row, :fg [r g b], :bg [r g b] where r,g,b are ints from 0-255.")
  (replace-chars! [this layer-id characters] "Replaces the characters in a layer. `characters is an array of arrays where each element is a map and must have these keys: :c - character or keyword, :fg [r g b] :bg [r g b] where r,g,b are ints from 0-255.")
  (set-fg! [this layer-id x y fg] "Changes the foreground color of a character in a layer.")
  (set-bg! [this layer-id x y bg] "Changes the background color of a character in a layer.")
  (assoc-shader-param! [this k v] "Changes the value of a uniform variable in the post-processing shader.")
  (pub [this] "Returns a clojure.core.async publication partitioned into these topics: :keypress :mouse-down :mouse-up :click :mouse-leave :mouse-enter :close.")
  (refresh! [this] "Uses group and layer information to draw to the screen.")
  (clear! [this]
          [this layer-id] "Clears all layers or just a specific layer.")
  (set-window-size! [this v] "Changes the terminal to fullscreen mode if v is a value returned by fullscreen-sizes. If false is supplied the terminal will revert to windowed mode.")
  (fullscreen-sizes [this] "Returns a list of fullscreen values.")
  (destroy! [this] "Stops the terminal, and closes the window.")
  (destroyed? [this] "True if destroy! cas been called or the window closed."))

(defmulti do-frame-clear type)

(defmacro time-val
  "Evaluates expr and returns the time it took.  Returns the value of
 [expr millis]."
  [expr]
  `(let [start# (. System (nanoTime))
         ret# ~expr
         dt# (/ (double (- (. System (nanoTime)) start#)) 1000000.0)]
     [ret# dt#]))

(defmacro do-frame
  ([t d & body]
    `(let [terminal# ~t
           sleep-time# ~d]
       (future
         (-> (Thread/currentThread) (.setName (str "render-thread-" sleep-time#)))
         (try
           (loop []
             (when-not (destroyed? terminal#)
               (let [dt# (second
                           (time-val
                             (dosync
							   (do-frame-clear terminal#)
							   ~@body
							   (refresh! terminal#))))
                     pause# (max 0 (- sleep-time# dt#))]
               (when (< 0 pause#)
                 (Thread/sleep pause#))
               (recur))))
           (log/info "finished do-frame loop")
           (catch Throwable th#
             (log/error th# "Error rendering")))))))

;; namespace with only a protocol gets optimized out, causing missing dependencies.
;; add a dummp def to prevent this ns from being optimized away.
#?(:cljs
(def x 1))

Fix typo

Fix typo


(ns nightmod.sandbox
  (:require [clojail.core :as jail]
            [clojail.jvm :as jvm]
            [clojail.testers :as jail-test]
            [clojure.java.io :as io]
            [nightmod.utils :as u]))

(def tester
  [(jail-test/blacklist-objects
     [clojure.lang.Compiler clojure.lang.Ref clojure.lang.Reflector
      clojure.lang.Namespace clojure.lang.RT
      java.io.ObjectInputStream])
   (jail-test/blacklist-packages
     ["java.lang.reflect"
      "java.security"
      "java.util.concurrent"
      "java.awt"])
   (jail-test/blacklist-symbols
    '#{alter-var-root eval catch
       load-string load-reader addMethod ns-resolve resolve find-var
       *read-eval* ns-publics ns-unmap set! ns-map ns-interns the-ns
       push-thread-bindings pop-thread-bindings future-call agent send
       send-off pmap pcalls pvals in-ns System/out System/in System/err
       with-redefs-fn Class/forName
       set-screen! setScreen app! postRunnable})
   (jail-test/blacklist-nses '[clojure.main])
   (jail-test/blanket "clojail")])

(def context (-> (doto (jvm/permissions)
                   (.add (java.io.FilePermission. "<<ALL FILES>>" "read")))
                 jvm/domain
                 jvm/context))

(def sb (jail/sandbox tester
                      :context context
                      :timeout 5000
                      :namespace 'nightmod.game
                      :init '(require '[nightmod.public :refer :all]
                                      '[play-clj.core :refer :all]
                                      '[play-clj.g2d :refer :all]
                                      '[play-clj.g2d-physics :refer :all]
                                      '[play-clj.g3d :refer :all]
                                      '[play-clj.math :refer :all]
                                      '[play-clj.ui :refer :all]
                                      '[play-clj.utils :refer :all])))

(defn set-policy!
  []
  (System/setProperty "java.security.policy"
                      (-> "java.policy" io/resource .toString)))

(defn run-file!
  [path]
  (reset! u/error nil)
  (-> (format "(do %s\n)" (slurp path))
      jail/safe-read
      sb
      (try (catch Exception e (reset! u/error e)))))

(ns nightmod.sandbox
  (:require [clojail.core :as jail]
            [clojail.jvm :as jvm]
            [clojail.testers :as jail-test]
            [clojure.java.io :as io]
            [nightmod.utils :as u]))

(def tester
  [(jail-test/blacklist-objects
     [clojure.lang.Compiler clojure.lang.Namespace
      clojure.lang.Ref clojure.lang.Reflector clojure.lang.RT
      java.io.ObjectInputStream java.lang.Thread])
   (jail-test/blacklist-packages
     ["java.lang.reflect"
      "java.security"
      "java.util.concurrent"
      "java.awt"])
   (jail-test/blacklist-symbols
    '#{alter-var-root resolve find-var with-redefs-fn
       *read-eval* set! eval catch
       addMethod forName
       load load-file load-string load-reader
       ns-resolve ns-publics ns-unmap ns-map ns-interns the-ns in-ns
       push-thread-bindings pop-thread-bindings future future-call
       agent send send-off
       pmap pvalues pcalls
       System/out System/in System/err
       set-screen! setScreen app! app})
   (jail-test/blacklist-nses '[clojure.main])
   (jail-test/blanket "clojail")])

(def context (-> (doto (jvm/permissions)
                   (.add (java.io.FilePermission. "<<ALL FILES>>" "read")))
                 jvm/domain
                 jvm/context))

(def sb (jail/sandbox tester
                      :context context
                      :timeout 5000
                      :namespace 'nightmod.game
                      :init '(require '[nightmod.public :refer :all]
                                      '[play-clj.core :refer :all]
                                      '[play-clj.g2d :refer :all]
                                      '[play-clj.g2d-physics :refer :all]
                                      '[play-clj.g3d :refer :all]
                                      '[play-clj.math :refer :all]
                                      '[play-clj.ui :refer :all]
                                      '[play-clj.utils :refer :all])))

(defn set-policy!
  []
  (System/setProperty "java.security.policy"
                      (-> "java.policy" io/resource .toString)))

(defn run-file!
  [path]
  (reset! u/error nil)
  (-> (format "(do %s\n)" (slurp path))
      jail/safe-read
      sb
      (try (catch Exception e (reset! u/error e)))))

Add to and rearrange sandbox values

Add to and rearrange sandbox values


(ns mars-ogler.views
  (:require [clj-time.core :as time]
            [clj-time.coerce :as cvt-time]
            [clojure.string :as str]
            [mars-ogler.scrape :as scrape]
            [mars-ogler.times :as times])
  (:use [hiccup core page]))

(defn pic->hiccup
  [{:keys [cam cam-name id lag released size sol taken-marstime taken-utc
           thumbnail-url type url w h]}]
  [:div.pic-wrapper
   [:div.pic
    [:a {:href url} [:img {:src thumbnail-url}]]]
   [:div.pic-info
    [:div.title-line
     cam-name [:span.at " at "] [:span.marstime taken-marstime] " on Sol " sol]
    "Earth Date:  " [:span.takendate taken-utc] [:br]
    "Released " lag " later at " [:span.releasedate released] [:br]
    w [:span.x " x "] h " pixels | Type " type " | ID: " id]])

(defn pics
  [{:keys [cams page per-page sorting thumbs]
    :or {cams "mahli mastcam navcam"
         page "1"
         per-page "25"
         sorting "released"
         thumbs "no"}}]
  (let [page (Integer/parseInt page)
        per-page (min (Integer/parseInt per-page) 100)
        sorting (keyword sorting)
        cams (->> (str/split cams #" ") (map keyword) set)
        cam-pred (fn [img] (-> img :cam cams))
        size-pred (case thumbs
                    "no" #(not= (:size %) :thumbnail)
                    "yes" (constantly true)
                    "only" #(= (:size %) :thumbnail))]
    (->> (filter (every-pred size-pred cam-pred)
                 (get @scrape/sorted-images sorting ()))
      (drop (* (dec page) per-page))
      (take per-page)
      (map pic->hiccup))))

(defn index
  [filter-params]
  (html5
    [:head
     [:title "The Mars Ogler"]
     (include-css "/css/main.css")
     (include-css "http://fonts.googleapis.com/css?family=Oswald:400,700,300")
     (include-css "http://fonts.googleapis.com/css?family=Source+Sans+Pro:400,700")]
    [:body
     [:div#content
      [:h1 "The Mars Ogler"]
      [:div#blurb
       "A Curiosity Mars Science Laboratory raw images viewer."
       [:br]
       "Built on top of "
       [:a {:href "http://curiositymsl.com/"} "Curiosity MSL Viewer"]
       " and "
       [:a {:href "http://mars.jpl.nasa.gov/"} "NASA JPL Mars Exploration"]
       "."
       ]
      [:div#toolbar
       "Eventually there will be some tools here"]
      [:div#pics (pics filter-params)]
      ]]))

(ns mars-ogler.views
  (:require [clj-time.core :as time]
            [clj-time.coerce :as cvt-time]
            [clojure.string :as str]
            [mars-ogler.scrape :as scrape]
            [mars-ogler.times :as times])
  (:use [hiccup core page]))

(defn pic->hiccup
  [{:keys [cam cam-name id lag released size sol taken-marstime taken-utc
           thumbnail-url type url w h]}]
  [:div.pic-wrapper
   [:div.pic
    [:a {:href url} [:img {:src thumbnail-url}]]]
   [:div.pic-info
    [:div.title-line
     cam-name [:span.at " at "] [:span.marstime taken-marstime] " on Sol " sol]
    "Earth Date:  " [:span.takendate taken-utc] [:br]
    "Released " lag " later at " [:span.releasedate released] [:br]
    w [:span.x " x "] h " " type " | ID: " id]])

(defn pics
  [{:keys [cams page per-page sorting thumbs]
    :or {cams "mahli mastcam navcam"
         page "1"
         per-page "25"
         sorting "released"
         thumbs "no"}}]
  (let [page (Integer/parseInt page)
        per-page (min (Integer/parseInt per-page) 100)
        sorting (keyword sorting)
        cams (->> (str/split cams #" ") (map keyword) set)
        cam-pred (fn [img] (-> img :cam cams))
        size-pred (case thumbs
                    "no" #(not= (:size %) :thumbnail)
                    "yes" (constantly true)
                    "only" #(= (:size %) :thumbnail))]
    (->> (filter (every-pred size-pred cam-pred)
                 (get @scrape/sorted-images sorting ()))
      (drop (* (dec page) per-page))
      (take per-page)
      (map pic->hiccup))))

(defn index
  [filter-params]
  (html5
    [:head
     [:title "The Mars Ogler"]
     (include-css "/css/main.css")
     (include-css "http://fonts.googleapis.com/css?family=Oswald:400,700,300")
     (include-css "http://fonts.googleapis.com/css?family=Source+Sans+Pro:400,700")]
    [:body
     [:div#content
      [:h1 "The Mars Ogler"]
      [:div#blurb
       "A Curiosity Mars Science Laboratory raw images viewer."
       [:br]
       "Built on top of "
       [:a {:href "http://curiositymsl.com/"} "Curiosity MSL Viewer"]
       " and "
       [:a {:href "http://mars.jpl.nasa.gov/"} "NASA JPL Mars Exploration"]
       "."
       ]
      [:div#toolbar
       "Eventually there will be some tools here"]
      [:div#pics (pics filter-params)]
      ]]))

Adjust for formatted types in view

Adjust for formatted types in view


(ns nightmod.screens
  (:require [clojure.edn :as edn]
            [clojure.java.io :as io]
            [nightmod.utils :as u]
            [play-clj.core :refer :all]
            [play-clj.ui :refer :all]))

(declare nightmod main-screen blank-screen overlay-screen)

(def ^:const templates ["arcade" "platformer"
                        "orthogonal-rpg" "isometric-rpg"
                        "barebones-2d" "barebones-3d"])

(defn read-title
  [f]
  [(.getCanonicalPath f)
   (or (-> (io/file f u/properties-file)
            slurp
            edn/read-string
            :title
            (try (catch Exception _)))
       (-> (.getName f)
           Long/parseLong
           u/format-date
           (try (catch Exception _)))
       "Invalid")])

(defn load-project!
  [path]
  (reset! u/project-dir path))

(defn new-project!
  [template]
  (load-project! (u/new-project! template)))

(defscreen main-screen
  :on-show
  (fn [screen entities]
    (update! screen :renderer (stage) :camera (orthographic))
    (when-not @u/main-dir
      (reset! u/main-dir (u/get-data-dir)))
    (let [ui-skin (skin "uiskin.json")
          create-button (fn [[k v]]
                          (text-button v ui-skin :set-name k))
          template-names ["Arcade" "Platformer"
                          "Orthogonal RPG" "Isometric RPG"
                          "Barebones 2D" "Barebones 3D"]
          new-games (->> (for [i (range (count templates))]
                           [(nth templates i)
                            (nth template-names i)])
                         (map create-button))
          saved-games (->> (io/file @u/main-dir)
                           .listFiles
                           (filter #(.isDirectory %))
                           (map read-title)
                           (map create-button))]
      (-> (cons (label "New Game:" ui-skin) new-games)
          (concat (when (seq saved-games)
                    (cons (label "Load Game:" ui-skin) saved-games)))
          (vertical :pack)
          (scroll-pane (style :scroll-pane nil nil nil nil nil))
          vector
          (table :align (align :center) :set-fill-parent true))))
  :on-render
  (fn [screen entities]
    (clear!)
    (render! screen entities))
  :on-resize
  (fn [screen entities]
    (height! screen (:height screen)))
  :on-ui-changed
  (fn [screen entities]
    (when-let [n (text-button! (:actor screen) :get-name)]
      (if (contains? (set templates) n)
        (new-project! n)
        (load-project! n)))
    nil))

(defscreen blank-screen
  :on-render
  (fn [screen entities]
    (clear!)))

(defscreen overlay-screen
  :on-show
  (fn [screen entities]
    (update! screen :camera (orthographic) :renderer (stage))
    (let [ui-skin (skin "uiskin.json")]
      [(-> [(text-button "Home" ui-skin :set-name "home")
            (text-button "Restart" ui-skin :set-name "restart")
            (text-button "Files" ui-skin :set-name "files")]
           (vertical :pack)
           (assoc :id :menu :x 5))
       (-> (label "" ui-skin :set-wrap true)
           (assoc :id :error :x 5 :y 5))]))
  :on-render
  (fn [screen entities]
    (->> (for [e entities]
           (case (:id e)
             :error (doto e
                      (label! :set-text (or (some-> @u/error .toString) ""))
                      (label! :pack))
             e))
         (render! screen)))
  :on-resize
  (fn [screen entities]
    (height! screen (:height screen))
    (for [e entities]
      (case (:id e)
        :menu (assoc e :y (- (:height screen) (vertical! e :get-height)))
        :error (assoc e :width (:width screen))
        e)))
  :on-ui-changed
  (fn [screen entities]
    (case (text-button! (:actor screen) :get-name)
      "home" (do (u/toggle-glass! false)
               (set-screen! nightmod main-screen))
      "restart" (reset! u/project-dir @u/project-dir)
      "files" (u/toggle-glass!)
      nil)
    nil))

(defgame nightmod
  :on-create
  (fn [this]
    (set-screen! this main-screen)))

(add-watch u/error
           :show-error
           (fn [_ _ _ e]
             (when e
               (->> (set-screen! nightmod blank-screen overlay-screen)
                    (fn [])
                    (app! :post-runnable)))))

(ns nightmod.screens
  (:require [clojure.edn :as edn]
            [clojure.java.io :as io]
            [nightmod.utils :as u]
            [play-clj.core :refer :all]
            [play-clj.ui :refer :all]))

(declare nightmod main-screen blank-screen overlay-screen)

(def ^:const border-space 5)
(def ^:const templates ["arcade" "platformer"
                        "orthogonal-rpg" "isometric-rpg"
                        "barebones-2d" "barebones-3d"])

(defn read-title
  [f]
  [(.getCanonicalPath f)
   (or (-> (io/file f u/properties-file)
            slurp
            edn/read-string
            :title
            (try (catch Exception _)))
       (-> (.getName f)
           Long/parseLong
           u/format-date
           (try (catch Exception _)))
       "Invalid")])

(defn load-project!
  [path]
  (reset! u/project-dir path))

(defn new-project!
  [template]
  (load-project! (u/new-project! template)))

(defscreen main-screen
  :on-show
  (fn [screen entities]
    (update! screen :renderer (stage) :camera (orthographic))
    (when-not @u/main-dir
      (reset! u/main-dir (u/get-data-dir)))
    (let [ui-skin (skin "uiskin.json")
          create-button (fn [[k v]]
                          (text-button v ui-skin :set-name k))
          template-names ["Arcade" "Platformer"
                          "Orthogonal RPG" "Isometric RPG"
                          "Barebones 2D" "Barebones 3D"]
          new-games (->> (for [i (range (count templates))]
                           [(nth templates i)
                            (nth template-names i)])
                         (map create-button))
          saved-games (->> (io/file @u/main-dir)
                           .listFiles
                           (filter #(.isDirectory %))
                           (map read-title)
                           (map create-button))]
      (-> (cons (label "New Game:" ui-skin) new-games)
          (concat (when (seq saved-games)
                    (cons (label "Load Game:" ui-skin) saved-games)))
          (vertical :pack)
          (scroll-pane (style :scroll-pane nil nil nil nil nil))
          vector
          (table :align (align :center) :set-fill-parent true))))
  :on-render
  (fn [screen entities]
    (clear!)
    (render! screen entities))
  :on-resize
  (fn [screen entities]
    (height! screen (:height screen)))
  :on-ui-changed
  (fn [screen entities]
    (when-let [n (text-button! (:actor screen) :get-name)]
      (if (contains? (set templates) n)
        (new-project! n)
        (load-project! n)))
    nil))

(defscreen blank-screen
  :on-render
  (fn [screen entities]
    (clear!)))

(defscreen overlay-screen
  :on-show
  (fn [screen entities]
    (update! screen :camera (orthographic) :renderer (stage))
    (let [ui-skin (skin "uiskin.json")]
      [(-> (label "" ui-skin
                  :set-wrap true
                  :set-alignment (bit-or (align :left) (align :bottom)))
           (scroll-pane (style :scroll-pane nil nil nil nil nil))
           (assoc :id :error :x border-space :y border-space))
       (-> [(text-button "Home" ui-skin :set-name "home")
            (text-button "Restart" ui-skin :set-name "restart")
            (text-button "Files" ui-skin :set-name "files")]
           (vertical :pack)
           (assoc :id :menu :x border-space))]))
  :on-render
  (fn [screen entities]
    (->> (for [e entities]
           (case (:id e)
             :error (let [l (-> e (scroll-pane! :get-children) first)]
                      (label! l :set-text (or (some-> @u/error .toString) ""))
                      e)
             e))
         (render! screen)))
  :on-resize
  (fn [{:keys [width height] :as screen} entities]
    (height! screen height)
    (for [e entities]
      (case (:id e)
        :menu (assoc e :y (- height
                             (vertical! e :get-height)
                             border-space))
        :error (assoc e :width width :height height)
        e)))
  :on-ui-changed
  (fn [screen entities]
    (case (text-button! (:actor screen) :get-name)
      "home" (do (u/toggle-glass! false)
               (set-screen! nightmod main-screen))
      "restart" (reset! u/project-dir @u/project-dir)
      "files" (u/toggle-glass!)
      nil)
    nil))

(defgame nightmod
  :on-create
  (fn [this]
    (set-screen! this main-screen)))

(add-watch u/error
           :show-error
           (fn [_ _ _ e]
             (when e
               (->> (set-screen! nightmod blank-screen overlay-screen)
                    (fn [])
                    (app! :post-runnable)))))

Put error label in a scroll pane

Put error label in a scroll pane


(ns akvo.lumen.lib.visualisation.maps
  (:require [akvo.lumen.lib :as lib]
            [akvo.lumen.postgres.filter :as filter]
            [akvo.lumen.lib.visualisation.map-config :as map-config]
            [akvo.lumen.lib.visualisation.map-metadata :as map-metadata]
            [akvo.lumen.lib.transformation.engine :as engine]
            [akvo.lumen.util :as util]
            [cheshire.core :as json]
            [clj-http.client :as client]
            [clojure.core.match :refer [match]]
            [clojure.walk :as walk]
            [hugsql.core :as hugsql])
  (:import [com.zaxxer.hikari HikariDataSource]
           [java.net URI]))

(hugsql/def-db-fns "akvo/lumen/lib/dataset.sql")
(hugsql/def-db-fns "akvo/lumen/lib/raster.sql")

(defn- headers [tenant-conn]
  (let [db-uri (-> ^HikariDataSource (:datasource tenant-conn)
                   .getJdbcUrl
                   (subs 5)
                   URI.)
        {:keys [password user]} (util/query-map (.getQuery db-uri))
        port (let [p (.getPort db-uri)]
               (if (pos? p) p 5432))
        db-name (subs (.getPath db-uri) 1)]
    {"x-db-host" (.getHost db-uri)
     "x-db-last-update" (quot (System/currentTimeMillis) 1000)
     "x-db-password" password
     "x-db-port" port
     "X-db-name" db-name
     "x-db-user" user}))

(defn- check-columns
  "Make sure supplied columns are distinct and satisfy predicate."
  [p & columns]
  (and (= (count columns)
          (count (into #{} columns)))
       (every? p columns)))

(defn valid-location?
  "Validate map spec layer."
  [layer p]
  (let [m (into {} (remove (comp nil? val)
                           (select-keys layer [:geom :latitude :longitude])))]
    (match [m]
           [({:geom geom} :only [:geom])] (p geom)

           [({:geom geom :latitude latitude} :only [:geom :latitude])]
           (check-columns p geom latitude)

           [({:geom geom :longitude longitude} :only [:geom :longitude])]
           (check-columns p geom longitude)

           [({:latitude latitude :longitude longitude}
             :only [:latitude :longitude])]
           (check-columns p latitude longitude)

           [{:geom geom :latitude latitude :longitude longitude}]
           (check-columns p geom latitude longitude)

           :else false)))

(defn conform-create-args [layers]
  (let [dataset-id (->> layers
                        (filter (fn[layer] (util/valid-dataset-id? (:datasetId layer))))
                        first
                        :datasetId)
        raster-id (->> layers
                       (filter (fn[layer] (util/valid-dataset-id? (:rasterId layer))))
                       first
                       :rasterId)]
    (cond
      (and (not dataset-id) (not raster-id))
      (throw (ex-info "No valid datasetID"
                      {"reason" "No valid datasetID"}))

      (some (fn [layer] (not (valid-location? layer util/valid-column-name?)))
            (filter (fn [layer] (not (= (:layerType layer) "raster"))) layers))
      (throw (ex-info "Location spec not valid"
                      {"reason" "Location spec not valid"}))

      :else [(if (not dataset-id) raster-id dataset-id)])))

(defn do-create [tenant-conn windshaft-url layers]
  (let [metadata-array (map (fn [current-layer]
                              (let [current-layer-type (:layerType current-layer)
                                    current-dataset-id (if (= current-layer-type "raster")
                                                         (:rasterId current-layer)
                                                         (:datasetId current-layer))
                                    {:keys [table-name columns raster_table]} (if (= current-layer-type "raster")
                                                                                (raster-by-id tenant-conn {:id current-dataset-id})
                                                                                (dataset-by-id tenant-conn {:id current-dataset-id}))
                                    current-where-clause (filter/sql-str (walk/keywordize-keys columns) (:filters current-layer))]
                                (map-metadata/build tenant-conn (or raster_table table-name) current-layer current-where-clause)))
                            layers)
        headers (headers tenant-conn)
        url (format "%s/layergroup" windshaft-url)
        map-config (map-config/build tenant-conn "todo: remove this" layers metadata-array)
        layer-group-id (-> (client/post url {:body (json/encode map-config)
                                             :headers headers
                                             :content-type :json})
                           :body json/decode (get "layergroupid"))]
    (lib/ok {:layerGroupId layer-group-id
             :layerMetadata metadata-array})))

(defn create-raster [tenant-conn windshaft-url raster-id]
  (let [{:keys [raster_table metadata]} (raster-by-id tenant-conn {:id raster-id})
        headers (headers tenant-conn)
        url (format "%s/layergroup" windshaft-url)
        map-config (map-config/build-raster raster_table (:min metadata) (:max metadata))
        layer-group-id (-> (client/post url {:body (json/encode map-config)
                                             :headers headers
                                             :content-type :json})
                           :body json/decode (get "layergroupid"))
        layer-meta (map-metadata/build tenant-conn raster_table {:layerType "raster"} nil)]
    (lib/ok {:layerGroupId layer-group-id
             :layerMetadata layer-meta})))

(defn create
  [tenant-conn windshaft-url layers]
  (try
    (conform-create-args layers)
    (do-create tenant-conn windshaft-url layers)
    (catch Exception e
      (println e)
      (lib/bad-request (ex-data e)))))

(ns akvo.lumen.lib.visualisation.maps
  (:require [akvo.lumen.lib :as lib]
            [akvo.lumen.postgres.filter :as filter]
            [akvo.lumen.lib.visualisation.map-config :as map-config]
            [akvo.lumen.lib.visualisation.map-metadata :as map-metadata]
            [akvo.lumen.lib.transformation.engine :as engine]
            [clojure.tools.logging :as log]
            [akvo.lumen.util :as util]
            [cheshire.core :as json]
            [clj-http.client :as client]
            [clojure.core.match :refer [match]]
            [clojure.walk :as walk]
            [hugsql.core :as hugsql])
  (:import [com.zaxxer.hikari HikariDataSource]
           [java.net URI]))

(hugsql/def-db-fns "akvo/lumen/lib/dataset.sql")
(hugsql/def-db-fns "akvo/lumen/lib/raster.sql")

(defn- headers [tenant-conn]
  (let [db-uri (-> ^HikariDataSource (:datasource tenant-conn)
                   .getJdbcUrl
                   (subs 5)
                   URI.)
        {:keys [password user]} (util/query-map (.getQuery db-uri))
        port (let [p (.getPort db-uri)]
               (if (pos? p) p 5432))
        db-name (subs (.getPath db-uri) 1)]
    {"x-db-host" (.getHost db-uri)
     "x-db-last-update" (quot (System/currentTimeMillis) 1000)
     "x-db-password" password
     "x-db-port" port
     "X-db-name" db-name
     "x-db-user" user}))

(defn- check-columns
  "Make sure supplied columns are distinct and satisfy predicate."
  [p & columns]
  (and (= (count columns)
          (count (into #{} columns)))
       (every? p columns)))

(defn valid-location?
  "Validate map spec layer."
  [layer p]
  (let [m (into {} (remove (comp nil? val)
                           (select-keys layer [:geom :latitude :longitude])))]
    (match [m]
           [({:geom geom} :only [:geom])] (p geom)

           [({:geom geom :latitude latitude} :only [:geom :latitude])]
           (check-columns p geom latitude)

           [({:geom geom :longitude longitude} :only [:geom :longitude])]
           (check-columns p geom longitude)

           [({:latitude latitude :longitude longitude}
             :only [:latitude :longitude])]
           (check-columns p latitude longitude)

           [{:geom geom :latitude latitude :longitude longitude}]
           (check-columns p geom latitude longitude)

           :else false)))

(defn conform-create-args [layers]
  (let [dataset-id (->> layers
                        (filter (fn[layer] (util/valid-dataset-id? (:datasetId layer))))
                        first
                        :datasetId)
        raster-id (->> layers
                       (filter (fn[layer] (util/valid-dataset-id? (:rasterId layer))))
                       first
                       :rasterId)]
    (cond
      (and (not dataset-id) (not raster-id))
      (throw (ex-info "No valid datasetID"
                      {"reason" "No valid datasetID"}))

      (some (fn [layer] (not (valid-location? layer util/valid-column-name?)))
            (filter (fn [layer] (not (= (:layerType layer) "raster"))) layers))
      (throw (ex-info "Location spec not valid"
                      {"reason" "Location spec not valid"}))

      :else [(if (not dataset-id) raster-id dataset-id)])))

(defn do-create [tenant-conn windshaft-url layers]
  (let [metadata-array (map (fn [current-layer]
                              (let [current-layer-type (:layerType current-layer)
                                    current-dataset-id (if (= current-layer-type "raster")
                                                         (:rasterId current-layer)
                                                         (:datasetId current-layer))
                                    {:keys [table-name columns raster_table]} (if (= current-layer-type "raster")
                                                                                (raster-by-id tenant-conn {:id current-dataset-id})
                                                                                (dataset-by-id tenant-conn {:id current-dataset-id}))
                                    current-where-clause (filter/sql-str (walk/keywordize-keys columns) (:filters current-layer))]
                                (map-metadata/build tenant-conn (or raster_table table-name) current-layer current-where-clause)))
                            layers)
        headers (headers tenant-conn)
        url (format "%s/layergroup" windshaft-url)
        map-config (map-config/build tenant-conn "todo: remove this" layers metadata-array)
        layer-group-id (-> (client/post url {:body (json/encode map-config)
                                             :headers headers
                                             :content-type :json})
                           :body json/decode (get "layergroupid"))]
    (lib/ok {:layerGroupId layer-group-id
             :layerMetadata metadata-array})))

(defn create-raster [tenant-conn windshaft-url raster-id]
  (let [{:keys [raster_table metadata]} (raster-by-id tenant-conn {:id raster-id})
        headers* (headers tenant-conn)
        url (format "%s/layergroup" windshaft-url)
        map-config (map-config/build-raster raster_table (:min metadata) (:max metadata))
          _ (log/warn :map-config map-config)
          _ (log/warn :headers headers)
        layer-group-id (-> (client/post url {:body (json/encode map-config)
                                             :headers headers*
                                             :content-type :json})
                           :body json/decode (get "layergroupid"))
        layer-meta (map-metadata/build tenant-conn raster_table {:layerType "raster"} nil)]
    (lib/ok {:layerGroupId layer-group-id
             :layerMetadata layer-meta})))

(defn create
  [tenant-conn windshaft-url layers]
  (try
    (conform-create-args layers)
    (do-create tenant-conn windshaft-url layers)
    (catch Exception e
      (println e)
      (lib/bad-request (ex-data e)))))

Add logs

[#2097] Add logs


(ns akvo.lumen.specs.visualisation.maps.layer
  (:require [akvo.lumen.specs :as lumen.s]
            [akvo.lumen.specs.db.dataset-version :as db.dataset-version.s]
            [akvo.lumen.specs.db.dataset-version.column :as db.dsv.column.s]
            [clojure.spec.alpha :as s]
            [clojure.string :as str])
  (:import [java.awt Color]))

(create-ns  'akvo.lumen.specs.visualisation.maps.layer.legend)

(alias 'layer.legend.s 'akvo.lumen.specs.visualisation.maps.layer.legend)

(s/def ::layer.legend.s/title (s/nilable string?))
(s/def ::layer.legend.s/visible boolean?)

(s/def ::legend (s/keys :req-un [::layer.legend.s/title ::layer.legend.s/visible]))

(s/def ::layerType #{"geo-location" "geo-shape" "raster"})

(s/def ::aggregationMethod #{"avg"})

(create-ns  'akvo.lumen.specs.visualisation.maps.layer.popup)

(alias 'layer.popup.s 'akvo.lumen.specs.visualisation.maps.layer.popup)

(s/def ::layer.popup.s/column ::db.dsv.column.s/columnName)
(s/def ::popup-item (s/keys :req-un [::layer.popup.s/column]))
(s/def ::popup (s/coll-of ::popup-item :kind vector? :distinct true))

(defn string-pos-int? [s] (try (pos-int? (Integer/parseInt s))
                          (catch Exception e false)))

(s/def ::pointSize  string-pos-int?)

(create-ns  'akvo.lumen.specs.visualisation.maps.layer.point-color-mapping)

(alias 'layer.point-color-mapping.s 'akvo.lumen.specs.visualisation.maps.layer.point-color-mapping)
(s/def ::layer.point-color-mapping.s/op #{"equals"})
(s/def ::layer.point-color-mapping.s/value double?)

(defn valid-hex? [s] (try
                       (Color/decode s)
                       true
                       (catch Exception e false)))

(s/def ::layer.point-color-mapping.s/color valid-hex?)
(s/def ::point-color-mapping-item (s/keys :req-un [::layer.point-color-mapping.s/op
                                                   ::layer.point-color-mapping.s/value
                                                   ::layer.point-color-mapping.s/color]))
(s/def ::pointColorMapping (s/coll-of ::point-color-mapping-item :kind vector?))

(s/def ::pointColorColumn ::db.dsv.column.s/columnName)

(s/def ::datasetId ::db.dataset-version.s/dataset-id)

(s/def ::rasterId (s/nilable (s/with-gen
                     lumen.s/str-uuid?
                     lumen.s/str-uuid-gen))) ;; todo recheck
(s/def ::longitude (s/nilable string?)) ;; todo
(s/def ::latitude (s/nilable string?)) ;; todo
(s/def ::title string?)
(s/def ::geom string?) ;; todo derivation columnName
(s/def ::visible boolean?)

[{:aggregationMethod "avg",
  :popup [],
  :filters [],
  :layerType "geo-location",

  :legend {:title nil, :visible true},

  :rasterId nil,
  :pointSize 3,
  :pointColorMapping [],
  :longitude nil,
  :datasetId "5c5bfbea-6a60-409f-9fcf-11c87a5f7da3",
  :title "Untitled layer 1",
  :geom "d1",
  :pointColorColumn nil,
  :latitude nil,
  :visible true}]

(ns akvo.lumen.specs.visualisation.maps.layer
  (:require [akvo.lumen.specs :as lumen.s]
            [akvo.lumen.specs.db.dataset-version :as db.dataset-version.s]
            [akvo.lumen.specs.db.dataset-version.column :as db.dsv.column.s]
            [clojure.spec.alpha :as s]
            [clojure.string :as str])
  (:import [java.awt Color]))

(create-ns  'akvo.lumen.specs.visualisation.maps.layer.legend)

(alias 'layer.legend.s 'akvo.lumen.specs.visualisation.maps.layer.legend)

(s/def ::layer.legend.s/title (s/nilable string?))
(s/def ::layer.legend.s/visible boolean?)

(s/def ::legend (s/keys :req-un [::layer.legend.s/title ::layer.legend.s/visible]))

(s/def ::layerType #{"geo-location" "geo-shape" "raster"})

(s/def ::aggregationMethod #{"avg"})

(create-ns  'akvo.lumen.specs.visualisation.maps.layer.popup)

(alias 'layer.popup.s 'akvo.lumen.specs.visualisation.maps.layer.popup)

(s/def ::layer.popup.s/column ::db.dsv.column.s/columnName)
(s/def ::popup-item (s/keys :req-un [::layer.popup.s/column]))
(s/def ::popup (s/coll-of ::popup-item :kind vector? :distinct true))

(defn string-pos-int? [s] (try (pos-int? (Integer/parseInt s))
                          (catch Exception e false)))

(s/def ::pointSize  string-pos-int?)

(create-ns  'akvo.lumen.specs.visualisation.maps.layer.point-color-mapping)

(alias 'layer.point-color-mapping.s 'akvo.lumen.specs.visualisation.maps.layer.point-color-mapping)
(s/def ::layer.point-color-mapping.s/op #{"equals"})
(s/def ::layer.point-color-mapping.s/value double?)

(defn valid-hex? [s] (try
                       (Color/decode s)
                       (catch Exception e false)))

(s/def ::layer.point-color-mapping.s/color valid-hex?)

(s/def ::point-color-mapping-item (s/keys :req-un [::layer.point-color-mapping.s/op
                                                   ::layer.point-color-mapping.s/value
                                                   ::layer.point-color-mapping.s/color]))
(s/def ::pointColorMapping (s/coll-of ::point-color-mapping-item :kind vector?))

(s/def ::pointColorColumn ::db.dsv.column.s/columnName)

(s/def ::datasetId ::db.dataset-version.s/dataset-id)

(s/def ::rasterId (s/nilable (s/with-gen
                     lumen.s/str-uuid?
                     lumen.s/str-uuid-gen))) ;; todo recheck
(s/def ::longitude (s/nilable string?)) ;; todo
(s/def ::latitude (s/nilable string?)) ;; todo
(s/def ::title string?)
(s/def ::geom string?) ;; todo derivation columnName
(s/def ::visible boolean?)

[{:aggregationMethod "avg",
  :popup [],
  :filters [],
  :layerType "geo-location",

  :legend {:title nil, :visible true},

  :rasterId nil,
  :pointSize 3,
  :pointColorMapping [],
  :longitude nil,
  :datasetId "5c5bfbea-6a60-409f-9fcf-11c87a5f7da3",
  :title "Untitled layer 1",
  :geom "d1",
  :pointColorColumn nil,
  :latitude nil,
  :visible true}]

Fix lint error

Fix lint error


(ns metabase.test-utils
  (:require [clojure.java.io :as io]
            [clojure.tools.logging :as log]
            [expectations :refer :all]
            [ring.adapter.jetty :as ring]
            (metabase [core :as core]
                      [db :refer :all]
                      [test-data :refer :all])))

(declare set-test-logging-level
         setup-test-db
         start-jetty)

;; # SETTINGS

;; Don't run unit tests whenever JVM shuts down
;; it's pretty annoying to have our DB reset all the time
(expectations/disable-run-on-shutdown)

;; # FUNCTIONS THAT GET RUN ON TEST SUITE START / STOP

(defn test-setup
  {:expectations-options :before-run}
  []
  (set-test-logging-level)
  (setup-test-db)
  (start-jetty))

;; ## Logging Setup

(defn set-test-logging-level
  "Disable debug logging since it clutters up our output."
  []
  (.setLevel (org.apache.log4j.Logger/getLogger "metabase") org.apache.log4j.Level/INFO))

;; ## DB Setup
;; WARNING: BY RUNNING ANY UNIT TESTS THAT REQUIRE THIS FILE OR BY RUNNING YOUR ENTIRE TEST SUITE YOU WILL EFFECTIVELY BE WIPING OUT YOUR DATABASE.
;; SETUP-DB DELETES YOUR DATABASE FILE, AND GETS RAN AUTOMATICALLY BY EXPECTATIONS. USE AT YOUR OWN RISK!

(defn setup-test-db
  "Setup database schema."
  []
  (let [filename (-> (re-find #"file:(\w+\.db).*" (db-file)) second)] ; db-file is prefixed with "file:", so we strip that off
    (map (fn [file-extension]                                         ; delete the database files, e.g. `metabase.db.h2.db`, `metabase.db.trace.db`, etc.
           (let [file (str filename file-extension)]
             (when (.exists (io/file file))
               (io/delete-file file))))
         [".h2.db"
          ".trace.db"
          ".lock.db"]))
  (log/info "tearing down database and resetting to empty schema")
  (migrate (setup-jdbc-db) :down)
  (log/info "setting up database and running all migrations")
  (setup-db :auto-migrate true)
  (log/info "database setup complete")

  ;; Now load the test data
  @test-db)

;; ## Jetty (Web) Server

(def ^:private jetty-instance
  (delay
   (try (ring/run-jetty core/app {:port 3000
                                  :join? false}) ; detach the thread
        (catch java.net.BindException e          ; assume server is already running if port's already bound
          (log/warn "ALREADY RUNNING!")))))       ; e.g. if someone is running `lein ring server` locally. Tests should still work normally.

(defn start-jetty
  "Start the Jetty web server."
  []
  (log/info "STARTING THE JETTY SERVER...")
  @jetty-instance)

(defn stop-jetty
  "Stop the Jetty web server."
  {:expectations-options :after-run}
  []
  (when @jetty-instance
    (.stop ^org.eclipse.jetty.server.Server @jetty-instance)))

(ns metabase.test-utils
  (:require [clojure.java.io :as io]
            [clojure.tools.logging :as log]
            [expectations :refer :all]
            [ring.adapter.jetty :as ring]
            (metabase [core :as core]
                      [db :refer :all]
                      [test-data :refer :all])))

(declare set-test-logging-level
         setup-test-db
         start-jetty)

;; # SETTINGS

;; Don't run unit tests whenever JVM shuts down
;; it's pretty annoying to have our DB reset all the time
(expectations/disable-run-on-shutdown)

;; # FUNCTIONS THAT GET RUN ON TEST SUITE START / STOP

(defn test-setup
  {:expectations-options :before-run}
  []
  ;; Disable debug logging since it clutters up our output
  (.setLevel (org.apache.log4j.Logger/getLogger "metabase") org.apache.log4j.Level/INFO)
  (setup-test-db)
  (start-jetty))

;; ## DB Setup
;; WARNING: BY RUNNING ANY UNIT TESTS THAT REQUIRE THIS FILE OR BY RUNNING YOUR ENTIRE TEST SUITE YOU WILL EFFECTIVELY BE WIPING OUT YOUR DATABASE.
;; SETUP-DB DELETES YOUR DATABASE FILE, AND GETS RAN AUTOMATICALLY BY EXPECTATIONS. USE AT YOUR OWN RISK!

(defn setup-test-db
  "Setup database schema."
  []
  (let [filename (-> (re-find #"file:(\w+\.db).*" (db-file)) second)] ; db-file is prefixed with "file:", so we strip that off
    (map (fn [file-extension]                                         ; delete the database files, e.g. `metabase.db.h2.db`, `metabase.db.trace.db`, etc.
           (let [file (str filename file-extension)]
             (when (.exists (io/file file))
               (io/delete-file file))))
         [".h2.db"
          ".trace.db"
          ".lock.db"]))
  (log/info "tearing down database and resetting to empty schema")
  (migrate (setup-jdbc-db) :down)
  (log/info "setting up database and running all migrations")
  (setup-db :auto-migrate true)
  (log/info "database setup complete")

  ;; Now load the test data
  @test-db)

;; ## Jetty (Web) Server

(def ^:private jetty-instance
  (delay
   (try (ring/run-jetty core/app {:port 3000
                                  :join? false}) ; detach the thread
        (catch java.net.BindException e          ; assume server is already running if port's already bound
          (log/warn "ALREADY RUNNING!")))))       ; e.g. if someone is running `lein ring server` locally. Tests should still work normally.

(defn start-jetty
  "Start the Jetty web server."
  []
  (log/info "STARTING THE JETTY SERVER...")
  @jetty-instance)

(defn stop-jetty
  "Stop the Jetty web server."
  {:expectations-options :after-run}
  []
  (when @jetty-instance
    (.stop ^org.eclipse.jetty.server.Server @jetty-instance)))

remove unneeded fn

remove unneeded fn


(ns onyx.log.pulse-test
  (:require [clojure.core.async :refer [chan >!! <!! close! sliding-buffer]]
            [onyx.extensions :as extensions]
            [onyx.log.entry :refer [create-log-entry]]
            [onyx.messaging.dummy-messenger]
            [onyx.plugin.core-async :refer [take-segments!]]
            [onyx.test-helper :refer [load-config]]
            [onyx.api :as api]
            [midje.sweet :refer :all]
            [onyx.log.curator :as zk]))

(def onyx-id (java.util.UUID/randomUUID))

(def config (load-config))

(def env-config (assoc (:env-config config) :onyx/id onyx-id))

(def env (onyx.api/start-env env-config))

(extensions/write-chunk (:log env) :job-scheduler {:job-scheduler :onyx.job-scheduler/balanced} nil)
(extensions/write-chunk (:log env) :messaging {:onyx.messaging/impl :dummy-messenger} nil)

(def a-id "a")

(def b-id "b")

(def c-id "c")

(def d-id "d")

(def entry (create-log-entry :prepare-join-cluster {:joiner d-id
                                                    :peer-site {:address 1}}))

(def ch (chan 5))

(extensions/write-log-entry (:log env) entry)

(extensions/subscribe-to-log (:log env) ch)

(def read-entry (<!! ch))

(def f (partial extensions/apply-log-entry read-entry))

(def rep-diff (partial extensions/replica-diff read-entry))

(def rep-reactions (partial extensions/reactions read-entry))

(extensions/register-pulse (:log env) a-id)
(extensions/register-pulse (:log env) b-id)
(extensions/register-pulse (:log env) c-id)
(extensions/register-pulse (:log env) d-id)

(def old-replica {:messaging {:onyx.messaging/impl :dummy-messenger}
                  :job-scheduler :onyx.job-scheduler/greedy
                  :pairs {a-id b-id b-id c-id c-id a-id} :peers [a-id b-id c-id]})

(def new-replica (f old-replica))

(def diff (rep-diff old-replica new-replica))

(def reactions (rep-reactions old-replica new-replica diff {:id d-id}))

(extensions/fire-side-effects! read-entry old-replica new-replica diff {:log (:log env) :id a-id})

(def conn (zk/connect (:zookeeper/address (:env-config config))))

(zk/delete conn (str (onyx.log.zookeeper/pulse-path onyx-id) "/" d-id))

(zk/close conn)

(def entry (<!! ch))

(fact (:fn entry) => :leave-cluster)
(fact (:args entry) => {:id "d"})

(onyx.api/shutdown-env env)

(ns onyx.log.pulse-test
  (:require [clojure.core.async :refer [chan >!! <!! close! sliding-buffer]]
            [onyx.extensions :as extensions]
            [onyx.log.entry :refer [create-log-entry]]
            [onyx.messaging.dummy-messenger]
            [onyx.monitoring.no-op-monitoring :refer [no-op-monitoring-agent]]
            [onyx.plugin.core-async :refer [take-segments!]]
            [onyx.test-helper :refer [load-config]]
            [onyx.api :as api]
            [midje.sweet :refer :all]
            [onyx.log.curator :as zk]))

(def onyx-id (java.util.UUID/randomUUID))

(def config (load-config))

(def env-config (assoc (:env-config config) :onyx/id onyx-id))

(def env (onyx.api/start-env env-config))

(extensions/write-chunk (:log env) :job-scheduler {:job-scheduler :onyx.job-scheduler/balanced} nil)
(extensions/write-chunk (:log env) :messaging {:onyx.messaging/impl :dummy-messenger} nil)

(def a-id "a")

(def b-id "b")

(def c-id "c")

(def d-id "d")

(def entry (create-log-entry :prepare-join-cluster {:joiner d-id
                                                    :peer-site {:address 1}}))

(def ch (chan 5))

(extensions/write-log-entry (:log env) entry)

(extensions/subscribe-to-log (:log env) ch)

(def read-entry (<!! ch))

(def f (partial extensions/apply-log-entry read-entry))

(def rep-diff (partial extensions/replica-diff read-entry))

(def rep-reactions (partial extensions/reactions read-entry))

(extensions/register-pulse (:log env) a-id)
(extensions/register-pulse (:log env) b-id)
(extensions/register-pulse (:log env) c-id)
(extensions/register-pulse (:log env) d-id)

(def old-replica {:messaging {:onyx.messaging/impl :dummy-messenger}
                  :job-scheduler :onyx.job-scheduler/greedy
                  :pairs {a-id b-id b-id c-id c-id a-id} :peers [a-id b-id c-id]})

(def new-replica (f old-replica))

(def diff (rep-diff old-replica new-replica))

(def reactions (rep-reactions old-replica new-replica diff {:id d-id}))

(def state {:log (:log env) :id a-id
            :monitoring (no-op-monitoring-agent)})

(extensions/fire-side-effects! read-entry old-replica new-replica diff state)

(def conn (zk/connect (:zookeeper/address (:env-config config))))

(zk/delete conn (str (onyx.log.zookeeper/pulse-path onyx-id) "/" d-id))

(zk/close conn)

(def entry (<!! ch))

(fact (:fn entry) => :leave-cluster)
(fact (:args entry) => {:id "d"})

(onyx.api/shutdown-env env)

Fix pulse test.

Fix pulse test.


(ns incise.deploy.workflows.git-branch
  (:require [incise.once :refer [once]]
            [incise.utils :refer [remove-prefix-from-path]]
            [incise.deploy.core :refer [register]]
            [taoensso.timbre :refer [debug info warn]]
            [clojure.java.io :refer [file]]
            [clojure.string :as s]
            (clj-jgit [porcelain :refer :all :exclude [git-push with-repo]]
                      [querying :refer [commit-info find-rev-commit]]
                      [internal :refer [new-rev-walk]])
            [clojure.java.shell :refer [with-sh-dir sh]]))

(declare ^:dynamic *repo*)
(declare ^:dynamic *out-dir*)
(declare ^:dynamic *work-dir*)

(def ^:private ^:const subdir "_incise")
(defn git-sub-dir-from-repo [repo]
  (-> repo
      (.getRepository)
      (.getDirectory)
      (file subdir)))

(defn work-tree [repo]
  (-> repo
      (.getRepository)
      (.getWorkTree)))

(defmacro with-repo [path & body]
  `(binding [~'*repo* (load-repo ~path)]
     (binding [~'*out-dir* (git-sub-dir-from-repo ~'*repo*)
               ~'*work-dir* (work-tree ~'*repo*)]
       (with-sh-dir *work-dir*
         ~@body))))

(defn branch-exists?
  [branch]
  (boolean (some #{(str "refs/heads/" branch)}
                 (map #(.getName %) (git-branch-list *repo*)))))

(defn checkout-orphaned-branch [branch]
  (let [{:keys [exit err]} (sh "git" "checkout" "--orphan" branch)]
    (if (= 0 exit)
      (sh "git" "rm" "-rf" "*")
      (throw (RuntimeException. err)))))

(defn- force-checkout [branch]
  (sh "git" "checkout" "--force" branch))

(defn setup-branch
  "Setup the given branch if it does not already exist and check it out."
  [branch]
  ((if (branch-exists? branch)
     force-checkout
     checkout-orphaned-branch) branch))

(defn- once-in-out-dir []
  (.mkdirs *out-dir*)
  (once :out-dir (.getPath *out-dir*)))

(defn- head-info []
  (when-let [commit (find-rev-commit *repo*
                                   (new-rev-walk *repo*)
                                   "HEAD")]
    (commit-info *repo* commit)))

(def remove-out-dir (partial remove-prefix-from-path *out-dir*))

(defn move-to-work-dir
  "Move the given file to the working tree directory."
  [from-file]
  (let [to-file (file *work-dir* (remove-out-dir from-file))]
    (if (.isDirectory from-file)
      (do
        (.mkdir to-file)
        nil)
      (do
        (.renameTo from-file to-file)
        to-file))))

(defn git-push
  "Shell out to git and push the current branch to the given remote and branch."
  [remote branch]
  (let [{:keys [exit err]} (sh "git" "push" "-f" remote branch)]
    (when-not (= exit 0)
      (throw (RuntimeException. err)))))

(defn log-files [files]
  (info "Adding the following files:")
  (doseq [afile files]
    (info " " (.getPath afile)))
  files)

(defn add-file [afile]
  (sh "git" "add" (.getPath afile)))

(defn stash [source-commit-hash]
  (let [stash-message (str "(>'')> incise stashing on " source-commit-hash)
        {:keys [out]} (sh "git" "stash" "create" stash-message)
        reference (when-not (s/blank? out) (s/trim-newline out))]
    (when reference
      (sh "git" "stash" "store" reference))
    reference))

(defn unstash [reference]
  (let [{:keys [exit err]} (sh "git" "stash" "apply" reference)]
    (when (not= exit 0)
      (warn "Failed to apply stash:" err))))

(defn deploy
  "Deploy to the given branch. Follow options for commit and push behaviour."
  [{:keys [path remote branch commit push]
    :or {path "."
         remote "origin"
         branch "gh-pages"
         commit true
         push true}}]
  {:pre [(string? branch) (string? remote)]}
  (with-repo path
    (once-in-out-dir)
    (let [{source-commit-hash :id} (head-info)
          start-branch (git-branch-current *repo*)
          stash-ref (stash source-commit-hash)]
      (when stash-ref
        (debug "Stashed with reference:" stash-ref))
      (setup-branch branch)
      (->> *out-dir*
           (file-seq)
           (map move-to-work-dir)
           (keep identity)
           (log-files)
           (map add-file)
           (dorun))
      (when commit
        (let [commit-msg (str "Built from " source-commit-hash \.)]
          (info "Committing with message:" commit-msg)
          (git-commit *repo* commit-msg))
        (when push
          (info "Pushing to" (str remote \/ branch))
          (git-push remote branch)
          (force-checkout start-branch)
          (when stash-ref (unstash stash-ref)))))))

(register :git-branch deploy)

(ns incise.deploy.workflows.git-branch
  (:require [incise.once :refer [once]]
            [incise.utils :refer [remove-prefix-from-path]]
            [incise.deploy.core :refer [register]]
            [taoensso.timbre :refer [debug info warn]]
            [clojure.java.io :refer [file]]
            [clojure.string :as s]
            (clj-jgit [porcelain :refer :all :exclude [git-push with-repo]]
                      [querying :refer [commit-info find-rev-commit]]
                      [internal :refer [new-rev-walk]])
            [clojure.java.shell :refer [with-sh-dir sh]]))

(declare ^:dynamic *repo*)
(declare ^:dynamic *out-dir*)
(declare ^:dynamic *work-dir*)

(def ^:private ^:const subdir "_incise")
(defn git-sub-dir-from-repo [repo]
  (-> repo
      (.getRepository)
      (.getDirectory)
      (file subdir)))

(defn work-tree [repo]
  (-> repo
      (.getRepository)
      (.getWorkTree)))

(defmacro with-repo [path & body]
  `(binding [~'*repo* (load-repo ~path)]
     (binding [~'*out-dir* (git-sub-dir-from-repo ~'*repo*)
               ~'*work-dir* (work-tree ~'*repo*)]
       (with-sh-dir *work-dir*
         ~@body))))

(defn branch-exists?
  [branch]
  (boolean (some #{(str "refs/heads/" branch)}
                 (map #(.getName %) (git-branch-list *repo*)))))

(defn checkout-orphaned-branch [branch]
  (let [{:keys [exit err]} (sh "git" "checkout" "--orphan" branch)]
    (if (= 0 exit)
      (sh "git" "rm" "-rf" "*")
      (throw (RuntimeException. err)))))

(defn- force-checkout [branch]
  (sh "git" "checkout" "--force" branch))

(defn setup-branch
  "Setup the given branch if it does not already exist and check it out."
  [branch]
  ((if (branch-exists? branch)
     force-checkout
     checkout-orphaned-branch) branch))

(defn- once-in-out-dir []
  (.mkdirs *out-dir*)
  (once :out-dir (.getPath *out-dir*)))

(defn- head-info []
  (when-let [commit (find-rev-commit *repo*
                                   (new-rev-walk *repo*)
                                   "HEAD")]
    (commit-info *repo* commit)))

(defn remove-out-dir [afile]
  (remove-prefix-from-path *out-dir* afile))

(defn move-to-work-dir
  "Move the given file to the working tree directory."
  [from-file]
  (let [to-file (file *work-dir* (remove-out-dir from-file))]
    (if (.isDirectory from-file)
      (do
        (.mkdir to-file)
        nil)
      (do
        (.renameTo from-file to-file)
        to-file))))

(defn git-push
  "Shell out to git and push the current branch to the given remote and branch."
  [remote branch]
  (let [{:keys [exit err]} (sh "git" "push" "-f" remote branch)]
    (when-not (= exit 0)
      (throw (RuntimeException. err)))))

(defn log-files [files]
  (info "Adding the following files:")
  (doseq [afile files]
    (info " " (.getPath afile)))
  files)

(defn add-file [afile]
  (sh "git" "add" (.getPath afile)))

(defn stash [source-commit-hash]
  (let [stash-message (str "(>'')> incise stashing on " source-commit-hash)
        {:keys [out]} (sh "git" "stash" "create" stash-message)
        reference (when-not (s/blank? out) (s/trim-newline out))]
    (when reference
      (sh "git" "stash" "store" reference))
    reference))

(defn unstash [reference]
  (let [{:keys [exit err]} (sh "git" "stash" "apply" reference)]
    (when (not= exit 0)
      (warn "Failed to apply stash:" err))))

(defn deploy
  "Deploy to the given branch. Follow options for commit and push behaviour."
  [{:keys [path remote branch commit push]
    :or {path "."
         remote "origin"
         branch "gh-pages"
         commit true
         push true}}]
  {:pre [(string? branch) (string? remote)]}
  (with-repo path
    (once-in-out-dir)
    (let [{source-commit-hash :id} (head-info)
          start-branch (git-branch-current *repo*)
          stash-ref (stash source-commit-hash)]
      (when stash-ref
        (debug "Stashed with reference:" stash-ref))
      (setup-branch branch)
      (->> *out-dir*
           (file-seq)
           (map move-to-work-dir)
           (keep identity)
           (log-files)
           (map add-file)
           (dorun))
      (when commit
        (let [commit-msg (str "Built from " source-commit-hash \.)]
          (info "Committing with message:" commit-msg)
          (git-commit *repo* commit-msg))
        (when push
          (info "Pushing to" (str remote \/ branch))
          (git-push remote branch)
          (force-checkout start-branch)
          (when stash-ref (unstash stash-ref)))))))

(register :git-branch deploy)

Fix definition of git-branch/remove-out-dir.

Using a partial leaves *out-dir* unbound. Immutability ftw.


(ns conference-rating.add-conference-page.add-conference-page
  (:require [conference-rating.history :as history]
            [ajax.core :as ajax]
            [cljs-time.core :as t]
            [cljs-time.format :as tf]
            [reagent.core :refer [atom]]
            [reagent-forms.core :as forms]
            [conference-rating.util :as util]
            [conference-rating.backend :as backend]
            [conference-rating.view-utils.navbar :as navbar]
            [conference-rating.view-utils.typeahead :as typeahead]))

(defn form-input [label input]
  [:div {:class "form-group"}
   [:label {:for (:id (second input))} label]
   input])

(defn conference-series-input []
  [:input {:field :text :id :series :class "form-control" :placeholder "Name of the conference series, e.g. EuroClojure for the EuroClojure 2015 conference"}])

(defn conference-series-suggestions [q cb]
  (backend/load-series-suggestions q (fn [x]
                                       (cb x))))

(defn conference-series-template [series]
  (str "
"
       "
"series"
"
       "
"))

(def conference-series-component
  (typeahead/init-typeahead
    conference-series-input
    (typeahead/config {:hint true,
                       :highlight true,
                       :minLength 1})
    (typeahead/data-sets {:name "series",
                          :source conference-series-suggestions
                          :display identity
                          :async true
                          :templates {:suggestion conference-series-template}})))

(def conference-form-template
  [:div
   (form-input "Series" [conference-series-component])
   (form-input "Name" [:input {:field :text :id :name :class "form-control" :placeholder "Name of the conference"}])
   [:div {:class "row"}
    [:div {:class "col-md-6"} (form-input "From" [:div {:field :datepicker :id :from-date :date-format "yyyy/mm/dd" :inline false :auto-close? true}])]
    [:div {:class "col-md-6"} (form-input "To" [:div {:field :datepicker :id :to-date :date-format "yyyy/mm/dd" :inline false :auto-close? true}])]]
   (form-input "Link" [:input {:field :text :id :link :class "form-control" :placeholder "Link to the conference page"}])
   (form-input "Description" [:textarea {:field :textarea :rows 5 :id :description :class "form-control" :placeholder "More information about the conference"}])])

(defn create-conference [data-atom]
  (let [data    @data-atom
        payload {:from        (util/form-date-to-datestr (:from-date data))
                 :to          (util/form-date-to-datestr (:to-date data))
                 :name        (:name data)
                 :series      (:series data)
                 :link        (:link data)
                 :description (:description data)}]
  (ajax/POST "/api/conferences/" {:params          payload
                                  :format          :json
                                  :response-format :json
                                  :keywords?       true
                                  :handler         #(let [conference-id (:_id %)]
                                                     (history/redirect-to (str "/conferences/" conference-id)))
                                  :error-handler   #(js/alert (str "could not create conference" %1))})))
(defn add-conference-page []
  (let [doc (atom {})]
    [:div
     (navbar/nav-bar)
     [:div {:class "container-fluid content-container pad-top"}
      [:div {:class "row"}
       [:div {:class "col-lg-2"}]
       [:div {:class "col-lg-8"}
        [:div {:class "add-conference-form-container bg-light"}
         [forms/bind-fields conference-form-template doc]
         [:button {:class "btn btn-primary btn-md btn-orange" :on-click #(create-conference doc)} "Create"]]]
       [:div {:class "col-lg-2"}]]]]))

(ns conference-rating.add-conference-page.add-conference-page
  (:require [conference-rating.history :as history]
            [ajax.core :as ajax]
            [cljs-time.core :as t]
            [cljs-time.format :as tf]
            [reagent.core :refer [atom]]
            [reagent-forms.core :as forms]
            [conference-rating.util :as util]
            [conference-rating.backend :as backend]
            [conference-rating.view-utils.navbar :as navbar]
            [conference-rating.view-utils.typeahead :as typeahead]))

(defn form-input [label input]
  [:div {:class "form-group"}
   [:label {:for (:id (second input))} label]
   input])

(defn conference-series-input []
  [:input {:field :text :id :series :class "form-control" :placeholder "Name of the conference series, e.g. EuroClojure for the EuroClojure 2015 conference"}])

(defn conference-series-suggestions [q cb]
  (backend/load-series-suggestions q (fn [x]
                                       (cb x))))

(defn conference-series-template [series]
  (str "
"
       "
"series"
"
       "
"))

(def conference-series-component
  (typeahead/init-typeahead
    conference-series-input
    (typeahead/config {:hint true,
                       :highlight true,
                       :minLength 1})
    (typeahead/data-sets {:name "series",
                          :source conference-series-suggestions
                          :display identity
                          :async true
                          :templates {:suggestion conference-series-template}})))

(def conference-form-template
  [:div
   (form-input "Series" [:input {:field :text :id :series :class "form-control" :placeholder "Name of the conference series, e.g. EuroClojure for the EuroClojure 2015 conference"}])
   (form-input "Name" [:input {:field :text :id :name :class "form-control" :placeholder "Name of the conference"}])
   [:div {:class "row"}
    [:div {:class "col-md-6"} (form-input "From" [:div {:field :datepicker :id :from-date :date-format "yyyy/mm/dd" :inline false :auto-close? true}])]
    [:div {:class "col-md-6"} (form-input "To" [:div {:field :datepicker :id :to-date :date-format "yyyy/mm/dd" :inline false :auto-close? true}])]]
   (form-input "Link" [:input {:field :text :id :link :class "form-control" :placeholder "Link to the conference page"}])
   (form-input "Description" [:textarea {:field :textarea :rows 5 :id :description :class "form-control" :placeholder "More information about the conference"}])])

(defn create-conference [data-atom]
  (let [data    @data-atom
        payload {:from        (util/form-date-to-datestr (:from-date data))
                 :to          (util/form-date-to-datestr (:to-date data))
                 :name        (:name data)
                 :series      (:series data)
                 :link        (:link data)
                 :description (:description data)}]
  (ajax/POST "/api/conferences/" {:params          payload
                                  :format          :json
                                  :response-format :json
                                  :keywords?       true
                                  :handler         #(let [conference-id (:_id %)]
                                                     (history/redirect-to (str "/conferences/" conference-id)))
                                  :error-handler   #(js/alert (str "could not create conference" %1))})))
(defn add-conference-page []
  (let [doc (atom {})]
    [:div
     (navbar/nav-bar)
     [:div {:class "container-fluid content-container pad-top"}
      [:div {:class "row"}
       [:div {:class "col-lg-2"}]
       [:div {:class "col-lg-8"}
        [:div {:class "add-conference-form-container bg-light"}
         [forms/bind-fields conference-form-template doc]
         [:button {:class "btn btn-primary btn-md btn-orange" :on-click #(create-conference doc)} "Create"]]]
       [:div {:class "col-lg-2"}]]]]))

undo series typeahead because of bug, series does not get stored


(ns replikativ.crdt)

(defrecord CDVCS [commit-graph heads version])

(defrecord SimpleGSet [elements])

(defrecord SimpleORMap [adds removals])

(defrecord LWW [register])

fix merge conflict

fix merge conflict