(ns yetibot.core.adapters.irc
  (:require
    [schema.core :as s]
    [clojure.set :refer [difference union intersection]]
    [yetibot.core.adapters.adapter :as a]
    [taoensso.timbre :as log :refer [info debug]]
    [rate-gate.core :refer [rate-limit]]
    [irclj
     [core :as irc]
     [connection :as irc-conn]]
    [yetibot.core.models.users :as users]
    [clojure.string :refer [split-lines join]]
    [yetibot.core.config :as config]
    [yetibot.core.config-mutable :as mconfig]
    [yetibot.core.chat :refer [base-chat-source chat-source
                               chat-data-structure send-msg-for-each
                               *target* *adapter*] :as chat]
    [yetibot.core.util.format :as fmt]
    [yetibot.core.handler :refer [handle-raw]]))

(declare join-or-part-with-current-channels connect start)

(defn rooms [{:keys [current-channels] :as a}] @current-channels)

(defn config-path [adapter]
 [:yetibot :irc (a/uuid adapter)])

(defn rooms-config-path [adapter]
  (conj (config-path adapter) :rooms))

(def wait-before-reconnect 30000)

(def irc-max-message-length 420)

(defn split-msg-into-irc-max-length-chunks [msg]
  (map join (partition-all irc-max-message-length msg)))

(def send-msg
  "Rate-limited function for sending messages to IRC. It's rate limited in order
   to prevent 'Excess Flood' kicks"
  (rate-limit
    (fn [{:keys [conn] :as adapter} msg]
      (log/info "send message to channel" *target*)
      (try
        (if (> (count msg) irc-max-message-length)
          (doall (map send-msg (split-msg-into-irc-max-length-chunks msg)))
          (irc/message @conn *target* msg))
        (catch java.net.SocketException e
          ; it must have disconnect, try reconnecting again
          ; TODO add better retry, like Slack
          (log/info "SocketException, trying to reconnect in" wait-before-reconnect "ms")
          (Thread/sleep wait-before-reconnect)
          (connect adapter)
          (start adapter))))
    3 900))

(defn- create-user [info]
  (let [username (:nick info)
        id (:user info)]
    (users/create-user username (merge info {:id id}))))

(def prepare-paste
  "Since pastes are sent as individual messages, blank lines would get
   translated into \"No Results\" by the chat namespace. Instead of a blank
   line, map it into a single space."
  (comp (fn [coll] (map #(if (empty? %) " " %) coll))
        split-lines))

(defn send-paste
  "In IRC there are new newlines. Each line must be sent as a separate message, so
   split it and send one for each"
  [a p] (send-msg-for-each (prepare-paste p)))

(def channels-schema #{s/Str})

(def mutable-config-schema {:rooms #{s/Str}})

(defn reload-and-reset-config!
  "Reloads config from disk, then uses adapter uuid to lookup the correct config
   map for this instance and resets the config atom with it."
  [{:keys [mutable-config] :as a}]
  (mconfig/reload-config!)
  (let [new-conf (:value (mconfig/get-config
                           mutable-config-schema (config-path a)))]
    (info "reloaded config, now:" new-conf)
    (reset! mutable-config new-conf)))

(defn set-rooms-config
  "Accepts a function that will be passed the current rooms config. Return value
   of function will be used to set the new rooms config"
  [adapter f]
  (log/info "rooms config path is" (rooms-config-path adapter)
            (f (rooms adapter)))
  (mconfig/update-config! (rooms-config-path adapter) (f (rooms adapter)))
  (reload-and-reset-config! adapter))

(defn add-room-to-config [a room]
  (log/info "add room" room "to irc config")
  (log/info
    (set-rooms-config a #(set (conj % room)))))

(defn remove-room-from-config [a room]
  (log/info "remove room from irc config")
  (set-rooms-config a (comp set (partial filter #(not= % room)))))

(defn join-room [a room]
  (add-room-to-config a room)
  (join-or-part-with-current-channels a)
  (str "Joined " room))

(defn leave-room [a room]
  (remove-room-from-config a room)
  (join-or-part-with-current-channels a)
  (str "Left " room))

(defn fetch-users [a]
  (doall (map #(irc-conn/write-irc-line @(:conn a) "WHO" %) (rooms a))))

(defn recognized-chan? [a chan] ((set (rooms a)) chan))

(defn handle-message
  "Recieve and handle messages from IRC. This can either be in channels yetibot
   is listening in, or it can be a private message. If yetibot does not
   recognize the :target, reply back to user with PRIVMSG."
  [a _ info]
  (log/info "handle message" info)
  (let [user-id (:user info)
        chan (or (recognized-chan? a (:target info)) (:nick info))
        user (users/get-user (chat-source chan) user-id)]
    (log/info "handle-message from" chan)
    (binding [*target* chan]
      (handle-raw (chat-source chan) user :message (:text info)))))

(defn handle-part [a _ info]
  (handle-raw (chat-source (:target info))
              (create-user info) :leave nil))

(defn handle-join [a _ info]
  (log/debug "handle-join" info)
  (handle-raw (chat-source (:target info))
              (create-user info) :enter nil))

(defn handle-nick [a _ info]
  (let [[nick] (:params info)
        id (:user info)]
    (users/update-user (chat-source (:target info)) id {:username nick :name nick})))

(defn handle-who-reply [a _ info]
  (log/debug "352" info)
  (let [{[_ channel user _ _ nick] :params} info]
    (log/info "add user" channel user nick)
    (users/add-user (chat-source channel)
                    (create-user {:user user :nick nick}))))

(defn handle-invite [a _ info]
  (log/info "handle invite" info)
  (join-room a (second (:params info))))

(defn handle-raw-log [adapter _ b c] (log/trace b c))

(defn handle-end-of-names
  "Callback for end of names list from IRC. Currently not doing anything with it."
  [adapter irc event]
  (let [users (-> @irc :channels vals first :users)]))

(defn callbacks [adapter]
  (into {}
        (for [[k v]
              {:privmsg #'handle-message
               :raw-log #'handle-raw-log
               :part #'handle-part
               :join #'handle-join
               :nick #'handle-nick
               :invite #'handle-invite
               :366 #'handle-end-of-names
               :352 #'handle-who-reply}]
          [k (partial v adapter)])))

(defn connect [{:keys [config conn] :as a}]
  (let [username (or (:username config) (str "yetibot_" (rand-int 1000)))
        host (or (:host config) "irc.freenode.net")
        port (read-string (or (:port config) "6667"))
        ssl? (boolean (:ssl config))]
    (info "Connecting to IRC"
          {:host host :port port :ssl? ssl? :username username})
    (reset!
      conn
      (irc/connect host port username
                   :ssl? ssl?
                   :callbacks (callbacks a)))))

(defn join-or-part-with-current-channels
  "Determine the diff between current-channels and configured channels to
   determine which to join and part. After resolving the diff, set
   current-channels equal to configured rooms."
  [{:keys [conn mutable-config current-channels] :as adapter}]
  (let [configured-rooms (:rooms @mutable-config)
        to-part (difference @current-channels configured-rooms)
        to-join (difference configured-rooms @current-channels)]
    (info "configured-rooms" configured-rooms)
    (debug "channels" @current-channels)
    (debug "to-part" to-part)
    (debug "to-join" to-join)
    (reset! current-channels configured-rooms)
    (doall (map #(irc/join @conn %) to-join))
    (doall (map #(irc/part @conn %) to-part))
    (fetch-users adapter)))

(defn part
  "Not currently used"
  [{:keys [conn]} channel]
  (when conn (irc/part @conn channel)))

(defn start
  "Join and fetch all users with WHO <channel>"
  [{:keys [mutable-config config conn] :as adapter}]
  (binding [*adapter* adapter]
    (info "starting IRC with" config)
    (reload-and-reset-config! adapter)
    (connect adapter)
    (join-or-part-with-current-channels adapter)))

(defn stop
  "Kill the irc conection"
  [{:keys [conn]}]
  (when @conn (irc/kill @conn))
  (reset! conn nil))

(defrecord IRC [config mutable-config current-channels conn]

  ; config
  ; Holds the immutable configuration for a single IRC Adapter instance.

  ; mutable-config
  ; Loaded from disk in start. It stores the IRC channels that Yetibot should
  ; join on startup. When Yetibot is commanded to join or leave channels,
  ; mutable-config is updated and persisted to disk.

  ; current-channels
  ; Atom holding the set of current channels that Yetibot is listening on. This
  ; is necessary to track in addition to mutable config in order to diff
  ; channels when modifying config to know which ones to part or join.

  ; conn
  ; An atom that holds the IRC connection

  a/Adapter

  (a/uuid [_] (:name config))

  (a/platform-name [_] "IRC")

  (a/rooms [a] (rooms a))

  (a/send-paste [a msg] (send-paste a msg))

  (a/send-msg [a msg] (send-msg a msg))

  (a/join [a room] (join-room a room))

  (a/leave [a room] (leave-room a room))

  (a/chat-source [_ room] (chat-source room))

  (a/stop [adapter] (stop adapter))

  (a/start [adapter] (start adapter)))

(defn make-irc
  [config]
  (->IRC config (atom {}) (atom #{}) (atom nil)))

(ns yetibot.core.adapters.irc
  (:require
    [schema.core :as s]
    [clojure.set :refer [difference union intersection]]
    [yetibot.core.adapters.adapter :as a]
    [taoensso.timbre :as log :refer [info debug]]
    [rate-gate.core :refer [rate-limit]]
    [irclj
     [core :as irc]
     [connection :as irc-conn]]
    [yetibot.core.models.users :as users]
    [clojure.string :refer [split-lines join]]
    [yetibot.core.config :as config]
    [yetibot.core.config-mutable :as mconfig]
    [yetibot.core.chat :refer [base-chat-source chat-source
                               chat-data-structure send-msg-for-each
                               *target* *adapter*] :as chat]
    [yetibot.core.util.format :as fmt]
    [yetibot.core.handler :refer [handle-raw]]))

(declare join-or-part-with-current-channels connect start)

(defn rooms [{:keys [current-channels] :as a}] @current-channels)

(defn config-path [adapter]
 [:yetibot :irc (a/uuid adapter)])

(defn rooms-config-path [adapter]
  (conj (config-path adapter) :rooms))

(def wait-before-reconnect 30000)

(def irc-max-message-length 420)

(defn split-msg-into-irc-max-length-chunks [msg]
  (map join (partition-all irc-max-message-length msg)))

(def send-msg
  "Rate-limited function for sending messages to IRC. It's rate limited in order
   to prevent 'Excess Flood' kicks"
  (rate-limit
    (fn [{:keys [conn] :as adapter} msg]
      (log/info "send message to channel" *target*)
      (try
        (if (> (count msg) irc-max-message-length)
          (doall (map
                   (partial send-msg adapter)
                   (split-msg-into-irc-max-length-chunks msg)))
          (irc/message @conn *target* msg))
        (catch java.net.SocketException e
          ; it must have disconnect, try reconnecting again
          ; TODO add better retry, like Slack
          (log/info "SocketException, trying to reconnect in" wait-before-reconnect "ms")
          (Thread/sleep wait-before-reconnect)
          (connect adapter)
          (start adapter))))
    3 900))

(defn- create-user [info]
  (let [username (:nick info)
        id (:user info)]
    (users/create-user username (merge info {:id id}))))

(def prepare-paste
  "Since pastes are sent as individual messages, blank lines would get
   translated into \"No Results\" by the chat namespace. Instead of a blank
   line, map it into a single space."
  (comp (fn [coll] (map #(if (empty? %) " " %) coll))
        split-lines))

(defn send-paste
  "In IRC there are new newlines. Each line must be sent as a separate message, so
   split it and send one for each"
  [a p] (send-msg-for-each (prepare-paste p)))

(def channels-schema #{s/Str})

(def mutable-config-schema {:rooms #{s/Str}})

(defn reload-and-reset-config!
  "Reloads config from disk, then uses adapter uuid to lookup the correct config
   map for this instance and resets the config atom with it."
  [{:keys [mutable-config] :as a}]
  (mconfig/reload-config!)
  (let [new-conf (:value (mconfig/get-config
                           mutable-config-schema (config-path a)))]
    (info "reloaded config, now:" new-conf)
    (reset! mutable-config new-conf)))

(defn set-rooms-config
  "Accepts a function that will be passed the current rooms config. Return value
   of function will be used to set the new rooms config"
  [adapter f]
  (log/info "rooms config path is" (rooms-config-path adapter)
            (f (rooms adapter)))
  (mconfig/update-config! (rooms-config-path adapter) (f (rooms adapter)))
  (reload-and-reset-config! adapter))

(defn add-room-to-config [a room]
  (log/info "add room" room "to irc config")
  (log/info
    (set-rooms-config a #(set (conj % room)))))

(defn remove-room-from-config [a room]
  (log/info "remove room from irc config")
  (set-rooms-config a (comp set (partial filter #(not= % room)))))

(defn join-room [a room]
  (add-room-to-config a room)
  (join-or-part-with-current-channels a)
  (str "Joined " room))

(defn leave-room [a room]
  (remove-room-from-config a room)
  (join-or-part-with-current-channels a)
  (str "Left " room))

(defn fetch-users [a]
  (doall (map #(irc-conn/write-irc-line @(:conn a) "WHO" %) (rooms a))))

(defn recognized-chan? [a chan] ((set (rooms a)) chan))

(defn handle-message
  "Recieve and handle messages from IRC. This can either be in channels yetibot
   is listening in, or it can be a private message. If yetibot does not
   recognize the :target, reply back to user with PRIVMSG."
  [a _ info]
  (log/info "handle message" info)
  (let [user-id (:user info)
        chan (or (recognized-chan? a (:target info)) (:nick info))
        user (users/get-user (chat-source chan) user-id)]
    (log/info "handle-message from" chan)
    (binding [*target* chan]
      (handle-raw (chat-source chan) user :message (:text info)))))

(defn handle-part [a _ info]
  (handle-raw (chat-source (:target info))
              (create-user info) :leave nil))

(defn handle-join [a _ info]
  (log/debug "handle-join" info)
  (handle-raw (chat-source (:target info))
              (create-user info) :enter nil))

(defn handle-nick [a _ info]
  (let [[nick] (:params info)
        id (:user info)]
    (users/update-user (chat-source (:target info)) id {:username nick :name nick})))

(defn handle-who-reply [a _ info]
  (log/debug "352" info)
  (let [{[_ channel user _ _ nick] :params} info]
    (log/info "add user" channel user nick)
    (users/add-user (chat-source channel)
                    (create-user {:user user :nick nick}))))

(defn handle-invite [a _ info]
  (log/info "handle invite" info)
  (join-room a (second (:params info))))

(defn handle-raw-log [adapter _ b c] (log/trace b c))

(defn handle-end-of-names
  "Callback for end of names list from IRC. Currently not doing anything with it."
  [adapter irc event]
  (let [users (-> @irc :channels vals first :users)]))

(defn callbacks [adapter]
  (into {}
        (for [[k v]
              {:privmsg #'handle-message
               :raw-log #'handle-raw-log
               :part #'handle-part
               :join #'handle-join
               :nick #'handle-nick
               :invite #'handle-invite
               :366 #'handle-end-of-names
               :352 #'handle-who-reply}]
          [k (partial v adapter)])))

(defn connect [{:keys [config conn] :as a}]
  (let [username (or (:username config) (str "yetibot_" (rand-int 1000)))
        host (or (:host config) "irc.freenode.net")
        port (read-string (or (:port config) "6667"))
        ssl? (boolean (:ssl config))]
    (info "Connecting to IRC"
          {:host host :port port :ssl? ssl? :username username})
    (reset!
      conn
      (irc/connect host port username
                   :ssl? ssl?
                   :callbacks (callbacks a)))))

(defn join-or-part-with-current-channels
  "Determine the diff between current-channels and configured channels to
   determine which to join and part. After resolving the diff, set
   current-channels equal to configured rooms."
  [{:keys [conn mutable-config current-channels] :as adapter}]
  (let [configured-rooms (:rooms @mutable-config)
        to-part (difference @current-channels configured-rooms)
        to-join (difference configured-rooms @current-channels)]
    (info "configured-rooms" configured-rooms)
    (debug "channels" @current-channels)
    (debug "to-part" to-part)
    (debug "to-join" to-join)
    (reset! current-channels configured-rooms)
    (doall (map #(irc/join @conn %) to-join))
    (doall (map #(irc/part @conn %) to-part))
    (fetch-users adapter)))

(defn part
  "Not currently used"
  [{:keys [conn]} channel]
  (when conn (irc/part @conn channel)))

(defn start
  "Join and fetch all users with WHO <channel>"
  [{:keys [mutable-config config conn] :as adapter}]
  (binding [*adapter* adapter]
    (info "starting IRC with" config)
    (reload-and-reset-config! adapter)
    (connect adapter)
    (join-or-part-with-current-channels adapter)))

(defn stop
  "Kill the irc conection"
  [{:keys [conn]}]
  (when @conn (irc/kill @conn))
  (reset! conn nil))

(defrecord IRC [config mutable-config current-channels conn]

  ; config
  ; Holds the immutable configuration for a single IRC Adapter instance.

  ; mutable-config
  ; Loaded from disk in start. It stores the IRC channels that Yetibot should
  ; join on startup. When Yetibot is commanded to join or leave channels,
  ; mutable-config is updated and persisted to disk.

  ; current-channels
  ; Atom holding the set of current channels that Yetibot is listening on. This
  ; is necessary to track in addition to mutable config in order to diff
  ; channels when modifying config to know which ones to part or join.

  ; conn
  ; An atom that holds the IRC connection

  a/Adapter

  (a/uuid [_] (:name config))

  (a/platform-name [_] "IRC")

  (a/rooms [a] (rooms a))

  (a/send-paste [a msg] (send-paste a msg))

  (a/send-msg [a msg] (send-msg a msg))

  (a/join [a room] (join-room a room))

  (a/leave [a room] (leave-room a room))

  (a/chat-source [_ room] (chat-source room))

  (a/stop [adapter] (stop adapter))

  (a/start [adapter] (start adapter)))

(defn make-irc
  [config]
  (->IRC config (atom {}) (atom #{}) (atom nil)))

Fix arity bug in IRC send-msg

Fix arity bug in IRC send-msg


(ns wombats.test.arena.utils
  (:require [clojure.test :refer :all]
            [wombats.arena.utils :as a-utils]))

(defonce test-4x4-empty-perimeter
  (load-file "resources/arena/4x4-empty-perimeter.edn"))

(defonce test-4x5-empty-perimeter
  (load-file "resources/arena/4x5-empty-perimeter.edn"))

(deftest get-arena-dimensions
  (testing "calculates a square arena"
    (is (= [4 4]
           (a-utils/get-arena-dimensions test-4x4-empty-perimeter))))

  (testing "calculates a non square  arena"
    (is (= [4 5]
           (a-utils/get-arena-dimensions test-4x5-empty-perimeter)))))

(deftest pos-open?
  (testing "returns true when it encounters an open cell"
    (is (= true
           (a-utils/pos-open?
            [1 1]
            test-4x4-empty-perimeter))))
  (testing "returns false when it encounters any other cell"
    (is (= false
           (a-utils/pos-open?
            [0 0]
            test-4x4-empty-perimeter)))))

(deftest coords-inbounds?
  (testing "returns true if coords are inbounds"
    (is (= (a-utils/coords-inbounds? [0 0] test-4x4-empty-arena)
           true))
    (is (= (a-utils/coords-inbounds? [0 3] test-4x4-empty-arena)
           true))
    (is (= (a-utils/coords-inbounds? [2 3] test-4x4-empty-arena)
           true)))
  (testing "returns false if coords are out of bounds"
    (is (= (a-utils/coords-inbounds? [4 4] test-4x4-empty-arena)
           false))))

(deftest update-cell
  (testing "returns the same arena if x is out of bounds"
    (is (= test-4x4-empty-arena
           (a-utils/update-cell test-4x4-empty-arena
                                [8 0]
                                {:update true}))))
  (testing "returns the same arena if y is out of bounds"
    (is (= test-4x4-empty-arena
           (a-utils/update-cell test-4x4-empty-arena
                                [0 8]
                                {:update true}))))
  (testing "returns a modified arena if x & y are inbounds"
    (is (not= test-4x4-empty-arena
           (a-utils/update-cell test-4x4-empty-arena
                                [1 1]
                                {:update true})))))

(ns wombats.test.arena.utils
  (:require [clojure.test :refer :all]
            [wombats.arena.utils :as a-utils]))

(defonce test-4x4-empty-perimeter
  (load-file "resources/arena/4x4-empty-perimeter.edn"))

(defonce test-4x5-empty-perimeter
  (load-file "resources/arena/4x5-empty-perimeter.edn"))

(defonce test-4x4-empty-arena
  (load-file "resources/arena/4x4-empty-arena.edn"))

(deftest get-arena-dimensions
  (testing "calculates a square arena"
    (is (= [4 4]
           (a-utils/get-arena-dimensions test-4x4-empty-perimeter))))

  (testing "calculates a non square  arena"
    (is (= [4 5]
           (a-utils/get-arena-dimensions test-4x5-empty-perimeter)))))

(deftest pos-open?
  (testing "returns true when it encounters an open cell"
    (is (= true
           (a-utils/pos-open?
            [1 1]
            test-4x4-empty-perimeter))))
  (testing "returns false when it encounters any other cell"
    (is (= false
           (a-utils/pos-open?
            [0 0]
            test-4x4-empty-perimeter)))))

(deftest coords-inbounds?
  (testing "returns true if coords are inbounds"
    (is (= (a-utils/coords-inbounds? [0 0] test-4x4-empty-arena)
           true))
    (is (= (a-utils/coords-inbounds? [0 3] test-4x4-empty-arena)
           true))
    (is (= (a-utils/coords-inbounds? [2 3] test-4x4-empty-arena)
           true)))
  (testing "returns false if coords are out of bounds"
    (is (= (a-utils/coords-inbounds? [4 4] test-4x4-empty-arena)
           false))))

(deftest update-cell
  (testing "returns the same arena if x is out of bounds"
    (is (= test-4x4-empty-arena
           (a-utils/update-cell test-4x4-empty-arena
                                [8 0]
                                {:update true}))))
  (testing "returns the same arena if y is out of bounds"
    (is (= test-4x4-empty-arena
           (a-utils/update-cell test-4x4-empty-arena
                                [0 8]
                                {:update true}))))
  (testing "returns a modified arena if x & y are inbounds"
    (is (not= test-4x4-empty-arena
           (a-utils/update-cell test-4x4-empty-arena
                                [1 1]
                                {:update true})))))

add back in missing arena in tests

add back in missing arena in tests


(ns bardo.interpolate
  (:require [clojure.set :refer [union]]))

;; a protocol for birthing new values from nil
(defprotocol IBirth (birth [x]))

(extend-protocol IBirth

    #+clj java.lang.Number
    #+cljs number
    (birth [x]
      0))

(defprotocol IInterpolate (interpolate [start end]))

(extend-protocol IInterpolate

  nil
  (interpolate [start end]
    (interpolate (birth end) end))

  #+clj java.lang.Number
  #+cljs number
  (interpolate [start end]
    (cond
       (nil? end) (interpolate start (birth start))
       :else (fn [t]
               (+ start (* t (- end start))))))

  #+clj clojure.lang.PersistentVector
  #+cljs PersistentVector
  (interpolate [start end]
    (fn [t]
      (mapv (comp #(% t) interpolate) start end)))

  #+clj clojure.lang.PersistentList
  #+cljs List
  (interpolate [start end]
    (fn [t]
      (map (comp #(% t) interpolate) start end)))

  #+clj clojure.lang.PersistentArrayMap
  #+cljs PersistentArrayMap
  (interpolate [start end]
    (fn [t]
      (into {} (for [k (->> [start end]
                            (map keys)
                            (map set)
                            (apply union))]
                 [k (apply (comp #(% t) interpolate) (map k [start end]))])))))

(ns bardo.interpolate
  (:require [clojure.set :refer [union]]
            [clojure.core.match :refer [match]]))

;; a protocol for birthing new values from nil
(defprotocol IFresh
  (fresh [x]))

(extend-protocol IFresh

  #+clj java.lang.Number
  #+cljs number
  (fresh [x]
    0)

  #+clj clojure.lang.Sequential
  #+cljs Sequential
  (fresh [x]
    '())

  #+clj clojure.lang.PersistentArrayMap
  #+cljs PersistentArrayMap
  (fresh [x]
    {}))

(defn wrap-nil
  "if a value is nil, replace it with a fresh value of the other
  value if it satisfies IFresh"
  [start end]
  (match [start end]
         [nil nil] nil
         [nil end] (if (satisfies? IFresh end)
                     [(fresh end) end]
                     [nil end])
         [start nil] (if (satisfies? IFresh start)
                       [start (fresh start)]
                       [start nil])
         [start end] [start end]))

(defn is-lazy? [s]
  (= clojure.lang.LazySeq (class s)))

(defn prevent-infinite [x y]
  (match (mapv is-lazy? [x y])
         [true true] (throw
                      (Exception. "Cannot interpolate between two LazySeq"))
         [true _] [(take (count y) x) y]
         [_ true] [x (take (count x) y)]
         [_ _] [x y]))

(defn coerce
  "attempt to coerce values to the same type"
  [x y]
  (let [classes (mapv class [x y])]
    (if (apply = classes)
      (prevent-infinite x y)
      (match [x y]
             ;; [seq seq]
             [([& _] :seq) ([& _] :seq)] (prevent-infinite x y)
             ;; [vector seq]
             [[& _] ([& _] :seq)] (coerce [(seq x) y])
             ;; [seq vector]
             [([& _] :seq) [& _]] (coerce [x (seq y)])
             [_ _] [nil nil]))))

(defprotocol IInterpolate (-interpolate [start end]))

(defn interpolate [start end]
  (let [coerced (some->> [start end]
                         (apply wrap-nil)
                         (apply coerce))]
    (let [can-interpolate (->> coerced
                               (mapv (partial satisfies? IInterpolate)))]
      (if (apply = true can-interpolate)
        (apply -interpolate coerced)
        (do
          (throw
           (Exception. (str "Cannot interpolate between " start " and " end))))))))

(extend-protocol IInterpolate

  #+clj java.lang.Number
  #+cljs number
  (-interpolate [start end]
    (fn [t]
      (+ start (* t (- end start)))))

  #+clj clojure.lang.Sequential
  #+cljs Sequential
  (-interpolate [start end]
    (fn [t]
      (seq (for [k (range (Math/max (count start)
                                    (count end)))]
             (->> [(nth start k nil) (nth end k nil)]
                  (apply wrap-nil)
                  (apply interpolate)
                  (#(% t)))))))

  #+clj clojure.lang.IPersistentMap
  #+cljs IPersistentMap
  (-interpolate [start end]
    (fn [t]
      (into {} (for [k (->> [start end]
                            (map keys)
                            (map set)
                            (apply union))]
                 [k (->> [start end]
                         (map k)
                         (apply interpolate)
                         (#(% t)))])))))

(comment
  (defn intrpl [start end]
    ((interpolate start end) 0.5))

  (mapv #(satisfies? IInterpolate %) [1 ""])
  (satisfies? IInterpolate "")
  (intrpl 1 2)
  (intrpl [1 2] [5 6])
  ;; fails correctly
  (intrpl [1 5] [2 [1 2]])
  ;; works
  (intrpl [1 2] (range 5))
  (intrpl (range 5) [1 2])
  (intrpl [1 2] (repeat 5))

  (intrpl (repeat 5) (repeat 2))

  (intrpl {:a 0 :c 1} {:a 5 :b 2})
  )

allow seqs of different length. coerce to interpolatable type. prevent infinite lazyness. fresh value protocol


(ns virt.core
  (:require [compojure.handler :as handler]
            [compojure.route :as route]
            [compojure.core :as compojure :refer [GET POST ANY defroutes]]
            [ring.util.response :as resp]
            (ring.middleware [params :refer [wrap-params]]
                             [nested-params :refer [wrap-nested-params]]
                             [keyword-params :refer [wrap-keyword-params]]
                             [session :refer [wrap-session]]
                             [resource :refer [wrap-resource]]
                             [content-type :refer [wrap-content-type]])
            [aleph.http :refer :all]
            [aleph.formats :refer :all]
            [lamina.core :refer :all]
            [korma.core :as korma]
            [korma.db :as db]))

(def apps
  {:chat {:link "/chat"}})

(declare channels threads messages)

(defn geoFromText [lon lat]
  (str "ST_GeographyFromText('SRID=4326;POINT(" lon " " lat ")')"))

(defn get-channels [lon lat]
  (korma/select channels
    (korma/where
      (korma/raw (str "ST_DWithin(location," (geoFromText lon lat) ",200)")))))

(defn add-channel [channel-name lon lat]
  (korma/insert channels
    (korma/values
      {:name channel-name
       :location (korma/raw (geoFromText lon lat))})))

(defn get-threads [channel-id]
  (korma/select threads
    (korma/where {:channel_id channel-id})))

(defn add-chat-thread [channel-id thread-descr]
  (korma/insert threads
    (korma/values {:channel_id channel-id
                   :description thread-descr})))

(defn get-messages [channel-id thread-id]
  (korma/select messages
    (korma/where {:channel_id channel-id
                  :thread_id thread-id})))

(defn add-msg [channel-id thread-id msg]
  (korma/insert messages
    (korma/values {:channel_id channel-id
                   :thread_id thread-id
                   :message msg})))

(defn edn-response [body]
  {:status 200
   :headers {"Content-Type" "application/edn"}
   :body (pr-str body)})

(defn apps-handler [request]
  (edn-response apps))

(defn channels-handler [request]
  (edn-response
    (let [params (:params request)
          lon (Double/parseDouble (:lon params))
          lat (Double/parseDouble (:lat params))]
      (get-channels lon lat))))

(defn new-channel-handler [request]
  (edn-response
    (let [body (read-string (slurp (:body request)))
          geolocation (:geolocation body)]
      (add-channel (:channel-name body) (:lon geolocation) (:lat geolocation)))))

(defn chat-threads-handler [request]
  (edn-response
    (let [params (:route-params request)
          channel-id (Integer/parseInt (:channel-id params))]
      (get-threads channel-id))))

(defn new-chat-thread-handler [request]
  (edn-response
    (let [params (:route-params request)
          channel-id (Integer/parseInt (:channel-id params))
          body (read-string (slurp (:body request)))]
      (add-chat-thread channel-id (:thread-descr body)))))

(defn chat-messages-handler [request]
  (edn-response
    (let [params (:route-params request)
          channel-id (Integer/parseInt (:channel-id params))
          thread-id (Integer/parseInt (:thread-id params))]
      (get-messages channel-id thread-id))))

(defn chat-thread-ws-handler [ch request]
  (let [params (:route-params request)
        channel-id (Integer/parseInt (:channel-id params))
        thread-id (Integer/parseInt (:thread-id params))
        chat (named-channel
               (str thread-id)
               (fn [new-ch]
                 (receive-all new-ch
                   (fn [msg]
                     (let [[msg-type msg-data] (read-string msg)]
                       (case msg-type
                         :message (add-msg channel-id thread-id msg-data)))))))]
    (enqueue ch (pr-str [:initial (vec (get-messages channel-id thread-id))]))
    (siphon chat ch)
    (siphon ch chat)))

(defn serve-page [page]
  (-> (resp/resource-response (str page ".html") {:root "public"})
      (resp/content-type "text/html")))

(defroutes api-routes
  (GET "/apps" [] apps-handler)
  (GET "/channels" [] channels-handler)
  (POST "/channels" [] new-channel-handler)
  (GET "/chat/:channel-id/threads" [] chat-threads-handler)
  (POST "/chat/:channel-id/threads" [] new-chat-thread-handler)
  (GET "/chat/:channel-id/threads/:thread-id" [] chat-messages-handler)
  (GET ["/chat/:channel-id/threads/:thread-id/watch", :thread-id #"[0-9A-Za-z]+"] {}
       (wrap-aleph-handler chat-thread-ws-handler))
  ; TODO: aleph throwing exception
  (route/not-found "No such api path"))

(defroutes page-routes
  (GET "/chat*" [] (serve-page "chat"))
  (GET "/*" [] (serve-page "index")))

(defn -main [& args]
  (korma.db/defdb db (db/postgres {:db "virt"
                                   :user "postgres"
                                   :password "postgres"}))

  (korma/defentity channels
    (korma/transform
      (fn [c] (-> c
                  (assoc :app :chat)
                  (dissoc :location)
                  (clojure.set/rename-keys {:id :channel-id})))))

  (korma/defentity threads
    (korma/transform
      (fn [t] (clojure.set/rename-keys t {:id :thread-id
                                          :channel_id :channel-id}))))

  (korma/defentity messages
    (korma/transform
      (fn [m] (-> m
                  (clojure.set/rename-keys {:id :message-id
                                            :thread_id :thread-id
                                            :channel_id :channel-id})
                  :message))))

  (start-http-server
    (wrap-ring-handler
      (-> (compojure/routes (compojure/context "/api" [] api-routes)
                            page-routes)
          (wrap-session)
          (wrap-keyword-params)
          (wrap-nested-params)
          (wrap-params)
          (wrap-resource "public")
          (wrap-content-type)))
    {:port 3000 :websocket true}))

(ns virt.core
  (:require [compojure.handler :as handler]
            [compojure.route :as route]
            [compojure.core :as compojure :refer [GET POST ANY defroutes]]
            [ring.util.response :as resp]
            (ring.middleware [params :refer [wrap-params]]
                             [nested-params :refer [wrap-nested-params]]
                             [keyword-params :refer [wrap-keyword-params]]
                             [session :refer [wrap-session]]
                             [resource :refer [wrap-resource]]
                             [content-type :refer [wrap-content-type]])
            [aleph.http :refer :all]
            [aleph.formats :refer :all]
            [lamina.core :refer :all]
            [korma.core :as korma]
            [korma.db :as db]))

(def apps
  {:chat {:link "/chat"}})

(declare channels threads messages)

(defn geoFromText [lon lat]
  (str "ST_GeographyFromText('SRID=4326;POINT(" lon " " lat ")')"))

(defn get-channels [lon lat]
  (korma/select channels
    (korma/where
      (korma/raw (str "ST_DWithin(location," (geoFromText lon lat) ",200)")))
    (korma/order :id :DESC)))

(defn add-channel [channel-name lon lat]
  (korma/insert channels
    (korma/values
      {:name channel-name
       :location (korma/raw (geoFromText lon lat))})))

(defn get-threads [channel-id]
  (korma/select threads
    (korma/where {:channel_id channel-id})
    (korma/order :id :DESC)))

(defn add-chat-thread [channel-id thread-descr]
  (korma/insert threads
    (korma/values {:channel_id channel-id
                   :description thread-descr})))

(defn get-messages [channel-id thread-id]
  (korma/select messages
    (korma/where {:channel_id channel-id
                  :thread_id thread-id})
    (korma/order :id :ASC)))

(defn add-msg [channel-id thread-id msg]
  (korma/insert messages
    (korma/values {:channel_id channel-id
                   :thread_id thread-id
                   :message msg})))

(defn edn-response [body]
  {:status 200
   :headers {"Content-Type" "application/edn"}
   :body (pr-str body)})

(defn apps-handler [request]
  (edn-response apps))

(defn channels-handler [request]
  (edn-response
    (let [params (:params request)
          lon (Double/parseDouble (:lon params))
          lat (Double/parseDouble (:lat params))]
      (get-channels lon lat))))

(defn new-channel-handler [request]
  (edn-response
    (let [body (read-string (slurp (:body request)))
          geolocation (:geolocation body)]
      (add-channel (:channel-name body) (:lon geolocation) (:lat geolocation)))))

(defn chat-threads-handler [request]
  (edn-response
    (let [params (:route-params request)
          channel-id (Integer/parseInt (:channel-id params))]
      (get-threads channel-id))))

(defn new-chat-thread-handler [request]
  (edn-response
    (let [params (:route-params request)
          channel-id (Integer/parseInt (:channel-id params))
          body (read-string (slurp (:body request)))]
      (add-chat-thread channel-id (:thread-descr body)))))

(defn chat-messages-handler [request]
  (edn-response
    (let [params (:route-params request)
          channel-id (Integer/parseInt (:channel-id params))
          thread-id (Integer/parseInt (:thread-id params))]
      (get-messages channel-id thread-id))))

(defn chat-thread-ws-handler [ch request]
  (let [params (:route-params request)
        channel-id (Integer/parseInt (:channel-id params))
        thread-id (Integer/parseInt (:thread-id params))
        chat (named-channel
               (str thread-id)
               (fn [new-ch]
                 (receive-all new-ch
                   (fn [msg]
                     (let [[msg-type msg-data] (read-string msg)]
                       (case msg-type
                         :message (add-msg channel-id thread-id msg-data)))))))]
    (enqueue ch (pr-str [:initial (vec (get-messages channel-id thread-id))]))
    (siphon chat ch)
    (siphon ch chat)))

(defn serve-page [page]
  (-> (resp/resource-response (str page ".html") {:root "public"})
      (resp/content-type "text/html")))

(defroutes api-routes
  (GET "/apps" [] apps-handler)
  (GET "/channels" [] channels-handler)
  (POST "/channels" [] new-channel-handler)
  (GET "/chat/:channel-id/threads" [] chat-threads-handler)
  (POST "/chat/:channel-id/threads" [] new-chat-thread-handler)
  (GET "/chat/:channel-id/threads/:thread-id" [] chat-messages-handler)
  (GET ["/chat/:channel-id/threads/:thread-id/watch", :thread-id #"[0-9A-Za-z]+"] {}
       (wrap-aleph-handler chat-thread-ws-handler))
  ; TODO: aleph throwing exception
  (route/not-found "No such api path"))

(defroutes page-routes
  (GET "/chat*" [] (serve-page "chat"))
  (GET "/*" [] (serve-page "index")))

(defn -main [& args]
  (korma.db/defdb db (db/postgres {:db "virt"
                                   :user "postgres"
                                   :password "postgres"}))

  (korma/defentity channels
    (korma/transform
      (fn [c] (-> c
                  (assoc :app :chat)
                  (dissoc :location)
                  (clojure.set/rename-keys {:id :channel-id})))))

  (korma/defentity threads
    (korma/transform
      (fn [t] (clojure.set/rename-keys t {:id :thread-id
                                          :channel_id :channel-id}))))

  (korma/defentity messages
    (korma/transform
      (fn [m] (-> m
                  (clojure.set/rename-keys {:id :message-id
                                            :thread_id :thread-id
                                            :channel_id :channel-id})
                  :message))))

  (start-http-server
    (wrap-ring-handler
      (-> (compojure/routes (compojure/context "/api" [] api-routes)
                            page-routes)
          (wrap-session)
          (wrap-keyword-params)
          (wrap-nested-params)
          (wrap-params)
          (wrap-resource "public")
          (wrap-content-type)))
    {:port 3000 :websocket true}))

Select models in correct order

Select models in correct order


(ns cake.tasks.jar
  (:use cake cake.core cake.file uncle.core
        [cake.deps :only [deps]]
        [bake.core :only [current-context log project-with-context]]
        [clojure.java.io :only [copy writer]]
        [clojure.string :only [join]]
        [useful.utils :only [verify]]
        [useful.map :only [into-map]])
  (:require [clojure.xml :as xml])
  (:import [org.apache.tools.ant.taskdefs Jar War Copy Delete Chmod Replace]
           [org.apache.tools.ant.types FileSet ZipFileSet]
           [org.codehaus.plexus.logging.console ConsoleLogger]
           [org.apache.maven.artifact.ant InstallTask Pom]
           [java.io File FileOutputStream]
           [java.util.jar JarFile]))

(defn artifact [name-key ext]
  (file (str (name-key *project*)
             (when-let [context (current-context)]
               (str "-" context))
             ext)))

(defn jarfile [] (artifact :jar-name ".jar"))

(defn manifest []
  (merge (:manifest *project*)
         {"Created-By" "cake"
          "Built-By"   (System/getProperty "user.name")
          "Build-Jdk"  (System/getProperty "java.version")
          "Class-Path" (:jar-classpath *project*)
          "Main-Class" (when-let [main (:main *project*)]
                         (-> main str (.replaceAll "-" "_")))}))

(defn add-license [task]
  (add-fileset task {:file (file "LICENSE")}))

(defn- file-mapping [from to]
  (let [from (file from)]
    (when (.exists from)
      (if (.isDirectory from)
        {:dir from :prefix to :includes "**/*"}
        {:file from :fullpath to}))))

(defn add-file-mappings [task mappings]
  (doseq [m mappings]
    (cond (map?    m) (add-zipfileset task m)
          (string? m) (add-zipfileset task (file-mapping m m))
          (vector? m) (add-zipfileset task (apply file-mapping m)))))

(defn bakepath [& opts]
  (let [bakepath (System/getProperty "bake.path")]
    (merge (into-map opts)
           (if (.endsWith bakepath ".jar")
             {:src bakepath}
             {:dir bakepath}))))

(defn add-path [task path-name & [opts]]
  (doseq [path (*project* path-name)]
    (add-zipfileset task (assoc opts :dir path))))

(defn add-source-files [task & [opts]]
  (when-not (:omit-source *project*)
    (add-path task :source-path {:includes "**/*.clj, **/*.java"}))
  (when (:bake *project*)
    (add-zipfileset task (bakepath opts :excludes "cake.clj"))))

(defn build-context []
  (ant Copy {:todir "build/jar" :overwrite true}
       (add-zipfileset (bakepath :includes "cake.clj")))
  (let [cake-clj "build/jar/cake.clj"
        context (current-context)
        project (project-with-context context)]
    (ant Replace {:file cake-clj :token "(comment project)" :value (pr-str `(quote ~project))})
    (when (nil? context)
      (ant Replace {:file cake-clj :token "(comment context)" :value (pr-str `(quote ~*context*))}))))

(defn build-jar []
  (let [maven (format "META-INF/maven/%s/%s" (:group-id *project*) (:artifact-id *project*))
        cake  (format "META-INF/cake/%s/%s"  (:group-id *project*) (:artifact-id *project*))]
    (when (:bake *project*)
      (build-context))
    (ant Jar {:dest-file (jarfile)}
      (add-manifest (manifest))
      (add-license)
      (add-source-files)
      (add-path :compile-path {:includes "**/*.class"})
      (add-path :resources-path)
      (add-zipfileset {:dir (file ".") :prefix maven  :includes "pom.xml"})
      (add-zipfileset {:dir (file ".") :prefix cake   :includes "*.clj"})
      (add-fileset    {:dir (file "build" "jar")})
      (add-zipfileset {:dir (file "native") :prefix "native"})
      (add-file-mappings (:jar-files *project*)))))

(defn clean [pattern]
  (when (:clean *opts*)
    (ant Delete {:dir (file ".") :includes pattern})))

(deftask jar #{compile}
  "Build a jar file containing project source and class files."
  (clean "*.jar")
  (build-jar))

(defn uberjarfile [] (artifact :uberjar-name ".jar"))

(defn jars []
  (concat [(jarfile)]
          (deps :dependencies)
          (deps :ext-dependencies)))

(defn plexus-components [jar]
  (let [jarfile (JarFile. jar)]
    (if-let [entry (.getEntry jarfile "META-INF/plexus/components.xml")]
      (->> entry (.getInputStream jarfile)
           xml/parse :content (filter #(= :components (:tag %))) first :content))))

(defn merge-plexus-components [jars dest]
  (when-let [components (seq (mapcat plexus-components jars))]
    (.mkdirs (.getParentFile dest))
    (with-open [file (writer dest)]
      (binding [*out* file]
        (xml/emit {:tag "component-set" :content [{:tag "components" :content components}]})
        (flush)))))

(defn add-jar-contents [task jars]
  (doseq [jar jars :let [name (.replace (.getName jar) ".jar" "")]]
    (add-zipfileset task {:src jar :excludes "META-INF/**/*, project.clj, LICENSE"})
    (add-zipfileset task {:src jar :includes "META-INF/**/*" :prefix (str "META-INF/" name)})))

(defn build-uberjar [jarfile jars]
  (let [plexus-components (file "build/uberjar/META-INF/plexus/components.xml")]
    (merge-plexus-components jars plexus-components)
    (ant Jar {:dest-file jarfile :duplicate "preserve"}
         (add-manifest (manifest))
         (add-jar-contents jars)
         (add-fileset {:dir (file "build" "uberjar")}))))

(deftask uberjar #{jar}
  "Create a standalone jar containing all project dependencies."
  (build-uberjar (uberjarfile) (jars)))

(deftask bin #{uberjar}
  "Create a standalone console executable for your project."
  "Add :main to your project.clj to specify the namespace that contains your -main function."
  (if (:main *project*)
    (let [binfile (file (:artifact-id *project*))
          uberjar (uberjarfile)]
      (when (newer? uberjar binfile)
        (log "Creating standalone executable:" (.getPath binfile))
        (with-open [bin (FileOutputStream. binfile)]
          (let [opts (or (get *config* "project.java_opts") "")
                unix (format ":;exec java %s -jar $0 \"$@\"\n" opts)
                dos  (format "@echo off\r\njava %s -jar %%1 \"%%~f0\" %%*\r\ngoto :eof\r\n" opts)]
            (.write bin (.getBytes unix))
            (.write bin (.getBytes dos)))
          (copy uberjar bin))
        (ant Chmod {:file binfile :perm "+x"})))
    (println "Cannot create bin without :main namespace in project.clj")))

(defn warfile [] (artifact :war-name ".war"))

(defn add-web-files [task]
  (doseq [path (:source-path *project*)]
    (add-zipfileset task {:dir path :prefix "WEB-INF" :includes "*web.xml"})
    (add-fileset    task {:dir (file path "html")})))

(defn build-war []
  (build-context)
  (ant War {:dest-file (warfile)}
    (add-manifest (manifest))
    (add-license)
    (add-source-files {:prefix "WEB-INF/classes"})
    (add-web-files)
    (add-path :compile-path   {:prefix "WEB-INF/classes" :includes "**/*.class"})
    (add-path :resources-path {:prefix "WEB-INF/classes"})
    (add-zipfileset {:dir (file "build" "jar")      :prefix "WEB-INF/classes"})
    (add-fileset    {:dir (file "build" "war")})
    (add-file-mappings (:war-files *project*))))

(deftask war #{compile}
  "Create a web archive containing project source and class files."
  (clean "*.war")
  (build-war))

(deftask uberwar #{war}
  "Create a web archive containing all project dependencies."
  (let [task (ant-type War {:dest-file (warfile) :update true})]
    (doseq [jar (jars)]
      (add-zipfileset task {:file jar :prefix "WEB-INF/lib"}))
    (execute task)))

(ns cake.tasks.jar
  (:use cake cake.core cake.file uncle.core
        [cake.deps :only [deps]]
        [bake.core :only [current-context log project-with-context]]
        [clojure.java.io :only [copy writer]]
        [clojure.string :only [join]]
        [useful.utils :only [verify]]
        [useful.map :only [into-map]])
  (:require [clojure.xml :as xml])
  (:import [org.apache.tools.ant.taskdefs Jar War Copy Delete Chmod Replace]
           [org.apache.tools.ant.types FileSet ZipFileSet]
           [org.codehaus.plexus.logging.console ConsoleLogger]
           [org.apache.maven.artifact.ant InstallTask Pom]
           [java.io File FileOutputStream]
           [java.util.jar JarFile]))

(defn artifact [name-key ext]
  (file (str (name-key *project*)
             (when-let [context (current-context)]
               (str "-" context))
             ext)))

(defn jarfile [] (artifact :jar-name ".jar"))

(defn manifest []
  (merge (:manifest *project*)
         {"Created-By" "cake"
          "Built-By"   (System/getProperty "user.name")
          "Build-Jdk"  (System/getProperty "java.version")
          "Class-Path" (:jar-classpath *project*)
          "Main-Class" (when-let [main (:main *project*)]
                         (-> main str (.replaceAll "-" "_")))}))

(defn add-license [task]
  (add-fileset task {:file (file "LICENSE")}))

(defn- file-mapping [from to]
  (let [from (file from)]
    (when (.exists from)
      (if (.isDirectory from)
        {:dir from :prefix to :includes "**/*"}
        {:file from :fullpath to}))))

(defn add-file-mappings [task mappings]
  (doseq [m mappings]
    (cond (map?    m) (add-zipfileset task m)
          (string? m) (add-zipfileset task (file-mapping m m))
          (vector? m) (add-zipfileset task (apply file-mapping m)))))

(defn bakepath [& opts]
  (let [bakepath (System/getProperty "bake.path")]
    (merge (into-map opts)
           (if (.endsWith bakepath ".jar")
             {:src bakepath}
             {:dir bakepath}))))

(defn add-path [task path-name & [opts]]
  (doseq [path (*project* path-name)]
    (add-zipfileset task (assoc opts :dir path))))

(defn add-source-files [task & [opts]]
  (when-not (:omit-source *project*)
    (add-path task :source-path (assoc opts :includes "**/*.clj, **/*.java")))
  (when (:bake *project*)
    (add-zipfileset task (bakepath opts :excludes "cake.clj"))))

(defn build-context []
  (ant Copy {:todir "build/jar" :overwrite true}
       (add-zipfileset (bakepath :includes "cake.clj")))
  (let [cake-clj "build/jar/cake.clj"
        context (current-context)
        project (project-with-context context)]
    (ant Replace {:file cake-clj :token "(comment project)" :value (pr-str `(quote ~project))})
    (when (nil? context)
      (ant Replace {:file cake-clj :token "(comment context)" :value (pr-str `(quote ~*context*))}))))

(defn build-jar []
  (let [maven (format "META-INF/maven/%s/%s" (:group-id *project*) (:artifact-id *project*))
        cake  (format "META-INF/cake/%s/%s"  (:group-id *project*) (:artifact-id *project*))]
    (when (:bake *project*)
      (build-context))
    (ant Jar {:dest-file (jarfile)}
      (add-manifest (manifest))
      (add-license)
      (add-source-files)
      (add-path :compile-path {:includes "**/*.class"})
      (add-path :resources-path)
      (add-zipfileset {:dir (file ".") :prefix maven  :includes "pom.xml"})
      (add-zipfileset {:dir (file ".") :prefix cake   :includes "*.clj"})
      (add-fileset    {:dir (file "build" "jar")})
      (add-zipfileset {:dir (file "native") :prefix "native"})
      (add-file-mappings (:jar-files *project*)))))

(defn clean [pattern]
  (when (:clean *opts*)
    (ant Delete {:dir (file ".") :includes pattern})))

(deftask jar #{compile}
  "Build a jar file containing project source and class files."
  (clean "*.jar")
  (build-jar))

(defn uberjarfile [] (artifact :uberjar-name ".jar"))

(defn jars []
  (concat [(jarfile)]
          (deps :dependencies)
          (deps :ext-dependencies)))

(defn plexus-components [jar]
  (let [jarfile (JarFile. jar)]
    (if-let [entry (.getEntry jarfile "META-INF/plexus/components.xml")]
      (->> entry (.getInputStream jarfile)
           xml/parse :content (filter #(= :components (:tag %))) first :content))))

(defn merge-plexus-components [jars dest]
  (when-let [components (seq (mapcat plexus-components jars))]
    (.mkdirs (.getParentFile dest))
    (with-open [file (writer dest)]
      (binding [*out* file]
        (xml/emit {:tag "component-set" :content [{:tag "components" :content components}]})
        (flush)))))

(defn add-jar-contents [task jars]
  (doseq [jar jars :let [name (.replace (.getName jar) ".jar" "")]]
    (add-zipfileset task {:src jar :excludes "META-INF/**/*, project.clj, LICENSE"})
    (add-zipfileset task {:src jar :includes "META-INF/**/*" :prefix (str "META-INF/" name)})))

(defn build-uberjar [jarfile jars]
  (let [plexus-components (file "build/uberjar/META-INF/plexus/components.xml")]
    (merge-plexus-components jars plexus-components)
    (ant Jar {:dest-file jarfile :duplicate "preserve"}
         (add-manifest (manifest))
         (add-jar-contents jars)
         (add-fileset {:dir (file "build" "uberjar")}))))

(deftask uberjar #{jar}
  "Create a standalone jar containing all project dependencies."
  (build-uberjar (uberjarfile) (jars)))

(deftask bin #{uberjar}
  "Create a standalone console executable for your project."
  "Add :main to your project.clj to specify the namespace that contains your -main function."
  (if (:main *project*)
    (let [binfile (file (:artifact-id *project*))
          uberjar (uberjarfile)]
      (when (newer? uberjar binfile)
        (log "Creating standalone executable:" (.getPath binfile))
        (with-open [bin (FileOutputStream. binfile)]
          (let [opts (or (get *config* "project.java_opts") "")
                unix (format ":;exec java %s -jar $0 \"$@\"\n" opts)
                dos  (format "@echo off\r\njava %s -jar %%1 \"%%~f0\" %%*\r\ngoto :eof\r\n" opts)]
            (.write bin (.getBytes unix))
            (.write bin (.getBytes dos)))
          (copy uberjar bin))
        (ant Chmod {:file binfile :perm "+x"})))
    (println "Cannot create bin without :main namespace in project.clj")))

(defn warfile [] (artifact :war-name ".war"))

(defn add-web-files [task]
  (doseq [path (:source-path *project*)]
    (add-zipfileset task {:dir path :prefix "WEB-INF" :includes "*web.xml"})
    (add-fileset    task {:dir (file path "html")})))

(defn build-war []
  (build-context)
  (ant War {:dest-file (warfile)}
    (add-manifest (manifest))
    (add-license)
    (add-source-files {:prefix "WEB-INF/classes"})
    (add-web-files)
    (add-path :compile-path   {:prefix "WEB-INF/classes" :includes "**/*.class"})
    (add-path :resources-path {:prefix "WEB-INF/classes"})
    (add-zipfileset {:dir (file "build" "jar")      :prefix "WEB-INF/classes"})
    (add-fileset    {:dir (file "build" "war")})
    (add-file-mappings (:war-files *project*))))

(deftask war #{compile}
  "Create a web archive containing project source and class files."
  (clean "*.war")
  (build-war))

(deftask uberwar #{war}
  "Create a web archive containing all project dependencies."
  (let [task (ant-type War {:dest-file (warfile) :update true})]
    (doseq [jar (jars)]
      (add-zipfileset task {:file jar :prefix "WEB-INF/lib"}))
    (execute task)))

fix war task

fix war task


(ns reply.exit)

(defn done-commands [eof]
  #{eof 'quit 'exit '(quit) '(exit)})

(defn done? [eof expression]
  ((done-commands eof) expression))

(defn exit
  "Exits the REPL. This is fairly brutal, does (System/exit 0)."
  []
  (shutdown-agents)
  (print "Bye for now!")
  (flush)
  (System/exit 0))

(ns reply.exit)

(defn done-commands [eof]
  #{eof 'quit 'exit '(quit) '(exit)
    "quit" "(quit)" "exit" "(exit)"})

(defn done? [eof expression]
  ((done-commands eof) expression))

(defn exit
  "Exits the REPL. This is fairly brutal, does (System/exit 0)."
  []
  (shutdown-agents)
  (print "Bye for now!")
  (flush)
  (System/exit 0))

Fix exit/quit for sjacket parsing (as strings)


(ns c2.scale)

(defn linear [& {:keys [domain range]
                 :or {domain [0 1]
                      range  [0 1]}}]
  (let [domain-length (- (last domain) (first domain))
        range-length (- (last range) (first range))]
    (fn [x]
      (+ (first range)
         (* range-length
            (/ (- x (first domain))
               domain-length))))))

(defn log [& {:keys [domain range]
              :or {domain [1 10]
                   range  [0 1]}}]
  (let [log #(/ (.log js/Math %)
                (.-LN10 js/Math))
        lin (linear :domain (map log domain)
                    :range range)]
    (comp lin log)))

Add log (base 10) scale.

Add log (base 10) scale.


(ns export-server.core
  (:import (java.util Properties)
           (java.nio.charset Charset))
  (:use [compojure.route :only [not-found]]
        org.httpkit.server
        compojure.core)
  (:require [ring.util.response]
            [clojure.string :as string]
            [clojure.tools.cli :refer [parse-opts]]
            [ring.middleware.params :refer [wrap-params]]
            [ring.middleware.keyword-params :refer [wrap-keyword-params]]
            [ring.middleware.session :refer [wrap-session]]
            [export-server.state :as state]
            [export-server.web-handlers :as web]
            [export-server.cmd-handlers :as cmd]
            [export-server.utils.phantom :as browser]
            ;[export-server.utils.jbrowser :as browser]
            [export-server.utils.config :as config]
            [export-server.sharing.core :as sharing]
            [export-server.sharing.twitter :as twitter]
            [export-server.sharing.storage :as storage :refer [create-storage init]]
            [compojure.route :as route]
            [clojure.java.io :as io]
            [taoensso.timbre :as timbre]
            [taoensso.timbre.appenders.core :as appenders])
  (:gen-class))

;====================================================================================
; Main utils
;====================================================================================
(defn get-project-version
  ([] (get-project-version "export-server" "export-server"))
  ([groupid artifact] (-> (doto (Properties.)
         (.load (-> "META-INF/maven/%s/%s/pom.properties"
                    (format groupid artifact)
                    (io/resource)
                    (io/reader))))
       (.get "version"))))

(def server-name (str "AnyChart Export Server " (get-project-version)))

(defn init-logger [log-file-name]
  (clojure.java.io/delete-file log-file-name :quiet)
  (timbre/merge-config!
    {:appenders {:spit (appenders/spit-appender {:fname log-file-name})}})
  ; Set the lowest-level to output as :debug
  (timbre/set-level! :debug)
  (Thread/setDefaultUncaughtExceptionHandler
    (reify Thread$UncaughtExceptionHandler
      (uncaughtException [_ thread ex]
        (timbre/error ex "Uncaught exception on" (.getName thread))))))

;====================================================================================
; Server Usage
;====================================================================================
(defn server-usage [options-summary]
  (->> [server-name
        ""
        "Action: server"
        "Usage: java -jar anychart-export.jar server [options]"
        "See https://github.com/AnyChart/export-server for HTTP API."
        ""
        "Options:"
        options-summary
        ""
        "Please, see http://docs.anychart.com for more info."
        ]
       (string/join \newline)))

;====================================================================================
; Command Line Usage
;====================================================================================
(defn cmd-usage [options-summary]
  (->> [server-name
        ""
        "Action: cmd"
        "Usage: java -jar anychart-export.jar cmd [options]"
        ""
        "Options:"
        options-summary
        ""
        "Please, see http://docs.anychart.com for more info."
        ]
       (string/join \newline)))

(defn exit [status msg]
  (println msg)
  (System/exit status))

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

;====================================================================================
; Common Usage
;====================================================================================
(def common-options
  [["-C" "--config PATH" "Path to config"
    :default nil]

   ;Server Args--------------------------------------------------------------------------------------------
   ["-P" "--port PORT" "Port number for the server."
    :parse-fn #(Integer/parseInt %)
    :validate [#(< 0 % 0x10000) "Must be a number between 0 and 65536"]]

   ["-H" "--host HOST" "Ip, if has many ips to bind."]

   ["-F" "--log FILE" "File for server logging."]

   ["-a" "--allow-scripts-executing ALLOW_SCRIPTS_EXECUTING" "Allow to execute violent scripts in phantom js."
    :parse-fn #(or (= "true" %) (= "1" %) (= "y" %) (= "yes" %))]

   ;Saving image or pdf to folder
   ["-z" "--saving-folder PATH" "Path to save images or pdf"]
   ["-Z" "--saving-url-prefix PREFIX" "URL prefix will be returned to request"]

   ;; sharing
   [nil "--sharing-port PORT" "Sharing mysql database port" :parse-fn #(Integer/parseInt %)]
   [nil "--sharing-db NAME" "Sharing mysql database name"]
   [nil "--sharing-user USER" "Sharing mysql database user"]
   [nil "--sharing-password PASSWORD" "Sharing mysql database password"]

   ;; twitter
   [nil "--twitter-key KEY" "Twitter application key"]
   [nil "--twitter-secret SECRET" "Twitter application secret"]
   [nil "--twitter-callback" "Twitter application callback URL"]

   ;Command Line Common Args--------------------------------------------------------------------------------------------
   ["-s" "--script SCRIPT" "JavaScript String to Execute." ]

   ["-i" "--input-file INPUT_FILE" "JavaScript file to Execute"]

   ["-o" "--output-file OUTPUT_FILE" "Output File name, file extentions is optional."]

   ["-p" "--output-path OUTPUT_PATH" "Output File Directory"]

   ["-t" "--type TYPE" "Type of the output file."
    :validate [#(contains? #{"png" "jpg" "svg" "pdf"} %) "Type must be one of the following types: png, jpg, svg, pdf"]]

   ["-c" "--container-id CONTAINER_ID" "Container id."]

   ["-W" "--container-width CONTAINER_WIDTH" "Container width."]

   ["-L" "--container-height CONTAINER_HEIGHT" "Container height"]

   ;Export Images Args--------------------------------------------------------------------------------------------------
   ["-w" "--image-width IMAGE_WIDTH" "Image width."
    :parse-fn #(Integer/parseInt %)]

   ["-l" "--image-height IMAGE_HEIGHT" "Image height"
    :parse-fn #(Integer/parseInt %)]

   ["-f" "--force-transparent-white FORCE_TRANSPARENT_WHITE" "Force transparent to white"]

   ["-q" "--jpg-quality JPG_QUALITY" "Image quality,"
    :parse-fn #(Float/parseFloat %)]

   ;Export PDF Args--------------------------------------------------------------------------------------------------
   ["-S" "--pdf-size PDF-SIZE" "PDF Size"
    :parse-fn #(keyword %)]

   ["-X" "--pdf-width PDF-WIDTH" "Pdf width"
    :parse-fn #(Integer/parseInt %)]

   ["-Y" "--pdf-height PDF-HEIGHT" "Pdf height"
    :parse-fn #(Integer/parseInt %)]

   ["-x" "--pdf-x PDF-X" "Pdf X"
    :parse-fn #(Integer/parseInt %)]

   ["-y" "--pdf-y PDF-Y" "Pdf Y"
    :parse-fn #(Integer/parseInt %)]

   ["-O" "--pdf-landscape PDF-LANDSCAPE" "PDF Orientation"]

   ;Export PDF Args--------------------------------------------------------------------------------------------------
   ["-v" "--version" "Print version, can be used without action"]
   ["-h" "--help"]])

(defn usage []
  (->> [server-name
        ""
        "Usage: java -jar anychart-export.jar action [options]"
        "Actions:"
        "  server    Start a new instance of AnyChart Export Server."
        "            Use --help arg with action for more info."
        ""
        "  cmd       Run Export Server once"
        "            Use --help arg with action for more info."
        ""
        "Please, see http://docs.anychart.com for more info."
        ]
       (string/join \newline)))

;====================================================================================
; Server Actions
;====================================================================================
(defroutes app-routes
           (GET "/status" [] "ok")
           (POST "/status" [] "ok")
           (POST "/sharing/twitter" [] web/sharing-twitter)
           (GET "/sharing/twitter_oauth" [] twitter/twitter-oauth)
           (POST "/sharing/twitter_confirm" [] twitter/twitter-confirm)
           (GET "/dialog" [] twitter/dialog)
           (POST "/png" [] web/png)
           (POST "/jpg" [] web/jpg)
           (POST "/svg" [] web/svg)
           (POST "/pdf" [] web/pdf)
           (POST "/xml" [] web/xml)
           (POST "/json" [] web/json)
           (POST "/csv" [] web/csv)
           (POST "/xlsx" [] web/xlsx)
           (route/not-found "
Page not found.
"))

;(def app (-> app-routes wrap-params))
(def app (-> app-routes wrap-params (wrap-session {:store (create-storage)})))

(defn shutdown-server []
  (timbre/info "Shutdown...")
  (state/stop-server!)
  (browser/stop-phantom))

(defn start-server [options summary]
  (if (:help options) (exit 0 (server-usage summary)))
  (when (:log options)
    (init-logger (:log options)))
  (timbre/info (str "Starting export server on " (:host options) ":" (:port options)))
  (if (sharing/init options)
    (timbre/info "Sharing initialiazed")
    (timbre/warn "Sharing did not initialize. Provide both twitter-* and sharing-* options."))
  (when (:allow-scripts-executing options)
    (browser/setup-phantom))
  (state/set-server! (run-server app {:port (:port options) :ip (:host options)}))
  (.addShutdownHook (Runtime/getRuntime) (Thread. shutdown-server)))

;====================================================================================
; Cmd Actions
;====================================================================================
(defn cmd-export [options summary]
  (if (:help options) (exit 0 (cmd-usage summary)))
  (let [script (:script options)
        file (:input-file options)]
    (cond
      (and (nil? script) (nil? file)) (exit 1 (error-msg ["script or file should be specified in 'cmd' mode."]))
      (and file (not (.exists (io/file file)))) (exit 1 (error-msg ["Input File not exists."]))
      :else (case (:type options)
              "png" (cmd/png options)
              "jpg" (cmd/jpg options)
              "svg" (cmd/svg options)
              "pdf" (cmd/pdf options)))))

;====================================================================================
; Main
;====================================================================================
(defn -main [& args]
  (let [{:keys [options arguments errors summary]} (parse-opts args common-options)]
    (cond
      (:version options) (exit 0 server-name)
      errors (exit 1 (error-msg errors))
      (nil? (state/init (first arguments) options)) (exit 1 "Can't read config file"))
    (let [options @state/options
          mode (:mode options)]
      (reset! web/allow-script-executing (:allow-scripts-executing options))
      (println options)
      (case mode
        "server" (start-server options summary)
        "cmd" (cmd-export options summary)
        (exit 1 (usage))))))

(ns export-server.core
  (:import (java.util Properties)
           (java.nio.charset Charset))
  (:use [compojure.route :only [not-found]]
        org.httpkit.server
        compojure.core)
  (:require [ring.util.response]
            [clojure.string :as string]
            [clojure.tools.cli :refer [parse-opts]]
            [ring.middleware.params :refer [wrap-params]]
            [ring.middleware.keyword-params :refer [wrap-keyword-params]]
            [ring.middleware.session :refer [wrap-session]]
            [export-server.state :as state]
            [export-server.web-handlers :as web]
            [export-server.cmd-handlers :as cmd]
            [export-server.utils.phantom :as browser]
            ;[export-server.utils.jbrowser :as browser]
            [export-server.utils.config :as config]
            [export-server.sharing.core :as sharing]
            [export-server.sharing.twitter :as twitter]
            [export-server.sharing.storage :as storage :refer [create-storage init]]
            [compojure.route :as route]
            [clojure.java.io :as io]
            [taoensso.timbre :as timbre]
            [taoensso.timbre.appenders.core :as appenders])
  (:gen-class))

;====================================================================================
; Main utils
;====================================================================================
(defn get-project-version
  ([] (get-project-version "export-server" "export-server"))
  ([groupid artifact] (-> (doto (Properties.)
         (.load (-> "META-INF/maven/%s/%s/pom.properties"
                    (format groupid artifact)
                    (io/resource)
                    (io/reader))))
       (.get "version"))))

(def server-name (str "AnyChart Export Server " (get-project-version)))

(defn init-logger [log-file-name]
  (clojure.java.io/delete-file log-file-name :quiet)
  (timbre/merge-config!
    {:appenders {:spit (appenders/spit-appender {:fname log-file-name})}})
  ; Set the lowest-level to output as :debug
  (timbre/set-level! :debug)
  (Thread/setDefaultUncaughtExceptionHandler
    (reify Thread$UncaughtExceptionHandler
      (uncaughtException [_ thread ex]
        (timbre/error ex "Uncaught exception on" (.getName thread))))))

;====================================================================================
; Server Usage
;====================================================================================
(defn server-usage [options-summary]
  (->> [server-name
        ""
        "Action: server"
        "Usage: java -jar anychart-export.jar server [options]"
        "See https://github.com/AnyChart/export-server for HTTP API."
        ""
        "Options:"
        options-summary
        ""
        "Please, see http://docs.anychart.com for more info."
        ]
       (string/join \newline)))

;====================================================================================
; Command Line Usage
;====================================================================================
(defn cmd-usage [options-summary]
  (->> [server-name
        ""
        "Action: cmd"
        "Usage: java -jar anychart-export.jar cmd [options]"
        ""
        "Options:"
        options-summary
        ""
        "Please, see http://docs.anychart.com for more info."
        ]
       (string/join \newline)))

(defn exit [status msg]
  (println msg)
  (System/exit status))

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

;====================================================================================
; Common Usage
;====================================================================================
(def common-options
  [["-C" "--config PATH" "Path to config"
    :default nil]

   ;Server Args--------------------------------------------------------------------------------------------
   ["-P" "--port PORT" "Port number for the server."
    :parse-fn #(Integer/parseInt %)
    :validate [#(< 0 % 0x10000) "Must be a number between 0 and 65536"]]

   ["-H" "--host HOST" "Ip, if has many ips to bind."]

   ["-F" "--log FILE" "File for server logging."]

   ["-a" "--allow-scripts-executing ALLOW_SCRIPTS_EXECUTING" "Allow to execute violent scripts in phantom js."
    :parse-fn #(or (= "true" %) (= "1" %) (= "y" %) (= "yes" %))]

   ;Saving image or pdf to folder
   ["-z" "--saving-folder PATH" "Path to save images or pdf"]
   ["-Z" "--saving-url-prefix PREFIX" "URL prefix will be returned to request"]

   ;; sharing
   [nil "--sharing-port PORT" "Sharing mysql database port" :parse-fn #(Integer/parseInt %)]
   [nil "--sharing-db NAME" "Sharing mysql database name"]
   [nil "--sharing-user USER" "Sharing mysql database user"]
   [nil "--sharing-password PASSWORD" "Sharing mysql database password"]

   ;; twitter
   [nil "--twitter-key KEY" "Twitter application key"]
   [nil "--twitter-secret SECRET" "Twitter application secret"]
   [nil "--twitter-callback" "Twitter application callback URL"]

   ;Command Line Common Args--------------------------------------------------------------------------------------------
   ["-s" "--script SCRIPT" "JavaScript String to Execute." ]

   ["-i" "--input-file INPUT_FILE" "JavaScript file to Execute"]

   ["-o" "--output-file OUTPUT_FILE" "Output File name, file extentions is optional."]

   ["-p" "--output-path OUTPUT_PATH" "Output File Directory"]

   ["-t" "--type TYPE" "Type of the output file."
    :validate [#(contains? #{"png" "jpg" "svg" "pdf"} %) "Type must be one of the following types: png, jpg, svg, pdf"]]

   ["-c" "--container-id CONTAINER_ID" "Container id."]

   ["-W" "--container-width CONTAINER_WIDTH" "Container width."]

   ["-L" "--container-height CONTAINER_HEIGHT" "Container height"]

   ;Export Images Args--------------------------------------------------------------------------------------------------
   ["-w" "--image-width IMAGE_WIDTH" "Image width."
    :parse-fn #(Integer/parseInt %)]

   ["-l" "--image-height IMAGE_HEIGHT" "Image height"
    :parse-fn #(Integer/parseInt %)]

   ["-f" "--force-transparent-white FORCE_TRANSPARENT_WHITE" "Force transparent to white"]

   ["-q" "--jpg-quality JPG_QUALITY" "Image quality,"
    :parse-fn #(Float/parseFloat %)]

   ;Export PDF Args--------------------------------------------------------------------------------------------------
   ["-S" "--pdf-size PDF-SIZE" "PDF Size"
    :parse-fn #(keyword %)]

   ["-X" "--pdf-width PDF-WIDTH" "Pdf width"
    :parse-fn #(Integer/parseInt %)]

   ["-Y" "--pdf-height PDF-HEIGHT" "Pdf height"
    :parse-fn #(Integer/parseInt %)]

   ["-x" "--pdf-x PDF-X" "Pdf X"
    :parse-fn #(Integer/parseInt %)]

   ["-y" "--pdf-y PDF-Y" "Pdf Y"
    :parse-fn #(Integer/parseInt %)]

   ["-O" "--pdf-landscape PDF-LANDSCAPE" "PDF Orientation"]

   ;Export PDF Args--------------------------------------------------------------------------------------------------
   ["-v" "--version" "Print version, can be used without action"]
   ["-h" "--help"]])

(defn usage []
  (->> [server-name
        ""
        "Usage: java -jar anychart-export.jar action [options]"
        "Actions:"
        "  server    Start a new instance of AnyChart Export Server."
        "            Use --help arg with action for more info."
        ""
        "  cmd       Run Export Server once"
        "            Use --help arg with action for more info."
        ""
        "Please, see http://docs.anychart.com for more info."
        ]
       (string/join \newline)))

;====================================================================================
; Server Actions
;====================================================================================
(defroutes app-routes
           (GET "/status" [] "ok")
           (POST "/status" [] "ok")
           (POST "/sharing/twitter" [] web/sharing-twitter)
           (GET "/sharing/twitter_oauth" [] twitter/twitter-oauth)
           (POST "/sharing/twitter_confirm" [] twitter/twitter-confirm)
           (GET "/dialog" [] twitter/dialog)
           (POST "/png" [] web/png)
           (POST "/jpg" [] web/jpg)
           (POST "/svg" [] web/svg)
           (POST "/pdf" [] web/pdf)
           (POST "/xml" [] web/xml)
           (POST "/json" [] web/json)
           (POST "/csv" [] web/csv)
           (POST "/xlsx" [] web/xlsx)
           (route/not-found "
Page not found.
"))

;(def app (-> app-routes wrap-params))
(def app (-> app-routes wrap-params (wrap-session {:store (create-storage)})))

(defn shutdown-server []
  (timbre/info "Shutdown...")
  (state/stop-server!)
  (browser/stop-phantom))

(defn start-server [options summary]
  (if (:help options) (exit 0 (server-usage summary)))
  (when (:log options)
    (init-logger (:log options)))
  (timbre/info (str "Starting export server on " (:host options) ":" (:port options)))
  (if (sharing/init options)
    (timbre/info "Sharing initialiazed")
    (timbre/warn "Sharing did not initialize. Provide both twitter-* and sharing-* options."))
  (when (:allow-scripts-executing options)
    (browser/setup-phantom))
  (state/set-server! (run-server app {:port (:port options) :ip (:host options)}))
  (.addShutdownHook (Runtime/getRuntime) (Thread. shutdown-server)))

;====================================================================================
; Cmd Actions
;====================================================================================
(defn cmd-export [options summary]
  (if (:help options) (exit 0 (cmd-usage summary)))
  (let [script (:script options)
        file (:input-file options)]
    (cond
      (and (nil? script) (nil? file)) (exit 1 (error-msg ["script or file should be specified in 'cmd' mode."]))
      (and file (not (.exists (io/file file)))) (exit 1 (error-msg ["Input File not exists."]))
      :else (case (:type options)
              "png" (cmd/png options)
              "jpg" (cmd/jpg options)
              "svg" (cmd/svg options)
              "pdf" (cmd/pdf options)))))

;====================================================================================
; Main
;====================================================================================
(defn -main [& args]
  (let [{:keys [options arguments errors summary]} (parse-opts args common-options)]
    (cond
      (:version options) (exit 0 server-name)
      errors (exit 1 (error-msg errors))
      (nil? (state/init (first arguments) options)) (exit 1 "Can't read config file"))
    (let [options @state/options
          mode (:mode options)]
      (reset! web/allow-script-executing (:allow-scripts-executing options))
      (case mode
        "server" (start-server options summary)
        "cmd" (cmd-export options summary)
        (exit 1 (usage))))))

Delete log

Delete log


(ns madouc.db.migrator
  (:require [migratus.core :as migratus]
            [madouc.config :refer [env]]))

(defn- config->migratus-params
  [config]
  {:store :database
   :migration-dir "migrations/"
   :db {:classname "org.postgresql.Driver"
        :subprotocol "postgresql"
        :subname (format "//%s/%s" (:db-host config) (:db-name config))
        :user (:db-user config)
        :password (:db-password config)}})

(defn migrate!
  []
  (migratus/migrate (config->migratus-params env)))

(defn rollback!
  []
  (migratus/rollback (config->migratus-params env)))

(defn pending-list
  []
  (migratus/pending-list (config->migratus-params env)))

(defn debug-config
  []
  (config->migratus-params env))

(defn create!
  [migration-name]
  (migratus/create (config->migratus-params env) migration-name))

Add create migration operation to migrator


(ns movie-app.response
  (:import [org.bson.types ObjectId])
  (:require   [movie-app.db :as db]
              [movie-app.utility :as util]
              [cheshire.core :as cheshire]
              [cheshire.generate :as generate :refer [add-encoder encode-str]]))

(generate/add-encoder org.bson.types.ObjectId generate/encode-str)

(defn json-200 [to-render]
  {:status 200
   :headers {"Content-Type" "text/json; charset=utf-8"
             "Cache-Control" "no-cache, no-store, must-revalidate"
             "Pragma" "no-cache"
             "Expires" "0"}
   :body (cheshire/generate-string
          to-render {:key-fn #(util/memoized->camelCase (name %))})})

(defn json-404 []
  {:status 404
   :headers {"Content-Type" "text/json; charset=utf-8"
             "Cache-Control" "no-cache, no-store, must-revalidate"
             "Pragma" "no-cache"
             "Expires" "0"}
   :body (cheshire/generate-string "Page not found")})

(defn result-nil? [result]
  (if (nil? result)
    (json-404)
    (json-200 result)))

(defn gen-stars-per-movie [movie-id]
  (let [reviews (filter #(= (:movie-id %) movie-id)  (db/get-maps "reviews"))]
    (/ (reduce + (map :rating reviews)) (count reviews))))

(defn reviews? [movie-id]
  (let [reviews (filter #(= (:movie-id %) movie-id)  (db/get-maps "reviews"))]
    (count reviews)))

(defn convert-to-object-id [id]
  (if (= ObjectId (class id))
    id (ObjectId. id)))

(defn get-movie-reviews [movie-id]
  (db/get-maps "reviews" :conditions
               {:movie-id (convert-to-object-id movie-id)}))

(defn assoc-stars-reviews [movie movie-id]
  (let [id (convert-to-object-id movie-id)]
    (assoc (db/get-by-id "movies" (convert-to-object-id movie-id))
           :stars (format "%.1f" (gen-stars-per-movie (convert-to-object-id movie-id)))
           :reviews (get-movie-reviews (convert-to-object-id movie-id)))))

(defn get-movie-by-id [id]
  (try
    (assoc-stars-reviews (db/get-by-id "movies" (convert-to-object-id id)) id)
    (catch IllegalArgumentException e
      (str "Caught exception: " (.getMessage e)))))

(defn get-rated-movies []
  (for [movie (db/get-maps "movies")]
    (assoc-stars-reviews movie (:_id movie))))

;;; Response endpoints that include movie and review information

(defn get-movies-list []
  (let [result (get-rated-movies)]
    (result-nil? result)))

(defn get-movie-entry [id-string]
  (let [result (get-movie-by-id id-string)]
    (result-nil? result)))

(ns movie-app.response
  (:import [org.bson.types ObjectId])
  (:require   [movie-app.db :as db]
              [movie-app.utility :as util]
              [cheshire.core :as cheshire]
              [cheshire.generate :as generate :refer [add-encoder encode-str]]))

(generate/add-encoder org.bson.types.ObjectId generate/encode-str)

(defn json-200 [to-render]
  {:status 200
   :headers {"Content-Type" "text/json; charset=utf-8"
             "Cache-Control" "no-cache, no-store, must-revalidate"
             "Pragma" "no-cache"
             "Expires" "0"}
   :body (cheshire/generate-string
          to-render {:key-fn #(util/memoized->camelCase (name %))})})

(defn json-404 [e]
  {:status 404
   :headers {"Content-Type" "text/json; charset=utf-8"
             "Cache-Control" "no-cache, no-store, must-revalidate"
             "Pragma" "no-cache"
             "Expires" "0"}
   :body (cheshire/generate-string e)})

(defn result-nil? [result]
  (if (nil? result)
    (json-404 "404 - Page not found")
    (json-200 result)))

(defn gen-stars-per-movie [movie-id]
  (let [reviews (filter #(= (:movie-id %) movie-id)  (db/get-maps "reviews"))]
    (/ (reduce + (map :rating reviews)) (count reviews))))

(defn reviews? [movie-id]
  (let [reviews (filter #(= (:movie-id %) movie-id)  (db/get-maps "reviews"))]
    (count reviews)))

(defn convert-to-object-id [id]
  (if (= ObjectId (class id))
    id (ObjectId. id)))

(defn get-movie-reviews [movie-id]
  (db/get-maps "reviews" :conditions
               {:movie-id (convert-to-object-id movie-id)}))

(defn assoc-stars-reviews [movie movie-id]
  (let [id (convert-to-object-id movie-id)]
    (assoc (db/get-by-id "movies" id)
           :stars (format "%.1f" (gen-stars-per-movie id))
           :reviews (get-movie-reviews id))))

(defn get-movie-by-id [id]
  (assoc-stars-reviews (db/get-by-id "movies" (convert-to-object-id id)) id))

(defn get-rated-movies []
  (for [movie (db/get-maps "movies")]
    (assoc-stars-reviews movie (:_id movie))))

;;; Response endpoints that include movie and review information

(defn get-movies-list []
  (let [result (get-rated-movies)]
    (result-nil? result)))

(defn get-movie-entry [id-string]
  (try
    (let [result (get-movie-by-id id-string)]
      (result-nil? result))
    (catch IllegalArgumentException e
      (json-404 (.toString e)))))

Fix Error Handling in get-movie-by-id

Fix Error Handling in get-movie-by-id

Changes error handling for ObjectId in movie API
To return 404 when id is malformed. Commit also
refactors assoc-stars-reviews. Closes #5


(ns incise.watcher
  (:require [watchtower.core :refer [watcher rate file-filter extensions
                                     on-change]]))

(defn watch
  [change-fn]
  (watcher ["resources/posts/" "resources/pages/"]
           (rate 300)
           (on-change change-fn)))

(def watching nil)

(defn start-watching [& args]
  (alter-var-root #'watching (fn [& _] (apply watch args))))

(defn stop-watching []
  (when watching
    (future-cancel watching)))

(ns incise.watcher
  (:require [watchtower.core :refer [watcher rate file-filter extensions
                                     on-change]]))

(defn log-exceptions [func & args]
  "Log (i.e. print) exceptions received from the given function."
  (try
    (apply func args)
    (catch Exception e
      (println (.getMessage e)))))

(defn watch
  [change-fn]
  (watcher ["resources/posts/" "resources/pages/"]
           (rate 300)
           (on-change (partial log-exceptions change-fn))))

(def watching nil)

(defn start-watching [& args]
  (alter-var-root #'watching (fn [& _] (apply watch args))))

(defn stop-watching []
  (when watching
    (future-cancel watching)))

Add log-exceptions wrapper to watch.

Add log-exceptions wrapper to watch.


(ns leiningen.core
  (:use [clojure.contrib.with-ns])
  (:import [java.io File])
  (:gen-class))

(def project nil)

(defmacro defproject [project-name version & args]
  ;; This is necessary since we must allow defproject to be eval'd in
  ;; any namespace due to load-file; we can't just create a var with
  ;; def or we would not have access to it once load-file returned.
  `(do
     (let [m# (apply hash-map (quote ~args))
           root# ~(.getParent (java.io.File. *file*))]
       (alter-var-root #'project
                       (fn [_#] (assoc m#
                                  :name ~(name project-name)
                                  :group ~(or (namespace project-name)
                                              (name project-name))
                                  :version ~version
                                  :compile-path (or (:compile-path m#)
                                                    (str root# "/classes"))
                                  :source-path (or (:source-path m#)
                                                   (str root# "/src"))
                                  :library-path (or (:library-path m#)
                                                    (str root# "/lib"))
                                  :test-path (or (:test-path m#)
                                                 (str root# "/test"))
                                  :resources-path (or (:resources-path m#)
                                                      (str root# "/resources"))
                                  :root root#))))
     (def ~(symbol (name project-name)) project)))

;; So it doesn't need to be fully-qualified in project.clj
(with-ns 'clojure.core (use ['leiningen.core :only ['defproject]]))

(defn exit-with-error [msg]
  (println msg)
  (System/exit 1))

;; TODO: prompt to run "new" if no project file is found
(defn read-project
  ([file]
     (try
      (load-file file)
      project
      (catch java.io.FileNotFoundException _
        (exit-with-error "No project.clj found in this directory."))))
  ([] (read-project "project.clj")))

(def aliases {"--help" "help" "-h" "help" "-?" "help"
              "-v" "version" "--version" "version"})

(def no-project-needed #{"new" "help" "version"})

(defn resolve-task [task]
  (let [task-ns (symbol (str "leiningen." task))
        task (symbol task)
        error-fn (fn [& _]
                   (exit-with-error
                     (format "%s is not a task. Use \"help\" to list all tasks."
                             task)))]
    (try
     (require task-ns)
     (or (ns-resolve task-ns task)
         error-fn)
     (catch java.io.FileNotFoundException e
       error-fn))))

(defn -main [& [task & args]]
  (let [task (or (aliases task) task "help")
        args (if (no-project-needed task)
               args
               (conj args (read-project)))
        compile-path (:compile-path (first args))]
    (when compile-path (.mkdirs (File. compile-path)))
    (binding [*compile-path* compile-path]
      (try
       (apply (resolve-task task) args)
       (catch IllegalArgumentException _
         (exit-with-error (format "Wrong number of arguments to task %s."
                                  task)))))
    ;; In case tests or some other task started any:
    (shutdown-agents)))

(ns leiningen.core
  (:use [clojure.contrib.with-ns])
  (:import [java.io File])
  (:gen-class))

(def project nil)

(defmacro defproject [project-name version & args]
  ;; This is necessary since we must allow defproject to be eval'd in
  ;; any namespace due to load-file; we can't just create a var with
  ;; def or we would not have access to it once load-file returned.
  `(do
     (let [m# (apply hash-map (quote ~args))
           root# ~(.getParent (java.io.File. *file*))]
       (alter-var-root #'project
                       (fn [_#] (assoc m#
                                  :name ~(name project-name)
                                  :group ~(or (namespace project-name)
                                              (name project-name))
                                  :version ~version
                                  :compile-path (or (:compile-path m#)
                                                    (str root# "/classes"))
                                  :source-path (or (:source-path m#)
                                                   (str root# "/src"))
                                  :library-path (or (:library-path m#)
                                                    (str root# "/lib"))
                                  :test-path (or (:test-path m#)
                                                 (str root# "/test"))
                                  :resources-path (or (:resources-path m#)
                                                      (str root# "/resources"))
                                  :root root#))))
     (def ~(symbol (name project-name)) project)))

;; So it doesn't need to be fully-qualified in project.clj
(with-ns 'clojure.core (use ['leiningen.core :only ['defproject]]))

(defn abort [msg]
  (println msg)
  (System/exit 1))

;; TODO: prompt to run "new" if no project file is found
(defn read-project
  ([file]
     (try
      (load-file file)
      project
      (catch java.io.FileNotFoundException _
        (abort "No project.clj found in this directory."))))
  ([] (read-project "project.clj")))

(def aliases {"--help" "help" "-h" "help" "-?" "help"
              "-v" "version" "--version" "version"})

(def no-project-needed #{"new" "help" "version"})

(defn resolve-task [task]
  (let [task-ns (symbol (str "leiningen." task))
        task (symbol task)
        error-fn (fn [& _]
                   (abort
                    (format "%s is not a task. Use \"help\" to list all tasks."
                             task)))]
    (try
     (require task-ns)
     (or (ns-resolve task-ns task)
         error-fn)
     (catch java.io.FileNotFoundException e
       error-fn))))

(defn -main [& [task & args]]
  (let [task (or (aliases task) task "help")
        args (if (no-project-needed task)
               args
               (conj args (read-project)))
        compile-path (:compile-path (first args))]
    (when compile-path (.mkdirs (File. compile-path)))
    (binding [*compile-path* compile-path]
      (try
       (apply (resolve-task task) args)
       (catch IllegalArgumentException _
         (abort (format "Wrong number of arguments to task %s."
                        task)))))
    ;; In case tests or some other task started any:
    (shutdown-agents)))

Rename exit-with-error to abort.

Rename exit-with-error to abort.