(ns simple-check.core-test
  (:use clojure.test)
  (:require [simple-check.core       :as sc]
            [simple-check.generators :as gen]))

;; plus and 0 form a monoid
;; ---------------------------------------------------------------------------

(defn passes-monoid-properties
  [a b c]
  (and (= (+ 0 a) a)
       (= (+ a 0) a)
       (= (+ a (+ b c)) (+ (+ a b) c))))

(deftest plus-and-0-are-a-monoid
  (testing "+ and 0 form a monoid"
           (is (let [a gen/int]
                 (:result
                   (sc/quick-check 1000 passes-monoid-properties [a a a]))))))

;; reverse
;; ---------------------------------------------------------------------------

(defn reverse-equal?-helper
  [l]
  (let [r (vec (reverse l))]
    (and (= (count l) (count r))
         (= (seq l) (rseq r)))))

(deftest reverse-equal?
  (testing "For all lists L, reverse(reverse(L)) == L"
           (is (let [v (gen/vector gen/int)]
                 (:result (sc/quick-check 1000 reverse-equal?-helper [v]))))))

;; failing reverse
;; ---------------------------------------------------------------------------

(deftest bad-reverse-test
  (testing "For all lists L, L == reverse(L). Not true"
           (is (false?
                 (let [v (gen/vector gen/int)]
                   (:result (sc/quick-check 1000 #(= (reverse %) %) [v])))))))

;; failing element remove
;; ---------------------------------------------------------------------------

(defn first-is-gone
  [l]
  (not (some #{(first l)} (vec (rest l)))))

(deftest bad-remove
  (testing "For all lists L, if we remove the first element E, E should not
           longer be in the list. (This is a false assumption)"
           (is (false?
                 (let [v (gen/vector gen/int)]
                   (:result (sc/quick-check 1000 first-is-gone [v])))))))

;; exceptions shrink and return as result
;; ---------------------------------------------------------------------------

(def exception (Exception. "I get caught"))

(defn exception-thrower
  [& args]
  (throw exception))

(deftest exceptions-are-caught
  (testing "Exceptions during testing are caught. They're also shrunk as long
           as they continue to throw."
           (is (= [exception [0]]
                  (let [result (sc/quick-check 1000 exception-thrower [gen/int])]
                    [(:result result) (get-in result [:shrunk :smallest])])))))

;; Count and concat work as expected
;; ---------------------------------------------------------------------------

(defn concat-counts-correct
  [a b]
  (= (count (concat a b))
     (+ (count a) (count b))))

(deftest count-and-concat
  (testing "For all vectors A and B:
           length(A + B) == length(A) + length(B)"
           (is (:result
                 (let [v (gen/vector gen/int)]
                   (sc/quick-check 1000 concat-counts-correct [v v]))))))

;; Interpose (Count)
;; ---------------------------------------------------------------------------

(defn interpose-twice-the-length ;; (or one less)
  [v]
  (let [interpose-count (count (interpose :i v))]
    (or
      (= (* 2 interpose-count))
      (= (dec (* 2 interpose-count))))))

(deftest interpose-creates-sequence-twice-the-length
  (testing
    "Interposing a collection with a value makes it's count
    twice the original collection, or ones less."
    (is (:result
          (sc/quick-check 1000 interpose-twice-the-length
                          [(gen/vector gen/int)])))))

;; Sorting
;; ---------------------------------------------------------------------------

(defn elements-are-in-order-after-sorting
  [v]
  (every? identity (map <= (partition 2 1 (sort v)))))

(deftest sorting
  (testing
    ""
    (is (:result
          (sc/quick-check 1000 elements-are-in-order-after-sorting
                          [(gen/vector gen/int)])))))

;; Tests are deterministic
;; ---------------------------------------------------------------------------

(defn vector-elements-are-unique
  [v]
  (== (count v) (count (distinct v))))

(defn unique-test
  [seed]
  (sc/quick-check 1000 vector-elements-are-unique
                  [(gen/vector gen/int)] :seed seed))

(defn equiv-runs
  [seed]
  (= (unique-test seed) (unique-test seed)))

(deftest tests-are-deterministic
  (testing "If two runs are started with the same seed, they should
           return the same results."
           (is (:result
                 (sc/quick-check 1000 equiv-runs [gen/int])))))

(ns simple-check.core-test
  (:use clojure.test)
  (:require [simple-check.core       :as sc]
            [simple-check.generators :as gen]))

;; plus and 0 form a monoid
;; ---------------------------------------------------------------------------

(defn passes-monoid-properties
  [a b c]
  (and (= (+ 0 a) a)
       (= (+ a 0) a)
       (= (+ a (+ b c)) (+ (+ a b) c))))

(deftest plus-and-0-are-a-monoid
  (testing "+ and 0 form a monoid"
           (is (let [a gen/int]
                 (:result
                   (sc/quick-check 1000 passes-monoid-properties [a a a]))))))

;; reverse
;; ---------------------------------------------------------------------------

(defn reverse-equal?-helper
  [l]
  (let [r (vec (reverse l))]
    (and (= (count l) (count r))
         (= (seq l) (rseq r)))))

(deftest reverse-equal?
  (testing "For all lists L, reverse(reverse(L)) == L"
           (is (let [v (gen/vector gen/int)]
                 (:result (sc/quick-check 1000 reverse-equal?-helper [v]))))))

;; failing reverse
;; ---------------------------------------------------------------------------

(deftest bad-reverse-test
  (testing "For all lists L, L == reverse(L). Not true"
           (is (false?
                 (let [v (gen/vector gen/int)]
                   (:result (sc/quick-check 1000 #(= (reverse %) %) [v])))))))

;; failing element remove
;; ---------------------------------------------------------------------------

(defn first-is-gone
  [l]
  (not (some #{(first l)} (vec (rest l)))))

(deftest bad-remove
  (testing "For all lists L, if we remove the first element E, E should not
           longer be in the list. (This is a false assumption)"
           (is (false?
                 (let [v (gen/vector gen/int)]
                   (:result (sc/quick-check 1000 first-is-gone [v])))))))

;; exceptions shrink and return as result
;; ---------------------------------------------------------------------------

(def exception (Exception. "I get caught"))

(defn exception-thrower
  [& args]
  (throw exception))

(deftest exceptions-are-caught
  (testing "Exceptions during testing are caught. They're also shrunk as long
           as they continue to throw."
           (is (= [exception [0]]
                  (let [result (sc/quick-check 1000 exception-thrower [gen/int])]
                    [(:result result) (get-in result [:shrunk :smallest])])))))

;; Count and concat work as expected
;; ---------------------------------------------------------------------------

(defn concat-counts-correct
  [a b]
  (= (count (concat a b))
     (+ (count a) (count b))))

(deftest count-and-concat
  (testing "For all vectors A and B:
           length(A + B) == length(A) + length(B)"
           (is (:result
                 (let [v (gen/vector gen/int)]
                   (sc/quick-check 1000 concat-counts-correct [v v]))))))

;; Interpose (Count)
;; ---------------------------------------------------------------------------

(defn interpose-twice-the-length ;; (or one less)
  [v]
  (let [interpose-count (count (interpose :i v))]
    (or
      (= (* 2 interpose-count))
      (= (dec (* 2 interpose-count))))))

(deftest interpose-creates-sequence-twice-the-length
  (testing
    "Interposing a collection with a value makes it's count
    twice the original collection, or ones less."
    (is (:result
          (sc/quick-check 1000 interpose-twice-the-length
                          [(gen/vector gen/int)])))))

;; Sorting
;; ---------------------------------------------------------------------------

(defn elements-are-in-order-after-sorting
  [v]
  (every? identity (map <= (partition 2 1 (sort v)))))

(deftest sorting
  (testing
    "For all vectors V, sorted(V) should have the elements in order"
    (is (:result
          (sc/quick-check 1000 elements-are-in-order-after-sorting
                          [(gen/vector gen/int)])))))

;; Tests are deterministic
;; ---------------------------------------------------------------------------

(defn vector-elements-are-unique
  [v]
  (== (count v) (count (distinct v))))

(defn unique-test
  [seed]
  (sc/quick-check 1000 vector-elements-are-unique
                  [(gen/vector gen/int)] :seed seed))

(defn equiv-runs
  [seed]
  (= (unique-test seed) (unique-test seed)))

(deftest tests-are-deterministic
  (testing "If two runs are started with the same seed, they should
           return the same results."
           (is (:result
                 (sc/quick-check 1000 equiv-runs [gen/int])))))

Add testing string for sort test

Add testing string for sort test


(ns caesium.crypto.box
  "Bindings to the public key authenticated encryption scheme."
  (:require [caesium.binding :as b]
            [caesium.crypto.scalarmult :as s]
            [caesium.byte-bufs :as bb])
  (:import [java.nio ByteBuffer]))

(b/defconsts [seedbytes
              publickeybytes
              secretkeybytes
              noncebytes
              macbytes
              primitive])

(defn keypair-to-buf!
  "Generate a key pair into provided pk (public key) and sk (secret
  key) bufs. If also passed a seed, uses it to seed the key pair.

  This API matches libsodium's `crypto_box_keypair` and
  `crpyto_box_seed_keypair`."
  ([pk sk]
   (b/✨ keypair pk sk))
  ([pk sk seed]
   (b/✨ seed-keypair pk sk seed)))

(defn keypair!
  "Create a `crypto_box` keypair.

  This fn will take either:

  - nothing, generating the key pair from scratch securely
  - a seed, generating the key pair from the seed

  Previously, this API matched Kalium, where the seed would be used as the
  secret key directly. Now, it matches libsodium, where the seed is hashed
  before being used as a secret. The old behavior can be useful in some cases,
  e.g. if you are storage-constrained and only want to store secret keys, and
  you care that it is _really_ the secret key and not some value derived from
  it (you probably don't). See [[sk->keypair]] for details.

  Returns a map containing the public and private key bytes (mutable
  arrays)."
  ([]
   (let [pk (bb/alloc publickeybytes)
         sk (bb/alloc secretkeybytes)]
     (keypair-to-buf! pk sk)
     {:public pk :secret sk}))
  ([seed]
   (let [pk (bb/alloc publickeybytes)
         sk (bb/alloc secretkeybytes)]
     (keypair-to-buf! pk sk (bb/->indirect-byte-buf seed))
     {:public pk :secret sk})))

(def ^:deprecated generate-keypair
  "Deprecated alias for [[keypair!]].

  Please note that there was a breaking backwards-incompatible change between
  0.4.0 and 0.5.0+ if you specify a seed; see [[keypair!]] docs for details."
  keypair!)

(defn sk->keypair
  "Generates a key pair from a secret key.

  This is different from generating a key pair from a seed. The former
  uses the libsodium API which will first hash the secret to an array
  of appropriate length; this will use the secret key verbatim. To be
  precise: it will use the secret key as a scalar to perform the
  Curve25519 scalar mult."
  [sk]
  (let [pk (bb/alloc publickeybytes)]
    (s/scalarmult-to-buf! sk pk)
    {:public pk :secret sk}))

(defn box-easy-to-buf!
  "Encrypts ptext into out with `crypto_box_easy` using given nonce,
  public key and secret key.

  All arguments must be `java.nio.ByteBuffer`.

  This function is only useful if you're managing your own output
  buffer, which includes in-place encryption. You probably
  want [[box-easy]]."
  [c m n pk sk]
  (b/✨ easy c m plen n pk sk)
  c)

(defn box-open-easy-to-buf!
  "Decrypts ptext into out with `crypto_box_open_easy` using given
  nonce, public key and secret key.

  All arguments must be `java.nio.ByteBuffer`.

  This function is only useful if you're managing your own output
  buffer, which includes in-place decryption. You probably
  want [[box-open-easy]]."
  [m c n pk sk]
  (let [res (b/✨ open-easy m c n pk sk)]
    (if (zero? res)
      m
      (throw (RuntimeException. "Ciphertext verification failed")))))

(defn mlen->clen
  "Given a plaintext length, return the ciphertext length.

  This should be an implementation detail unless you want to manage
  your own output buffer together with [[box-easy-to-buf!]]."
  [mlen]
  (+ mlen macbytes))

(defn clen->mlen
  "Given a ciphertext length, return the plaintext length.

  This should be an implementation detail unless you want to manage
  your own output buffer together with [[box-open-easy-to-buf!]]."
  [clen]
  (- clen macbytes))

(defn box-easy
  "Encrypts ptext with `crypto_box_easy` using given nonce, public key
  and secret key.

  This creates the output ciphertext byte array for you, which is
  probably what you want. If you would like to manage the array
  yourself, or do in-place encryption, see [[box-easy-to-buf!]]."
  [ptext nonce pk sk]
  (let [out (bb/alloc (mlen->clen (bb/buflen ptext)))]
    (box-easy-to-buf!
     out
     (bb/->indirect-byte-buf ptext)
     (bb/->indirect-byte-buf nonce)
     (bb/->indirect-byte-buf pk)
     (bb/->indirect-byte-buf sk))
    (bb/->bytes out)))

(defn box-open-easy
  "Decrypts ptext with `crypto_box_open_easy` using given nonce, public
  key and secret key.

  This creates the output plaintext byte array for you, which is probably what
  you want. If you would like to manage the array yourself, or do in-place
  decryption, see [[box-open-easy-to-buf!]]."
  [ctext nonce pk sk]
  (let [out (bb/alloc (clen->mlen (bb/buflen ctext)))]
    (box-open-easy-to-buf!
     out
     (bb/->indirect-byte-buf ctext)
     (bb/->indirect-byte-buf nonce)
     (bb/->indirect-byte-buf pk)
     (bb/->indirect-byte-buf sk))
    (bb/->bytes out)))

(defn encrypt
  "Encrypt with `crypto_box_easy`.

  To encrypt, use the recipient's public key and the sender's secret
  key.

  This is an alias for [[box-easy]] with a different argument
  order. [[box-easy]] follows the same argument order as the libsodium
  function."
  [pk sk nonce ptext]
  (box-easy ptext nonce pk sk))

(defn decrypt
  "Decrypt with `crypto_box_open_easy`.

  To decrypt, use the sender's public key and the recipient's secret
  key.

  This is an alias for [[box-open-easy]] with a different argument
  order. [[box-open-easy]] follows the same argument order as the
  libsodium function."
  [pk sk nonce ctext]
  (box-open-easy ctext nonce pk sk))

(ns caesium.crypto.box
  "Bindings to the public key authenticated encryption scheme."
  (:require [caesium.binding :as b]
            [caesium.crypto.scalarmult :as s]
            [caesium.byte-bufs :as bb])
  (:import [java.nio ByteBuffer]))

(b/defconsts [seedbytes
              publickeybytes
              secretkeybytes
              noncebytes
              macbytes
              primitive])

(defn keypair-to-buf!
  "Generate a key pair into provided pk (public key) and sk (secret
  key) bufs. If also passed a seed, uses it to seed the key pair.

  This API matches libsodium's `crypto_box_keypair` and
  `crpyto_box_seed_keypair`."
  ([pk sk]
   (b/✨ keypair pk sk))
  ([pk sk seed]
   (b/✨ seed-keypair pk sk seed)))

(defn keypair!
  "Create a `crypto_box` keypair.

  This fn will take either:

  - nothing, generating the key pair from scratch securely
  - a seed, generating the key pair from the seed

  Previously, this API matched Kalium, where the seed would be used as the
  secret key directly. Now, it matches libsodium, where the seed is hashed
  before being used as a secret. The old behavior can be useful in some cases,
  e.g. if you are storage-constrained and only want to store secret keys, and
  you care that it is _really_ the secret key and not some value derived from
  it (you probably don't). See [[sk->keypair]] for details.

  Returns a map containing the public and private key bytes (mutable
  arrays)."
  ([]
   (let [pk (bb/alloc publickeybytes)
         sk (bb/alloc secretkeybytes)]
     (keypair-to-buf! pk sk)
     {:public pk :secret sk}))
  ([seed]
   (let [pk (bb/alloc publickeybytes)
         sk (bb/alloc secretkeybytes)]
     (keypair-to-buf! pk sk (bb/->indirect-byte-buf seed))
     {:public pk :secret sk})))

(def ^:deprecated generate-keypair
  "Deprecated alias for [[keypair!]].

  Please note that there was a breaking backwards-incompatible change between
  0.4.0 and 0.5.0+ if you specify a seed; see [[keypair!]] docs for details."
  keypair!)

(defn sk->keypair
  "Generates a key pair from a secret key.

  This is different from generating a key pair from a seed. The former
  uses the libsodium API which will first hash the secret to an array
  of appropriate length; this will use the secret key verbatim. To be
  precise: it will use the secret key as a scalar to perform the
  Curve25519 scalar mult."
  [sk]
  (let [pk (bb/alloc publickeybytes)]
    (s/scalarmult-to-buf! pk sk)
    {:public pk :secret sk}))

(defn box-easy-to-buf!
  "Encrypts ptext into out with `crypto_box_easy` using given nonce,
  public key and secret key.

  All arguments must be `java.nio.ByteBuffer`.

  This function is only useful if you're managing your own output
  buffer, which includes in-place encryption. You probably
  want [[box-easy]]."
  [c m n pk sk]
  (b/✨ easy c m plen n pk sk)
  c)

(defn box-open-easy-to-buf!
  "Decrypts ptext into out with `crypto_box_open_easy` using given
  nonce, public key and secret key.

  All arguments must be `java.nio.ByteBuffer`.

  This function is only useful if you're managing your own output
  buffer, which includes in-place decryption. You probably
  want [[box-open-easy]]."
  [m c n pk sk]
  (let [res (b/✨ open-easy m c n pk sk)]
    (if (zero? res)
      m
      (throw (RuntimeException. "Ciphertext verification failed")))))

(defn mlen->clen
  "Given a plaintext length, return the ciphertext length.

  This should be an implementation detail unless you want to manage
  your own output buffer together with [[box-easy-to-buf!]]."
  [mlen]
  (+ mlen macbytes))

(defn clen->mlen
  "Given a ciphertext length, return the plaintext length.

  This should be an implementation detail unless you want to manage
  your own output buffer together with [[box-open-easy-to-buf!]]."
  [clen]
  (- clen macbytes))

(defn box-easy
  "Encrypts ptext with `crypto_box_easy` using given nonce, public key
  and secret key.

  This creates the output ciphertext byte array for you, which is
  probably what you want. If you would like to manage the array
  yourself, or do in-place encryption, see [[box-easy-to-buf!]]."
  [ptext nonce pk sk]
  (let [out (bb/alloc (mlen->clen (bb/buflen ptext)))]
    (box-easy-to-buf!
     out
     (bb/->indirect-byte-buf ptext)
     (bb/->indirect-byte-buf nonce)
     (bb/->indirect-byte-buf pk)
     (bb/->indirect-byte-buf sk))
    (bb/->bytes out)))

(defn box-open-easy
  "Decrypts ptext with `crypto_box_open_easy` using given nonce, public
  key and secret key.

  This creates the output plaintext byte array for you, which is probably what
  you want. If you would like to manage the array yourself, or do in-place
  decryption, see [[box-open-easy-to-buf!]]."
  [ctext nonce pk sk]
  (let [out (bb/alloc (clen->mlen (bb/buflen ctext)))]
    (box-open-easy-to-buf!
     out
     (bb/->indirect-byte-buf ctext)
     (bb/->indirect-byte-buf nonce)
     (bb/->indirect-byte-buf pk)
     (bb/->indirect-byte-buf sk))
    (bb/->bytes out)))

(defn encrypt
  "Encrypt with `crypto_box_easy`.

  To encrypt, use the recipient's public key and the sender's secret
  key.

  This is an alias for [[box-easy]] with a different argument
  order. [[box-easy]] follows the same argument order as the libsodium
  function."
  [pk sk nonce ptext]
  (box-easy ptext nonce pk sk))

(defn decrypt
  "Decrypt with `crypto_box_open_easy`.

  To decrypt, use the sender's public key and the recipient's secret
  key.

  This is an alias for [[box-open-easy]] with a different argument
  order. [[box-open-easy]] follows the same argument order as the
  libsodium function."
  [pk sk nonce ctext]
  (box-open-easy ctext nonce pk sk))

Fix scalarmult order

Fix scalarmult order


(ns async-ring.beauty
  "This namespace contains the Beauty concurrent quality of service routing middleware. See README.md for details on how to use Beauty in your application."
  (:require [clojure.data.priority-map :refer (priority-map)]
            [clojure.core.async :as async]
            [clojure.tools.logging :as log]))

(defmacro beauty-route
  "This defers its body to run on the specied pool, with the optionally specified
   priority. If you want to execute side-effects in the body, you'll want to wrap it
   in a do."
  ([pool body]
   `{::beauty true
     :thunk (fn [] ~body)
     :pool ~pool
     :priority 5})
  ([pool priority body]
   `{::beauty true
     :thunk (fn [] ~body)
     :pool ~pool
     :priority ~priority}))

(defn beauty-router
  "Creates a beauty-router pool. The pools-config should be a map, where the keys
   are the pool names, and the values are maps with 2 keys: :parallelism, which
   defines how many requests the pool can process concurrently, and :buffer-size,
   which defines how many requests can be queued on the pool before it starts to
   exhibit backpressure. Those keys have default values of 5 and 10, respectively."
  [handler pools-config]
  (let [pools (->> pools-config
                   (map (fn [[k]]
                          [k (async/chan)]))
                   (into {}))
        req-chan (async/chan)]
    (doseq [[pool {:keys [parallelism buffer-size]
                   :or {parallelism 5 buffer-size 10}}] pools-config
            :let [c (get pools pool)
                  work-chan (async/chan)]]
      (log/debug  "Creating beauty router pool" pool
                 "with parallelism" parallelism
                 "and buffer size" buffer-size)
      (dotimes [i parallelism]
        (async/go
          (while true
            (let [{:keys [thunk request] :as task} (async/<! work-chan)]
              (try
                (async/>! (:async-response request) (thunk))
                (catch Throwable t
                  (async/>! (:async-error request) t)))))))
      (async/go
        (loop [buf (priority-map)]
          (let [cur-buf-size (count buf)
                request-op (when (<= cur-buf-size buffer-size)
                             [c])
                next-work-item (ffirst (rseq buf))
                work-op (when (pos? cur-buf-size)
                          [[work-chan next-work-item]])
                ops (vec (concat request-op work-op))
                [val port] (async/alts! ops)]
            (if (= port work-chan)
              (recur (dissoc buf next-work-item))
              (recur (assoc buf val (:priority val))))))))
    (async/go
      (while true
        (let [req (async/<! req-chan)
              ;; First, let the router run
              resp (try
                     (handler req)
                     (catch Throwable t
                       {::error t}))]
          (cond
            (::beauty resp)
            ;; It's a beauty route
            (async/>! (get pools (:pool resp)) (assoc resp :request req))
            ;; It's an error
            (::error resp)
            (async/>! (:async-error req) (::error resp))
            ;; It's a normal response
            :else
            (async/>! (:async-response req) resp)))))
    req-chan))

(ns async-ring.beauty
  "This namespace contains the Beauty concurrent quality of service routing middleware. See README.md for details on how to use Beauty in your application."
  (:require [clojure.data.priority-map :refer (priority-map)]
            [clojure.core.async :as async]
            [clojure.tools.logging :as log]))

(defmacro beauty-route
  "This defers its body to run on the specied pool, with the optionally specified
   priority. If you want to execute side-effects in the body, you'll want to wrap it
   in a do."
  ;; Note that we prioritize so that a higher user-provided priority runs sooner,
  ;; and the oldest requests run sooner
  ([pool body]
   `{::beauty true
     :thunk (fn [] ~body)
     :pool ~pool
     :priority [5 (- (System/currentTimeMillis))]})
  ([pool priority body]
   `{::beauty true
     :thunk (fn [] ~body)
     :pool ~pool
     :priority [~priority (- (System/currentTimeMillis))]}))

(defn beauty-router
  "Creates a beauty-router pool. The pools-config should be a map, where the keys
   are the pool names, and the values are maps with 2 keys: :parallelism, which
   defines how many requests the pool can process concurrently, and :buffer-size,
   which defines how many requests can be queued on the pool before it starts to
   exhibit backpressure. Those keys have default values of 5 and 10, respectively."
  [handler pools-config]
  (let [pools (->> pools-config
                   (map (fn [[k]]
                          [k (async/chan)]))
                   (into {}))
        req-chan (async/chan)]
    (doseq [[pool {:keys [parallelism buffer-size]
                   :or {parallelism 5 buffer-size 10}}] pools-config
            :let [c (get pools pool)
                  work-chan (async/chan)]]
      (log/debug  "Creating beauty router pool" pool
                 "with parallelism" parallelism
                 "and buffer size" buffer-size)
      (dotimes [i parallelism]
        (async/go
          (while true
            (let [{:keys [thunk request] :as task} (async/<! work-chan)]
              (try
                (async/>! (:async-response request) (thunk))
                (catch Throwable t
                  (async/>! (:async-error request) t)))))))
      (async/go
        (loop [buf (priority-map)]
          (let [cur-buf-size (count buf)
                request-op (when (<= cur-buf-size buffer-size)
                             [c])
                next-work-item (ffirst (rseq buf))
                work-op (when (pos? cur-buf-size)
                          [[work-chan next-work-item]])
                ops (vec (concat request-op work-op))
                [val port] (async/alts! ops)]
            (if (= port work-chan)
              (recur (dissoc buf next-work-item))
              (recur (assoc buf val (:priority val))))))))
    (async/go
      (while true
        (let [req (async/<! req-chan)
              ;; First, let the router run
              resp (try
                     (handler req)
                     (catch Throwable t
                       {::error t}))]
          (cond
            (::beauty resp)
            ;; It's a beauty route
            (async/>! (get pools (:pool resp)) (assoc resp :request req))
            ;; It's an error
            (::error resp)
            (async/>! (:async-error req) (::error resp))
            ;; It's a normal response
            :else
            (async/>! (:async-response req) resp)))))
    req-chan))

Add FIFO within priority levels of beauty


(ns skytwit.server
  (:require [clojure.java.io :as io]
            [compojure.core :refer [ANY GET PUT POST DELETE defroutes]]
            [compojure.route :refer [resources]]
            [ring.middleware.defaults :refer [wrap-defaults api-defaults]]
            [ring.middleware.gzip :refer [wrap-gzip]]
            [ring.middleware.logger :refer [wrap-with-logger]]
            [environ.core :refer [env]]
            [org.httpkit.server :refer [run-server]]
            [twitter.oauth :as oauth]
            [twitter.callbacks :as cb]
            [twitter.callbacks.handlers :as twh]
            [twitter.api :as tapi]
            [twitter.api.restful :as tr]
            [twitter.api.streaming :as ts]
            [cheshire.core :as json]
            [taoensso.sente :as sente]
            [taoensso.sente.server-adapters.http-kit
             :refer [sente-web-server-adapter]]
            [clojure.core.async :as async :refer [go go-loop >! <!]])
  (:import (twitter.callbacks.protocols AsyncStreamingCallback
                                        SyncSingleCallback))
  (:gen-class))

(defn get-credentials-from-env
  []
  (oauth/make-oauth-creds (env :oauth-consumer-key)
                          (env :oauth-consumer-secret)
                          (env :oauth-app-key)
                          (env :oauth-app-secret)))

;; Taken from Sente README
(let [{:keys [ch-recv
              send-fn
              ajax-post-fn
              ajax-get-or-ws-handshake-fn
              connected-uids]}
            (sente/make-channel-socket!
              sente-web-server-adapter
              {:user-id-fn (fn [& args] 1)})]
  (def ring-ajax-post                ajax-post-fn)
  (def ring-ajax-get-or-ws-handshake ajax-get-or-ws-handshake-fn)
  (def ch-chsk                       ch-recv) ; ChannelSocket's receive channel
  (def chsk-send!                    send-fn) ; ChannelSocket's send API fn
  (def connected-uids                connected-uids) ; Watchable, read-only atom
  )

(comment
(chsk-send! 1 [:a/ping "hello"])
)

(defn get-user-profile
  [creds screen-name]
  (try
    (let [user (-> (tr/users-show :oauth-creds creds
                                  :params {:screen-name "InternetRadio"})
                   :body)]
      {:name (:screen_name user)
       :id (:id user)
       :number-of-tweets (:statuses_count user)
       :last-tweet-id (-> user :status :id)})
    (catch Exception _ nil)))

(defn format-tweet
  [t uid]
  {:user uid
   :id (:id t)
   :tags (->> t :entities :hashtags (mapv :text))})

(defn get-tweets-before-tweet-id
  [creds screen-name id]
  (let [get-raw-tweets
        (fn rec []
          (tr/statuses-user-timeline
            :oauth-creds creds
            :params {:screen-name screen-name
                     :max-id id
                     :trim-user true
                     :exclude-replies true
                     :count 200}
            :callbacks (SyncSingleCallback.
                         twh/response-return-body
                         (fn [resp]
                           ;; TODO: Proper logging
                           (.. System out
                               (println (pr-str [:failure resp])))
                           (if (twh/rate-limit-error? @(:status resp))
                             (do (Thread/sleep (60 * 1000))
                                 (rec))
                             (twh/response-throw-error resp)))
                         twh/exception-rethrow)))
        uid (:id (get-user-profile creds screen-name))
        tweets (->> (get-raw-tweets)
                    (map #(format-tweet % uid)))]
    (if (= id (:id (first tweets)))
      (rest tweets)
      tweets)))

(defn put-old-tweets-on-channel
  [creds screen-name chan]
  (let [max-id (-> (get-user-profile creds screen-name) :last-tweet-id inc)
        end? (atom false)]
    (go-loop [last-id max-id]
             (when-not @end?
               (let [next-batch (get-tweets-before-tweet-id
                                  creds screen-name last-id)]
                 (when (seq next-batch)
                   (>! chan next-batch)
                   (recur (:id (last next-batch)))))))
    (fn [] (reset! end? true))))

(defn put-new-tweets-on-channel
  [creds screen-name chan]
  (let [w (java.io.PipedWriter.)
        r (java.io.PipedReader. w)
        end? (atom false)
        id (:id (get-user-profile creds screen-name))
        s (ts/statuses-filter :params {:follow id}
                              :oauth-creds creds
                              :callbacks (AsyncStreamingCallback.
                                           (fn [_ body]
                                             (io/copy (.toByteArray body) w))
                                           twh/response-throw-error
                                           twh/exception-rethrow))
        f (go-loop [s (json/parsed-seq r true)]
                   (when-not @end?
                     (>! chan [(format-tweet (first s) id)])
                     (recur (rest s))))]
    ;; TODO: There may be a small memory leak here: if statuses-filter
    ;;       is stopped in the middle of a JSON string, the lazy seq may
    ;;       be blocked and the go-block may not get GC'd.
    (fn []
      ((:cancel s))
      (reset! end? true))))

(comment
  (def creds (get-credentials-from-env))
  (def a (atom []))

  (let [ch (async/chan)]
    #_(put-old-tweets-on-channel creds "_toch" ch)
    (put-new-tweets-on-channel creds "InternetRadio" ch)
    (go-loop []
             (when-let [v (<! ch)]
               (swap! a concat v)
               (recur))))

  (-> a deref count)
  )

(defroutes routes
  (GET "/" _
    {:status 200
     :headers {"Content-Type" "text/html; charset=utf-8"}
     :body (io/input-stream (io/resource "public/index.html"))})
  (GET  "/chsk" req (ring-ajax-get-or-ws-handshake req))
  (POST "/chsk" req (ring-ajax-post                req))
  (resources "/"))

(def http-handler
  (-> routes
      (wrap-defaults api-defaults)
      wrap-with-logger
      wrap-gzip))

(defn -main [& [port]]
  (let [port (Integer. (or port (env :port) 10555))]
    (run-server http-handler {:port port :join? false})))

(ns skytwit.server
  (:require [clojure.java.io :as io]
            [compojure.core :refer [ANY GET PUT POST DELETE defroutes]]
            [compojure.route :refer [resources]]
            [ring.middleware.defaults :refer [wrap-defaults api-defaults]]
            [ring.middleware.gzip :refer [wrap-gzip]]
            [ring.middleware.logger :refer [wrap-with-logger]]
            [environ.core :refer [env]]
            [org.httpkit.server :refer [run-server]]
            [twitter.oauth :as oauth]
            [twitter.callbacks :as cb]
            [twitter.callbacks.handlers :as twh]
            [twitter.api :as tapi]
            [twitter.api.restful :as tr]
            [twitter.api.streaming :as ts]
            [cheshire.core :as json]
            [taoensso.sente :as sente]
            [taoensso.sente.server-adapters.http-kit
             :refer [sente-web-server-adapter]]
            [clojure.core.async :as async :refer [go go-loop >! <!]])
  (:import (twitter.callbacks.protocols AsyncStreamingCallback
                                        SyncSingleCallback))
  (:gen-class))

(defn get-credentials-from-env
  []
  (oauth/make-oauth-creds (env :oauth-consumer-key)
                          (env :oauth-consumer-secret)
                          (env :oauth-app-key)
                          (env :oauth-app-secret)))

;; Taken from Sente README
(let [{:keys [ch-recv
              send-fn
              ajax-post-fn
              ajax-get-or-ws-handshake-fn
              connected-uids]}
            (sente/make-channel-socket!
              sente-web-server-adapter
              {:user-id-fn (fn [& args] 1)})]
  (def ring-ajax-post                ajax-post-fn)
  (def ring-ajax-get-or-ws-handshake ajax-get-or-ws-handshake-fn)
  (def ch-chsk                       ch-recv) ; ChannelSocket's receive channel
  (def chsk-send!                    send-fn) ; ChannelSocket's send API fn
  (def connected-uids                connected-uids) ; Watchable, read-only atom
  )

(comment
(chsk-send! 1 [:a/ping "hello"])
)

(defn get-user-profile
  [creds screen-name]
  (try
    (let [user (-> (tr/users-show :oauth-creds creds
                                  :params {:screen-name "InternetRadio"})
                   :body)]
      {:name (:screen_name user)
       :id (:id user)
       :number-of-tweets (:statuses_count user)
       :last-tweet-id (-> user :status :id)})
    (catch Exception _ nil)))

(defn format-tweet
  [t uid]
  {:user uid
   :id (:id t)
   :tags (->> t :entities :hashtags (mapv :text))})

(defn get-tweets-before-tweet-id
  [creds screen-name id]
  (let [get-raw-tweets
        (fn rec []
          (tr/statuses-user-timeline
            :oauth-creds creds
            :params {:screen-name screen-name
                     :max-id id
                     :trim-user true
                     :exclude-replies true
                     :count 200}
            :callbacks (SyncSingleCallback.
                         twh/response-return-body
                         (fn [resp]
                           ;; TODO: Proper logging
                           (.. System out
                               (println (pr-str [:failure resp])))
                           (if (twh/rate-limit-error? @(:status resp))
                             (do (Thread/sleep (60 * 1000))
                                 (rec))
                             (twh/response-throw-error resp)))
                         twh/exception-rethrow)))
        uid (:id (get-user-profile creds screen-name))
        tweets (->> (get-raw-tweets)
                    (map #(format-tweet % uid)))]
    (if (= id (:id (first tweets)))
      (rest tweets)
      tweets)))

(defn put-old-tweets-on-channel
  [creds screen-name chan]
  (let [max-id (-> (get-user-profile creds screen-name) :last-tweet-id inc)
        end? (atom false)]
    (go-loop [last-id max-id]
             (when-not @end?
               (let [next-batch (get-tweets-before-tweet-id
                                  creds screen-name last-id)]
                 (when (seq next-batch)
                   (>! chan next-batch)
                   (recur (:id (last next-batch)))))))
    (fn [] (reset! end? true))))

(defn put-new-tweets-on-channel
  [creds screen-name chan]
  (let [w (java.io.PipedWriter.)
        r (java.io.PipedReader. w)
        end? (atom false)
        id (:id (get-user-profile creds screen-name))
        s (ts/statuses-filter :params {:follow id}
                              :oauth-creds creds
                              :callbacks (AsyncStreamingCallback.
                                           (fn [_ body]
                                             (io/copy (.toByteArray body) w))
                                           twh/response-throw-error
                                           twh/exception-rethrow))
        f (go-loop [s (json/parsed-seq r true)]
                   (when-not @end?
                     (>! chan [(format-tweet (first s) id)])
                     (recur (rest s))))]
    ;; TODO: There may be a small memory leak here: if statuses-filter
    ;;       is stopped in the middle of a JSON string, the lazy seq may
    ;;       be blocked and the go-block may not get GC'd.
    (fn []
      ((:cancel (meta s)))
      (reset! end? true))))

(comment
  (def creds (get-credentials-from-env))
  (def a (atom []))

  (let [ch (async/chan)]
    #_(put-old-tweets-on-channel creds "_toch" ch)
    (put-new-tweets-on-channel creds "InternetRadio" ch)
    (go-loop []
             (when-let [v (<! ch)]
               (swap! a concat v)
               (recur))))

  (-> a deref count)
  )

(defroutes routes
  (GET "/" _
    {:status 200
     :headers {"Content-Type" "text/html; charset=utf-8"}
     :body (io/input-stream (io/resource "public/index.html"))})
  (GET  "/chsk" req (ring-ajax-get-or-ws-handshake req))
  (POST "/chsk" req (ring-ajax-post                req))
  (resources "/"))

(def http-handler
  (-> routes
      (wrap-defaults api-defaults)
      wrap-with-logger
      wrap-gzip))

(defn -main [& [port]]
  (let [port (Integer. (or port (env :port) 10555))]
    (run-server http-handler {:port port :join? false})))

Add missing meta call

Add missing meta call


;; -------------------------------------------------------------------
;; clj-fuzzy Helper Functions
;; -------------------------------------------------------------------
;;
;;
;;   Author: PLIQUE Guillaume (Yomguithereal)
;;   Version: 0.1
;;
(ns clj-fuzzy.helpers
  (:require clojure.string))

;; Strings helpers
;;----------------
(defn slice
  "Slice a [string] from [start] and up to [length]."
  [string start length]
  (let [offset (if (neg? start) (+ (count string) start) start)]
    (apply str (take length (drop offset string)))))

(defn chop
  "Drop the last character of a [string]."
  [string]
  (subs string 0 (dec (count string))))

(defn eat
  "Drop the first letter of a [string]."
  [string]
  (apply str (drop 1 string)))

(defn batch-replace
  "Apply several [replacements] to a [string]."
  [string replacements]
  (let [replacement-list (partition 2 replacements)]
    (reduce #(apply clojure.string/replace %1 %2) string replacement-list)))

(defn clean-non-alphabetical
  "Drop every non alphabetical character in [word]."
  [word]
  (clojure.string/replace word #"[^a-zA-Z]" ""))

;; Regex helpers
;;--------------
(defn re-test?
  "Test a [string] against a [regular-expression]."
  [regular-expression string]
  (not (nil? (re-find regular-expression string))))

;; Sequences helpers
;;------------------
(defn distinct-consecutive
  "Drop consecutive duplicates in sequence"
  [sequence] (map first (partition-by identity sequence)))

(defn n-grams
  "Lazily compute the n-grams of a sequence."
  [n s]
  (partition n 1 s))

(defn bigrams [s] (n-grams 2 s))
(defn trigrams [s] (n-grams 3 s))
(defn quadrigrams [s] (n-grams 4 s))

(defn- any?
  "Is any of the [coll] item true according to the given [predicate]?"
  [pred coll]
  (boolean (some pred coll)))

(defn in?
  "Checks whether a [string] is contained within a [sequence]."
  [string sequence]
  (boolean (some #{string} sequence)))

(def not-in? (complement in?))

;; -------------------------------------------------------------------
;; clj-fuzzy Helper Functions
;; -------------------------------------------------------------------
;;
;;
;;   Author: PLIQUE Guillaume (Yomguithereal)
;;   Version: 0.1
;;
(ns clj-fuzzy.helpers
  (:refer-clojure :exclude [any?])
  (:require clojure.string))

;; Strings helpers
;;----------------
(defn slice
  "Slice a [string] from [start] and up to [length]."
  [string start length]
  (let [offset (if (neg? start) (+ (count string) start) start)]
    (apply str (take length (drop offset string)))))

(defn chop
  "Drop the last character of a [string]."
  [string]
  (subs string 0 (dec (count string))))

(defn eat
  "Drop the first letter of a [string]."
  [string]
  (apply str (drop 1 string)))

(defn batch-replace
  "Apply several [replacements] to a [string]."
  [string replacements]
  (let [replacement-list (partition 2 replacements)]
    (reduce #(apply clojure.string/replace %1 %2) string replacement-list)))

(defn clean-non-alphabetical
  "Drop every non alphabetical character in [word]."
  [word]
  (clojure.string/replace word #"[^a-zA-Z]" ""))

;; Regex helpers
;;--------------
(defn re-test?
  "Test a [string] against a [regular-expression]."
  [regular-expression string]
  (not (nil? (re-find regular-expression string))))

;; Sequences helpers
;;------------------
(defn distinct-consecutive
  "Drop consecutive duplicates in sequence"
  [sequence] (map first (partition-by identity sequence)))

(defn n-grams
  "Lazily compute the n-grams of a sequence."
  [n s]
  (partition n 1 s))

(defn bigrams [s] (n-grams 2 s))
(defn trigrams [s] (n-grams 3 s))
(defn quadrigrams [s] (n-grams 4 s))

(defn- any?
  "Is any of the [coll] item true according to the given [predicate]?"
  [pred coll]
  (boolean (some pred coll)))

(defn in?
  "Checks whether a [string] is contained within a [sequence]."
  [string sequence]
  (boolean (some #{string} sequence)))

(def not-in? (complement in?))

Exclude any? to remove warning with Clojure 1.9.


(ns clj-tutorials.core
  (:require [org.httpkit.client :as http]
            [clojure.core.async :as async :refer [go <! >!]]))

;STEP 1
(defn run1 [number-of-users step]
  (let [cs (repeatedly number-of-users async/chan)]
    (doseq [c cs]
      (go (>! c (step))))))

;STEP 2
(defn- collect-result [cs]
  (let [[result c] (async/alts!! cs)]
    result))

(defn run-with-results [number-of-users step]
  (let [cs (repeatedly number-of-users async/chan)]
    (doseq [c cs]
      (go (>! c (step))))
    (repeatedly number-of-users #(collect-result cs))))

;STEP 3
(defn bench [function]
  (let [start (System/currentTimeMillis)
        result (function)]
    [(- (System/currentTimeMillis) start) result]))

(defn run-with-bench [number-of-users step]
  (let [cs (repeatedly number-of-users async/chan)]
    (doseq [c cs]
      (go (>! c (bench step))))
    (repeatedly number-of-users #(collect-result cs))))

;STEP 4
(defn http-get [url]
  (fn []
    (= 200 (:status @(http/get url)))))

(defn run-with-url [number-of-users url]
  (let [cs (repeatedly number-of-users async/chan)]
    (doseq [c cs]
      (go (>! c (bench (http-get url)))))
    (repeatedly number-of-users #(collect-result cs))))

;(STEP 5 "Non blocking http")

(defn non-blocking-http-get [url]
  (fn [cb]
    (http/get url {} #(cb (= 200 (:status %))))))

(defn callback->chan [fn-with-cb]
  (let [c (async/chan)
        start (System/currentTimeMillis)]
    (fn-with-cb #(async/put! c [(- (System/currentTimeMillis) start) %]))
    c))

(defn run-non-blocking [number-of-users url]
  (let [cs (repeatedly number-of-users async/chan)]
    (doseq [c cs]
      (go (>! c (callback->chan (non-blocking-http-get url)))))
    (let [results (mapv (fn [_] (collect-result cs)) cs)]
      (doall (repeatedly number-of-users  #(collect-result results))))))

(ns clj-tutorials.core
  (:require [org.httpkit.client :as http]
            [clojure.core.async :as async :refer [go <! >!]]))

;STEP 1
(defn run1 [number-of-users step]
  (let [cs (repeatedly number-of-users async/chan)]
    (doseq [c cs]
      (go (>! c (step))))))

;STEP 2
(defn- collect-result [cs]
  (let [[result c] (async/alts!! cs)]
    result))

(defn run-with-results [number-of-users step]
  (let [cs (repeatedly number-of-users async/chan)]
    (doseq [c cs]
      (go (>! c (step))))
    (repeatedly number-of-users #(collect-result cs))))

;STEP 3
(defn bench [function]
  (let [start (System/currentTimeMillis)
        result (function)]
    [(- (System/currentTimeMillis) start) result]))

(defn run-with-bench [number-of-users step]
  (let [cs (repeatedly number-of-users async/chan)]
    (doseq [c cs]
      (go (>! c (bench step))))
    (repeatedly number-of-users #(collect-result cs))))

;STEP 4
(defn http-get [url]
  (fn []
    (= 200 (:status @(http/get url)))))

(defn run-with-url [number-of-users url]
  (let [cs (repeatedly number-of-users async/chan)]
    (doseq [c cs]
      (go (>! c (bench (http-get url)))))
    (repeatedly number-of-users #(collect-result cs))))

;(STEP 5 "Non blocking http")

(defn chan-http-get [url c]
  (let [start (System/currentTimeMillis)]
    (http/get url {} #(async/put! c [(- (System/currentTimeMillis) start)
                                     (= 200 (:status %))]))))

(defn run-non-blocking [number-of-users url]
  (let [cs (repeatedly number-of-users async/chan)]
    (doseq [c cs]
        (go (chan-http-get url c)))
    (repeatedly number-of-users #(collect-result cs))))

Refactor non-blocking-http sending

Refactor non-blocking-http sending


(ns cljs-api-gen.write
  (:refer-clojure :exclude [replace])
  (:require
    [clojure.edn :as edn]
    [clojure.set :refer [rename-keys]]
    [clojure.string :refer [join replace split trim]]
    [fipp.edn :refer [pprint]]
    [cljs-api-gen.repo-cljs :refer [cljs-tag->version]]
    [cljs-api-gen.config :refer [*output-dir*
                                 refs-dir
                                 edn-result-file]]
    [cljs-api-gen.util :refer [symbol->filename mapmap]]
    [me.raynes.fs :refer [exists? mkdir]]
    [stencil.core :as stencil]
    ))

(defn md-escape
  [sym]
  (-> sym
      (replace "*" "\\*")))

(defn md-strikethru
  [s]
  (str "~~" s "~~"))

(defn md-header-link
  [s]
  (-> s
      (replace "." "")))

(defn shield-escape
  [s]
  (-> s
      (replace "-" "--")))

(defn make-clj-ref
  [item]
  (when-let [full-name (:clj-symbol item)]
    {:full-name full-name
     :link (let [ns- (-> full-name symbol namespace)]
             (str "http://clojure.github.io/clojure/branch-master/" ns- "-api.html#" full-name))}))

(defn item-filename
  [item]
  (str *output-dir* "/" refs-dir "/" (:ns item) "_" (symbol->filename (:name item))))

(defn history-change
  [[change version]]
  (let [change ({"+" "Added", "-" "Removed"} change)]
    {:change change
     :version version}))

(defn history-change-shield
  [[change version]]
  (let [color ({"+" "lightgrey" "-" "red"} change)
        change ({"+" "+", "-" "×"} change)]
    (str
      ""
      ""
      "")))

(defn sig-args
  [text]
  (let [[_ args] (re-find #"^\[(.*)\]$" text)]
    args))

(defn source-link
  [filename item]
  (str "[" filename ":" (join "-" (:source-lines item)) "](" (:source-link item) ")"))

(defn source-path
  [item]
  ;; clojurescript/
  ;; └── src/
  ;;     └── cljs/
  ;;         └── cljs/
  ;;             └── [core.cljs:2109-2114](https://github.com/clojure/clojurescript/blob/r3211/src/cljs/cljs/core.cljs#L2109-L2114)
  (let [crumbs (split (:source-filename item) #"/")
        last-i (dec (count crumbs))
        branch "└── "
        space  "    "]
    (join "\n"
      (map-indexed
        (fn [i crumb]
          (if (zero? i)
            crumb
            (str (join (repeat (dec i) space))
                 branch
                 (if (= i last-i)
                   (source-link crumb item)
                   crumb))))
        crumbs))))

(defn ref-file-data
  [item]
  (-> item
      (assoc
        :display-name (cond-> (md-escape (:full-name item))
                        (:removed item) md-strikethru)
        :data (with-out-str (pprint item))
        :history (map history-change-shield (:history item))
        :signature (map #(hash-map :name (:name item)
                                   :args (sig-args %))
                        (:signature item))
        :source-path (source-path item)
        :clj-symbol (make-clj-ref item))
      (update-in [:docstring]
        #(if (or (nil? %) (= "" (trim %)))
           "(no docstring)"
           %))))

(defn dump-ref-file!
  [item]
  (let [filename (item-filename item)]
    (spit (str filename ".md")
      (stencil/render-string
        (slurp "templates/ref.md")
        (ref-file-data item)))))

(defn get-edn-path []
  (str *output-dir* "/" edn-result-file))

(defn get-last-written-result []
  (let [path (get-edn-path)]
    (when (exists? path)
      (edn/read-string (slurp path)))))

(defn readme-library-changes
  [result]
  ;; name-link tuples
  (let [api (:library-api result)
        changes (last (:changes api))
        symbols (:symbols api)
        make (fn [full-name change]
               (let [item (get symbols full-name)]
                 {:text (cond-> (md-escape full-name)
                          (= change :removed) md-strikethru)
                  :change ({:added "+" :removed "-"} change)
                  :type (:type item)
                  :name (:name item)
                  :ns (:ns item)
                  :link (str refs-dir "/" (:full-name-encode item) ".md")
                  }))
        added (map #(make % :added) (:added changes))
        removed (map #(make % :removed) (:removed changes))
        sort-key (fn [item] [(:ns item) (:name item)])
        all (sort-by sort-key (concat added removed))]
    all))

(defn readme-library-symbols
  [result]
  ;; clj-name-type-history tuples
  (let [all (-> result :library-api :symbols)
        make-item (fn [item]
                    {:display-name (cond-> (md-escape (:name item))
                                     (:removed item) md-strikethru)
                     :link (str refs-dir "/" (:full-name-encode item) ".md")
                     :clj-symbol (make-clj-ref item)
                     :name (:name item)
                     :type (:type item)
                     :history (map history-change-shield (:history item))})
        transform-syms #(sort-by :name (map make-item %))
        ns-symbols (->> (vals all)
                        (group-by :ns)
                        (mapmap transform-syms)
                        (map (fn [[k v]] {:ns k :ns-link (md-header-link k) :symbols v}))
                        (sort-by :ns))]
    ns-symbols))

(defn readme-file-data
  [result]
  (let [changes (readme-library-changes result)
        no-changes (if (zero? (count changes)) true nil)]
    {:changes changes
     :no-changes no-changes
     :ns-symbols (readme-library-symbols result)
     :release (:release result)}))

(defn dump-readme! [result]
  (spit (str *output-dir* "/README.md")
        (stencil/render-string
          (slurp "templates/readme.md")
          (readme-file-data result)
          )))

(defn dump-edn-file! [result]
  (spit (get-edn-path) (with-out-str (pprint result))))

(defn dump-result! [result]
  (mkdir *output-dir*)
  (mkdir (str *output-dir* "/" refs-dir))

  (doseq [item (vals (:symbols (:library-api result)))]
    (dump-ref-file! item))

  (dump-readme! result)
  (dump-edn-file! result))

(ns cljs-api-gen.write
  (:refer-clojure :exclude [replace])
  (:require
    [clojure.edn :as edn]
    [clojure.set :refer [rename-keys]]
    [clojure.string :refer [join replace split trim]]
    [fipp.edn :refer [pprint]]
    [cljs-api-gen.repo-cljs :refer [cljs-tag->version]]
    [cljs-api-gen.config :refer [*output-dir*
                                 refs-dir
                                 edn-result-file]]
    [cljs-api-gen.util :refer [symbol->filename mapmap]]
    [me.raynes.fs :refer [exists? mkdir]]
    [stencil.core :as stencil]
    ))

(defn md-escape
  [sym]
  (-> sym
      (replace "*" "\\*")))

(defn md-strikethru
  [s]
  (str "~~" s "~~"))

(defn md-header-link
  [s]
  (-> s
      (replace "." "")))

(defn shield-escape
  [s]
  (-> s
      (replace "-" "--")))

(defn make-clj-ref
  [item]
  (when-let [full-name (:clj-symbol item)]
    {:full-name full-name
     :link (let [ns- (-> full-name symbol namespace)]
             (str "http://clojure.github.io/clojure/branch-master/" ns- "-api.html#" full-name))}))

(defn item-filename
  [item]
  (str *output-dir* "/" refs-dir "/" (:ns item) "_" (symbol->filename (:name item))))

(defn history-change
  [[change version]]
  (let [change ({"+" "Added", "-" "Removed"} change)]
    {:change change
     :version version}))

(defn history-change-shield
  [[change version]]
  (let [color ({"+" "lightgrey" "-" "red"} change)
        change ({"+" "+", "-" "×"} change)]
    (str
      ""
      ""
      "")))

(defn sig-args
  [text]
  (let [[_ args] (re-find #"^\[(.*)\]$" text)]
    args))

(defn source-link
  [filename item]
  (str "[" filename ":" (join "-" (:source-lines item)) "](" (:source-link item) ")"))

(defn source-path
  [item]
  ;; clojurescript/
  ;; └── src/
  ;;     └── cljs/
  ;;         └── cljs/
  ;;             └── [core.cljs:2109-2114](https://github.com/clojure/clojurescript/blob/r3211/src/cljs/cljs/core.cljs#L2109-L2114)
  (let [crumbs (split (:source-filename item) #"/")
        last-i (dec (count crumbs))
        branch "└── "
        space  "    "]
    (join "\n"
      (map-indexed
        (fn [i crumb]
          (if (zero? i)
            (str crumb "@" (second (re-find #"blob/([^/]*)" (:source-link item))))
            (str (join (repeat (dec i) space))
                 branch
                 (if (= i last-i)
                   (source-link crumb item)
                   crumb))))
        crumbs))))

(defn ref-file-data
  [item]
  (-> item
      (assoc
        :display-name (cond-> (md-escape (:full-name item))
                        (:removed item) md-strikethru)
        :data (with-out-str (pprint item))
        :history (map history-change-shield (:history item))
        :signature (map #(hash-map :name (:name item)
                                   :args (sig-args %))
                        (:signature item))
        :source-path (source-path item)
        :clj-symbol (make-clj-ref item))
      (update-in [:docstring]
        #(if (or (nil? %) (= "" (trim %)))
           "(no docstring)"
           %))))

(defn dump-ref-file!
  [item]
  (let [filename (item-filename item)]
    (spit (str filename ".md")
      (stencil/render-string
        (slurp "templates/ref.md")
        (ref-file-data item)))))

(defn get-edn-path []
  (str *output-dir* "/" edn-result-file))

(defn get-last-written-result []
  (let [path (get-edn-path)]
    (when (exists? path)
      (edn/read-string (slurp path)))))

(defn readme-library-changes
  [result]
  ;; name-link tuples
  (let [api (:library-api result)
        changes (last (:changes api))
        symbols (:symbols api)
        make (fn [full-name change]
               (let [item (get symbols full-name)]
                 {:text (cond-> (md-escape full-name)
                          (= change :removed) md-strikethru)
                  :change ({:added "+" :removed "-"} change)
                  :type (:type item)
                  :name (:name item)
                  :ns (:ns item)
                  :link (str refs-dir "/" (:full-name-encode item) ".md")
                  }))
        added (map #(make % :added) (:added changes))
        removed (map #(make % :removed) (:removed changes))
        sort-key (fn [item] [(:ns item) (:name item)])
        all (sort-by sort-key (concat added removed))]
    all))

(defn readme-library-symbols
  [result]
  ;; clj-name-type-history tuples
  (let [all (-> result :library-api :symbols)
        make-item (fn [item]
                    {:display-name (cond-> (md-escape (:name item))
                                     (:removed item) md-strikethru)
                     :link (str refs-dir "/" (:full-name-encode item) ".md")
                     :clj-symbol (make-clj-ref item)
                     :name (:name item)
                     :type (:type item)
                     :history (map history-change-shield (:history item))})
        transform-syms #(sort-by :name (map make-item %))
        ns-symbols (->> (vals all)
                        (group-by :ns)
                        (mapmap transform-syms)
                        (map (fn [[k v]] {:ns k :ns-link (md-header-link k) :symbols v}))
                        (sort-by :ns))]
    ns-symbols))

(defn readme-file-data
  [result]
  (let [changes (readme-library-changes result)
        no-changes (if (zero? (count changes)) true nil)]
    {:changes changes
     :no-changes no-changes
     :ns-symbols (readme-library-symbols result)
     :release (:release result)}))

(defn dump-readme! [result]
  (spit (str *output-dir* "/README.md")
        (stencil/render-string
          (slurp "templates/readme.md")
          (readme-file-data result)
          )))

(defn dump-edn-file! [result]
  (spit (get-edn-path) (with-out-str (pprint result))))

(defn dump-result! [result]
  (mkdir *output-dir*)
  (mkdir (str *output-dir* "/" refs-dir))

  (doseq [item (vals (:symbols (:library-api result)))]
    (dump-ref-file! item))

  (dump-readme! result)
  (dump-edn-file! result))

add tag to source display (close #33)

add tag to source display (close #33)


(ns catalog.web.views
  "Views for web application"
  (:require [catalog
             [validation :as validation]
             [vubis :as vubis]]
            [catalog.layout
             [common :refer [translations]]
             [dtbook :as layout.dtbook]
             [fop :as layout.fop]]
            [catalog.web.layout :as layout]
            [cemerick.friend :as friend]
            [clojure.edn :as edn]
            [clojure.java.io :as io]
            [hiccup
             [core :refer [h]]
             [form :as form]]
            [ring.util
             [anti-forgery :refer [anti-forgery-field]]
             [response :as response]]
            [schema.core :as s]))

(defn icon-button [href icon label]
  [:a.btn.btn-default {:href href :role "button" :aria-label label}
   [:span.glyphicon {:class (str "glyphicon-" icon) :aria-hidden "true"}] (str " " label)])

(defn home [request]
  (let [identity (friend/identity request)]
    (layout/common
     identity
     [:div.row
      [:div.col-md-6
       [:div.well
        [:h2 (translations :all-formats)]
        (icon-button "/neu-im-sortiment.pdf" "download" "Download")]]
      [:div.col-md-6
       [:div.well
        [:h2 (translations :grossdruck)]
        (icon-button "/neue-grossdruckbücher.pdf" "download" "Download")]]]
     [:div.row
      [:div.col-md-6
       [:div.well
        [:h2 (translations :braille)]
        (icon-button "/neue-braillebücher.xml" "download" "Download")]]
      [:div.col-md-6
       [:div.well
        [:h2 (translations :hörbuch)]
        (icon-button "/neue-hörbücher.pdf" "download" "Download")
        (icon-button "/neue-hörbücher.ncc" "download" "NCC")
        (icon-button "/neue-hörbücher-toc.pdf" "download" "TOC")]]])))

(defn read-catalog [f]
  (-> f io/reader java.io.PushbackReader. edn/read))

(defn neu-im-sortiment []
  (let [temp-file (java.io.File/createTempFile "neu-im-sortiment" ".pdf")]
    (-> "catalog.edn"
        read-catalog
        (layout.fop/document :all-formats)
        (layout.fop/generate-pdf! temp-file))
    (-> temp-file
        response/response
        (response/content-type "application/pdf"))))

(defn neue-grossdruckbücher []
  (let [temp-file (java.io.File/createTempFile "neue-grossdruckbücher" ".pdf")]
    (-> "catalog.edn"
        read-catalog
        (layout.fop/document :grossdruck)
        (layout.fop/generate-pdf! temp-file))
    (-> temp-file
        response/response
        (response/content-type "application/pdf"))))

(defn neue-braillebücher []
  (-> "catalog.edn"
      read-catalog
      :braille
      layout.dtbook/dtbook
      response/response
      (response/content-type "application/xml")))

(defn neue-hörbücher []
  (let [temp-file (java.io.File/createTempFile "neue-hörbücher" ".pdf")]
    (-> "catalog.edn"
        read-catalog
        (layout.fop/document :hörbuch)
        (layout.fop/generate-pdf! temp-file))
    (-> temp-file
        response/response
        (response/content-type "application/pdf"))))

(defn upload-form [request & [errors]]
  (let [identity (friend/identity request)]
    (layout/common
     identity
     [:div.row
      [:div.col-md-6
       [:div.well
        [:h2 "Upload Neu im Sortiment"]
        (when (seq errors)
          [:p [:ul.alert.alert-danger (for [e errors] [:li e])]])
        (form/form-to
         {:enctype "multipart/form-data"
          :class "form-inline"}
         [:post "/upload-confirm"]
         (anti-forgery-field)
         (form/file-upload "file")
         " "
         (form/submit-button {:class "btn btn-default"} "Upload"))]]
      [:div.col-md-6
       [:div.well
        [:h2 "Upload Gesamtkatalog Hörfilm"]
        (when (seq errors)
          [:p [:ul.alert.alert-danger (for [e errors] [:li e])]])
        (form/form-to
         {:enctype "multipart/form-data"
          :class "form-inline"}
         [:post "/upload-confirm"]
         (anti-forgery-field)
         (form/file-upload "file")
         " "
         (form/submit-button {:class "btn btn-default"} "Upload"))]]]
     [:div.row
      [:div.col-md-6
       [:div.well
        [:h2 "Upload Gesamtkatalog Spiele"]
        (when (seq errors)
          [:p [:ul.alert.alert-danger (for [e errors] [:li e])]])
        (form/form-to
         {:enctype "multipart/form-data"
          :class "form-inline"}
         [:post "/upload-confirm"]
         (anti-forgery-field)
         (form/file-upload "file")
         " "
         (form/submit-button {:class "btn btn-default"} "Upload"))]]
      [:div.col-md-6
       [:div.well
        [:h2 "Upload Gesamtkatalog Taktile Bücher"]
        (when (seq errors)
          [:p [:ul.alert.alert-danger (for [e errors] [:li e])]])
        (form/form-to
         {:enctype "multipart/form-data"
          :class "form-inline"}
         [:post "/upload-confirm"]
         (anti-forgery-field)
         (form/file-upload "file")
         " "
         (form/submit-button {:class "btn btn-default"} "Upload"))]]])))

(defn upload-confirm [request file]
  (let [{tempfile :tempfile} file
        path (.getPath tempfile)
        items (vubis/collate-all-duplicate-items (vubis/read-file path))
        checker (s/checker validation/CatalogItem)
        problems (keep #(when-let [error (checker %)] [error %]) items)]
    (if (seq problems)
      (let [identity (friend/identity request)]
        (layout/common identity
                       [:h1 "Confirm Upload"]
                       [:table#productions.table.table-striped
                        [:thead [:tr (map #(vec [:th %]) ["Record-id" "Title" "Field" "Value" "Error"])]]
                        [:tbody
                         (for [[errors {:keys [record-id title] :as item}] problems]
                           (for [[k v] errors]
                             [:tr
                              [:td record-id]
                              [:td (h title)]
                              [:td k]
                              [:td (h (item k))]
                              [:td (str v)]]))]]
                       (form/form-to
                        {:enctype "multipart/form-data"}
                        [:post "/upload"]
                        (anti-forgery-field)
                        (form/submit-button "Upload Anyway"))))
      (do
        ;; add the file
        ;; and redirect to the index
        (response/redirect-after-post "/")))))

(defn editorial-form [request]
  (let [identity (friend/identity request)]
    (layout/common
     identity
     [:h1 "Editorial"]
     (form/form-to
      [:post "/editorial"]
      (anti-forgery-field)
      [:div.form-group
       (form/label "editorial" "Editorial:")
       (form/text-area {:class "form-control" :data-provide "markdown" :data-hidden-buttons "cmdImage cmdCode" :data-resize "vertical" :rows 30} "editorial")]
      [:div.form-group
       (form/label "recommended" "Buchtipps:")
       (form/text-area {:class "form-control" :data-provide "markdown" :data-hidden-buttons "cmdImage cmdCode" :data-resize "vertical" :rows 30} "recommended")]
      (form/submit-button {:class "btn btn-default"} "Submit")))))

(defn editorial [request editorial recommended]
  (response/redirect-after-post "/"))

(defn login-form []
  (layout/common nil
   [:h3 "Login"]
   (form/form-to
    [:post "/login"]
    (anti-forgery-field)
    [:div.form-group
     (form/label "username" "Username:")
     (form/text-field {:class "form-control"} "username")]
    [:div.form-group
     (form/label "password" "Password:")
     (form/password-field {:class "form-control"} "password")]
    (form/submit-button {:class "btn btn-default"} "Login"))))

(defn unauthorized [request]
  (let [identity (friend/identity request)]
    (->
     (layout/common identity
      [:h2
       [:div.alert.alert-danger
        "Sorry, you do not have sufficient privileges to access "
        (:uri request)]]
      [:p "Please ask an administrator for help"])
     response/response
     (response/status 401))))

(ns catalog.web.views
  "Views for web application"
  (:require [catalog
             [validation :as validation]
             [vubis :as vubis]]
            [catalog.layout
             [common :refer [translations]]
             [dtbook :as layout.dtbook]
             [fop :as layout.fop]]
            [catalog.web.layout :as layout]
            [cemerick.friend :as friend]
            [clojure.edn :as edn]
            [clojure.java.io :as io]
            [hiccup
             [core :refer [h]]
             [form :as form]]
            [ring.util
             [anti-forgery :refer [anti-forgery-field]]
             [response :as response]]
            [schema.core :as s]
            [clojure.string :as string]))

(defn icon-button [href icon label]
  [:a.btn.btn-default {:href href :role "button" :aria-label label}
   [:span.glyphicon {:class (str "glyphicon-" icon) :aria-hidden "true"}] (str " " label)])

(defn home [request]
  (let [identity (friend/identity request)]
    (layout/common
     identity
     [:div.row
      [:div.col-md-6
       [:div.well
        [:h2 (translations :all-formats)]
        (icon-button "/neu-im-sortiment.pdf" "download" "Download")]]
      [:div.col-md-6
       [:div.well
        [:h2 (translations :grossdruck)]
        (icon-button "/neue-grossdruckbücher.pdf" "download" "Download")]]]
     [:div.row
      [:div.col-md-6
       [:div.well
        [:h2 (translations :braille)]
        (icon-button "/neue-braillebücher.xml" "download" "Download")]]
      [:div.col-md-6
       [:div.well
        [:h2 (translations :hörbuch)]
        (icon-button "/neue-hörbücher.pdf" "download" "Download")
        (icon-button "/neue-hörbücher.ncc" "download" "NCC")
        (icon-button "/neue-hörbücher-toc.pdf" "download" "TOC")]]])))

(defn read-catalog [f]
  (-> f io/reader java.io.PushbackReader. edn/read))

(defn neu-im-sortiment []
  (let [temp-file (java.io.File/createTempFile "neu-im-sortiment" ".pdf")]
    (-> "catalog.edn"
        read-catalog
        (layout.fop/document :all-formats)
        (layout.fop/generate-pdf! temp-file))
    (-> temp-file
        response/response
        (response/content-type "application/pdf"))))

(defn neue-grossdruckbücher []
  (let [temp-file (java.io.File/createTempFile "neue-grossdruckbücher" ".pdf")]
    (-> "catalog.edn"
        read-catalog
        (layout.fop/document :grossdruck)
        (layout.fop/generate-pdf! temp-file))
    (-> temp-file
        response/response
        (response/content-type "application/pdf"))))

(defn neue-braillebücher []
  (-> "catalog.edn"
      read-catalog
      :braille
      layout.dtbook/dtbook
      response/response
      (response/content-type "application/xml")))

(defn neue-hörbücher []
  (let [temp-file (java.io.File/createTempFile "neue-hörbücher" ".pdf")]
    (-> "catalog.edn"
        read-catalog
        (layout.fop/document :hörbuch)
        (layout.fop/generate-pdf! temp-file))
    (-> temp-file
        response/response
        (response/content-type "application/pdf"))))

(defn upload-form [request & [errors]]
  (let [identity (friend/identity request)]
    (layout/common
     identity
     [:div.row
      [:div.col-md-6
       [:div.well
        [:h2 "Upload Neu im Sortiment"]
        (when (seq errors)
          [:p [:ul.alert.alert-danger (for [e errors] [:li e])]])
        (form/form-to
         {:enctype "multipart/form-data"
          :class "form-inline"}
         [:post "/upload-confirm"]
         (anti-forgery-field)
         (form/file-upload "file")
         " "
         (form/submit-button {:class "btn btn-default"} "Upload"))]]
      [:div.col-md-6
       [:div.well
        [:h2 "Upload Gesamtkatalog Hörfilm"]
        (when (seq errors)
          [:p [:ul.alert.alert-danger (for [e errors] [:li e])]])
        (form/form-to
         {:enctype "multipart/form-data"
          :class "form-inline"}
         [:post "/upload-confirm"]
         (anti-forgery-field)
         (form/file-upload "file")
         " "
         (form/submit-button {:class "btn btn-default"} "Upload"))]]]
     [:div.row
      [:div.col-md-6
       [:div.well
        [:h2 "Upload Gesamtkatalog Spiele"]
        (when (seq errors)
          [:p [:ul.alert.alert-danger (for [e errors] [:li e])]])
        (form/form-to
         {:enctype "multipart/form-data"
          :class "form-inline"}
         [:post "/upload-confirm"]
         (anti-forgery-field)
         (form/file-upload "file")
         " "
         (form/submit-button {:class "btn btn-default"} "Upload"))]]
      [:div.col-md-6
       [:div.well
        [:h2 "Upload Gesamtkatalog Taktile Bücher"]
        (when (seq errors)
          [:p [:ul.alert.alert-danger (for [e errors] [:li e])]])
        (form/form-to
         {:enctype "multipart/form-data"
          :class "form-inline"}
         [:post "/upload-confirm"]
         (anti-forgery-field)
         (form/file-upload "file")
         " "
         (form/submit-button {:class "btn btn-default"} "Upload"))]]])))

(defn upload-confirm [request file]
  (let [{tempfile :tempfile} file
        path (.getPath tempfile)
        items (vubis/collate-all-duplicate-items (vubis/read-file path))
        checker (s/checker validation/CatalogItem)
        problems (keep #(when-let [error (checker %)] [error %]) items)]
    (if (seq problems)
      (let [identity (friend/identity request)]
        (layout/common identity
                       [:h1 "Confirm Upload"]
                       [:table#productions.table.table-striped
                        [:thead [:tr (map #(vec [:th %]) ["Record-id" "Title" "Field" "Value" "Error"])]]
                        [:tbody
                         (for [[errors {:keys [record-id title] :as item}] problems]
                           (for [[k v] errors]
                             [:tr
                              [:td record-id]
                              [:td (h title)]
                              [:td k]
                              [:td (h (item k))]
                              [:td (str v)]]))]]
                       (form/form-to
                        {:enctype "multipart/form-data"}
                        [:post "/upload"]
                        (anti-forgery-field)
                        (form/submit-button "Upload Anyway"))))
      (do
        ;; add the file
        ;; and redirect to the index
        (response/redirect-after-post "/")))))

(defn editorial-form [request fmt]
  (let [identity (friend/identity request)]
    (layout/common
     identity
     [:h1 (format "Editorial und Buchtipps für %s" (string/capitalize fmt))]
     (form/form-to
      [:post "/editorial"]
      (anti-forgery-field)
      [:div.form-group
       (form/label "editorial" "Editorial:")
       (form/text-area {:class "form-control" :data-provide "markdown" :data-hidden-buttons "cmdImage cmdCode" :data-resize "vertical" :rows 30} "editorial")]
      [:div.form-group
       (form/label "recommended" "Buchtipps:")
       (form/text-area {:class "form-control" :data-provide "markdown" :data-hidden-buttons "cmdImage cmdCode" :data-resize "vertical" :rows 30} "recommended")]
      (form/submit-button {:class "btn btn-default"} "Submit")))))

(defn editorial [request editorial recommended]
  (response/redirect-after-post "/"))

(defn login-form []
  (layout/common nil
   [:h3 "Login"]
   (form/form-to
    [:post "/login"]
    (anti-forgery-field)
    [:div.form-group
     (form/label "username" "Username:")
     (form/text-field {:class "form-control"} "username")]
    [:div.form-group
     (form/label "password" "Password:")
     (form/password-field {:class "form-control"} "password")]
    (form/submit-button {:class "btn btn-default"} "Login"))))

(defn unauthorized [request]
  (let [identity (friend/identity request)]
    (->
     (layout/common identity
      [:h2
       [:div.alert.alert-danger
        "Sorry, you do not have sufficient privileges to access "
        (:uri request)]]
      [:p "Please ask an administrator for help"])
     response/response
     (response/status 401))))

Make the editorial form more generic

Make the editorial form more generic

so it can handle multiple formats


(ns ceres.curator
  (:refer-clojure :exclude [sort find])
  (:require [monger.core :as mg]
            [monger.collection :as mc]
            [monger.operators :refer :all]
            [monger.conversion :refer [from-db-object]]
            [monger.query :refer :all]
            [monger.joda-time]
            [clojure.string :refer [split join]]
            [net.cgrand.enlive-html :as enlive]
            [clojure.data.json :as json]
            [clj-time.format :as f]
            [taoensso.timbre :as timbre]
            [clj-time.core :as t])
 (:import org.bson.types.ObjectId))

(timbre/refer-timbre)

(def mongo-state
  (atom
   {:db (let [^MongoOptions opts (mg/mongo-options :threads-allowed-to-block-for-connection-multiplier 300)
              ^ServerAddress sa  (mg/server-address (or (System/getenv "DB_PORT_27017_TCP_ADDR") "127.0.0.1") 27017)]
          (mg/get-db (mg/connect sa opts) "athena"))
    :custom-formatter (f/formatter "E MMM dd HH:mm:ss Z YYYY")
    :news-accounts #{"FAZ_NET" "dpa" "tagesschau" "SPIEGELONLINE" "SZ" "BILD" "DerWesten" "ntvde" "tazgezwitscher" "welt" "ZDFheute" "N24_de" "sternde" "focusonline"}}))

(def months
  [(range 1 32)
   (range 1 29)
   (range 1 32)
   (range 1 31)
   (range 1 32)
   (range 1 31)
   (range 1 32)
   (range 1 32)
   (range 1 31)
   (range 1 32)
   (range 1 31)
   (range 1 32)])

(defn fetch-url [url]
  (enlive/html-resource (java.net.URL. url)))

(defn- expand-url
  "Expands shortened url strings, thanks to http://www.philippeadjiman.com/blog/2009/09/07/the-trick-to-write-a-fast-universal-java-url-expander/"
  [url-str]
  (let [url (java.net.URL. url-str)
        conn (.openConnection url)]
    (do (.setInstanceFollowRedirects conn false)
        (.connect conn)
        (let [expanded-url (.getHeaderField conn "Location")
              content-type (.getContentType conn)]
          (try
            (do (.close (.getInputStream conn))
                {:url expanded-url
                 :content-type content-type})
            (catch Exception e (do (error (str e))
                                   {:url "Not available"
                                    :content-type content-type})))))))

(defn trace-parent
  "Compute ancestor trace of given tweet"
  [tweet origins]
  (let [replied-id (:in_reply_to_status_id_str tweet)
        retweeted-status-id (-> tweet :retweeted_status :id_str)
        parent (if replied-id
                 (mc/find-one-as-map (:db @mongo-state) "tweets" {:id_str replied-id})
                 (if retweeted-status-id
                   (mc/find-one-as-map (:db @mongo-state) "tweets" {:id_str retweeted-status-id})
                   nil))]
    (if parent
      (trace-parent parent (into origins [(:_id parent)]))
      origins)))

(defn store-url [{:keys [article record ts source]}]
  (mc/insert-and-return
   (:db @mongo-state)
   "urls"
   {:tweet record
    :article article
    :source source
    :ts ts}))

(defn store-origin [{:keys [article record ts source ancestors]}]
  (mc/insert-and-return
   (:db @mongo-state)
   "origins"
   {:tweet record
    :article article
    :source source
    :ancestors ancestors
    :ts ts}))

(defn store-article [{:keys [url content-type ts] :as expanded-url}]
  (let [raw-html (slurp url)
        html-title (-> (java.io.StringReader. raw-html) enlive/html-resource (enlive/select [:head :title]) first :content first)]
    (mc/insert-and-return
     (:db @mongo-state)
     "articles"
     {:url url
      :title html-title
      :content-type content-type
      :html raw-html
      :ts ts})))

(defn store
  "Stores the given tweet in mongodb"
  [tweet]
  (let [oid (ObjectId.)
        doc (update-in tweet [:created_at] (fn [x] (f/parse (:custom-formatter @mongo-state) x)))
        record (from-db-object (mc/insert-and-return (:db @mongo-state) "tweets" (merge doc {:_id oid})) true)
        ts (:created_at record)
        source ((:news-accounts @mongo-state) (-> record :user :screen_name))
        record-urls (-> record :entities :urls)
        expanded-urls (if (empty? record-urls)
                        nil
                        (map #(let [expanded-url (expand-url (:expanded_url %))]
                                (if (:url expand-url)
                                  expanded-url
                                  (assoc expanded-url :url (:expanded_url %)))) record-urls))
        articles (if (nil? expanded-urls)
                   nil
                   (map #(assoc % :article (-> (mc/find-one-as-map (:db @mongo-state) "articles" {:url (:url %)}) :_id)) expanded-urls))
        ancestors (trace-parent record [])]
    (if (nil? articles)
      (do
        (store-origin (assoc % :record oid :ts ts :source source :ancestors ancestors))
        nil)
      (doall
       (map
        #(if (:article %)
           (do (store-origin (assoc % :record oid :ts ts :source source :ancestors ancestors))
               (update-in (mc/find-map-by-id (:db @mongo-state) "articles" (:article %)) [:ts] (fn [x] (f/unparse (:custom-formatter @mongo-state) x))))
           (let [article (store-article (assoc % :ts ts))]
             (do (store-origin (assoc % :article (:_id article) :record oid :ts ts :source source :ancestors ancestors))
                 (do (store-url (assoc % :record oid :ts ts :source source))
                     (update-in article [:ts] (fn [x] (f/unparse (:custom-formatter @mongo-state) x)))))))
        articles)))))

;;todo check if id exists in database
(defn read-data
  "Reads in json data from given path and stores it"
  [path]
  (doall (map #(let [data (json/read-str % :key-fn keyword)]
                 (println "Importing " (:id data))
                 (store data)) (split (slurp path) #"\n"))))

(defn get-recent-tweets
  "Retrieve the last 25*n tweets"
  [n]
  (->> (mc/find (:db @mongo-state) "tweets")
       seq
       (take-last (+ (* n 25) 100))
       (take 25)
       (mapv #(from-db-object % true))))

(defn get-news-frequencies []
  (mapv #(vec [% (mc/count (:db @mongo-state) "tweets" {:user.screen_name %
                                                        :created_at {$gt (t/date-time 2014 7 1)}})]) (:news-accounts @mongo-state)))

(defn get-tweet-count []
  (mc/count (:db @mongo-state) "tweets" {:created_at {$gt (t/date-time 2014 7 1)}}))

(defn get-tweets-from-date [month day]
  (mc/find-maps (:db @mongo-state) "tweets"
                {:created_at {$gt (t/date-time 2014 month day 0 0 0 0)
                              $lte (t/date-time 2014 month day 23 59 59 999)}}))

(defn get-hashtag-frequencies [coll]
  (->> coll
       (map #(from-db-object % true))
       (map #(map (fn [hashtag] (hashtag :text)) (-> % :entities :hashtags)))
       flatten
       frequencies))

(defn compute-diffusion [user]
  (->> (mc/count (:db @mongo-state) "tweets" {$and [{$or [{"entities.user_mentions.screen_name" user}
                                                           {"retweeted_status.user.screen_name" user}
                                                           {"in_reply_to_screen_name" user}]}
                                                    {:created_at {$gt (t/date-time 2014 7 1)}}]})))

(defn compute-tweet-diffusion [tweet-id parents]
  (let [tweet (mc/find-one-as-map (:db @mongo-state) "tweets" {:id_str tweet-id})
        neighbor-tweets (->> (mc/find-maps
                              (:db @mongo-state)
                              "tweets"
                              {$and [{$or [{"retweeted_status.id_str" tweet-id}
                                           {"in_reply_to_status_id_str" tweet-id}]}
                                     {:created_at {$gt (t/date-time 2014 7 1)}}]}
                              [:text :user.screen_name :id_str :in_reply_to_status_id_str :retweeted_status.id_str])
                             (pmap #(assoc % :parents (into parents [(:_id tweet)]))))
        neightbar-ids (pmap :id_str neighbor-tweets)]
    (merge neighbor-tweets (pmap #(compute-tweet-diffusion % (into parents [(:_id tweet)])) neightbar-ids))))

(defn get-news-diffusion []
  (mapv #(vec [% (compute-diffusion %)]) (:news-accounts @mongo-state)))

(defn get-month-distribution [month]
  (let [day-range (months (dec month))]
    (vec
     (pmap
      (fn [day]
        (into {} [[:date (str (t/date-time 2014 month day))]
                  [:count
                   (mc/count
                    (:db @mongo-state)
                    "tweets"
                    {:created_at
                     {$gt (t/date-time 2014 month day 0 0 0 0)
                      $lte (t/date-time 2014 month day 23 59 59 999)}})]]))
      day-range))))

(defn export-edn
  "Export all collected tweets from a specific date as edn file. Read https://github.com/edn-format/edn for edn format details."
  [m d]
  (->> (get-tweets-from-date m d)
       (map #(dissoc % :_id))
       (map #(update-in % [:created_at] (fn [x] (f/unparse (:custom-formatter @mongo-state) x))))
       (map str)
       (clojure.string/join "\n")))

(defn get-recent-articles []
  (->> (mc/find-maps (:db @mongo-state) "articles" {:ts {$gt (t/date-time 2014 7 20)}})
       (pmap #(dissoc % :html :_id))
       vec))

(defn get-articles-count []
  (mc/count (:db @mongo-state) "articles"))

(defn find-source [id]
  (mc/find-maps (:db @mongo-state) "urls" {$and [{:article id} {:source {$ne nil}}]} [:source :tweet :ts]))

(comment

  ;; TODO update on server
  (time
   (doseq [x (monger.collection/find-maps (:db @mongo-state) "tweets")]
     (mc/update-by-id
      (:db @mongo-state)
      "tweets"
      (:_id x)
      (update-in x [:created_at] #(f/parse (:custom-formatter @mongo-state) (:created_at %))))))

  (mc/ensure-index (:db @mongo-state) "articles" (array-map :ts 1))

  (mc/ensure-index (:db @mongo-state) "origins" (array-map :ts 1 :article 1))

  (mc/ensure-index (:db @mongo-state) "tweets" (array-map :id 1) {:unique true})

  (def sz-url (->> (mc/find-maps (:db @mongo-state) "articles" {:ts {$gt (t/today)}} [:title])
                  (map #(vec [(:_id %) (:title %) (first (find-source (:_id %)))]))
                  (remove #(empty? (last %)))
                  (filter #(= "SZ" (-> % last :source)))
                  first))

  (def sz-tweet (mc/find-map-by-id (:db @mongo-state) "tweets" (-> sz-url last :tweet)))

  (->> (compute-tweet-diffusion (:id_str sz-tweet))
       clojure.pprint/pprint)

  (->> (mc/find-maps (:db @mongo-state) "urls" {:article (first sz-url)})
       (mapv #(assoc % :tweet  (mc/find-map-by-id (:db @mongo-state) "tweets" (:tweet %) [:in_reply_to_status_id_str :text :user.screen_name :retweeted :id_str])))
       clojure.pprint/pprint)

  (def spon-url (->> (mc/find-maps (:db @mongo-state) "articles" {:ts {$gt (t/date-time 2014 7 27)}} [:title])
                  (map #(vec [(:_id %) (:title %) (first (find-source (:_id %)))]))
                  (remove #(empty? (last %)))
                  (filter #(= "SPIEGELONLINE" (-> % last :source)))
                  first))

  (def spon-tweet (mc/find-map-by-id (:db @mongo-state) "tweets" (-> spon-url last :tweet)))

  (->> (compute-tweet-diffusion (:id_str spon-tweet) [])
       flatten
       clojure.pprint/pprint)

  (->> (mc/find-maps (:db @mongo-state) "urls" {:article (first spon-url)})
       (mapv #(assoc % :tweet  (mc/find-map-by-id (:db @mongo-state) "tweets" (:tweet %) [:in_reply_to_status_id_str :text :user.screen_name :retweeted_status.id_str :id_str])))
       count
       clojure.pprint/pprint)

  (let [tweet (-> (mc/find-maps (:db @mongo-state) "tweets" {:created_at {$gt (t/today)}})
                  rand-nth)
        record-urls (-> tweet :entities :urls)
        expanded-urls (if (empty? record-urls)
                        nil
                        (map #(let [expanded-url (expand-url (:expanded_url %))]
                                (if (:url expand-url)
                                  expanded-url
                                  (assoc expanded-url :url (:expanded_url %)))) record-urls))
        articles (if (nil? expanded-urls)
                   nil
                   (map #(assoc % :article (-> (mc/find-one-as-map (:db @mongo-state) "articles" {:url (:url %)}) :_id)) expanded-urls))]
    (-> (vec [(:text tweet) (trace-parent tweet []) articles])
        clojure.pprint/pprint))

  (->> (mc/find-maps (:db @mongo-state) "origins")
       (filter #(nil? (-> % :article)))
       )

  )

(ns ceres.curator
  (:refer-clojure :exclude [sort find])
  (:require [monger.core :as mg]
            [monger.collection :as mc]
            [monger.operators :refer :all]
            [monger.conversion :refer [from-db-object]]
            [monger.query :refer :all]
            [monger.joda-time]
            [clojure.string :refer [split join]]
            [net.cgrand.enlive-html :as enlive]
            [clojure.data.json :as json]
            [clj-time.format :as f]
            [taoensso.timbre :as timbre]
            [clj-time.core :as t])
 (:import org.bson.types.ObjectId))

(timbre/refer-timbre)

(def mongo-state
  (atom
   {:db (let [^MongoOptions opts (mg/mongo-options :threads-allowed-to-block-for-connection-multiplier 300)
              ^ServerAddress sa  (mg/server-address (or (System/getenv "DB_PORT_27017_TCP_ADDR") "127.0.0.1") 27017)]
          (mg/get-db (mg/connect sa opts) "athena"))
    :custom-formatter (f/formatter "E MMM dd HH:mm:ss Z YYYY")
    :news-accounts #{"FAZ_NET" "dpa" "tagesschau" "SPIEGELONLINE" "SZ" "BILD" "DerWesten" "ntvde" "tazgezwitscher" "welt" "ZDFheute" "N24_de" "sternde" "focusonline"}}))

(def months
  [(range 1 32)
   (range 1 29)
   (range 1 32)
   (range 1 31)
   (range 1 32)
   (range 1 31)
   (range 1 32)
   (range 1 32)
   (range 1 31)
   (range 1 32)
   (range 1 31)
   (range 1 32)])

(defn fetch-url [url]
  (enlive/html-resource (java.net.URL. url)))

(defn- expand-url
  "Expands shortened url strings, thanks to http://www.philippeadjiman.com/blog/2009/09/07/the-trick-to-write-a-fast-universal-java-url-expander/"
  [url-str]
  (let [url (java.net.URL. url-str)
        conn (.openConnection url)]
    (do (.setInstanceFollowRedirects conn false)
        (.connect conn)
        (let [expanded-url (.getHeaderField conn "Location")
              content-type (.getContentType conn)]
          (try
            (do (.close (.getInputStream conn))
                {:url expanded-url
                 :content-type content-type})
            (catch Exception e (do (error (str e))
                                   {:url "Not available"
                                    :content-type content-type})))))))

(defn trace-parent
  "Compute ancestor trace of given tweet"
  [tweet origins]
  (let [replied-id (:in_reply_to_status_id_str tweet)
        retweeted-status-id (-> tweet :retweeted_status :id_str)
        parent (if replied-id
                 (mc/find-one-as-map (:db @mongo-state) "tweets" {:id_str replied-id})
                 (if retweeted-status-id
                   (mc/find-one-as-map (:db @mongo-state) "tweets" {:id_str retweeted-status-id})
                   nil))]
    (if parent
      (trace-parent parent (into origins [(:_id parent)]))
      origins)))

(defn store-url [{:keys [article record ts source]}]
  (mc/insert-and-return
   (:db @mongo-state)
   "urls"
   {:tweet record
    :article article
    :source source
    :ts ts}))

(defn store-origin [{:keys [article record ts source ancestors root]}]
  (mc/insert-and-return
   (:db @mongo-state)
   "origins"
   {:tweet record
    :article article
    :source source
    :ancestors ancestors
    :root root
    :ts ts}))

(defn store-article [{:keys [url content-type ts] :as expanded-url}]
  (let [raw-html (slurp url)
        html-title (-> (java.io.StringReader. raw-html) enlive/html-resource (enlive/select [:head :title]) first :content first)]
    (mc/insert-and-return
     (:db @mongo-state)
     "articles"
     {:url url
      :title html-title
      :content-type content-type
      :html raw-html
      :ts ts})))

(defn store
  "Stores the given tweet in mongodb"
  [tweet]
  (let [oid (ObjectId.)
        doc (update-in tweet [:created_at] (fn [x] (f/parse (:custom-formatter @mongo-state) x)))
        record (from-db-object (mc/insert-and-return (:db @mongo-state) "tweets" (merge doc {:_id oid})) true)
        ts (:created_at record)
        source ((:news-accounts @mongo-state) (-> record :user :screen_name))
        record-urls (-> record :entities :urls)
        expanded-urls (if (empty? record-urls)
                        nil
                        (map #(let [expanded-url (expand-url (:expanded_url %))]
                                (if (:url expand-url)
                                  expanded-url
                                  (assoc expanded-url :url (:expanded_url %)))) record-urls))
        articles (if (nil? expanded-urls)
                   nil
                   (map #(assoc % :article (-> (mc/find-one-as-map (:db @mongo-state) "articles" {:url (:url %)}) :_id)) expanded-urls))
        ancestors (trace-parent record [])]
    (if (nil? articles)
      (do
        (store-origin {:record oid :ts ts :source source :ancestors ancestors :article nil :root (last ancestors)})
        nil)
      (doall
       (map
        #(if (:article %)
           (do (store-origin (assoc % :record oid :ts ts :source source :ancestors ancestors :root (last ancestors)))
               (update-in (mc/find-map-by-id (:db @mongo-state) "articles" (:article %)) [:ts] (fn [x] (f/unparse (:custom-formatter @mongo-state) x))))
           (let [article (store-article (assoc % :ts ts))]
             (do (store-origin (assoc % :article (:_id article) :record oid :ts ts :source source :ancestors ancestors :root (last ancestors)))
                 (do (store-url (assoc % :record oid :ts ts :source source))
                     (update-in article [:ts] (fn [x] (f/unparse (:custom-formatter @mongo-state) x)))))))
        articles)))))

;;todo check if id exists in database
(defn read-data
  "Reads in json data from given path and stores it"
  [path]
  (doall (map #(let [data (json/read-str % :key-fn keyword)]
                 (println "Importing " (:id data))
                 (store data)) (split (slurp path) #"\n"))))

(defn get-recent-tweets
  "Retrieve the last 25*n tweets"
  [n]
  (->> (mc/find (:db @mongo-state) "tweets")
       seq
       (take-last (+ (* n 25) 100))
       (take 25)
       (mapv #(from-db-object % true))))

(defn get-news-frequencies []
  (mapv #(vec [% (mc/count (:db @mongo-state) "tweets" {:user.screen_name %
                                                        :created_at {$gt (t/date-time 2014 7 1)}})]) (:news-accounts @mongo-state)))

(defn get-tweet-count []
  (mc/count (:db @mongo-state) "tweets" {:created_at {$gt (t/date-time 2014 7 1)}}))

(defn get-tweets-from-date [month day]
  (mc/find-maps (:db @mongo-state) "tweets"
                {:created_at {$gt (t/date-time 2014 month day 0 0 0 0)
                              $lte (t/date-time 2014 month day 23 59 59 999)}}))

(defn get-hashtag-frequencies [coll]
  (->> coll
       (map #(from-db-object % true))
       (map #(map (fn [hashtag] (hashtag :text)) (-> % :entities :hashtags)))
       flatten
       frequencies))

(defn compute-diffusion [user]
  (->> (mc/count (:db @mongo-state) "tweets" {$and [{$or [{"entities.user_mentions.screen_name" user}
                                                           {"retweeted_status.user.screen_name" user}
                                                           {"in_reply_to_screen_name" user}]}
                                                    {:created_at {$gt (t/date-time 2014 7 1)}}]})))

(defn compute-tweet-diffusion [tweet-id parents]
  (let [tweet (mc/find-one-as-map (:db @mongo-state) "tweets" {:id_str tweet-id})
        neighbor-tweets (->> (mc/find-maps
                              (:db @mongo-state)
                              "tweets"
                              {$and [{$or [{"retweeted_status.id_str" tweet-id}
                                           {"in_reply_to_status_id_str" tweet-id}]}
                                     {:created_at {$gt (t/date-time 2014 7 1)}}]}
                              [:text :user.screen_name :id_str :in_reply_to_status_id_str :retweeted_status.id_str])
                             (pmap #(assoc % :parents (into parents [(:_id tweet)]))))
        neightbar-ids (pmap :id_str neighbor-tweets)]
    (merge neighbor-tweets (pmap #(compute-tweet-diffusion % (into parents [(:_id tweet)])) neightbar-ids))))

(defn get-news-diffusion []
  (mapv #(vec [% (compute-diffusion %)]) (:news-accounts @mongo-state)))

(defn get-month-distribution [month]
  (let [day-range (months (dec month))]
    (vec
     (pmap
      (fn [day]
        (into {} [[:date (str (t/date-time 2014 month day))]
                  [:count
                   (mc/count
                    (:db @mongo-state)
                    "tweets"
                    {:created_at
                     {$gt (t/date-time 2014 month day 0 0 0 0)
                      $lte (t/date-time 2014 month day 23 59 59 999)}})]]))
      day-range))))

(defn export-edn
  "Export all collected tweets from a specific date as edn file. Read https://github.com/edn-format/edn for edn format details."
  [m d]
  (->> (get-tweets-from-date m d)
       (map #(dissoc % :_id))
       (map #(update-in % [:created_at] (fn [x] (f/unparse (:custom-formatter @mongo-state) x))))
       (map str)
       (clojure.string/join "\n")))

(defn get-recent-articles []
  (->> (mc/find-maps (:db @mongo-state) "articles" {:ts {$gt (t/date-time 2014 7 20)}})
       (pmap #(dissoc % :html :_id))
       vec))

(defn get-articles-count []
  (mc/count (:db @mongo-state) "articles"))

(defn find-source [id]
  (mc/find-maps (:db @mongo-state) "urls" {$and [{:article id} {:source {$ne nil}}]} [:source :tweet :ts]))

(comment

  ;; TODO update on server
  (time
   (doseq [x (monger.collection/find-maps (:db @mongo-state) "tweets")]
     (mc/update-by-id
      (:db @mongo-state)
      "tweets"
      (:_id x)
      (update-in x [:created_at] #(f/parse (:custom-formatter @mongo-state) (:created_at %))))))

  (mc/ensure-index (:db @mongo-state) "articles" (array-map :ts 1))

  (mc/ensure-index (:db @mongo-state) "origins" (array-map :ts 1 :article 1))

  (mc/ensure-index (:db @mongo-state) "tweets" (array-map :id 1) {:unique true})

  (->> (mc/find-maps (:db @mongo-state) "urls" {:article (first sz-url)})
       (mapv #(assoc % :tweet  (mc/find-map-by-id (:db @mongo-state) "tweets" (:tweet %) [:in_reply_to_status_id_str :text :user.screen_name :retweeted :id_str])))
       clojure.pprint/pprint)

  (->> (mc/find-maps (:db @mongo-state) "articles" {:ts {$gt (t/today)}} [:title])
                  (map #(vec [(:_id %) (:title %) (first (find-source (:_id %)))]))
                  (remove #(empty? (last %)))
                  (filter #(= "SPIEGELONLINE" (-> % last :source)))
                  rand-nth)

  (def spon-url (mc/find-map-by-id (:db @mongo-state) "urls" (ObjectId. "53d615fe657a4f9d852ca271")))

  (def spon-tweet (mc/find-map-by-id (:db @mongo-state) "tweets" (-> spon-url :tweet)))

  spon-url
  spon-tweet

  (->> (compute-tweet-diffusion (:id_str spon-tweet) []) flatten count)

  (->> (mc/find-maps (:db @mongo-state) "origins" {:article (:article spon-url)})
       (mapv #(assoc % :tweet  (mc/find-map-by-id (:db @mongo-state) "tweets" (:tweet %) [:in_reply_to_status_id_str :text :user.screen_name :retweeted_status.id_str :id_str])))
       count)

(->> (mc/find-maps (:db @mongo-state) "urls" {:article (:article spon-url)})
       (mapv #(assoc % :tweet  (mc/find-map-by-id (:db @mongo-state) "tweets" (:tweet %) [:in_reply_to_status_id_str :text :user.screen_name :retweeted_status.id_str :id_str])))
       count)

  )

store root ancestor

store root ancestor