(ns photon.streams
  (:require [clojure.core.async :refer [go-loop go <!! <! >! chan buffer sub
                                        sliding-buffer mult tap close! pub]
             :as async]
            [serializable.fn :as sfn]
            [clj-rhino :as js]
            [clojure.tools.logging :as log]
            [uap-clj.core :as uap]
            [clojure.data.json :as json]
            [somnium.congomongo :as m]
            [clj-time.coerce :as cc]
            [clojure.tools.logging :as log]
            [muon-clojure.common :as mcc]
            [photon.db :as db]))

;; Global defs
;;;;;;;;;;;;;;

;; TODO: Try to minimise

(def queries (ref {})) ;; TODO: Make persistent!
(defonce publications (ref {}))
(defonce global-channels (ref {}))
(defonce active-streams (ref {}))

;; Stream protocols and multimethods
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(defprotocol ColdStream
  (clean! [this])
  (data-from [this stream-name date-string]))

(defprotocol HotStream
  (next! [this]))

(defprotocol EventProcessor
  (register-query! [this projection-name stream-name lang f init])
  (current-query-value [this projection-name])
  (process-event! [this ev]))

(defprotocol StreamManager
  (init-stream-manager! [this])
  (update-streams! [this stream-name])
  (create-stream-endpoint! [this stream-name])
  (streams [this]))

(defmulti stream (fn [_ params]
                   (log/info (pr-str params))
                   (let [st (get params "stream-type"
                                 (get params :stream-type "hot"))]
                     (log/info "stream type:" st)
                     st)))

;; Code handling
;;;;;;;;;;;;;;;;

(defmulti generate-function (fn [lang _] (name lang)))

(defmethod generate-function "clojure" [lang f-string]
  (let [code (eval (let [f (read-string f-string)]
                     (if (= (first f) 'fn)
                       (conj (rest f) 'serializable.fn/fn)
                       f)))]
    {:computable code
     :persist f-string}))

(defn generate-fun-with-return [scope fun]
  (fn [& args]
    (let [res (apply js/call-timeout scope fun 9999999 args)]
      (try
        (let [converted (clojure.walk/walk
                         (fn [elem]
                           (if (instance?
                                org.mozilla.javascript.ConsString
                                elem)
                             (.toString elem)
                             elem))
                         identity
                         (js/from-js res)
                         #_(json/read-str res :key-fn keyword))]
          converted)
        (catch Exception e
          (println (.getMessage e))
          (.printStackTrace e)
          res)))))

(defmethod generate-function "javascript" [lang f]
  (let [sc (js/new-safe-scope)
        compiled-fun (js/compile-function sc f :filename (str (db/uuid) ".js"))
        fun-with-return (generate-fun-with-return sc compiled-fun)]
    {:computable fun-with-return
     :persist f}))

(extend org.bson.types.ObjectId js/RhinoConvertible
  {:-to-rhino (fn [obj scope ctx] (str obj))})

(defn extract-date [params]
  (let [pre-date (get params "from" 0)
        post-date (if (string? pre-date) (read-string pre-date) pre-date)]
    post-date))

(defn next-avg [avg x n] (double (/ (+ (* avg n) x) (inc n))))

(defn global-channel [async-stream]
  (dosync
    (let [ch (get @global-channels async-stream)]
      (if (nil? ch)
        (let [c (chan 1)
              new-ch {:channel c :mult-channel (mult c)}]
          (alter global-channels assoc async-stream new-ch)
          new-ch)
        ch))))

(defn publisher [async-stream]
  (dosync
    (let [p (get @publications async-stream)]
      (if (nil? p)
        (let [c (chan 1)
              new-p {:channel c
                     :p (pub c (fn [ev] (get ev "stream-name")))}]
          (alter publications assoc async-stream new-p)
          new-p)
        p))))

(defrecord AsyncStream [m db]
  StreamManager
  (init-stream-manager! [this]
    (let [db-streams (db/distinct-values db :stream-name)]
      (dorun (map #(update-streams! this %) db-streams)))
    (dosync
     (alter active-streams assoc-in
            [this :virtual-streams] #{"__all__"})))
  (update-streams! [this stream-name]
    (dosync
     (let [real-streams (into #{}
                              (:real-streams
                               (get @active-streams this)))]
       (if (not (contains? real-streams stream-name))
         (do
           (create-stream-endpoint! this stream-name)
           (alter active-streams
                  (fn [old-active-streams]
                    (assoc-in old-active-streams
                              [this :real-streams]
                              (conj real-streams stream-name)))))))))
  (create-stream-endpoint! [this stream-name]
    ;; TODO: Fix this mess
    (if (not (nil? m))
      (mcc/stream-source
       {:m m} (str "stream/" stream-name)
       (fn [params]
         (stream this
                 (assoc params
                        "stream-name" stream-name))))))
  (streams [this]
    {:streams
     (let [active-streams (get @active-streams this)]
       (map #(hash-map :stream %)
            (concat (:real-streams active-streams)
                    (:virtual-streams active-streams))))})
  ColdStream
  (clean! [this] (db/delete-all! db))
  (data-from [this stream-name date-string]
    (db/lazy-events db stream-name date-string))
  HotStream
  (next! [this] (go (<! (:channel (global-channel this)))))
  EventProcessor
  (register-query! [this projection-name stream-name lang f init]
    (let [s-name (if (nil? stream-name) "__all__" stream-name)
          function-descriptor (generate-function lang f)
          function (:computable function-descriptor)
          s (stream this {"from" "0" "stream-type" "hot-cold"
                          "stream-name" s-name})
          running-query (ref {:projection-name projection-name
                              :fn (:persist function-descriptor)
                              :stream-name s-name
                              :language lang
                              :current-value init
                              :processed 0
                              :last-event nil
                              :last-error nil
                              :avg-time 0
                              :status :running})]
      (dosync (alter queries assoc projection-name running-query))
      (go
        (loop [current-value init current-event (<! s)]
          (if (nil? current-event)
            (dosync (alter running-query assoc :status :finished))
            (let [start-ts (System/currentTimeMillis)
                  new-value (try
                              (function current-value current-event)
                              (catch Exception e
                                (log/info (.getMessage e))
                                (.printStackTrace e)
                                e))
                  current-time (- (System/currentTimeMillis) start-ts)]
              (if (instance? Exception new-value)
                (dosync
                  (alter running-query
                         merge {:last-event current-event
                                :avg-time (next-avg
                                            (:avg-time @running-query)
                                            current-time
                                            (:processed @running-query))
                                :processed (inc (:processed @running-query))
                                :last-error new-value
                                :status :failed}))
                (do
                  (dosync
                    (alter running-query
                           merge {:last-event current-event
                                  :avg-time (next-avg
                                              (:avg-time @running-query)
                                              current-time
                                              (:processed @running-query))
                                  :current-value new-value
                                  :processed (inc (:processed @running-query))}))
                  (recur new-value (<! s))))))))))
  (process-event! [this msg]
    ;; Think about the order of store+send to taps
    (println "!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! " (pr-str msg))
    (update-streams! this (get msg "stream-name"))
    (go (>! (:channel (global-channel this)) msg)
        (>! (:channel (publisher this)) msg))
    (db/store db msg)
    {:correct "true"}))

(defmethod stream "cold" [a-stream params]
  (log/info "cold-stream" (pr-str params))
  (let [ch (chan (buffer 1))
        full-s (data-from a-stream
                          (get params "stream-name" "__all__")
                          (extract-date params))
        full-s (if (and (contains? params :limit)
                        (not (nil? (:limit params))))
                 (take (:limit params) full-s)
                 full-s)]
    (go
      (log/info "Opening stream...")
      (loop [e (first full-s) s (rest full-s) closed? false]
        (if (nil? e)
          (do
            (close! ch)
            (log/info ":::::::::::::::::::: Stream depleted, closing"))
          (if closed?
            (log/info ":::::::::::::::::::: Stream closed!")
            (do
              (let [closed? (not (>! ch e))]
                (recur (first s) (rest s) closed?))))))
      (log/info "::: Cold stream over"))
    ch))

(defmethod stream "hot-cold" [a-stream params]
  (log/info "Initialising hot-cold stream with params" (pr-str params))
  (let [date (extract-date params)
        ch (chan (buffer 1))
        stream-name (get params "stream-name" "__all__")
        full-s (data-from a-stream
                          stream-name
                          (extract-date params))]
    (go
      (loop [e (first full-s)
             s (rest full-s)
             closed? false
             last-t (System/currentTimeMillis)]
        (if (nil? e)
          (log/info ":::::::::::::::::::: Stream depleted, switching to hot stream")
          (let [rest-s (rest s)
                new-s (if (empty? rest-s)
                        (concat s
                                (data-from a-stream stream-name last-t))
                        s)
                last-t (if (empty? rest-s) (System/currentTimeMillis) last-t)]
            (if closed?
              (log/info ":::::::::::::::::::: Stream closed by peer, switching to hot stream")
              (let [closed? (not (>! ch e))]
                (recur (first new-s) (rest new-s) closed? last-t))))))
      (if (= stream-name "__all__")
        (tap (:mult-channel (global-channel a-stream)) ch)
        (sub (:p (publisher a-stream)) stream-name ch)))
    ch))

(defmethod stream "hot" [a-stream params]
  (let [ch (chan 1)
        stream-name (get params "stream-name" "__all__")]
    (if (= stream-name "__all__")
      (tap (:mult-channel (global-channel a-stream)) ch)
      (sub (:p (publisher a-stream)) stream-name ch))
    ch))

(defn new-async-stream [m db]
  (let [as (->AsyncStream m db)]
    (init-stream-manager! as)
    as))

(ns photon.streams
  (:require [clojure.core.async :refer [go-loop go <!! <! >! chan buffer sub
                                        sliding-buffer mult tap close! pub]
             :as async]
            [serializable.fn :as sfn]
            [clj-rhino :as js]
            [clojure.tools.logging :as log]
            [uap-clj.core :as uap]
            [clojure.data.json :as json]
            [somnium.congomongo :as m]
            [clj-time.coerce :as cc]
            [clojure.tools.logging :as log]
            [muon-clojure.common :as mcc]
            [photon.db :as db]))

;; Global defs
;;;;;;;;;;;;;;

;; TODO: Try to minimise

(def queries (ref {})) ;; TODO: Make persistent!
(defonce publications (ref {}))
(defonce global-channels (ref {}))
(defonce active-streams (ref {}))

;; Stream protocols and multimethods
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(defprotocol ColdStream
  (clean! [this])
  (data-from [this stream-name date-string]))

(defprotocol HotStream
  (next! [this]))

(defprotocol EventProcessor
  (register-query! [this projection-name stream-name lang f init])
  (current-query-value [this projection-name])
  (process-event! [this ev]))

(defprotocol StreamManager
  (init-stream-manager! [this])
  (update-streams! [this stream-name])
  (create-stream-endpoint! [this stream-name])
  (streams [this]))

(defmulti stream (fn [_ params]
                   (log/info (pr-str params))
                   (let [st (get params "stream-type"
                                 (get params :stream-type "hot"))]
                     (log/info "stream type:" st)
                     st)))

;; Code handling
;;;;;;;;;;;;;;;;

(defmulti generate-function (fn [lang _] (name lang)))

(defmethod generate-function "clojure" [lang f-string]
  (let [code (eval (let [f (read-string f-string)]
                     (if (= (first f) 'fn)
                       (conj (rest f) 'serializable.fn/fn)
                       f)))]
    {:computable code
     :persist f-string}))

(defn generate-fun-with-return [scope fun]
  (fn [& args]
    (let [res (apply js/call-timeout scope fun 9999999 args)]
      (try
        (let [converted (clojure.walk/walk
                         (fn [elem]
                           (if (instance?
                                org.mozilla.javascript.ConsString
                                elem)
                             (.toString elem)
                             elem))
                         identity
                         (js/from-js res)
                         #_(json/read-str res :key-fn keyword))]
          converted)
        (catch Exception e
          (println (.getMessage e))
          (.printStackTrace e)
          res)))))

(defmethod generate-function "javascript" [lang f]
  (let [sc (js/new-safe-scope)
        compiled-fun (js/compile-function sc f :filename (str (db/uuid) ".js"))
        fun-with-return (generate-fun-with-return sc compiled-fun)]
    {:computable fun-with-return
     :persist f}))

(extend org.bson.types.ObjectId js/RhinoConvertible
  {:-to-rhino (fn [obj scope ctx] (str obj))})

(defn extract-date [params]
  (let [pre-date (get params "from" 0)
        post-date (if (string? pre-date) (read-string pre-date) pre-date)]
    post-date))

(defn next-avg [avg x n] (double (/ (+ (* avg n) x) (inc n))))

(defn global-channel [async-stream]
  (dosync
    (let [ch (get @global-channels async-stream)]
      (if (nil? ch)
        (let [c (chan 1)
              new-ch {:channel c :mult-channel (mult c)}]
          (alter global-channels assoc async-stream new-ch)
          new-ch)
        ch))))

(defn publisher [async-stream]
  (dosync
    (let [p (get @publications async-stream)]
      (if (nil? p)
        (let [c (chan 1)
              new-p {:channel c
                     :p (pub c (fn [ev] (get ev "stream-name"
                                             (get ev :stream-name))))}]
          (alter publications assoc async-stream new-p)
          new-p)
        p))))

(defrecord AsyncStream [m db]
  StreamManager
  (init-stream-manager! [this]
    (let [db-streams (db/distinct-values db :stream-name)]
      (dorun (map #(update-streams! this %) db-streams)))
    (dosync
     (alter active-streams assoc-in
            [this :virtual-streams] #{"__all__"})))
  (update-streams! [this stream-name]
    (dosync
     (let [real-streams (into #{}
                              (:real-streams
                               (get @active-streams this)))]
       (if (not (contains? real-streams stream-name))
         (do
           (create-stream-endpoint! this stream-name)
           (alter active-streams
                  (fn [old-active-streams]
                    (assoc-in old-active-streams
                              [this :real-streams]
                              (conj real-streams stream-name)))))))))
  (create-stream-endpoint! [this stream-name]
    ;; TODO: Fix this mess
    (if (not (nil? m))
      (mcc/stream-source
       {:m m} (str "stream/" stream-name)
       (fn [params]
         (stream this
                 (assoc (assoc params
                               "stream-name" stream-name)
                        :stream-name stream-name))))))
  (streams [this]
    {:streams
     (let [active-streams (get @active-streams this)]
       (map #(hash-map :stream %)
            (concat (:real-streams active-streams)
                    (:virtual-streams active-streams))))})
  ColdStream
  (clean! [this] (db/delete-all! db))
  (data-from [this stream-name date-string]
    (db/lazy-events db stream-name date-string))
  HotStream
  (next! [this] (go (<! (:channel (global-channel this)))))
  EventProcessor
  (register-query! [this projection-name stream-name lang f init]
    (let [s-name (if (nil? stream-name) "__all__" stream-name)
          function-descriptor (generate-function lang f)
          function (:computable function-descriptor)
          s (stream this {"from" "0" "stream-type" "hot-cold"
                          "stream-name" s-name})
          running-query (ref {:projection-name projection-name
                              :fn (:persist function-descriptor)
                              :stream-name s-name
                              :language lang
                              :current-value init
                              :processed 0
                              :last-event nil
                              :last-error nil
                              :avg-time 0
                              :status :running})]
      (dosync (alter queries assoc projection-name running-query))
      (go
        (loop [current-value init current-event (<! s)]
          (if (nil? current-event)
            (dosync (alter running-query assoc :status :finished))
            (let [start-ts (System/currentTimeMillis)
                  new-value (try
                              (function current-value current-event)
                              (catch Exception e
                                (log/info (.getMessage e))
                                (.printStackTrace e)
                                e))
                  current-time (- (System/currentTimeMillis) start-ts)]
              (if (instance? Exception new-value)
                (dosync
                  (alter running-query
                         merge {:last-event current-event
                                :avg-time (next-avg
                                            (:avg-time @running-query)
                                            current-time
                                            (:processed @running-query))
                                :processed (inc (:processed @running-query))
                                :last-error new-value
                                :status :failed}))
                (do
                  (dosync
                    (alter running-query
                           merge {:last-event current-event
                                  :avg-time (next-avg
                                              (:avg-time @running-query)
                                              current-time
                                              (:processed @running-query))
                                  :current-value new-value
                                  :processed (inc (:processed @running-query))}))
                  (recur new-value (<! s))))))))))
  (process-event! [this msg]
    ;; Think about the order of store+send to taps
    (println "!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! " (pr-str msg))
    (update-streams! this (get msg "stream-name"
                               (get msg :stream-name)))
    (go (>! (:channel (global-channel this)) msg)
        (>! (:channel (publisher this)) msg))
    (db/store db msg)
    {:correct "true"}))

(defmethod stream "cold" [a-stream params]
  (log/info "cold-stream" (pr-str params))
  (let [ch (chan (buffer 1))
        full-s (data-from a-stream
                          (get params "stream-name"
                               (get params :stream-name "__all__"))
                          (extract-date params))
        full-s (if (and (contains? params :limit)
                        (not (nil? (:limit params))))
                 (take (:limit params) full-s)
                 full-s)]
    (go
      (log/info "Opening stream...")
      (loop [e (first full-s) s (rest full-s) closed? false]
        (if (nil? e)
          (do
            (close! ch)
            (log/info ":::::::::::::::::::: Stream depleted, closing"))
          (if closed?
            (log/info ":::::::::::::::::::: Stream closed!")
            (do
              (let [closed? (not (>! ch e))]
                (recur (first s) (rest s) closed?))))))
      (log/info "::: Cold stream over"))
    ch))

(defmethod stream "hot-cold" [a-stream params]
  (log/info "Initialising hot-cold stream with params" (pr-str params))
  (let [date (extract-date params)
        ch (chan (buffer 1))
        stream-name (get params "stream-name"
                         (get params :stream-name "__all__"))
        full-s (data-from a-stream
                          stream-name
                          (extract-date params))]
    (go
      (loop [e (first full-s)
             s (rest full-s)
             closed? false
             last-t (System/currentTimeMillis)]
        (if (nil? e)
          (log/info ":::::::::::::::::::: Stream depleted, switching to hot stream")
          (let [rest-s (rest s)
                new-s (if (empty? rest-s)
                        (concat s
                                (data-from a-stream stream-name last-t))
                        s)
                last-t (if (empty? rest-s) (System/currentTimeMillis) last-t)]
            (if closed?
              (log/info ":::::::::::::::::::: Stream closed by peer, switching to hot stream")
              (let [closed? (not (>! ch e))]
                (recur (first new-s) (rest new-s) closed? last-t))))))
      (if (= stream-name "__all__")
        (tap (:mult-channel (global-channel a-stream)) ch)
        (sub (:p (publisher a-stream)) stream-name ch)))
    ch))

(defmethod stream "hot" [a-stream params]
  (let [ch (chan 1)
        stream-name (get params "stream-name"
                         (get params :stream-name "__all__"))]
    (if (= stream-name "__all__")
      (tap (:mult-channel (global-channel a-stream)) ch)
      (sub (:p (publisher a-stream)) stream-name ch))
    ch))

(defn new-async-stream [m db]
  (let [as (->AsyncStream m db)]
    (init-stream-manager! as)
    as))

Fix bug with virtual streams created from input events


;; Copyright (c) Andrew A. Raines
;;
;; Permission is hereby granted, free of charge, to any person
;; obtaining a copy of this software and associated documentation
;; files (the "Software"), to deal in the Software without
;; restriction, including without limitation the rights to use,
;; copy, modify, merge, publish, distribute, sublicense, and/or sell
;; copies of the Software, and to permit persons to whom the
;; Software is furnished to do so, subject to the following
;; conditions:
;;
;; The above copyright notice and this permission notice shall be
;; included in all copies or substantial portions of the Software.
;;
;; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
;; EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES
;; OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND
;; NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT
;; HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY,
;; WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING
;; FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR
;; OTHER DEALINGS IN THE SOFTWARE.

(ns postal.support
  (:require [clojure.java.io :as io])
  (:import (java.util Properties Random)
           (org.apache.commons.codec.binary Base64)))

(defmacro do-when
  [arg condition & body]
  `(when ~condition
     (doto ~arg ~@body)))

(defn make-props [sender {:keys [host port user tls]}]
  (doto (Properties.)
    (.put "mail.smtp.host" (or host "not.provided"))
    (.put "mail.smtp.port" (or port "25"))
    (.put "mail.smtp.auth" (if user "true" "false"))
    (do-when sender (.put "mail.smtp.from" sender))
    (do-when user (.put "mail.smtp.user" user))
    (do-when tls  (.put "mail.smtp.starttls.enable" "true"))))

(defn hostname []
  (.getHostName (java.net.InetAddress/getLocalHost)))

(defn message-id
  ([]
     (message-id (format "postal.%s" (hostname))))
  ([host]
     (let [bs (byte-array 16)
           r (Random.)
           _ (.nextBytes r bs)
           rs (String. (Base64/encodeBase64 bs))
           onlychars (apply str (re-seq #"[0-9A-Za-z]" rs))
           epoch (.getTime (java.util.Date.))]
       (format "<%s.%s@%s>" onlychars epoch host))))

(defn pom-version []
  (let [pom "META-INF/maven/com.draines/postal/pom.properties"
        props (doto (Properties.)
                (.load (-> pom io/resource io/input-stream)))]
    (.getProperty props "version")))

(defn user-agent []
  (let [prop (Properties.)
        ver (or (System/getProperty "postal.version")
                (pom-version))]
    (format "postal/%s" ver)))

;; Copyright (c) Andrew A. Raines
;;
;; Permission is hereby granted, free of charge, to any person
;; obtaining a copy of this software and associated documentation
;; files (the "Software"), to deal in the Software without
;; restriction, including without limitation the rights to use,
;; copy, modify, merge, publish, distribute, sublicense, and/or sell
;; copies of the Software, and to permit persons to whom the
;; Software is furnished to do so, subject to the following
;; conditions:
;;
;; The above copyright notice and this permission notice shall be
;; included in all copies or substantial portions of the Software.
;;
;; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
;; EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES
;; OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND
;; NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT
;; HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY,
;; WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING
;; FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR
;; OTHER DEALINGS IN THE SOFTWARE.

(ns postal.support
  (:require [clojure.java.io :as io])
  (:import (java.util Properties Random)
           (org.apache.commons.codec.binary Base64)))

(defmacro do-when
  [arg condition & body]
  `(when ~condition
     (doto ~arg ~@body)))

(defn make-props [sender {:keys [host port user tls localhost localaddress]}]
  (doto (Properties.)
    (.put "mail.smtp.host" (or host "not.provided"))
    (.put "mail.smtp.port" (or port "25"))
    (.put "mail.smtp.auth" (if user "true" "false"))
    (do-when sender (.put "mail.smtp.from" sender))
    (do-when user (.put "mail.smtp.user" user))
    (do-when tls  (.put "mail.smtp.starttls.enable" "true"))
    (do-when localhost (.put "mail.smtp.localhost" localhost))
    (do-when localaddress (.put "mail.smtp.localaddress" localaddress))))

(defn hostname []
  (.getHostName (java.net.InetAddress/getLocalHost)))

(defn message-id
  ([]
     (message-id (format "postal.%s" (hostname))))
  ([host]
     (let [bs (byte-array 16)
           r (Random.)
           _ (.nextBytes r bs)
           rs (String. (Base64/encodeBase64 bs))
           onlychars (apply str (re-seq #"[0-9A-Za-z]" rs))
           epoch (.getTime (java.util.Date.))]
       (format "<%s.%s@%s>" onlychars epoch host))))

(defn pom-version []
  (let [pom "META-INF/maven/com.draines/postal/pom.properties"
        props (doto (Properties.)
                (.load (-> pom io/resource io/input-stream)))]
    (.getProperty props "version")))

(defn user-agent []
  (let [prop (Properties.)
        ver (or (System/getProperty "postal.version")
                (pom-version))]
    (format "postal/%s" ver)))

Allow local address configuration for multihomed hosts

:localhost sets the host name used in the EHLO command.

:localaddress sets the address to bind to when generating the outbound
connection (for multihomed hosts).


(ns re-frame.core
  (:require
    [re-frame.events     :as events]
    [re-frame.subs       :as subs]
    [re-frame.fx         :as fx]
    [re-frame.router     :as router]
    [re-frame.loggers    :as loggers]
    [re-frame.registrar  :as registrar]
    [re-frame.interceptor :as interceptor :refer [base ->interceptor db-handler->interceptor fx-handler->interceptor]]))

;; --  dispatch
(def dispatch         router/dispatch)
(def dispatch-sync    router/dispatch-sync)

;; XXX move API functions up here

;; --  subscribe
(def reg-sub-raw         subs/register)
(def reg-sub             subs/register-pure)
(def subscribe           subs/subscribe)

;; --  effects
(def reg-fx       fx/register)
(def clear-fx     (partial registrar/clear-handlers fx/kind))

;; XXX add a clear all handlers:
;; XXX add a push handlers for testing purposes

;; --  middleware

; (def fx          fx/fx)
(def debug       interceptor/debug)
(def path        interceptor/path)
(def enrich      interceptor/enrich)
(def trim-v      interceptor/trim-v)
(def after       interceptor/after)
(def on-changes  interceptor/on-changes)

;; --  Events

;; usage (clear-event! :some-id)
(def clear-event!  (partial registrar/clear-handlers events/kind))    ;; XXX name with !

;; XXX note name change in changes.md

(defn reg-event-db
  "Register the given `id`, typically a kewyword, with the combination of
  `db-handler` and an interceptor chain.
  `db-handler` is a function: (db event) -> db
  `interceptors` is a collection of interceptors, possibly nested (needs flattenting).
  `db-handler` is wrapped in an interceptor and added to the end of the chain, so in the end
   there is only a chain."
  ([id db-handler]
    (reg-event-db id nil db-handler))

  ([id interceptors db-handler]
   (events/register id [base interceptors (db-handler->interceptor db-handler)])))   ;; XXX add a base-interceptor

(defn reg-event-fx
  ([id fx-handler]
   (reg-event-fx id nil fx-handler))

  ([id interceptors fx-handler]
   (events/register id [base interceptors (fx-handler->interceptor fx-handler)])))   ;; XXX add a base-interceptor

(defn reg-event-context
  ([id handler]
   (reg-event-context id nil handler))

  ([id interceptors handler]
   (events/register id [base interceptors handler])))   ;;   XXX can't just put in handler, must wrap it

;; --  Logging -----
;; Internally, re-frame uses the logging functions: warn, log, error, group and groupEnd
;; By default, these functions map directly to the js/console implementations,
;; but you can override with your own fns (set or subset).
;; Example Usage:
;;   (defn my-fn [& args]  (post-it-somewhere (apply str args)))  ;; here is my alternative
;;   (re-frame.core/set-loggers!  {:warn my-fn :log my-fn})       ;; override the defaults with mine
(def set-loggers! loggers/set-loggers!)

;; If you are writing an extension to re-frame, like perhaps
;; an effeects handler, you may want to use re-frame logging.
;;
;; usage:  (console :error "this is bad: " a-variable " and " anotherv)
;;         (console :warn "possible breach of containment wall at: " dt)
(def console loggers/console)

;; -- Event Procssing Callbacks

(defn add-post-event-callback
  "Registers a function `f` to be called after each event is procecessed
   `f` will be called with two arguments:
    - `event`: a vector. The event just processed.
    - `queue`: a PersistentQueue, possibly empty, of events yet to be processed.

   This is useful in advanced cases like:
     - you are implementing a complex bootstrap pipeline
     - you want to create your own handling infrastructure, with perhaps multiple
       handlers for the one event, etc.  Hook in here.
     - libraries providing 'isomorphic javascript' rendering on  Nodejs or Nashorn.

  'id' is typically a keyword. Supplied at \"add time\" so it can subsequently
  be used at \"remove time\" to get rid of the right callback.
  "
  ([f]
   (add-post-event-callback f f))   ;; use f as its own identifier
  ([id f]
   (router/add-post-event-callback re-frame.router/event-queue id f)))

(defn remove-post-event-callback
  [id]
  (router/remove-post-event-callback re-frame.router/event-queue id))

;; --  Deprecation Messages
;; Assisting the v0.0.7 ->  v0.0.8 tranistion.
(defn register-handler
  [& args]
  (console :warn  "re-frame:  \"register-handler\" has been renamed \"reg-event-db\"")
  (apply reg-event-db args))

(defn reg-event
  [& args]
  (console :warn  "re-frame:  \"reg-event\" has been renamed \"reg-event-db\"")
  (apply reg-event-db args))

(defn register-sub
  [& args]
  (console :error  "re-frame:  \"register-sub\" is deprecated. Use \"reg-sub-raw\".")
  (apply reg-sub-raw args))

(ns re-frame.core
  (:require
    [re-frame.events     :as events]
    [re-frame.subs       :as subs]
    [re-frame.fx         :as fx]
    [re-frame.router     :as router]
    [re-frame.loggers    :as loggers]
    [re-frame.registrar  :as registrar]
    [re-frame.interceptor :as interceptor :refer [base ->interceptor
                                                  db-handler->interceptor fx-handler->interceptor
                                                  ctx-handler->interceptor]]))

;; --  dispatch
(def dispatch         router/dispatch)
(def dispatch-sync    router/dispatch-sync)

;; XXX move API functions up here

;; --  subscribe
(def reg-sub-raw         subs/register)
(def reg-sub             subs/register-pure)
(def subscribe           subs/subscribe)

;; --  effects
(def reg-fx       fx/register)
(def clear-fx     (partial registrar/clear-handlers fx/kind))

;; XXX add a clear all handlers:
;; XXX add a push handlers for testing purposes

;; --  middleware

; (def fx          fx/fx)
(def debug       interceptor/debug)
(def path        interceptor/path)
(def enrich      interceptor/enrich)
(def trim-v      interceptor/trim-v)
(def after       interceptor/after)
(def on-changes  interceptor/on-changes)

;; --  Events

;; usage (clear-event! :some-id)
(def clear-event!  (partial registrar/clear-handlers events/kind))    ;; XXX name with !

;; XXX note name change in changes.md

(defn reg-event-db
  "Register the given `id`, typically a kewyword, with the combination of
  `db-handler` and an interceptor chain.
  `db-handler` is a function: (db event) -> db
  `interceptors` is a collection of interceptors, possibly nested (needs flattenting).
  `db-handler` is wrapped in an interceptor and added to the end of the chain, so in the end
   there is only a chain."
  ([id db-handler]
    (reg-event-db id nil db-handler))

  ([id interceptors db-handler]
   (events/register id [base interceptors (db-handler->interceptor db-handler)])))   ;; XXX add a base-interceptor

(defn reg-event-fx
  ([id fx-handler]
   (reg-event-fx id nil fx-handler))

  ([id interceptors fx-handler]
   (events/register id [base interceptors (fx-handler->interceptor fx-handler)])))   ;; XXX add a base-interceptor

(defn reg-event-ctx
  ([id handler]
   (reg-event-ctx id nil handler))

  ([id interceptors handler]
   (events/register id [base interceptors (ctx-handler->interceptor handler)])))

;; --  Logging -----
;; Internally, re-frame uses the logging functions: warn, log, error, group and groupEnd
;; By default, these functions map directly to the js/console implementations,
;; but you can override with your own fns (set or subset).
;; Example Usage:
;;   (defn my-fn [& args]  (post-it-somewhere (apply str args)))  ;; here is my alternative
;;   (re-frame.core/set-loggers!  {:warn my-fn :log my-fn})       ;; override the defaults with mine
(def set-loggers! loggers/set-loggers!)

;; If you are writing an extension to re-frame, like perhaps
;; an effeects handler, you may want to use re-frame logging.
;;
;; usage:  (console :error "this is bad: " a-variable " and " anotherv)
;;         (console :warn "possible breach of containment wall at: " dt)
(def console loggers/console)

;; -- Event Procssing Callbacks

(defn add-post-event-callback
  "Registers a function `f` to be called after each event is procecessed
   `f` will be called with two arguments:
    - `event`: a vector. The event just processed.
    - `queue`: a PersistentQueue, possibly empty, of events yet to be processed.

   This is useful in advanced cases like:
     - you are implementing a complex bootstrap pipeline
     - you want to create your own handling infrastructure, with perhaps multiple
       handlers for the one event, etc.  Hook in here.
     - libraries providing 'isomorphic javascript' rendering on  Nodejs or Nashorn.

  'id' is typically a keyword. Supplied at \"add time\" so it can subsequently
  be used at \"remove time\" to get rid of the right callback.
  "
  ([f]
   (add-post-event-callback f f))   ;; use f as its own identifier
  ([id f]
   (router/add-post-event-callback re-frame.router/event-queue id f)))

(defn remove-post-event-callback
  [id]
  (router/remove-post-event-callback re-frame.router/event-queue id))

;; --  Deprecation Messages
;; Assisting the v0.0.7 ->  v0.0.8 tranistion.
(defn register-handler
  [& args]
  (console :warn  "re-frame:  \"register-handler\" has been renamed \"reg-event-db\"")
  (apply reg-event-db args))

(defn reg-event
  [& args]
  (console :warn  "re-frame:  \"reg-event\" has been renamed \"reg-event-db\"")
  (apply reg-event-db args))

(defn register-sub
  [& args]
  (console :error  "re-frame:  \"register-sub\" is deprecated. Use \"reg-sub-raw\".")
  (apply reg-sub-raw args))

Fix up ctx registration

Fix up ctx registration


(ns african-polyphony-and-polyrhythm.talk
  (:require [overtone.live :refer :all :exclude [stop]]
            [leipzig.melody :refer :all]
            [leipzig.canon :refer [canon]]
            [leipzig.scale :refer [A B major minor pentatonic]]
            [leipzig.temperament :as temperament]
            [leipzig.live :as live]
            [leipzig.live :refer [stop]]))

(defn forever [riff]
  (concat riff (lazy-seq (->> riff forever (after (duration riff))))))

(defn clapping-music []
  (let [african-bell-pattern (rhythm [1/8 1/8 1/4 1/8 1/4 1/4 1/8 1/4])]
    (->> african-bell-pattern forever (all :part :clap1)
         (canon #(->> % (take 64) (then (rhythm [1/8])) forever (all :part :clap2))))))

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

(defmethod live/play-note :clap1 [_]
  ((sample "samples/click2.wav")))

(defmethod live/play-note :clap2 [_]
  ((sample "samples/select-click.wav")))

(defn split [n fraction]
  (fn [notes]
    (let [note (nth notes n)
          first-note (-> note (update-in [:duration] * fraction))
          second-note (-> note
                          (update-in [:duration] * (- 1 fraction))
                          (update-in [:time] + (:duration first-note)))]
      (concat
        (take n notes)
        [first-note second-note]
        (drop (inc n) notes)))))

(definst akadinda [freq 440 vol 0.5]
  (-> (sin-osc freq)
      (+ (* 1/3 (sin-osc (* 2.01 freq))))
      (+ (* 1/2 (sin-osc (* 3.001 freq))))
      (+ (* 1/8 (sin-osc (* 5.001 freq))))
      (clip2 0.8)
      (lpf (* 5 440))
      (* (env-gen (adsr 0.01 0.05 0.15 0.2) (line:kr 1 0 0.1) :action FREE))
      (+ (* (env-gen (perc 0.02 0.03)) (* 1/3 (sin-osc (* 0.5 freq)))))
      (* vol)))

(defmethod live/play-note :default [{:keys [pitch]}]
  (when pitch (akadinda pitch)))

(defn rand-variations [variations]
  (concat
    (rand-nth variations)
    (lazy-seq (after 4 (rand-variations variations)))))

(defn part [model variations]
  ((apply juxt variations) model))

(def tete
  (part
    (phrase [2 1/2 3/2] (repeat 0))
    [identity
     (split 0 1/8)
     (comp (split 1 1/7) (split 0 1/8))
     (comp (split 2 1/6) (split 1 1/7) (split 0 1/8))]))

(def ta
  (part
    (phrase [1 5/4 3/4 1] (cons nil (repeat 1)))
    [identity
     (split 2 1/3)
     (split 3 1/2)]))

(def ha
  (part
    (phrase [1/2 3 1/2] (cons nil (repeat 2)))
    [identity
     (comp (split 4 1/2) (split 2 1/6) (split 0 1/4))]))

(def balendorc
  (let [a (phrase [2 1/2 3/2] (repeat 0))
        b (phrase [1 5/4 3/4 1] (cons nil (repeat 1)))
        c (phrase [1/2 3 1/2] (cons nil (repeat 2)))
        d (phrase [2 2] (repeat 2))
        e (phrase [3/2 3/4 7/4] (cons nil (repeat 2)))
        ]
    (->> (rand-variations tete)
         (with (rand-variations ta))
         (with (rand-variations ha))
         (take-while #(-> % :time (< 32))))
    )
  )

(def inverse-pentatonic (comp (partial + 24) pentatonic -))

(comment
  (->>
    balendorc
    (where :pitch (comp temperament/equal A inverse-pentatonic))
    (tempo (bpm 120))
    (live/play)
    )
  )

(ns african-polyphony-and-polyrhythm.talk
  (:require [overtone.live :refer :all :exclude [stop]]
            [leipzig.melody :refer :all]
            [leipzig.canon :refer [canon]]
            [leipzig.scale :refer [A B major minor pentatonic]]
            [leipzig.temperament :as temperament]
            [leipzig.live :as live]
            [leipzig.live :refer [stop]]))

(defn forever [riff]
  (concat riff (lazy-seq (->> riff forever (after (duration riff))))))

(defn clapping-music []
  (let [african-bell-pattern (rhythm [1/8 1/8 1/4 1/8 1/4 1/4 1/8 1/4])]
    (->> african-bell-pattern forever (all :part :clap1)
         (canon #(->> % (take 64) (then (rhythm [1/8])) forever (all :part :clap2))))))

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

(defmethod live/play-note :clap1 [_]
  ((sample "samples/click2.wav")))

(defmethod live/play-note :clap2 [_]
  ((sample "samples/select-click.wav")))

(defn split [n fraction]
  (fn [notes]
    (let [note (nth notes n)
          first-note (-> note (update-in [:duration] * fraction))
          second-note (-> note
                          (update-in [:duration] * (- 1 fraction))
                          (update-in [:time] + (:duration first-note)))]
      (concat
        (take n notes)
        [first-note second-note]
        (drop (inc n) notes)))))

(definst akadinda [freq 440 vol 0.5]
  (-> (sin-osc freq)
      (+ (* 1/3 (sin-osc (* 2.01 freq))))
      (+ (* 1/2 (sin-osc (* 3.001 freq))))
      (+ (* 1/8 (sin-osc (* 5.001 freq))))
      (clip2 0.8)
      (lpf (* 5 440))
      (* (env-gen (adsr 0.01 0.05 0.15 0.2) (line:kr 1 0 0.1) :action FREE))
      (+ (* (env-gen (perc 0.02 0.03)) (* 1/3 (sin-osc (* 0.5 freq)))))
      (* vol)))

(defmethod live/play-note :default [{:keys [pitch]}]
  (when pitch (akadinda pitch)))

(defn rand-variations [variations]
  (concat
    (rand-nth variations)
    (lazy-seq (after 4 (rand-variations variations)))))

(defn part [model & variations]
  ((apply juxt variations) model))

(def tete
  (part
    (phrase [2 1/2 3/2] (repeat 0))
    identity
    (split 0 1/8)
    (comp (split 1 1/7) (split 0 1/8))
    (comp (split 2 1/6) (split 1 1/7) (split 0 1/8))))

(def ta
  (part
    (phrase [1 5/4 3/4 1] (cons nil (repeat 1)))
    identity
    (split 2 1/3)
    (split 3 1/2)))

(def ha
  (part
    (phrase [1/2 3 1/2] (cons nil (repeat 2)))
    identity
    (comp (split 4 1/2) (split 2 1/6) (split 0 1/4))))

(def balendorc
  (let [a (phrase [2 1/2 3/2] (repeat 0))
        b (phrase [1 5/4 3/4 1] (cons nil (repeat 1)))
        c (phrase [1/2 3 1/2] (cons nil (repeat 2)))
        d (phrase [2 2] (repeat 2))
        e (phrase [3/2 3/4 7/4] (cons nil (repeat 2)))
        ]
    (->> (rand-variations tete)
         (with (rand-variations ta))
         (with (rand-variations ha))
         (take-while #(-> % :time (< 32))))
    )
  )

(def inverse-pentatonic (comp (partial + 24) pentatonic -))

(comment
  (->>
    balendorc
    (where :pitch (comp temperament/equal A inverse-pentatonic))
    (tempo (bpm 120))
    (live/play)
    )
  )

Make part variadic to avoid []-wrapping.


(ns akvo.lumen.component.emailer
  (:require [cheshire.core :as json]
            [clj-http.client :as client]
            [akvo.lumen.protocols :as p]
            [akvo.lumen.specs.components :refer [integrant-key]]
            [clojure.spec.alpha :as s]
            [clojure.tools.logging :as log]
            [integrant.core :as ig]))

(defrecord DevEmailer []
  p/SendEmail
  (send-email [this recipients email]
    (log/info recipients)
    (log/info email)))

(defrecord MailJetV3Emailer [config]
  p/SendEmail
  (send-email [{{credentials :credentials
                 from-email  :from-email
                 from-name   :from-name} :config}
               recipients
               email]
    (let [body (merge email
                      {"FromEmail"  from-email
                       "FromName"   from-name
                       "Recipients" (into []
                                          (map (fn [email] {"Email" email})
                                               recipients))})]
      (client/post "https://api.mailjet.com/v3/send"
                   {:basic-auth credentials
                    :headers    {"Content-Type" "application/json"}
                    :body       (json/encode body)}))))

(defmethod ig/init-key :akvo.lumen.component.emailer/dev-emailer  [_ {:keys [from-email from-name] :as opts} ]
  (log/info  "Using std out emailer" opts)
  (map->DevEmailer opts))

(defmethod ig/init-key :akvo.lumen.component.emailer/mailjet-v3-emailer  [_ {:keys [email-password email-user from-email from-name]}]
  (map->MailJetV3Emailer
   {:config {:credentials [email-user email-password]
             :from-email  from-email
             :from-name   from-name}}))

(s/def ::email-password string?)
(s/def ::email-user string?)
(s/def ::from-email string?)
(s/def ::from-name string?)

(s/def ::emailer (partial satisfies? p/SendEmail))

(defmethod integrant-key :akvo.lumen.component.emailer/dev-emailer [_]
  (s/cat :kw keyword?
         :config (s/keys :req-un [::from-email ::from-name])))

(defmethod integrant-key :akvo.lumen.component.emailer/mailjet-v3-emailer [_]
  (s/cat :kw keyword?
         :config (s/keys :req-un [::email-password ::email-user ::from-email ::from-name])))

(ns akvo.lumen.component.emailer
  (:require [cheshire.core :as json]
            [clj-http.client :as client]
            [akvo.lumen.protocols :as p]
            [akvo.lumen.specs.components :refer [integrant-key]]
            [clojure.spec.alpha :as s]
            [clojure.tools.logging :as log]
            [integrant.core :as ig]))

(defrecord DevEmailer [store]
  p/SendEmail
  (send-email [this recipients email]
    (swap! store #(conj % {:email email
                           :recipients recipients}))
    (log/info recipients)
    (log/info email)))

(defrecord MailJetV3Emailer [config]
  p/SendEmail
  (send-email [{{credentials :credentials
                 from-email  :from-email
                 from-name   :from-name} :config}
               recipients
               email]
    (let [body (merge email
                      {"FromEmail"  from-email
                       "FromName"   from-name
                       "Recipients" (into []
                                          (map (fn [email] {"Email" email})
                                               recipients))})]
      (client/post "https://api.mailjet.com/v3/send"
                   {:basic-auth credentials
                    :headers    {"Content-Type" "application/json"}
                    :body       (json/encode body)}))))

(defmethod ig/init-key :akvo.lumen.component.emailer/dev-emailer  [_ {:keys [from-email from-name] :as opts} ]
  (log/info  "Using std out emailer" opts)
  (map->DevEmailer (assoc opts :store (atom []))))

(defmethod ig/init-key :akvo.lumen.component.emailer/mailjet-v3-emailer  [_ {:keys [email-password email-user from-email from-name]}]
  (map->MailJetV3Emailer
   {:config {:credentials [email-user email-password]
             :from-email  from-email
             :from-name   from-name}}))

(s/def ::email-password string?)
(s/def ::email-user string?)
(s/def ::from-email string?)
(s/def ::from-name string?)

(s/def ::emailer (partial satisfies? p/SendEmail))

(defmethod integrant-key :akvo.lumen.component.emailer/dev-emailer [_]
  (s/cat :kw keyword?
         :config (s/keys :req-un [::from-email ::from-name])))

(defmethod integrant-key :akvo.lumen.component.emailer/mailjet-v3-emailer [_]
  (s/cat :kw keyword?
         :config (s/keys :req-un [::email-password ::email-user ::from-email ::from-name])))

Add atom store in dev mailer version to check values in tests


(ns onyx.log.commands.accept-join-cluster
  (:require [clojure.core.async :refer [chan go >! <! >!! close!]]
            [clojure.data :refer [diff]]
            [clojure.set :refer [union difference map-invert]]
            [taoensso.timbre :refer [info] :as timbre]
            [onyx.extensions :as extensions]
            [onyx.log.commands.common :as common]
            [onyx.scheduling.common-job-scheduler :refer [reconfigure-cluster-workload]]))

(defmethod extensions/apply-log-entry :accept-join-cluster
  [{:keys [args]} replica]
  (let [{:keys [accepted-joiner accepted-observer]} args
        target (or (get-in replica [:pairs accepted-observer])
                   accepted-observer)
        already-joined? (some #{accepted-joiner} (:peers replica))
        no-observer? (not (some #{target} (:peers replica)))]
    (if (or already-joined? no-observer?)
      replica
      (-> replica
          (update-in [:pairs] merge {accepted-observer accepted-joiner})
          (update-in [:pairs] merge {accepted-joiner target})
          (update-in [:accepted] dissoc accepted-observer)
          (update-in [:peers] vec)
          (update-in [:peers] conj accepted-joiner)
          (assoc-in [:peer-state accepted-joiner] :idle)
          (reconfigure-cluster-workload)))))

(defmethod extensions/replica-diff :accept-join-cluster
  [entry old new]
  (if-not (= old new)
    (let [rets (first (diff (:accepted old) (:accepted new)))]
      (assert (<= (count rets) 1))
      (when (seq rets)
        {:observer (first (keys rets))
         :subject (first (vals rets))}))))

(defmethod extensions/reactions :accept-join-cluster
  [{:keys [args] :as entry} old new diff state]
  (let [accepted-joiner (:accepted-joiner args)
        already-joined? (some #{accepted-joiner} (:peers old))]
    (if (and (not already-joined?)
             (nil? diff)
             (= (:id state) accepted-joiner))
      [{:fn :abort-join-cluster
        :args {:id accepted-joiner}
        :immediate? true}])))

(defn unbuffer-messages [state diff new]
  (if (= (:id state) (:subject diff))
    (do (extensions/open-peer-site (:messenger state)
                                   (get-in new [:peer-sites (:id state)]))
        (doseq [entry (:buffered-outbox state)]
          (>!! (:outbox-ch state) entry))
        (assoc (dissoc state :buffered-outbox) :stall-output? false))
    state))

(defmethod extensions/fire-side-effects! :accept-join-cluster
  [entry old new diff state]
  (if-not (= old new)
    (let [next-state (unbuffer-messages state diff new)]
      (common/start-new-lifecycle old new diff next-state))))

(ns onyx.log.commands.accept-join-cluster
  (:require [clojure.core.async :refer [chan go >! <! >!! close!]]
            [clojure.data :refer [diff]]
            [clojure.set :refer [union difference map-invert]]
            [taoensso.timbre :refer [info] :as timbre]
            [onyx.extensions :as extensions]
            [onyx.log.commands.common :as common]
            [onyx.scheduling.common-job-scheduler :refer [reconfigure-cluster-workload]]))

(defmethod extensions/apply-log-entry :accept-join-cluster
  [{:keys [args]} replica]
  (let [{:keys [accepted-joiner accepted-observer]} args
        target (or (get-in replica [:pairs accepted-observer])
                   accepted-observer)
        already-joined? (some #{accepted-joiner} (:peers replica))
        no-observer? (not (some #{target} (:peers replica)))]
    (if (or already-joined? no-observer?)
      replica
      (-> replica
          (update-in [:pairs] merge {accepted-observer accepted-joiner})
          (update-in [:pairs] merge {accepted-joiner target})
          (update-in [:accepted] dissoc accepted-observer)
          (update-in [:peers] vec)
          (update-in [:peers] conj accepted-joiner)
          (assoc-in [:peer-state accepted-joiner] :idle)
          (reconfigure-cluster-workload)))))

(defmethod extensions/replica-diff :accept-join-cluster
  [entry old new]
  (if-not (= old new)
    (let [rets (first (diff (:accepted old) (:accepted new)))]
      (assert (<= (count rets) 1))
      (when (seq rets)
        {:observer (first (keys rets))
         :subject (first (vals rets))}))))

(defmethod extensions/reactions :accept-join-cluster
  [{:keys [args] :as entry} old new diff state]
  (let [accepted-joiner (:accepted-joiner args)
        already-joined? (some #{accepted-joiner} (:peers old))]
    (if (and (not already-joined?)
             (nil? diff)
             (= (:id state) accepted-joiner))
      [{:fn :abort-join-cluster
        :args {:id accepted-joiner}
        :immediate? true}]
      [])))

(defn unbuffer-messages [state diff new]
  (if (= (:id state) (:subject diff))
    (do (extensions/open-peer-site (:messenger state)
                                   (get-in new [:peer-sites (:id state)]))
        (doseq [entry (:buffered-outbox state)]
          (>!! (:outbox-ch state) entry))
        (assoc (dissoc state :buffered-outbox) :stall-output? false))
    state))

(defmethod extensions/fire-side-effects! :accept-join-cluster
  [entry old new diff state]
  (if-not (= old new)
    (let [next-state (unbuffer-messages state diff new)]
      (common/start-new-lifecycle old new diff next-state))))

Test expect empty vector to be returned when no command is returned


(ns scavenger.core
  (:require [compojure.core :refer :all]
            [compojure.route :as route]
            [ring.middleware.defaults :refer [wrap-defaults site-defaults]]
            [ring.util.response :refer [response]])
  (:use [datomic.api :only [db q] :as d]))

(def uri "datomic:free://localhost:4334/items")

(def conn (d/connect uri))

(defn get-all-items []
  (map first (q '[:find (pull ?c [*]) :where [?c item/name]] (db conn))))

(defroutes app-routes
  (GET "/items" []
    (response (str (into [] (get-all-items)))))
  (POST "/items" {body :body}
    (let [tempid (d/tempid :items)
          data (merge (read-string (slurp body)) {:db/id tempid})
          tx @(d/transact conn [data])
          id (d/resolve-tempid (db conn) (:tempids tx) tempid)]
      (response (str (d/touch (d/entity (db conn) id))))))
  (route/not-found "Page not found"))

(def app
  (wrap-defaults app-routes (assoc site-defaults :security nil)))

(ns scavenger.core
  (:require [compojure.core :refer :all]
            [compojure.route :as route]
            [ring.middleware.defaults :refer [wrap-defaults site-defaults]]
            [ring.util.response :refer [response header]])
  (:use [datomic.api :only [db q] :as d]))

(def uri "datomic:free://localhost:4334/items")

(def conn (d/connect uri))

(defn get-all-items []
  (map first (q '[:find (pull ?c [*]) :where [?c item/name]] (db conn))))

(defroutes app-routes
  (OPTIONS "/items" []
    (-> (response "")
      (header "Access-Control-Allow-Methods" "GET")
      (header "Access-Control-Allow-Headers" "content-type")
      (header "Access-Control-Allow-Origin" "*")))
  (GET "/items" []
    (-> (response (str (into [] (get-all-items))))
      (header "Access-Control-Allow-Origin" "*")))
  (POST "/items" {body :body}
    (let [tempid (d/tempid :items)
          data (merge (read-string (slurp body)) {:db/id tempid})
          tx @(d/transact conn [data])
          id (d/resolve-tempid (db conn) (:tempids tx) tempid)]
      (-> (response (str (d/touch (d/entity (db conn) id))))
        (header "Access-Control-Allow-Origin" "*"))))
  (route/not-found "Page not found"))

(def app
  (wrap-defaults app-routes (assoc site-defaults :security nil)))

Fix basic CORS support

Fix basic CORS support

Since our client side app and backend API is currently run under
different ports, XHR from the client app to the backend are cross origin
requests. Thus we need to support the preflight OPTIONS request from the
client and respond with appropriate CORS headers as well as allow origin
on the actual GET request.

Further abstraction of this should definitely be done, as well as
complete the support for POST requests.


(ns frontend.components.build-steps
  (:require [cljs.core.async :as async :refer [>! <! alts! chan sliding-buffer put! close!]]
            [frontend.datetime :as datetime]
            [frontend.models.action :as action-model]
            [frontend.models.container :as container-model]
            [frontend.models.build :as build-model]
            [frontend.components.common :as common]
            [frontend.utils :as utils :include-macros true]
            [om.core :as om :include-macros true]
            [sablono.core :as html :refer-macros [html]]
            [goog.string :as gstring]
            goog.string.format
            goog.fx.dom.Scroll
            goog.fx.easing))

(defn source-type [source]
  (condp = source
    "db" "UI"
    "template" "standard"
    source))

(defn source-title [source]
  (condp = source
    "template" "Circle generated this command automatically"
    "cache" "Circle caches some subdirectories to significantly speed up your tests"
    "config" "You specified this command in your circle.yml file"
    "inference" "Circle inferred this command from your source code and directory layout"
    "db" "You specified this command on the project settings page"
    "Unknown source"))

(defn output [out owner opts]
  (reify
    om/IRender
    (render [_]
      (let [message-html (:converted-message out)]
        (html
         [:span.pre {:dangerouslySetInnerHTML
                     #js {"__html" message-html}}])))))

(defn trailing-output [converters-state owner opts]
  (reify
    om/IRender
    (render [_]
      (let [trailing-out (action-model/trailing-output converters-state)]
        (html
         [:span {:dangerouslySetInnerHTML
                 #js {"__html" trailing-out}}])))))

(defn action [action owner opts]
  (reify
    om/IRender
    (render [_]
      (let [controls-ch (get-in opts [:comms :controls])
            visible? (get action :show-output (or (not= "success" (:status action))
                                                  (seq (:messages action))))
            header-classes  (concat [(:status action)]
                                    (when-not visible?
                                      ["minimize"])
                                    (when (action-model/has-content? action)
                                      ["contents"])
                                    (when (action-model/failed? action)
                                      ["failed"]))]
        (html
         [:div {:class (str "type-" (:type action))}
          [:div.type-divider
           [:span (:type action)]]
          [:div.build-output
           [:div.action_header {:class header-classes}
            [:div.ah_wrapper
             [:div.header {:class (when (action-model/has-content? action)
                                    header-classes)
                           ;; TODO: figure out what to put here
                           :on-click #(put! controls-ch [:action-log-output-toggled
                                                         {:index (:index @action)
                                                          :step (:step @action)}])}
              [:div.button {:class (when (action-model/has-content? action)
                                     header-classes)}
               (when (action-model/has-content? action)
                 [:i.fa.fa-chevron-down])]
              [:div.command {:class header-classes}
               [:span.command-text {:title (:bash_command action)}
                (str (when (= (:bash_command action)
                              (:name action))
                       "$ ")
                     (:name action)
                     (when (:parallel action)
                       (gstring/format " (%s)" (:index action))))]
               [:span.time {:title (str (:start_time action) " to "
                                        (:end_time action))}
                (str (action-model/duration action)
                     (when (:timedout action) " (timed out)"))]
               [:span.action-source
                [:span.action-source-inner {:title (source-title (:source action))}
                 (source-type (:source action))]]]]
             [:div.detail-wrapper
              (when (and visible? (action-model/has-content? action))
                [:div.detail {:class header-classes}
                 ;; XXX: better way to indicate loading
                 (if (and (:has_output action)
                          (nil? (:output action)))
                   [:div.loading-spinner common/spinner]

                   [:div#action-log-messages
                    ;; XXX click-to-scroll
                    [:i.click-to-scroll.fa.fa-arrow-circle-o-down.pull-right]

                    (common/messages (:messages action))
                    (when (:bash_command action)
                      [:span
                       (when (:exit_code action)
                         [:span.exit-code.pull-right
                          (str "Exit code: " (:exit_code action))])
                       [:pre.bash-command
                        {:title "The full bash comand used to run this setup"}
                        (:bash_command action)]])
                    [:pre.output.solarized {:style {:white-space "normal"}}
                     (when (:truncated action)
                       [:span.truncated "(this output has been truncated)"])
                     (om/build-all output (:output action) {:opts opts
                                                            :key :react-key})

                     (om/build trailing-output (:converters-state action) {:opts opts})

                     (when (:truncated action)
                       [:span.truncated "(this output has been truncated)"])]])])]]]]])))))

(defn container-view [{:keys [container non-parallel-actions]} owner opts]
  (reify
    om/IRender
    (render [_]
      (let [container-id (container-model/id container)
            controls-ch (get-in opts [:comms :controls])
            actions (map (fn [action]
                           (get non-parallel-actions (:step action) action))
                         (remove :filler-action (:actions container)))]
        (html
         [:div.container-view {:style {:left (str (* 100 (:index container)) "%")}
                               :id (str "container_" (:index container))}
          (om/build-all action actions {:opts opts :key :step})])))))

(defn container-build-steps [{:keys [containers current-container-id]} owner opts]
  (reify
    om/IRender
    (render [_]
      (let [non-parallel-actions (->> containers
                                      first
                                      :actions
                                      (remove :parallel)
                                      (map (fn [action]
                                             [(:step action) action]))
                                      (into {}))
            controls-ch (get-in opts [:comms :controls])]
        (html
         [:div#container_scroll_parent ;; hides horizontal scrollbar
          [:div#container_parent {:on-wheel (fn [e]
                                              (when (not= 0 (aget e "deltaX"))
                                                (.preventDefault e)
                                                (aset js/document.body "scrollTop" (+ (aget js/document.body "scrollTop") (aget e "deltaY")))))
                                  :on-scroll (fn [e]
                                               ;; prevent handling scrolling if we're animating the
                                               ;; transition to a new selected container
                                               (let [scroller (.. e -target -scroll_handler)]
                                                 (when (or (not scroller) (.isStopped scroller))
                                                   (put! controls-ch [:container-parent-scroll]))))
                                  :scroll "handle_browser_scroll"
                                  :window-resize "realign_container_viewport"
                                  :resize-sensor "height_changed"
                                  :class (str "selected_" current-container-id)}
           ;; XXX handle scrolling and resize sensor
           ;; probably have to replace resize sensor with something else
           (for [container containers]
             (om/build container-view
                       {:container container
                        :non-parallel-actions non-parallel-actions}
                       {:opts opts}))]])))))

(ns frontend.components.build-steps
  (:require [cljs.core.async :as async :refer [>! <! alts! chan sliding-buffer put! close!]]
            [frontend.datetime :as datetime]
            [frontend.models.action :as action-model]
            [frontend.models.container :as container-model]
            [frontend.models.build :as build-model]
            [frontend.components.common :as common]
            [frontend.utils :as utils :include-macros true]
            [om.core :as om :include-macros true]
            [sablono.core :as html :refer-macros [html]]
            [goog.string :as gstring]
            goog.string.format
            goog.fx.dom.Scroll
            goog.fx.easing))

(defn source-type [source]
  (condp = source
    "db" "UI"
    "template" "standard"
    source))

(defn source-title [source]
  (condp = source
    "template" "Circle generated this command automatically"
    "cache" "Circle caches some subdirectories to significantly speed up your tests"
    "config" "You specified this command in your circle.yml file"
    "inference" "Circle inferred this command from your source code and directory layout"
    "db" "You specified this command on the project settings page"
    "Unknown source"))

(defn output [out owner opts]
  (reify
    om/IRender
    (render [_]
      (let [message-html (:converted-message out)]
        (html
         [:span.pre {:dangerouslySetInnerHTML
                     #js {"__html" message-html}}])))))

(defn trailing-output [converters-state owner opts]
  (reify
    om/IRender
    (render [_]
      (let [trailing-out (action-model/trailing-output converters-state)]
        (html
         [:span {:dangerouslySetInnerHTML
                 #js {"__html" trailing-out}}])))))

(defn action [action owner opts]
  (reify
    om/IRender
    (render [_]
      (let [controls-ch (get-in opts [:comms :controls])
            visible? (get action :show-output (or (not= "success" (:status action))
                                                  (seq (:messages action))))
            header-classes  (concat [(:status action)]
                                    (when-not visible?
                                      ["minimize"])
                                    (when (action-model/has-content? action)
                                      ["contents"])
                                    (when (action-model/failed? action)
                                      ["failed"]))]
        (html
         [:div {:class (str "type-" (:type action))}
          [:div.type-divider
           [:span (:type action)]]
          [:div.build-output
           [:div.action_header {:class header-classes}
            [:div.ah_wrapper
             [:div.header {:class (when (action-model/has-content? action)
                                    header-classes)
                           ;; TODO: figure out what to put here
                           :on-click #(put! controls-ch [:action-log-output-toggled
                                                         {:index (:index @action)
                                                          :step (:step @action)}])}
              [:div.button {:class (when (action-model/has-content? action)
                                     header-classes)}
               (when (action-model/has-content? action)
                 [:i.fa.fa-chevron-down])]
              [:div.command {:class header-classes}
               [:span.command-text {:title (:bash_command action)}
                (str (when (= (:bash_command action)
                              (:name action))
                       "$ ")
                     (:name action)
                     (when (:parallel action)
                       (gstring/format " (%s)" (:index action))))]
               [:span.time {:title (str (:start_time action) " to "
                                        (:end_time action))}
                (str (action-model/duration action)
                     (when (:timedout action) " (timed out)"))]
               [:span.action-source
                [:span.action-source-inner {:title (source-title (:source action))}
                 (source-type (:source action))]]]]
             [:div.detail-wrapper
              (when (and visible? (action-model/has-content? action))
                [:div.detail {:class header-classes}
                 ;; XXX: better way to indicate loading
                 (if (and (:has_output action)
                          (nil? (:output action)))
                   [:div.loading-spinner common/spinner]

                   [:div#action-log-messages
                    ;; XXX click-to-scroll
                    [:i.click-to-scroll.fa.fa-arrow-circle-o-down.pull-right]

                    (common/messages (:messages action))
                    (when (:bash_command action)
                      [:span
                       (when (:exit_code action)
                         [:span.exit-code.pull-right
                          (str "Exit code: " (:exit_code action))])
                       [:pre.bash-command
                        {:title "The full bash comand used to run this setup"}
                        (:bash_command action)]])
                    [:pre.output.solarized {:style {:white-space "normal"}}
                     (when (:truncated action)
                       [:span.truncated "(this output has been truncated)"])
                     (om/build-all output (:output action) {:opts opts
                                                            :key :react-key})

                     (om/build trailing-output (:converters-state action) {:opts opts})

                     (when (:truncated action)
                       [:span.truncated "(this output has been truncated)"])]])])]]]]])))))

(defn container-view [{:keys [container non-parallel-actions]} owner opts]
  (reify
    om/IRender
    (render [_]
      (let [container-id (container-model/id container)
            controls-ch (get-in opts [:comms :controls])
            actions (remove :filler-action
                            (map (fn [action]
                                   (get non-parallel-actions (:step action) action))
                                 (:actions container)))]
        (html
         [:div.container-view {:style {:left (str (* 100 (:index container)) "%")}
                               :id (str "container_" (:index container))}
          (om/build-all action actions {:opts opts :key :step})])))))

(defn container-build-steps [{:keys [containers current-container-id]} owner opts]
  (reify
    om/IRender
    (render [_]
      (let [non-parallel-actions (->> containers
                                      first
                                      :actions
                                      (remove :parallel)
                                      (map (fn [action]
                                             [(:step action) action]))
                                      (into {}))
            controls-ch (get-in opts [:comms :controls])]
        (html
         [:div#container_scroll_parent ;; hides horizontal scrollbar
          [:div#container_parent {:on-wheel (fn [e]
                                              (when (not= 0 (aget e "deltaX"))
                                                (.preventDefault e)
                                                (aset js/document.body "scrollTop" (+ (aget js/document.body "scrollTop") (aget e "deltaY")))))
                                  :on-scroll (fn [e]
                                               ;; prevent handling scrolling if we're animating the
                                               ;; transition to a new selected container
                                               (let [scroller (.. e -target -scroll_handler)]
                                                 (when (or (not scroller) (.isStopped scroller))
                                                   (put! controls-ch [:container-parent-scroll]))))
                                  :scroll "handle_browser_scroll"
                                  :window-resize "realign_container_viewport"
                                  :resize-sensor "height_changed"
                                  :class (str "selected_" current-container-id)}
           ;; XXX handle scrolling and resize sensor
           ;; probably have to replace resize sensor with something else
           (for [container containers]
             (om/build container-view
                       {:container container
                        :non-parallel-actions non-parallel-actions}
                       {:opts opts}))]])))))

fix non-parallel actions

fix non-parallel actions


(ns testdouble.cljs.csv-test
  (:require [testdouble.cljs.csv :as csv]
            [cljs.test :as t])
  (:require-macros [cljs.test :refer [deftest testing is run-tests]]))

(enable-console-print!)

(deftest write-csv-test
  (let [data [[1 2 3] [4 5 6]]]
    (testing "default separator ','"
      (is (= "1,2,3\n4,5,6" (csv/write-csv data))))

    (testing "user defined separator '|'"
      (is (= "1|2|3\n4|5|6" (csv/write-csv data :separator "|"))))

    (testing "user defined newline ':cr+lf'"
      (is (= "1,2,3\r\n4,5,6" (csv/write-csv data :newline :cr+lf))))

    (testing "user defined separator '|' and newline ':cr+lf"
      (is (= "1|2|3\r\n4|5|6" (csv/write-csv data :separator "|" :newline :cr+lf))))

    (testing "quote each field"
      (is (= "\"1,000\",\"2\",\"3\"\n\"4\",\"5,000\",\"6\"" (csv/write-csv [["1,000" "2" "3"] ["4" "5,000" "6"]] :quote? true))))

    (testing "quote non-string fields"
      (is (= "\"1,000\",\"2\",\"3\"\n\"4\",\"5,000\",\"false\"" (csv/write-csv [["1,000" 2 "3"] ["4" "5,000" false]] :quote? true))))

    (testing "valid characters in quoted fields"
      (is (= "\"a\nb\",\"c\rd\"\n\"e,f\",\"g\"\"h\""
             (csv/write-csv [["a\nb" "c\rd"] ["e,f" "g\"h"]] :quote? true))))

    (testing "fields with spaces"
      (is (= "a b,c d\ne f,g h"
             (csv/write-csv [["a b" "c d"] ["e f" "g h"]])))
      (is (= "\"a b\",\"c d\"\n\"e f\",\"g h\""
             (csv/write-csv [["a b" "c d"] ["e f" "g h"]] :quote? true))))

    (testing "blank fields at end of row"
      (is (= "a,b,c\n1,1,1\n2,,\n3,,"
             (csv/write-csv [["a" "b" "c"]
                             ["1" "1" "1"]
                             ["2" "" ""]
                             ["3" "" ""]]))))

    (testing "error when newline is not one of :lf OR :cr+lf"
      (is (thrown-with-msg? js/Error #":newline" (csv/write-csv data :newline "foo"))))))

(deftest read-csv-test
  (let [data [["1" "2" "3"] ["4" "5" "6"]]]
    (testing "default separator ','"
      (is (= data (csv/read-csv "1,2,3\n4,5,6"))))

    (testing "user defined separator '|'"
      (is (= data (csv/read-csv "1|2|3\n4|5|6" :separator "|"))))

    (testing "user defined newline ':cr+lf'"
      (is (= data (csv/read-csv "1,2,3\r\n4,5,6" :newline :cr+lf))))

    (testing "user defined separator '|' and newline ':cr+lf'"
      (is (= data (csv/read-csv "1|2|3\r\n4|5|6" :separator "|" :newline :cr+lf))))

    (testing "valid characters in quoted fields"
      (is (= [["a\nb" "c\rd"] ["e,f" "g\"h"]]
             (csv/read-csv "\"a\nb\",\"c\rd\"\n\"e,f\",\"g\"\"h\""))))

    (testing "quoted fields containing only quotes"
      (is (= [["\"" "\"\""] ["\"\"\"" "\"\"\"\""]]
             (csv/read-csv "\"\"\"\",\"\"\"\"\"\"\n\"\"\"\"\"\"\"\",\"\"\"\"\"\"\"\"\"\""))))

    (testing "fields with spaces"
      (is (= [["a b" "c d"] ["e f" "g h"]]
             (csv/read-csv "\"a b\",c d\ne f,\"g h\""))))

    (testing "empty fields"
      (is (= [["a" "b" "c" "d"] ["1" "" "" "d"]]
             (csv/read-csv "a,b,c,d\n1,\"\",,d"))))

    (testing "blank fields at end of row"
      (is (= [["a" "b" "c"]
              ["1" "1" "1"]
              ["2" "" ""]
              ["3" "" ""]]
             (csv/read-csv "a,b,c\n1,1,1\n2,,\n3,,"))))))

(defn ^:export run []
  (run-tests))

(ns testdouble.cljs.csv-test
  (:require [testdouble.cljs.csv :as csv]
            [cljs.test :as t])
  (:require-macros [cljs.test :refer [deftest testing is run-tests]]))

(enable-console-print!)

(deftest write-csv-test
  (let [data [[1 2 3] [4 5 6]]]
    (testing "default separator ','"
      (is (= "1,2,3\n4,5,6" (csv/write-csv data))))

    (testing "user defined separator '|'"
      (is (= "1|2|3\n4|5|6" (csv/write-csv data :separator "|"))))

    (testing "user defined newline ':cr+lf'"
      (is (= "1,2,3\r\n4,5,6" (csv/write-csv data :newline :cr+lf))))

    (testing "user defined separator '|' and newline ':cr+lf"
      (is (= "1|2|3\r\n4|5|6" (csv/write-csv data :separator "|" :newline :cr+lf))))

    (testing "quote each field"
      (is (= "\"1,000\",\"2\",\"3\"\n\"4\",\"5,000\",\"6\"" (csv/write-csv [["1,000" "2" "3"] ["4" "5,000" "6"]] :quote? true))))

    (testing "str non-string fields"
      (is (= "100,2,\n4,500,false"
             (csv/write-csv [["100" 2 nil] ["4" "500" false]]))))

    (testing "str and quote non-string fields"
      (is (= "\"1,000\",\"2\",\"\"\n\"4\",\"5,000\",\"false\""
             (csv/write-csv [["1,000" 2 nil] ["4" "5,000" false]] :quote? true))))

    (testing "valid characters in quoted fields"
      (is (= "\"a\nb\",\"c\rd\"\n\"e,f\",\"g\"\"h\""
             (csv/write-csv [["a\nb" "c\rd"] ["e,f" "g\"h"]] :quote? true))))

    (testing "fields with spaces"
      (is (= "a b,c d\ne f,g h"
             (csv/write-csv [["a b" "c d"] ["e f" "g h"]])))
      (is (= "\"a b\",\"c d\"\n\"e f\",\"g h\""
             (csv/write-csv [["a b" "c d"] ["e f" "g h"]] :quote? true))))

    (testing "blank fields at end of row"
      (is (= "a,b,c\n1,1,1\n2,,\n3,,"
             (csv/write-csv [["a" "b" "c"]
                             ["1" "1" "1"]
                             ["2" "" ""]
                             ["3" "" ""]]))))

    (testing "error when newline is not one of :lf OR :cr+lf"
      (is (thrown-with-msg? js/Error #":newline" (csv/write-csv data :newline "foo"))))))

(deftest read-csv-test
  (let [data [["1" "2" "3"] ["4" "5" "6"]]]
    (testing "default separator ','"
      (is (= data (csv/read-csv "1,2,3\n4,5,6"))))

    (testing "user defined separator '|'"
      (is (= data (csv/read-csv "1|2|3\n4|5|6" :separator "|"))))

    (testing "user defined newline ':cr+lf'"
      (is (= data (csv/read-csv "1,2,3\r\n4,5,6" :newline :cr+lf))))

    (testing "user defined separator '|' and newline ':cr+lf'"
      (is (= data (csv/read-csv "1|2|3\r\n4|5|6" :separator "|" :newline :cr+lf))))

    (testing "valid characters in quoted fields"
      (is (= [["a\nb" "c\rd"] ["e,f" "g\"h"]]
             (csv/read-csv "\"a\nb\",\"c\rd\"\n\"e,f\",\"g\"\"h\""))))

    (testing "quoted fields containing only quotes"
      (is (= [["\"" "\"\""] ["\"\"\"" "\"\"\"\""]]
             (csv/read-csv "\"\"\"\",\"\"\"\"\"\"\n\"\"\"\"\"\"\"\",\"\"\"\"\"\"\"\"\"\""))))

    (testing "fields with spaces"
      (is (= [["a b" "c d"] ["e f" "g h"]]
             (csv/read-csv "\"a b\",c d\ne f,\"g h\""))))

    (testing "empty fields"
      (is (= [["a" "b" "c" "d"] ["1" "" "" "d"]]
             (csv/read-csv "a,b,c,d\n1,\"\",,d"))))

    (testing "blank fields at end of row"
      (is (= [["a" "b" "c"]
              ["1" "1" "1"]
              ["2" "" ""]
              ["3" "" ""]]
             (csv/read-csv "a,b,c\n1,1,1\n2,,\n3,,"))))))

(defn ^:export run []
  (run-tests))

Add tests for stringification of unquoted fields

Also include nil in the tests.


(ns cljam.t-bam
  (:use midje.sweet
        cljam.t-common)
  (:require [clojure.java.io :refer [copy file]]
            [cljam.bam :as bam]
            [cljam.io :as io]
            [cljam.bam-indexer :as bai]
            [cljam.sorter :as sorter]))

(def temp-file (str temp-dir "/test.bam"))
(def temp-file-sorted (str temp-dir "/test.sorted.bam"))

(fact "about slurp-bam"
      (slurp-bam-for-test test-bam-file) => test-sam)

(with-state-changes [(before :facts (prepare-cache!))
                     (after :facts (clean-cache!))]
  (fact "about spit-bam"
        (spit-bam-for-test temp-file test-sam) => anything
        (slurp-bam-for-test temp-file) => test-sam))

(with-state-changes [(before :facts (do (prepare-cache!)
                                        (spit-bam-for-test temp-file test-sam)))
                     (after :facts (clean-cache!))]
  (fact "about BAMReader"
        (let [rdr (bam/reader temp-file)]
          (io/read-refs rdr) => test-sam-refs)))

(with-state-changes [(before :facts (do (prepare-cache!)
                                        (copy (file test-sorted-bam-file) (file temp-file-sorted))))
                     (after :facts (clean-cache!))]
  (fact "about BAM indexer"
        (bai/create-index temp-file-sorted (str temp-file-sorted ".bai")) => anything
        (with-open [r (bam/reader temp-file-sorted)]
          (io/read-alignments r {:chr "ref" :start 0 :end 1000})) => (filter #(= "ref" (:rname %)) (:alignments test-sam-sorted-by-pos))
        ;; incomplete alignments tests
        (let [f (str temp-dir "/test.incomplete.bam")
              sorted-f (str temp-dir "/test.incomplete.sorted.bam")]
          ;; generate incomplete bam file on the fly
          (spit-bam-for-test f test-sam-incomplete-alignments)
          (sorter/sort-by-pos (bam/reader f) (bam/writer sorted-f))
          (bai/create-index sorted-f (str sorted-f ".bai"))) => anything
        (with-open [r (bam/reader (str temp-dir "/test.incomplete.sorted.bam"))]
          (io/read-alignments r {:chr "ref" :start 0 :end 1000})) => (filter #(= "ref" (:rname %)) (:alignments test-sam-incomplete-alignments-sorted-by-pos))
        ;; TODO: need more strictly check to .bai files
        ;; (it will use https://gitlab.xcoo.jp/chrovis/cljam/issues/8 later)
        ))

(ns cljam.t-bam
  (:use midje.sweet
        cljam.t-common)
  (:require [clojure.java.io :refer [copy file]]
            [cljam.bam :as bam]
            [cljam.io :as io]
            [cljam.bam-indexer :as bai]
            [cljam.sorter :as sorter]))

(def temp-file (str temp-dir "/test.bam"))
(def temp-file-sorted (str temp-dir "/test.sorted.bam"))

(fact "about slurp-bam"
      (slurp-bam-for-test test-bam-file) => test-sam
      (slurp-bam-for-test medium-bam-file) => anything
      )

(with-state-changes [(before :facts (prepare-cache!))
                     (after :facts (clean-cache!))]
  (fact "about spit-bam"
        (spit-bam-for-test temp-file test-sam) => anything
        (slurp-bam-for-test temp-file) => test-sam))

(with-state-changes [(before :facts (do (prepare-cache!)
                                        (spit-bam-for-test temp-file test-sam)))
                     (after :facts (clean-cache!))]
  (fact "about BAMReader"
        (let [rdr (bam/reader temp-file)]
          (io/read-refs rdr) => test-sam-refs)))

(with-state-changes [(before :facts (do (prepare-cache!)
                                        (copy (file test-sorted-bam-file)
                                              (file temp-file-sorted))))
                     (after :facts (clean-cache!))]
  (fact "about BAM indexer"
        (bai/create-index
          temp-file-sorted (str temp-file-sorted ".bai")) => anything
        (with-open [r (bam/reader temp-file-sorted)]
          (io/read-alignments r {:chr "ref" :start 0 :end 1000})
          ) => (filter #(= "ref" (:rname %))
                       (:alignments test-sam-sorted-by-pos))
        ))

(let [f (str temp-dir "/test.incomplete.bam")
      sorted-f (str temp-dir "/test.incomplete.sorted.bam")]
  (with-state-changes [(before :facts (do (prepare-cache!)
                                          (spit-bam-for-test
                                            f test-sam-incomplete-alignments)
                                          ;; TODO: go independent from sorter
                                          (sorter/sort-by-pos
                                            (bam/reader f)
                                            (bam/writer sorted-f))))
                       (after :facts (clean-cache!))]
    (fact "about BAM indexer (for incomplete alignments)"
          ;; generate incomplete bam file on the fly
          (bai/create-index sorted-f (str sorted-f ".bai")) => anything
          (with-open [r (bam/reader sorted-f)]
            (io/read-alignments r {:chr "ref" :start 0 :end 1000})
            ) => (filter #(= "ref" (:rname %))
                         (:alignments test-sam-incomplete-alignments-sorted-by-pos))
          ;; TODO: need more strictly check to .bai files
          ;; (it will use https://gitlab.xcoo.jp/chrovis/cljam/issues/8 later)
          )))

(with-state-changes [(before :facts (do (prepare-cache!)
                                        (copy (file medium-bam-file)
                                              (file temp-file-sorted))))
                     (after :facts (clean-cache!))]
  (fact "about BAM indexer (medium file)"
        (bai/create-index
          temp-file-sorted (str temp-file-sorted ".bai")) => anything
        ))

add "medium.bam" test (wip)

add "medium.bam" test (wip)


(ns afterglow.fixtures.chauvet
  "Models for fixtures provided by Chauvet Lighting."
  (:require [afterglow.channels :as chan]))

;; TODO functions for rotational tranformatons
;; TODO multi-head support, with relative locations

(defn slimpar-hex3-irc
  ([]
   (slimpar-hex3-irc :12-channel))
  ([mode]
   (assoc (case mode
            ;; TODO missing channels once we have definition support for them
            :12-channel {:channels [(chan/dimmer 1) (chan/color 2 :red) (chan/color 3 :green) (chan/color 4 :blue)
                                    (chan/color 5 :amber :hue 45) (chan/color 6 :white) (chan/color 7 :uv :label "UV")]}
            :8-channel {:channels [(chan/dimmer 1) (chan/color 2 :red) (chan/color 3 :green) (chan/color 4 :blue)
                                   (chan/color 5 :amber :hue 45) (chan/color 6 :white) (chan/color 7 :uv :label "UV")]}
            :6-channel {:channels [(chan/color 1 :red) (chan/color 2 :green) (chan/color 3 :blue)
                                   (chan/color 4 :amber :hue 45) (chan/color 5 :white) (chan/color 6 :uv :label "UV")]})
          :name "Chauvet SlimPAR Hex 3 IRC"
          :mode mode)))

(ns afterglow.fixtures.chauvet
  "Models for fixtures provided by Chauvet Lighting."
  (:require [afterglow.channels :as chan]))

;; TODO functions for rotational tranformatons
;; TODO multi-head support, with relative locations

(defn slimpar-hex3-irc
  ([]
   (slimpar-hex3-irc :12-channel-mix-uv))
  ([mode]
   (assoc (case mode
            ;; TODO missing channels once we have definition support for them
            :12-channel {:channels [(chan/dimmer 1) (chan/color 2 :red) (chan/color 3 :green) (chan/color 4 :blue)
                                    (chan/color 5 :amber :hue 45) (chan/color 6 :white) (chan/color 7 :uv :label "UV")]}
            :8-channel {:channels [(chan/dimmer 1) (chan/color 2 :red) (chan/color 3 :green) (chan/color 4 :blue)
                                   (chan/color 5 :amber :hue 45) (chan/color 6 :white) (chan/color 7 :uv :label "UV")]}
            :6-channel {:channels [(chan/color 1 :red) (chan/color 2 :green) (chan/color 3 :blue)
                                   (chan/color 4 :amber :hue 45) (chan/color 5 :white) (chan/color 6 :uv :label "UV")]}
            :12-channel-mix-uv {:channels [(chan/dimmer 1) (chan/color 2 :red) (chan/color 3 :green) (chan/color 4 :blue)
                                    (chan/color 5 :amber :hue 45) (chan/color 6 :white) (chan/color 7 :uv :label "UV" :hue 270)]}
            :8-channel-mix-uv {:channels [(chan/dimmer 1) (chan/color 2 :red) (chan/color 3 :green) (chan/color 4 :blue)
                                   (chan/color 5 :amber :hue 45) (chan/color 6 :white) (chan/color 7 :uv :label "UV" :hue 270)]}
            :6-channel-mix-uv {:channels [(chan/color 1 :red) (chan/color 2 :green) (chan/color 3 :blue)
                                   (chan/color 4 :amber :hue 45) (chan/color 5 :white) (chan/color 6 :uv :label "UV" :hue 270)]})
          :name "Chauvet SlimPAR Hex 3 IRC"
          :mode mode)))

Add ability to mix visible component of UV channel