(ns cljam.io.twobit.reader
  (:require [cljam.io.protocols :as protocols]
            [cljam.util :as util])
  (:import [java.io Closeable]
           [java.util TreeMap HashMap]
           [java.nio CharBuffer ByteBuffer ByteOrder]
           [java.nio.channels FileChannel FileChannel$MapMode]
           [java.nio.file Paths OpenOption StandardOpenOption]))

(deftype TwoBitReader [buf url index]
  Closeable
  (close [this]))

(defrecord ChromHeader [ambs masks ^long header-offset])

(defrecord Chrom [name ^int len ^int offset ^int index header])

(defn- ^TreeMap read-header-block! [^ByteBuffer buf]
  (let [n-blocks (.getInt buf)
        starts (doto (.slice buf) (.order (.order buf)))
        _ (.position buf (+ (.position buf) (* Integer/BYTES n-blocks)))
        m (TreeMap.)]
    (dotimes [_ n-blocks]
      (.put m (unchecked-inc-int (.getInt starts)) (.getInt buf)))
    (assert (= (.size m) n-blocks))
    m))

(defn- read-sequence-header! [buf]
  (let [amb-blocks (read-header-block! buf)
        mask-blocks (read-header-block! buf)]
    (ChromHeader.
     amb-blocks
     mask-blocks
     (* Integer/BYTES
        (+ 4 (* (.size amb-blocks) 2) (* (.size mask-blocks) 2))))))

(defn- read-file-index! [^ByteBuffer buf ^long n-seqs]
  (let [m (HashMap.)
        ba (byte-array 255)]
    (dotimes [i n-seqs]
      (let [chr-len (Byte/toUnsignedInt (.get buf))
            _ (.get buf ba 0 chr-len)
            chr (String. ba 0 chr-len)
            offset (.getInt buf)
            _ (.mark buf)
            _ (.position buf offset)
            len (.getInt buf)
            _ (.reset buf)
            header (delay
                    (let [buf' (.duplicate buf)]
                      (.order buf' (.order buf))
                      (.position buf' (+ offset Integer/BYTES))
                      (read-sequence-header! buf')))]
        (.put m chr (Chrom. chr len offset i header))))
    m))

(def ^:private ^"[[C" twobit-to-str
  (let [table "TCAG"]
    (->> 256
         range
         (map
          (fn [j] (let [i (byte (- j 128))
                        n4 (bit-and i 2r11)
                        n3 (bit-and (unsigned-bit-shift-right i 2) 2r11)
                        n2 (bit-and (unsigned-bit-shift-right i 4) 2r11)
                        n1 (bit-and (unsigned-bit-shift-right i 6) 2r11)]
                    (char-array [(.charAt table n1)
                                 (.charAt table n2)
                                 (.charAt table n3)
                                 (.charAt table n4)]))))
         (into-array (Class/forName "[C")))))

(defn replace-ambs!
  "Replace regions of charbuffer with Ns."
  [^CharBuffer cb ^TreeMap ambs ^long start ^long end]
  (let [floor (or (.floorKey ambs (int start)) (int 1))]
    (doseq [[^long n-start ^long n-size] (.subMap ambs floor (int (inc end)))]
      (when-not (or (< end n-start) (< (+ n-start n-size -1) start))
        (.position cb (max 0 (- n-start start)))
        (dotimes [_ (- (min end (+ n-start n-size -1)) (max start n-start) -1)]
          (.put cb \N))))))

(defn mask!
  "Mask regions of given charbuffer."
  [^CharBuffer cb ^TreeMap masks ^long start ^long end]
  (let [floor (or (.floorKey masks (int start)) (int 1))]
    (doseq [[^long m-start ^long m-size] (.subMap masks floor (int (inc end)))]
      (when-not (or (< end m-start) (< (+ m-start m-size -1) start))
        (.position cb (max 0 (- m-start start)))
        (.mark cb)
        (let [ca (char-array
                  (- (min end (+ m-start m-size -1))
                     (max start m-start) -1))]
          (.get cb ca)
          (.reset cb)
          (dotimes [i (alength ca)]
            ;; to lower case character
            (.put cb (unchecked-char
                      (unchecked-add-int
                       (unchecked-int (aget ca i)) 32)))))))))

(defn ^String read-sequence
  "Reads sequence at the given region from reader.
   Pass {:mask? true} to enable masking of sequence."
  ([rdr region]
   (read-sequence rdr region {}))
  ([^TwoBitReader rdr {:keys [chr start end]} {:keys [mask?] :or {mask? false}}]
   (when-let [^Chrom c (get (.index rdr) chr)]
     (let [start' (max 1 (or start 1))
           end' (min (.len c) (or end (.len c)))]
       (when (<= start' end')
         ;; Potential seek & read.
         (let [^ChromHeader h @(.header c)
               start-offset (quot (dec start') 4)
               end-offset (quot (dec end') 4)
               buf ^ByteBuffer (.buf rdr)
               cb (CharBuffer/allocate (* 4 (inc (- end-offset start-offset))))]
           (.position buf (+ (.offset c) (.header-offset h) start-offset))
           (while (.hasRemaining cb)
             (->> (unchecked-add-int 128 (.get buf))
                  ^chars (aget twobit-to-str)
                  (.put cb)))
           (let [cb' (-> cb
                         ^CharBuffer (.position (mod (dec start') 4))
                         ^CharBuffer .slice
                         (.limit (int (inc (- end' start')))))]
             (replace-ambs! cb' (.ambs h) start' end')
             (when mask? (mask! cb' (.masks h) start' end'))
             (.rewind cb')
             (.toString cb'))))))))

(defn- read-all-sequences*
  [rdr chrs option]
  (when (seq chrs)
    (let [[{:keys [name]} & nxt] chrs]
      (lazy-seq
       (cons {:name name
              :sequence (read-sequence rdr {:chr name} option)}
             (read-all-sequences* rdr nxt option))))))

(defn read-all-sequences
  "Reads all sequences in file."
  ([rdr]
   (read-all-sequences rdr {}))
  ([^TwoBitReader rdr option]
   (read-all-sequences* rdr (sort-by :index (vals (.index rdr))) option)))

(defn read-seq-summaries
  "Reads summaries of sequences in this 2bit file."
  [^TwoBitReader rdr]
  (mapv
   (fn [^Chrom c]
     {:name (.name c), :len (.len c)})
   (sort-by :index (vals (.index rdr)))))

(defn read-indices
  "Reads metadata of indexed sequences. Forces loading all indices."
  [^TwoBitReader rdr]
  (mapv
   (fn [{:keys [name len offset header]}]
     (let [{:keys [ambs header-offset masks]} @header]
       {:name name, :len len, :offset offset,
        :ambs (into {} ambs), :masks (into {} masks)
        :header-offset header-offset}))
   (sort-by :index (vals (.index rdr)))))

(extend-type TwoBitReader
  protocols/IReader
  (reader-url [this] (.url this))
  (read
    ([this] (protocols/read this {}))
    ([this option] (protocols/read-all-sequences this option)))
  (indexed? [_] true)
  protocols/ISequenceReader
  (read-seq-summaries
    [this] (read-seq-summaries this))
  (read-indices
    [this] (read-indices this))
  (read-all-sequences
    ([this] (protocols/read-all-sequences this {}))
    ([this option]
     (read-all-sequences this option)))
  (read-sequence
    (^String [this region]
     (protocols/read-sequence this region {}))
    (^String [this region option]
     (read-sequence this region option)))
  protocols/IRegionReader
  (read-in-region
    (^String [this region]
     (protocols/read-in-region this region {}))
    (^String [this {:keys [chr start end] :as region} option]
     (read-sequence this region option))))

(defn ^TwoBitReader reader
  [f]
  (let [url (util/as-url f)]
    (with-open [ch (-> url
                       .toURI
                       Paths/get
                       (FileChannel/open
                        (into-array OpenOption [StandardOpenOption/READ])))]
      (let [buf (.map ch FileChannel$MapMode/READ_ONLY 0 (.size ch))
            _ (.order buf (case (.getInt buf)
                            0x1A412743 ByteOrder/BIG_ENDIAN
                            0x4327411A ByteOrder/LITTLE_ENDIAN))
            version (.getInt buf)
            n-seqs (.getInt buf)
            zero (.getInt buf)]
        (when-not (zero? version)
          (throw (ex-info "Version number must be zero."
                          {:input f, :url url, :version version})))
        (when-not (zero? zero)
          (throw (ex-info "sequenceCount must be followed by zero."
                          {:input f, :url url, :zero zero})))
        (TwoBitReader. buf url (read-file-index! buf n-seqs))))))

(defn ^TwoBitReader clone-reader
  "Clones .2bit reader sharing persistent objects."
  [^TwoBitReader rdr]
  (let [buf (doto (.duplicate ^ByteBuffer (.buf rdr))
              (.order (.order ^ByteBuffer (.buf rdr))))]
    (TwoBitReader. buf (.url rdr) (.index rdr))))

(ns cljam.io.twobit.reader
  (:require [cljam.io.protocols :as protocols]
            [cljam.util :as util])
  (:import [java.io Closeable]
           [java.util TreeMap HashMap]
           [java.nio CharBuffer ByteBuffer ByteOrder]
           [java.nio.channels FileChannel FileChannel$MapMode]
           [java.nio.file Paths OpenOption StandardOpenOption]))

(deftype TwoBitReader [buf url index]
  Closeable
  (close [this]))

(defrecord ChromHeader [ambs masks ^long header-offset])

(defrecord Chrom [name ^int len ^int offset ^int index header])

(defn- ^TreeMap read-header-block! [^ByteBuffer buf]
  (let [n-blocks (.getInt buf)
        starts (doto (.slice buf) (.order (.order buf)))
        _ (.position buf (+ (.position buf) (* Integer/BYTES n-blocks)))
        m (TreeMap.)]
    (dotimes [_ n-blocks]
      (.put m (unchecked-inc-int (.getInt starts)) (.getInt buf)))
    (assert (= (.size m) n-blocks))
    m))

(defn- read-sequence-header! [buf]
  (let [amb-blocks (read-header-block! buf)
        mask-blocks (read-header-block! buf)]
    (ChromHeader.
     amb-blocks
     mask-blocks
     (* Integer/BYTES
        (+ 4 (* (.size amb-blocks) 2) (* (.size mask-blocks) 2))))))

(defn- read-file-index! [^ByteBuffer buf ^long n-seqs]
  (let [m (HashMap.)
        ba (byte-array 255)]
    (dotimes [i n-seqs]
      (let [chr-len (Byte/toUnsignedInt (.get buf))
            _ (.get buf ba 0 chr-len)
            chr (String. ba 0 chr-len)
            offset (.getInt buf)
            _ (.mark buf)
            _ (.position buf offset)
            len (.getInt buf)
            _ (.reset buf)
            header (delay
                    (let [buf' (.duplicate buf)]
                      (.order buf' (.order buf))
                      (.position buf' (+ offset Integer/BYTES))
                      (read-sequence-header! buf')))]
        (.put m chr (Chrom. chr len offset i header))))
    m))

(def ^:private ^"[[C" twobit-to-str
  (let [table "TCAG"]
    (->> 256
         range
         (map
          (fn [j] (let [i (byte (- j 128))
                        n4 (bit-and i 2r11)
                        n3 (bit-and (unsigned-bit-shift-right i 2) 2r11)
                        n2 (bit-and (unsigned-bit-shift-right i 4) 2r11)
                        n1 (bit-and (unsigned-bit-shift-right i 6) 2r11)]
                    (char-array [(.charAt table n1)
                                 (.charAt table n2)
                                 (.charAt table n3)
                                 (.charAt table n4)]))))
         (into-array (Class/forName "[C")))))

(defn replace-ambs!
  "Replace regions of charbuffer with Ns."
  [^CharBuffer cb ^TreeMap ambs ^long start ^long end]
  (let [floor (or (.floorKey ambs (int start)) (int 1))]
    (doseq [[^long n-start ^long n-size] (.subMap ambs floor (int (inc end)))]
      (when-not (or (< end n-start) (< (+ n-start n-size -1) start))
        (.position cb (max 0 (- n-start start)))
        (dotimes [_ (- (min end (+ n-start n-size -1)) (max start n-start) -1)]
          (.put cb \N))))))

(defn mask!
  "Mask regions of given charbuffer."
  [^CharBuffer cb ^TreeMap masks ^long start ^long end]
  (let [floor (or (.floorKey masks (int start)) (int 1))]
    (doseq [[^long m-start ^long m-size] (.subMap masks floor (int (inc end)))]
      (when-not (or (< end m-start) (< (+ m-start m-size -1) start))
        (.position cb (max 0 (- m-start start)))
        (.mark cb)
        (let [ca (char-array
                  (- (min end (+ m-start m-size -1))
                     (max start m-start) -1))]
          (.get cb ca)
          (.reset cb)
          (dotimes [i (alength ca)]
            ;; to lower case character
            (.put cb (unchecked-char
                      (unchecked-add-int
                       (unchecked-int (aget ca i)) 32)))))))))

(defn ^String read-sequence
  "Reads sequence at the given region from reader.
   Pass {:mask? true} to enable masking of sequence."
  ([rdr region]
   (read-sequence rdr region {}))
  ([^TwoBitReader rdr {:keys [chr start end]} {:keys [mask?] :or {mask? false}}]
   (when-let [^Chrom c (get (.index rdr) chr)]
     (let [start' (max 1 (or start 1))
           end' (min (.len c) (or end (.len c)))]
       (when (<= start' end')
         ;; Potential seek & read.
         (let [^ChromHeader h @(.header c)
               start-offset (quot (dec start') 4)
               end-offset (quot (dec end') 4)
               buf ^ByteBuffer (.buf rdr)
               cb (CharBuffer/allocate (* 4 (inc (- end-offset start-offset))))]
           (.position buf (+ (.offset c) (.header-offset h) start-offset))
           (while (.hasRemaining cb)
             (->> (unchecked-add-int 128 (.get buf))
                  ^chars (aget twobit-to-str)
                  (.put cb)))
           (let [cb' (-> cb
                         ^CharBuffer (.position (rem (dec start') 4))
                         ^CharBuffer .slice
                         (.limit (int (inc (- end' start')))))]
             (replace-ambs! cb' (.ambs h) start' end')
             (when mask? (mask! cb' (.masks h) start' end'))
             (.rewind cb')
             (.toString cb'))))))))

(defn- read-all-sequences*
  [rdr chrs option]
  (when (seq chrs)
    (let [[{:keys [name]} & nxt] chrs]
      (lazy-seq
       (cons {:name name
              :sequence (read-sequence rdr {:chr name} option)}
             (read-all-sequences* rdr nxt option))))))

(defn read-all-sequences
  "Reads all sequences in file."
  ([rdr]
   (read-all-sequences rdr {}))
  ([^TwoBitReader rdr option]
   (read-all-sequences* rdr (sort-by :index (vals (.index rdr))) option)))

(defn read-seq-summaries
  "Reads summaries of sequences in this 2bit file."
  [^TwoBitReader rdr]
  (mapv
   (fn [^Chrom c]
     {:name (.name c), :len (.len c)})
   (sort-by :index (vals (.index rdr)))))

(defn read-indices
  "Reads metadata of indexed sequences. Forces loading all indices."
  [^TwoBitReader rdr]
  (mapv
   (fn [{:keys [name len offset header]}]
     (let [{:keys [ambs header-offset masks]} @header]
       {:name name, :len len, :offset offset,
        :ambs (into {} ambs), :masks (into {} masks)
        :header-offset header-offset}))
   (sort-by :index (vals (.index rdr)))))

(extend-type TwoBitReader
  protocols/IReader
  (reader-url [this] (.url this))
  (read
    ([this] (protocols/read this {}))
    ([this option] (protocols/read-all-sequences this option)))
  (indexed? [_] true)
  protocols/ISequenceReader
  (read-seq-summaries
    [this] (read-seq-summaries this))
  (read-indices
    [this] (read-indices this))
  (read-all-sequences
    ([this] (protocols/read-all-sequences this {}))
    ([this option]
     (read-all-sequences this option)))
  (read-sequence
    (^String [this region]
     (protocols/read-sequence this region {}))
    (^String [this region option]
     (read-sequence this region option)))
  protocols/IRegionReader
  (read-in-region
    (^String [this region]
     (protocols/read-in-region this region {}))
    (^String [this {:keys [chr start end] :as region} option]
     (read-sequence this region option))))

(defn ^TwoBitReader reader
  [f]
  (let [url (util/as-url f)]
    (with-open [ch (-> url
                       .toURI
                       Paths/get
                       (FileChannel/open
                        (into-array OpenOption [StandardOpenOption/READ])))]
      (let [buf (.map ch FileChannel$MapMode/READ_ONLY 0 (.size ch))
            _ (.order buf (case (.getInt buf)
                            0x1A412743 ByteOrder/BIG_ENDIAN
                            0x4327411A ByteOrder/LITTLE_ENDIAN))
            version (.getInt buf)
            n-seqs (.getInt buf)
            zero (.getInt buf)]
        (when-not (zero? version)
          (throw (ex-info "Version number must be zero."
                          {:input f, :url url, :version version})))
        (when-not (zero? zero)
          (throw (ex-info "sequenceCount must be followed by zero."
                          {:input f, :url url, :zero zero})))
        (TwoBitReader. buf url (read-file-index! buf n-seqs))))))

(defn ^TwoBitReader clone-reader
  "Clones .2bit reader sharing persistent objects."
  [^TwoBitReader rdr]
  (let [buf (doto (.duplicate ^ByteBuffer (.buf rdr))
              (.order (.order ^ByteBuffer (.buf rdr))))]
    (TwoBitReader. buf (.url rdr) (.index rdr))))

Replace mod with rem

Replace mod with rem


(ns org.dada.core.ModelImpl
    (:use org.dada.core)
    ;;(:as this)
    (:import
     [java.util Collection LinkedHashMap]
     [org.dada.core AbstractModel Metadata Update]
     )
    (:gen-class
     :extends org.dada.core.AbstractModelView
     :constructors {[String org.dada.core.Metadata clojure.lang.IFn clojure.lang.IFn] [String org.dada.core.Metadata]}
     :methods []
     :init init
     :state state
     )
    )

(defn process-addition [[extant extinct key-fn version-fn i a d] addition]
  (let [new (.getNewValue addition)
	key (key-fn new)
	;;dummy (println "PROCESS:" key new)
	current (extant key)]
    (if (nil? current)
      (let [removed (extinct key)]
	(if (nil? removed)
	  [(conj {key new} extant) extinct key-fn version-fn (cons (Update. nil new) i) a d] ;insertion
	  ;; TODO - not extant but extinct
	  )
	)
      ;; extant - alteration - TODO - check version
      [(conj {key new} extant) extinct key-fn version-fn i (cons (Update. current new) a) d]
      )))

(defn process-deletion [[extant extinct key-fn version-fn i a d] addition]
  ;; ensure row with key
  ;; send insertion/alteration upstreamp
  [extant extinct key-fn version-fn i a d])

(defn process-update [extant extinct key-fn version-fn insertions alterations deletions]
  (reduce process-deletion
	  (reduce process-addition
		  (reduce process-addition
			  [extant extinct key-fn version-fn '() '() '()]
			  insertions)
		  alterations)
	  deletions))

(defn -init [#^String model-name #^Metadata tgt-metadata #^IFn key-fn #^IFn version-fn]
  [;; super ctor args
   [model-name tgt-metadata]
   ;; instance state
   (let [tgt-creator (.getCreator tgt-metadata)
	 update-fn (fn [[extant extinct] & updates]
		       (apply process-update extant extinct key-fn version-fn updates))]
     [(atom [{}{}]) update-fn])
   ])

(defn -getData [this]
  (let [[mutable-state] (.state this)
	[extant extinct] @mutable-state]
    (or (vals extant) '())))

(defn -update [#^AbstractModel this & inputs]
  ;;(debug "MODELIMPL -update:" this inputs)
  (let [[mutable-state update-fn] (.state this)
	;;dummy (debug "MODELIMPL INPUT:" inputs)
	[_ _ _ _ output-insertions output-alterations output-deletions]
	(apply swap! mutable-state update-fn inputs)
	;;dummy (debug "MODELIMPL OUTPUT:" output-insertions output-alterations output-deletions)
	]
    (apply
     (fn [#^Collection insertions #^Collection alterations #^Collection deletions]
	 (if (not (and (nil? insertions) (nil? alterations) (nil? deletions)))
	   (.notifyUpdate this insertions alterations deletions)))
     [output-insertions output-alterations output-deletions])))

(ns org.dada.core.ModelImpl
    (:import
     [java.util Collection LinkedHashMap]
     [org.dada.core AbstractModel Metadata Update]
     )
    (:gen-class
     :extends org.dada.core.AbstractModelView
     :constructors {[String org.dada.core.Metadata clojure.lang.IFn clojure.lang.IFn] [String org.dada.core.Metadata]}
     :methods []
     :init init
     :state state
     )
    )

(defn -init [#^String model-name #^Metadata tgt-metadata #^IFn key-fn #^IFn version-fn]

  [ ;; super ctor args
   [model-name tgt-metadata]
   ;; instance state
   (let [tgt-creator (.getCreator tgt-metadata)

	 process-addition
	 (fn [[extant extinct i a d] #^Update addition]
	     (let [new (.getNewValue addition)
		   key (key-fn new)
		   ;;dummy (println "PROCESS:" key new)
		   current (extant key)]
	       (if (nil? current)
		 (let [removed (extinct key)]
		   (if (nil? removed)
		     [(conj {key new} extant) extinct (cons (Update. nil new) i) a d] ;insertion
		     ;; TODO - not extant but extinct
		     )
		   )
		 ;; extant - alteration - TODO - check version
		 [(conj {key new} extant) extinct i (cons (Update. current new) a) d]
		 )))

	  process-deletion
	  (fn [[extant extinct i a d] #^Update addition]
	      ;; ensure row with key
	      ;; send insertion/alteration upstreamp
	      [extant extinct i a d])

	  process-update
	  (fn [extant extinct insertions alterations deletions]
	      (reduce process-deletion
		      (reduce process-addition
			      (reduce process-addition
				      [extant extinct '() '() '()]
				      insertions)
			      alterations)
		      deletions))

	 update-fn (fn [[extant extinct] & updates]
		       (apply process-update extant extinct updates))]
     [(atom [{}{}]) update-fn])
   ])

(defn -getData [#^org.dada.core.ModelImpl this]
  (let [[mutable-state] (.state this)
	[extant extinct] @mutable-state]
    (or (vals extant) '())))

(defn -update [#^org.dada.core.ModelImpl this & inputs]
  ;;(debug "MODELIMPL -update:" this inputs)
  (let [[mutable-state update-fn] (.state this)
	;;dummy (debug "MODELIMPL INPUT:" inputs)
	[_ _ output-insertions output-alterations output-deletions]
	(apply swap! mutable-state update-fn inputs)
	;;dummy (debug "MODELIMPL OUTPUT:" output-insertions output-alterations output-deletions)
	]
    (apply
     (fn [#^Collection insertions #^Collection alterations #^Collection deletions]
	 (if (not (and (nil? insertions) (nil? alterations) (nil? deletions)))
	   (.notifyUpdate this insertions alterations deletions)))
     [output-insertions output-alterations output-deletions])))

move aux fns within closure of ctor to avoid having to pass final vars around in param lists


(ns triboard.logic.turn
  (:require
    [cljs.spec :as s :include-macros true]
    [triboard.logic.constants :as cst]
    [triboard.logic.board :as board]
    [triboard.logic.move :as move]
    [triboard.logic.scores :as scores]
    ))

;; -----------------------------------------
;; Private
;; -----------------------------------------

(defn- with-available-moves
  "Add the available moves on the board"
  [{:keys [board] :as turn}]
  (assoc turn :moves (move/all-available-moves board)))

(defn- next-player
  [player]
  (case player
    :blue :red
    :red :green
    :green :blue))

(defn- next-3-players
  [player]
  (take 3 (iterate next-player (next-player player))))

(defn- with-next-player
  "Find the next player to act - dismiss those that cannot play any move"
  [{:keys [moves player] :as turn}]
  (let [who-can-play (filter #(get moves %) (next-3-players player))]
    (assoc turn :player (first who-can-play))
    ))

(defn- apply-moves
  [turn moves]
  (let [new-board (reduce move/apply-conversion (:board turn) moves)
        new-scores (reduce scores/update-scores (:scores turn) moves)]
    (-> turn
      (assoc :board new-board)
      (assoc :scores new-scores)
      )))

;; -----------------------------------------
;; Public API
;; -----------------------------------------

(s/def ::turn
  (s/keys :req-un
    [::board/board
     ::cst/player
     ::move/available-moves
     ::scores/scores]))

(defn new-init-turn []
  (-> {:board (board/new-board)
       :player (rand-nth cst/players)
       :moves {}
       :scores scores/initial-scores}
    with-available-moves
    with-next-player))

(defn get-player [turn] (:player turn))
(defn get-board [turn] (:board turn))
(defn get-scores [turn] (:scores turn))
(defn get-moves [turn] (:moves turn))

(defn get-moves-of
  "Access the available moves for the provided player, by coordinates"
  [turn player]
  (get (get-moves turn) player))

(s/fdef play-move
  :args (s/cat :turn ::turn :point ::board/coord)
  :ret ::turn)

(defn play-move
  "On player playing the move [x y] - update all the game state accordingly"
  [{:keys [player board] :as turn} point]
  (if-let [moves (get (get-moves-of turn player) point)]
    (-> turn
      (apply-moves (conj moves (move/empty-cell-conversion player point)))
      (with-available-moves)
      (with-next-player))
    turn))

(ns triboard.logic.turn
  (:require
    [cljs.spec :as s :include-macros true]
    [triboard.logic.constants :as cst]
    [triboard.logic.board :as board]
    [triboard.logic.move :as move]
    [triboard.logic.scores :as scores]
    ))

;; -----------------------------------------
;; Private
;; -----------------------------------------

(defn- with-available-moves
  "Add the available moves on the board"
  [{:keys [board] :as turn}]
  (assoc turn :moves (move/all-available-moves board)))

(defn- next-player
  [player]
  (case player
    :blue :red
    :red :green
    :green :blue))

(defn- next-3-players
  [player]
  (take 3 (iterate next-player (next-player player))))

(defn- with-next-player
  "Find the next player to act - dismiss those that cannot play any move"
  [{:keys [moves player] :as turn}]
  (let [who-can-play (filter #(get moves %) (next-3-players player))]
    (assoc turn :player (first who-can-play))
    ))

(defn- apply-moves
  [turn moves]
  (let [new-board (reduce move/apply-conversion (:board turn) moves)
        new-scores (reduce scores/update-scores (:scores turn) moves)]
    (-> turn
      (assoc :board new-board)
      (assoc :scores new-scores)
      )))

;; -----------------------------------------
;; Public API
;; -----------------------------------------

(s/def ::turn
  (s/keys :req-un
    [::board/board
     ::cst/player
     ::move/available-moves
     ::scores/scores]))

(defn new-init-turn []
  (-> {:board (board/new-board)
       :player (rand-nth cst/players)
       :moves {}
       :scores scores/initial-scores}
    with-available-moves
    with-next-player))

(defn get-player [turn] (:player turn))
(defn get-board [turn] (:board turn))
(defn get-scores [turn] (:scores turn))

(defn get-moves-of
  "Access the available moves for the provided player, by coordinates"
  [turn player]
  (get (get-moves turn) player))

(s/fdef play-move
  :args (s/cat :turn ::turn :point ::board/coord)
  :ret ::turn)

(defn play-move
  "On player playing the move [x y] - update all the game state accordingly"
  [{:keys [player board] :as turn} point]
  (if-let [moves (get (get-moves-of turn player) point)]
    (-> turn
      (apply-moves (conj moves (move/empty-cell-conversion player point)))
      (with-available-moves)
      (with-next-player))
    turn))

remove useless code

remove useless code


(ns clojournal.routes.article
  (:require [compojure.core :refer :all]
            [clojure.string :as str]
            [clojournal.layout :as layout]
            [clojournal.models.article :as article]
            [clojournal.models.author :as author]
            [noir.session :as session]))

(defn parse-content [content]
  (lazy-seq
    (let [[_ pre code post] (re-matches #"(?s)(?:(.*?)(?:```(.*?)```))?(.*)" content)]
      (cond (= post "") nil
            (nil? code) [[post nil]]
            :else (cons [pre code] (parse-content post))))))

(defn preprocess-content [content]
  (let [content (-> content
                    (str/replace "
" "")
                    (str/replace "
" "\n"))]
    (->> (for [[text code] (parse-content content)
               :let [text (-> text
                              (str/replace "\n" "")
                              (str/replace "
" "
\n
"))]]
           (if code
             (let [code (str/replace code " " " ")]
               (format "%s
\n
%s
\n
" text code))
             text))
         str/join
         (format "
%s
")
         ((fn [s] (str/replace s "

" ""))))))

(defn article-page [id]
  (when-let [article (article/find-article id)]
    (let [author (author/find-author (:author article))
          path (str "entry/" id)]
      (layout/render
        "article.html"
        {:page-title (str (:title article) " - clojournal")
         :page-description (:content article)
         :page-path path
         :author? (boolean (session/get :author))
         :title (:title article)
         :content (preprocess-content (:content article))
         :author (:name author)
         :tags (str/join ", " (:tags article))
         :path path
         :updated-at (:updated-at article)}))))

(defroutes article-routes
  (GET "/entry/:id" [id]
       (article-page id)))

(ns clojournal.routes.article
  (:require [compojure.core :refer :all]
            [clojure.string :as str]
            [clojournal.layout :as layout]
            [clojournal.models.article :as article]
            [clojournal.models.author :as author]
            [noir.session :as session]
            [clj-time.local :as local]))

(defn parse-content [content]
  (lazy-seq
    (let [[_ pre code post] (re-matches #"(?s)(?:(.*?)(?:```(.*?)```))?(.*)" content)]
      (cond (= post "") nil
            (nil? code) [[post nil]]
            :else (cons [pre code] (parse-content post))))))

(defn preprocess-content [content]
  (let [content (-> content
                    (str/replace "
" "")
                    (str/replace "
" "\n"))]
    (->> (for [[text code] (parse-content content)
               :let [text (-> text
                              (str/replace "\n" "")
                              (str/replace "
" "
\n
"))]]
           (if code
             (let [code (str/replace code " " " ")]
               (format "%s
\n
%s
\n
" text code))
             text))
         str/join
         (format "
%s
")
         ((fn [s] (str/replace s "

" ""))))))

(defn article-page [id]
  (when-let [article (article/find-article id)]
    (let [author (author/find-author (:author article))
          path (str "entry/" id)]
      (layout/render
        "article.html"
        {:page-title (str (:title article) " - clojournal")
         :page-description (:content article)
         :page-path path
         :author? (boolean (session/get :author))
         :title (:title article)
         :content (preprocess-content (:content article))
         :author (:name author)
         :tags (str/join ", " (:tags article))
         :path path
         :updated-at (local/to-local-date-time (:updated-at article))}))))

(defroutes article-routes
  (GET "/entry/:id" [id]
       (article-page id)))

Make update time displayed in appropriate time zone


(ns ^{:doc "Render the views for the application."}
  one.sample.view
  (:use [domina :only [set-html! set-styles! styles by-id set-style!
                       by-class value set-value! set-text! nodes single-node set-attr!]]
        [domina.xpath :only [xpath]]
        [one.browser.animation :only [play]]
        [one.logging :only [info, get-logger]]
        [goog.dom.selection :only [getStart setStart setEnd getEnd]])
  (:require-macros [one.sample.snippets :as snippets])
  (:require [goog.events.KeyCodes :as key-codes]
            [goog.events.KeyHandler :as key-handler]
            [clojure.browser.event :as event]
            [one.dispatch :as dispatch]
            [one.sample.animation :as fx]
            [one.sample.dvorak :as dvorak]))

(def ^{:doc "A map which contains chunks of HTML which may be used
  when rendering views."}
  snippets (snippets/snippets))

(defmulti render-button
  "Render the submit button based on the current state of the
  form. The button is disabled while the user is editing the form and
  becomes enabled when the form is complete."
  identity)

(defmethod render-button :default [_])

(defmulti render-form-field
  "Render a form field based on the current state transition. Form
  fields are validated as soon as they lose focus. There are six
  transitions and each one has its own animation."
  :transition)

(defmethod render-form-field :default [_])

(defn- label-xpath
  "Accepts an element id for an input field and return the xpath
  string to the label for that field."
  [id]
  (str "//label[@id='" id "-label']/span"))

(defmethod render-form-field [:empty :editing] [{:keys [id]}]
  (fx/label-move-up (label-xpath id)))

(defmethod render-form-field [:editing :empty] [{:keys [id]}]
  (fx/label-move-down (label-xpath id)))

(defmethod render-form-field [:valid :editing-valid] [{:keys [id]}]
  (play (label-xpath id) fx/fade-in))

(defmethod render-form-field [:editing :error] [{:keys [id error]}]
  (let [error-element (by-id (str id "-error"))]
    (set-style! error-element "opacity" "0")
    (set-html! error-element error)
    (play error-element fx/fade-in)))

(defn- swap-error-messages
  "Accepts an id and an error message and fades the old error message
  out and the new one in."
  [id error]
  (let [error-element (by-id (str id "-error"))]
    (play error-element fx/fade-out
             {:name "fade out error"})
    (play error-element fx/fade-in {:before #(set-html! error-element error)})))

(defmethod render-form-field [:error :editing-error] [{:keys [id error]}]
  (swap-error-messages id error))

(defmethod render-form-field [:editing-error :error] [{:keys [id error]}]
  (swap-error-messages id error))

(defmethod render-form-field [:editing-error :editing-valid] [{:keys [id]}]
  (let [error-element (by-id (str id "-error"))]
    (play error-element (assoc fx/fade-out :time 200))))

(defmethod render-form-field [:editing-error :empty] [{:keys [id]}]
  (let [error-element (by-id (str id "-error"))]
    (play error-element (assoc fx/fade-out :time 200))
    (fx/label-move-down (label-xpath id))))

(defn- add-input-event-listeners
  "Accepts a field-id and creates listeners for blur and focus events which will then fire
  `:field-changed` and `:editing-field` events."
  [field-id]
  (let [field (by-id field-id)
        keyboard (goog.events.KeyHandler. (by-id "form"))]
    (event/listen field
                  "blur"
                  #(dispatch/fire [:field-finished field-id] (value field)))
    (event/listen field
                  "focus"
                  #(dispatch/fire [:editing-field field-id]))
    (event/listen field
                  "keyup"
                  #(dispatch/fire [:field-changed field-id] (value field)))))

(defmulti render
  "Accepts a map which represents the current state of the application
  and renders a view based on the value of the `:state` key."
  :state)

(defn relevant-keypress-event
  [event]
  (not (or (.-ctrlKey event)
           (.-metaKey event)
           (= (.-keyCode event) key-codes/BACKSPACE)
           (= (.-keyCode event) key-codes/TAB)
           (= (.-keyCode event) key-codes/ENTER)
           (not (key-codes/isTextModifyingKeyEvent event)))))

(defn translate-keypress-event
  [text-box event]
  (let [start (getStart text-box)
        end (count (value text-box))
        prefix (apply str (take start (value text-box)))
        suffix (apply str (take-last (- end (getEnd text-box)) (value text-box)))]
    (set-value! (single-node text-box)
                (clojure.string/join [prefix
                                      (dvorak/simulate-dvorak (.fromCharCode js/String (.-charCode event)))
                                      suffix]))
    (setStart text-box (+ start 1))
    (setEnd text-box (+ start 1)))
  )

(defmethod render :init [_]
  (fx/initialize-views (:form snippets) (:greeting snippets))
  (add-input-event-listeners "text-input")

  (one.logging/start-display (one.logging/console-output))

  (set-value! (by-id "text-input") "The quick brown fox jumped over the lazy dog.")
  (dispatch/fire [:field-changed "text-input"] (value (by-id "text-input")))

  (let [text-box (by-id "text-dvorak-input")]
      (event/listen (goog.events.KeyHandler. text-box)
                    "key"
                    (fn [e]
                      (when (relevant-keypress-event e)
                        (translate-keypress-event text-box e)
                        (dispatch/fire :dvorak-input {
                                                      :charcode (.-charCode e)
                                                      :region-start (getStart text-box)
                                                      :region-end (getEnd text-box)
                                                      :target text-box
                                                      })
                        (.preventDefault e))))))

(defmethod render :form [{:keys [state error name]}]
  (fx/show-form)
  (set-value! (by-id "text-input") "")
  (dispatch/fire [:field-finished "text-input"] ""))

(defmethod render :greeting [{:keys [state name exists]}]
  (set-text! (single-node (by-class "name")) name)
  (set-text! (single-node (by-class "again")) (if exists "again" ""))
  (fx/show-greeting))

(dispatch/react-to #{:state-change} (fn [_ m] (render m)))

(defn- form-fields-status
  "Given a map of old and new form states, generate a map with `:id`,
  `:transition` and `:error` keys which can be passed to
  `render-form-field`."
  [m]
  (map #(hash-map :id %
                  :transition [(or (get-in m [:old :fields % :status]) :empty)
                               (get-in m [:new :fields % :status])]
                  :error (get-in m [:new :fields % :error]))
       (keys (get-in m [:new :fields]))))

(dispatch/react-to #{:form-change}
                   (fn [_ m]
                     (doseq [s (form-fields-status m)]
                       (render-form-field s))
                     (set-value! (single-node (by-id "text-output")) (get-in m [:new :dvorak-string]))
                     (render-button [(get-in m [:old :status])
                                     (get-in m [:new :status])] )))

(ns ^{:doc "Render the views for the application."}
  one.sample.view
  (:use [domina :only [set-html! set-styles! styles by-id set-style!
                       by-class value set-value! set-text! nodes single-node set-attr!]]
        [domina.xpath :only [xpath]]
        [one.browser.animation :only [play]]
        [one.logging :only [info, get-logger]]
        [goog.dom.selection :only [getStart setStart setEnd getEnd]])
  (:require-macros [one.sample.snippets :as snippets])
  (:require [goog.events.KeyCodes :as key-codes]
            [goog.events.KeyHandler :as key-handler]
            [clojure.browser.event :as event]
            [one.dispatch :as dispatch]
            [one.sample.animation :as fx]
            [one.sample.dvorak :as dvorak]))

(def ^{:doc "A map which contains chunks of HTML which may be used
  when rendering views."}
  snippets (snippets/snippets))

(defmulti render-button
  "Render the submit button based on the current state of the
  form. The button is disabled while the user is editing the form and
  becomes enabled when the form is complete."
  identity)

(defmethod render-button :default [_])

(defmulti render-form-field
  "Render a form field based on the current state transition. Form
  fields are validated as soon as they lose focus. There are six
  transitions and each one has its own animation."
  :transition)

(defmethod render-form-field :default [_])

(defn- label-xpath
  "Accepts an element id for an input field and return the xpath
  string to the label for that field."
  [id]
  (str "//label[@id='" id "-label']/span"))

(defmethod render-form-field [:empty :editing] [{:keys [id]}]
  (fx/label-move-up (label-xpath id)))

(defmethod render-form-field [:editing :empty] [{:keys [id]}]
  (fx/label-move-down (label-xpath id)))

(defmethod render-form-field [:valid :editing-valid] [{:keys [id]}]
  (play (label-xpath id) fx/fade-in))

(defmethod render-form-field [:editing :error] [{:keys [id error]}]
  (let [error-element (by-id (str id "-error"))]
    (set-style! error-element "opacity" "0")
    (set-html! error-element error)
    (play error-element fx/fade-in)))

(defn- swap-error-messages
  "Accepts an id and an error message and fades the old error message
  out and the new one in."
  [id error]
  (let [error-element (by-id (str id "-error"))]
    (play error-element fx/fade-out
             {:name "fade out error"})
    (play error-element fx/fade-in {:before #(set-html! error-element error)})))

(defmethod render-form-field [:error :editing-error] [{:keys [id error]}]
  (swap-error-messages id error))

(defmethod render-form-field [:editing-error :error] [{:keys [id error]}]
  (swap-error-messages id error))

(defmethod render-form-field [:editing-error :editing-valid] [{:keys [id]}]
  (let [error-element (by-id (str id "-error"))]
    (play error-element (assoc fx/fade-out :time 200))))

(defmethod render-form-field [:editing-error :empty] [{:keys [id]}]
  (let [error-element (by-id (str id "-error"))]
    (play error-element (assoc fx/fade-out :time 200))
    (fx/label-move-down (label-xpath id))))

(defn- add-input-event-listeners
  "Accepts a field-id and creates listeners for blur and focus events which will then fire
  `:field-changed` and `:editing-field` events."
  [field-id]
  (let [field (by-id field-id)
        keyboard (goog.events.KeyHandler. (by-id "form"))]
    (event/listen field
                  "blur"
                  #(dispatch/fire [:field-finished field-id] (value field)))
    (event/listen field
                  "focus"
                  #(dispatch/fire [:editing-field field-id]))
    (event/listen field
                  "keyup"
                  #(dispatch/fire [:field-changed field-id] (value field)))))

(defmulti render
  "Accepts a map which represents the current state of the application
  and renders a view based on the value of the `:state` key."
  :state)

(defn relevant-keypress-event
  [event]
  (not (or (.-ctrlKey event)
           (.-metaKey event)
           (= (.-keyCode event) key-codes/BACKSPACE)
           (= (.-keyCode event) key-codes/TAB)
           (= (.-keyCode event) key-codes/ENTER)
           (not (key-codes/isTextModifyingKeyEvent event)))))

(defn translate-keypress-event
  [text-box event]
  (let [start (getStart text-box)
        end (count (value text-box))
        prefix (apply str (take start (value text-box)))
        suffix (apply str (take-last (- end (getEnd text-box)) (value text-box)))]
    (set-value! (single-node text-box)
                (clojure.string/join [prefix
                                      (dvorak/simulate-dvorak (.fromCharCode js/String (.-charCode event)))
                                      suffix]))
    (setStart text-box (+ start 1))
    (setEnd text-box (+ start 1)))
  )

(defmethod render :init [_]
  (fx/initialize-views (:form snippets) (:greeting snippets))
  (add-input-event-listeners "text-input")

  (one.logging/start-display (one.logging/console-output))

  (set-value! (by-id "text-input") (rand-nth [
                                              "The quick brown fox jumped over the lazy dog.",
                                              "Hello, world!",
                                              "Live long and prosper.",
                                              "Hey, I just met you,\nAnd this is crazy, \nBut here's my number, \nSo call me, maybe?",
                                              "Elementary, my dear Watson.",
                                              "Toto, I've got a feeling we're not in Kansas anymore.",
                                              "Release the kraken!",
                                              "I'll make him an offer he can't refuse.",
                                              "May the Force be with you.",
                                              "Houston, we have a problem."
                                              ]))
  (dispatch/fire [:field-changed "text-input"] (value (by-id "text-input")))

  (let [text-box (by-id "text-dvorak-input")]
      (event/listen (goog.events.KeyHandler. text-box)
                    "key"
                    (fn [e]
                      (when (relevant-keypress-event e)
                        (translate-keypress-event text-box e)
                        (dispatch/fire :dvorak-input {
                                                      :charcode (.-charCode e)
                                                      :region-start (getStart text-box)
                                                      :region-end (getEnd text-box)
                                                      :target text-box
                                                      })
                        (.preventDefault e))))))

(defmethod render :form [{:keys [state error name]}]
  (fx/show-form)
  (set-value! (by-id "text-input") "")
  (dispatch/fire [:field-finished "text-input"] ""))

(defmethod render :greeting [{:keys [state name exists]}]
  (set-text! (single-node (by-class "name")) name)
  (set-text! (single-node (by-class "again")) (if exists "again" ""))
  (fx/show-greeting))

(dispatch/react-to #{:state-change} (fn [_ m] (render m)))

(defn- form-fields-status
  "Given a map of old and new form states, generate a map with `:id`,
  `:transition` and `:error` keys which can be passed to
  `render-form-field`."
  [m]
  (map #(hash-map :id %
                  :transition [(or (get-in m [:old :fields % :status]) :empty)
                               (get-in m [:new :fields % :status])]
                  :error (get-in m [:new :fields % :error]))
       (keys (get-in m [:new :fields]))))

(dispatch/react-to #{:form-change}
                   (fn [_ m]
                     (doseq [s (form-fields-status m)]
                       (render-form-field s))
                     (set-value! (single-node (by-id "text-output")) (get-in m [:new :dvorak-string]))
                     (render-button [(get-in m [:old :status])
                                     (get-in m [:new :status])] )))

Add random starting sample text.

Add random starting sample text.


(ns brainbot.nozzle.inihelper
  (:require [com.brainbot.iniconfig :as ini])
  (:require [langohr.core :as rmq])
  (:require [brainbot.nozzle.dynaload :as dynaload]
            [brainbot.nozzle.misc :as misc]))

(def main-section-name "nozzle")

(defn get-filesystems-from-iniconfig
  [iniconfig section]
  (misc/trimmed-lines-from-string
   (or (get-in iniconfig [section "filesystems"])
       (get-in iniconfig [main-section-name "filesystems"]))))

(def default-ini-config
  (-> "META-INF/brainbot.nozzle/default-config.ini"
      clojure.java.io/resource
      ini/read-ini))

(defn rmq-settings-from-config
  [iniconfig]
  (rmq/settings-from (get-in iniconfig [main-section-name "amqp-url"])))

(defn merge-with-default-config
  "merge cfg with default-ini-config, keep cfg's metadata"
  [cfg]
  (with-meta
    (merge default-ini-config cfg)
    (meta cfg)))

(defn read-ini-with-defaults
  [inifile]
  (-> inifile ini/read-ini merge-with-default-config))

(defprotocol IniConstructor
  (make-object-from-section [this system section-name]))

(def registry
  (atom
   {"file" 'brainbot.nozzle.real-fs
    "smbfs" 'brainbot.nozzle.smb-fs

    "fsworker" 'brainbot.nozzle.fsworker/runner
    "meta" 'brainbot.nozzle.meta-runner/runner
    "extract" 'brainbot.nozzle.extract2/runner
    "esconnect" 'brainbot.nozzle.esconnect/runner
    "manage" 'brainbot.nozzle.manage/runner

    "dotfile" 'brainbot.nozzle.fsfilter/dotfile
    "extensions" 'brainbot.nozzle.fsfilter/extensions-filter-constructor}))

(defn dynaload-section
  [system section-name]

  (let [iniconfig (:iniconfig system)
        type (get-in iniconfig [section-name "type"])]
    (when-not type
      (throw (ex-info (format "no type defined in section %s" section-name) {})))

    (let [loadable (dynaload/get-loadable (@registry type type))]
      (when-not (satisfies? IniConstructor loadable)
        (throw (ex-info "bad loadable" {:section-name section-name :type type})))
      (with-meta
        (make-object-from-section loadable system section-name)
        {:type type
         :section-name section-name}))))

(defn ensure-protocol
  [protocol x]
  (when-not (satisfies? protocol x)
    (throw (ex-info
            (format "wrong type in section %s, expected %s, got %s"
                    (:section-name (meta x))
                    (:on-interface protocol)
                    (class x))
            {:obj x})))
  x)

(ns brainbot.nozzle.inihelper
  (:require [com.brainbot.iniconfig :as ini])
  (:require [langohr.core :as rmq])
  (:require [brainbot.nozzle.dynaload :as dynaload]
            [brainbot.nozzle.misc :as misc]))

(def main-section-name "nozzle")

(defn get-filesystems-from-iniconfig
  [iniconfig section]
  (misc/trimmed-lines-from-string
   (or (get-in iniconfig [section "filesystems"])
       (get-in iniconfig [main-section-name "filesystems"]))))

(def default-ini-config
  (-> "META-INF/brainbot.nozzle/default-config.ini"
      clojure.java.io/resource
      ini/read-ini))

(defn rmq-settings-from-config
  [iniconfig]
  (rmq/settings-from (get-in iniconfig [main-section-name "amqp-url"])))

(defn merge-with-default-config
  "merge cfg with default-ini-config, keep cfg's metadata"
  [cfg]
  (with-meta
    (merge default-ini-config cfg)
    (meta cfg)))

(defn read-ini-with-defaults
  [inifile]
  (-> inifile ini/read-ini merge-with-default-config))

(defprotocol IniConstructor
  (make-object-from-section [this system section-name]))

(def registry
  (atom
   {"file" 'brainbot.nozzle.real-fs
    "smbfs" 'brainbot.nozzle.smb-fs

    "fsworker" 'brainbot.nozzle.fsworker/runner
    "meta" 'brainbot.nozzle.meta-runner/runner
    "extract" 'brainbot.nozzle.extract2/runner
    "esconnect" 'brainbot.nozzle.esconnect/runner
    "manage" 'brainbot.nozzle.manage/runner

    "dotfile" 'brainbot.nozzle.fsfilter/dotfile
    "extensions" 'brainbot.nozzle.fsfilter/extensions-filter-constructor}))

(defn dynaload-section
  [system section-name]

  (let [iniconfig (:iniconfig system)
        type (get-in iniconfig [section-name "type"])]
    (when-not (contains? iniconfig section-name)
      (throw (ex-info (format "no section %s declared" section-name)
                      {})))
    (when-not type
      (throw (ex-info (format "no type defined in section %s" section-name) {})))

    (let [loadable (dynaload/get-loadable (@registry type type))]
      (when-not (satisfies? IniConstructor loadable)
        (throw (ex-info "bad loadable" {:section-name section-name :type type})))
      (with-meta
        (make-object-from-section loadable system section-name)
        {:type type
         :section-name section-name}))))

(defn ensure-protocol
  [protocol x]
  (when-not (satisfies? protocol x)
    (throw (ex-info
            (format "wrong type in section %s, expected %s, got %s"
                    (:section-name (meta x))
                    (:on-interface protocol)
                    (class x))
            {:obj x})))
  x)

throw error when section is missing

throw error when section is missing


(ns nightcode.sandbox
  (:require [clojure.java.io :as io]
            [nightcode.utils :as utils]))

; filesystem

(defn get-dir
  []
  (System/getProperty "SandboxDirectory"))

(defn get-path
  [& dirs]
  (.getCanonicalPath (apply io/file (System/getProperty "user.home") dirs)))

(defn add-dir
  [args]
  (if-let [dir (get-dir)]
    (concat [(first args) (str "-DSandboxDirectory=" dir)] (rest args))
    args))

(defn get-env
  []
  (let [path (get-path ".lein")]
    (when (get-dir)
      (into-array String [(str "LEIN_HOME=" path)]))))

(defn set-home!
  []
  (some->> (get-dir) get-path (System/setProperty "user.home")))

(defn set-temp-dir!
  []
  (let [dir (get-path ".temp")]
    (when (get-dir)
      (-> dir io/file .mkdir)
      (System/setProperty "java.io.tmpdir" dir))))

(defn create-profiles-clj!
  []
  (let [profiles-clj (get-path ".lein" "profiles.clj")
        m2 (get-path ".m2")
        tmp (get-path ".temp")
        jvm-opts (str "-Djava.io.tmpdir=" tmp)
        content {:user {:local-repo m2
                        :jvm-opts [jvm-opts]
                        :gwt {:extraJvmArgs jvm-opts}}}]
    (when (get-dir)
      (doto (io/file profiles-clj)
        (-> .getParentFile .mkdir)
        (spit (pr-str content))))))

; objc

(defn get-objc-client
  []
  (some-> (try (Class/forName "ca.weblite.objc.Client")
            (catch Exception _))
          (.getMethod "getInstance" (into-array Class []))
          (.invoke nil (object-array []))))

(defn base64->nsdata
  [text]
  (some-> (get-objc-client)
          (.sendProxy "NSData" "data" (object-array []))
          (.send "initWithBase64Encoding:" (object-array [text]))))

(defn write-file-permission!
  [path]
  (some-> (get-objc-client)
          (.sendProxy "NSURL" "fileURLWithPath:" (object-array [path]))
          (.sendProxy "bookmarkDataWithOptions:includingResourceValuesForKeys:relativeToURL:error:"
            (object-array [2048 nil nil nil]))
          (.sendString "base64Encoding" (object-array []))))

(defn read-file-permission!
  [text]
  (some-> (get-objc-client)
          (.sendProxy "NSURL" "URLByResolvingBookmarkData:options:relativeToURL:bookmarkDataIsStale:error:"
            (object-array [(base64->nsdata text) 1024 nil false nil]))
          (.send "startAccessingSecurityScopedResource" (object-array []))))

(defn read-file-permissions!
  []
  (doseq [[path text] (utils/read-pref :permission-map)]
    (read-file-permission! text)))

(defn add-to-permission-map!
  [path]
  (some->> (write-file-permission! path)
           (assoc (utils/read-pref :permission-map) path)
           (utils/write-pref! :permission-map)))

(defn remove-from-permission-map!
  [path]
  (some->> (dissoc (utils/read-pref :permission-map) path)
           (utils/write-pref! :permission-map)))

(defn update-permission-map!
  [k path]
  (some-> (utils/read-pref k)
          remove-from-permission-map!)
  (add-to-permission-map! path))

(ns nightcode.sandbox
  (:require [clojure.java.io :as io]
            [nightcode.utils :as utils]))

; filesystem

(defn get-dir
  []
  (System/getProperty "SandboxDirectory"))

(defn get-path
  [& dirs]
  (.getCanonicalPath (apply io/file (System/getProperty "user.home") dirs)))

(defn add-dir
  [args]
  (if-let [dir (get-dir)]
    (concat [(first args) (str "-DSandboxDirectory=" dir)] (rest args))
    args))

(defn get-env
  []
  (when (get-dir)
    (let [path (get-path ".lein")]
      (into-array String [(str "LEIN_HOME=" path)]))))

(defn set-home!
  []
  (some->> (get-dir) get-path (System/setProperty "user.home")))

(defn set-temp-dir!
  []
  (when (get-dir)
    (let [dir (get-path ".temp")]
      (-> dir io/file .mkdir)
      (System/setProperty "java.io.tmpdir" dir))))

(defn create-profiles-clj!
  []
  (when (get-dir)
    (let [profiles-clj (get-path ".lein" "profiles.clj")
          m2 (get-path ".m2")
          tmp (get-path ".temp")
          jvm-opts (str "-Djava.io.tmpdir=" tmp)
          content {:user {:local-repo m2
                          :jvm-opts [jvm-opts]
                          :gwt {:extraJvmArgs jvm-opts}}}]
      (doto (io/file profiles-clj)
        (-> .getParentFile .mkdir)
        (spit (pr-str content))))))

; objc

(defn get-objc-client
  []
  (some-> (try (Class/forName "ca.weblite.objc.Client")
            (catch Exception _))
          (.getMethod "getInstance" (into-array Class []))
          (.invoke nil (object-array []))))

(defn base64->nsdata
  [text]
  (some-> (get-objc-client)
          (.sendProxy "NSData" "data" (object-array []))
          (.send "initWithBase64Encoding:" (object-array [text]))))

(defn write-file-permission!
  [path]
  (some-> (get-objc-client)
          (.sendProxy "NSURL" "fileURLWithPath:" (object-array [path]))
          (.sendProxy "bookmarkDataWithOptions:includingResourceValuesForKeys:relativeToURL:error:"
            (object-array [2048 nil nil nil]))
          (.sendString "base64Encoding" (object-array []))))

(defn read-file-permission!
  [text]
  (some-> (get-objc-client)
          (.sendProxy "NSURL" "URLByResolvingBookmarkData:options:relativeToURL:bookmarkDataIsStale:error:"
            (object-array [(base64->nsdata text) 1024 nil false nil]))
          (.send "startAccessingSecurityScopedResource" (object-array []))))

(defn read-file-permissions!
  []
  (doseq [[path text] (utils/read-pref :permission-map)]
    (read-file-permission! text)))

(defn add-to-permission-map!
  [path]
  (some->> (write-file-permission! path)
           (assoc (utils/read-pref :permission-map) path)
           (utils/write-pref! :permission-map)))

(defn remove-from-permission-map!
  [path]
  (some->> (dissoc (utils/read-pref :permission-map) path)
           (utils/write-pref! :permission-map)))

(defn update-permission-map!
  [k path]
  (some-> (utils/read-pref k)
          remove-from-permission-map!)
  (add-to-permission-map! path))

Clean up sandbox code

Clean up sandbox code


(ns analyze-data.corpus-to-tf-idf
  (:require [clojure.data.csv :as csv]
            [clojure.java.io :as io]
            [analyze-data.tf-idf.core :refer [to-terms tf-idf]]))

(defn csv-to-map
  "Given an io/reader of a csv file, return a lazy sequence of maps from csv
  header to data."
  [reader]
  (let [csv-file (csv/read-csv reader)
        header-row (first csv-file)
        data (rest csv-file)]
    (map #(zipmap header-row %) data)))

(defn write-sequence!
  "Write each item in sequence s as a line of edn to file-path. Uses doseq
  such that if s is lazy only a small number of items in s will reside in
  memory at a time."
  [s file-path]
  (with-open [out (io/writer file-path)]
    (doseq [line s]
      (.write out (prn-str line)))))

(defn corpus-to-tf-idf-data
  "Transform a corpus of documents into a sequence of tf-idf vectors.

  corpus: a sequence of maps containing keys 'item-name' and 'item-text',
          where 'item-name' is a unique identifier and 'item-text' is a
          document

  Return a lazy sequence of the following form:
  [['item-name' term1        term2        ...]
   [item-name1  term1-tf-idf term2-tf-idf ...]
   [item-name2  term1-tf-idf term2-tf-idf ...]
   ...]"
  [corpus]
  (let [document-names (map #(% "item-name") corpus)
        document-texts (map #(% "item-text") corpus)
        tf-idf-corpus (tf-idf (map to-terms document-texts))
        header-row (cons "item-name" (first tf-idf-corpus))
        data (map #(cons %1 %2) document-names (rest tf-idf-corpus))]
        (cons header-row data)))

(defn csv-corpus-to-tf-idf-data!
  "Transform a csv containing a corpus of documents into a file of tf-idf
  vectors.

  in-path: path to a csv file. It should contain the headers 'item-name' and
           'item-text', with values as described in corpus-to-tf-idf-data.
  out-path: path where the tf-idf vectors should be written. Each line of the
            output file will be an edn list, and each will correspond to an
            entry from the return value of corpus-to-tf-idf-data."
  [in-path out-path]
  (with-open [in (io/reader in-path)]
    (let [corpus (csv-to-map in)
          tf-idf-data (corpus-to-tf-idf-data corpus)]
      (write-sequence! tf-idf-data out-path))))

(ns analyze-data.corpus-to-tf-idf
  (:require [clojure.data.csv :as csv]
            [clojure.java.io :as io]
            [analyze-data.tf-idf.core :refer [to-terms tf-idf]]))

(defn csv-to-map
  "Given an io/reader of a csv file, return a lazy sequence of maps from csv
  header to data."
  [reader]
  (let [csv-file (csv/read-csv reader)
        header-row (first csv-file)
        data (rest csv-file)]
    (map #(zipmap header-row %) data)))

(defn write-sequence!
  "Write each item in sequence s as a line of edn to file-path. Uses doseq
  such that if s is lazy only a small number of items in s will reside in
  memory at a time."
  [s file-path]
  (with-open [out (io/writer file-path)]
    (binding [*out* out]
      (doseq [line s] (prn line)))))

(defn corpus-to-tf-idf-data
  "Transform a corpus of documents into a sequence of tf-idf vectors.

  corpus: a sequence of maps containing keys 'item-name' and 'item-text',
          where 'item-name' is a unique identifier and 'item-text' is a
          document

  Return a lazy sequence of the following form:
  [['item-name' term1        term2        ...]
   [item-name1  term1-tf-idf term2-tf-idf ...]
   [item-name2  term1-tf-idf term2-tf-idf ...]
   ...]"
  [corpus]
  (let [document-names (map #(% "item-name") corpus)
        document-texts (map #(% "item-text") corpus)
        tf-idf-corpus (tf-idf (map to-terms document-texts))
        header-row (cons "item-name" (first tf-idf-corpus))
        data (map #(cons %1 %2) document-names (rest tf-idf-corpus))]
        (cons header-row data)))

(defn csv-corpus-to-tf-idf-data!
  "Transform a csv containing a corpus of documents into a file of tf-idf
  vectors.

  in-path: path to a csv file. It should contain the headers 'item-name' and
           'item-text', with values as described in corpus-to-tf-idf-data.
  out-path: path where the tf-idf vectors should be written. Each line of the
            output file will be an edn list, and each will correspond to an
            entry from the return value of corpus-to-tf-idf-data."
  [in-path out-path]
  (with-open [in (io/reader in-path)]
    (let [corpus (csv-to-map in)
          tf-idf-data (corpus-to-tf-idf-data corpus)]
      (write-sequence! tf-idf-data out-path))))

Use binding so we write directly to the file instead of creating an intermediary string.


(ns docker-clojure.dockerfile
  (:require
   [clojure.java.shell :refer [sh]]
   [clojure.string :as str]
   [docker-clojure.dockerfile.boot :as boot]
   [docker-clojure.dockerfile.lein :as lein]
   [docker-clojure.dockerfile.tools-deps :as tools-deps]
   [docker-clojure.dockerfile.shared :refer :all]))

(defn build-dir [{:keys [base-image build-tool]}]
  (str/join "/" ["target"
                 (str/replace base-image ":" "-")
                 (if (= :docker-clojure.core/all build-tool)
                   "latest"
                   build-tool)]))

(defn all-prereqs [dir variant]
  (tools-deps/prereqs dir variant))

(defn all-contents [installer-hashes variant]
  (concat
    ["### INSTALL BOOT ###"]
    (boot/install
      installer-hashes
      (assoc variant :build-tool-version
             (get-in variant [:build-tool-versions "boot"])))
    ["" "### INSTALL LEIN ###"]
    (lein/install
      installer-hashes
      (assoc variant :build-tool-version
             (get-in variant [:build-tool-versions "lein"])))
    ["" "### INSTALL TOOLS-DEPS ###"]
    (tools-deps/install
      installer-hashes
     (assoc variant :build-tool-version
            (get-in variant [:build-tool-versions "tools-deps"])))
    [""]
    (entrypoint variant)
    ["" "CMD [\"repl\"]"]))

(defn contents [installer-hashes {:keys [build-tool] :as variant}]
  (str/join "\n"
            (concat [(format "FROM %s" (:base-image variant))
                     ""]
                    (case build-tool
                      :docker-clojure.core/all (all-contents installer-hashes variant)
                      "boot" (boot/contents installer-hashes variant)
                      "lein" (lein/contents installer-hashes variant)
                      "tools-deps" (tools-deps/contents installer-hashes variant)))))

(defn shared-prereqs [dir {:keys [build-tool]}]
  (let [entrypoint (case build-tool
                     "tools-deps"             "clj"
                     :docker-clojure.core/all "lein"
                     build-tool)]
    (copy-resource-file dir "entrypoint"
                        #(str/replace % "@@entrypoint@@" entrypoint))))

(defn do-prereqs [dir {:keys [build-tool] :as variant}]
  (shared-prereqs dir variant)
  (case build-tool
    :docker-clojure.core/all (all-prereqs dir variant)
    "boot" (boot/prereqs dir variant)
    "lein" (lein/prereqs dir variant)
    "tools-deps" (tools-deps/prereqs dir variant)))

(defn write-file [dir file installer-hashes variant]
  (let [{:keys [exit err]} (sh "mkdir" "-p" dir)]
    (if (zero? exit)
      (do
        (do-prereqs dir variant)
        (spit (str/join "/" [dir file])
              (str (contents installer-hashes variant) "\n")))
      (throw (ex-info (str "Error creating directory " dir)
                      {:error err})))))

(defn clean-all []
  (sh "sh" "-c" "rm -rf target/*"))

(ns docker-clojure.dockerfile
  (:require
   [clojure.java.shell :refer [sh]]
   [clojure.string :as str]
   [docker-clojure.dockerfile.boot :as boot]
   [docker-clojure.dockerfile.lein :as lein]
   [docker-clojure.dockerfile.tools-deps :as tools-deps]
   [docker-clojure.dockerfile.shared :refer :all]))

(defn build-dir [{:keys [base-image build-tool]}]
  (str/join "/" ["target"
                 (str/replace base-image ":" "-")
                 (if (= :docker-clojure.core/all build-tool)
                   "latest"
                   build-tool)]))

(defn all-prereqs [dir variant]
  (tools-deps/prereqs dir variant))

(defn all-contents [installer-hashes variant]
  (concat
    ["### INSTALL BOOT ###"]
    (boot/install
      installer-hashes
      (assoc variant :build-tool-version
             (get-in variant [:build-tool-versions "boot"])))
    ["" "### INSTALL LEIN ###"]
    (lein/install
      installer-hashes
      (assoc variant :build-tool-version
             (get-in variant [:build-tool-versions "lein"])))
    ["" "### INSTALL TOOLS-DEPS ###"]
    (tools-deps/install
      installer-hashes
     (assoc variant :build-tool-version
            (get-in variant [:build-tool-versions "tools-deps"])))
    [""]
    (entrypoint variant)
    ["" "CMD [\"repl\"]"]))

(defn contents [installer-hashes {:keys [build-tool] :as variant}]
  (str/join "\n"
            (concat [(format "FROM %s" (:base-image variant))
                     ""]
                    (case build-tool
                      :docker-clojure.core/all (all-contents installer-hashes variant)
                      "boot" (boot/contents installer-hashes variant)
                      "lein" (lein/contents installer-hashes variant)
                      "tools-deps" (tools-deps/contents installer-hashes variant)))))

(defn shared-prereqs [dir {:keys [build-tool]}]
  (let [entrypoint (case build-tool
                     "tools-deps"             "clj"
                     :docker-clojure.core/all "clj"
                     build-tool)]
    (copy-resource-file dir "entrypoint"
                        #(str/replace % "@@entrypoint@@" entrypoint))))

(defn do-prereqs [dir {:keys [build-tool] :as variant}]
  (shared-prereqs dir variant)
  (case build-tool
    :docker-clojure.core/all (all-prereqs dir variant)
    "boot" (boot/prereqs dir variant)
    "lein" (lein/prereqs dir variant)
    "tools-deps" (tools-deps/prereqs dir variant)))

(defn write-file [dir file installer-hashes variant]
  (let [{:keys [exit err]} (sh "mkdir" "-p" dir)]
    (if (zero? exit)
      (do
        (do-prereqs dir variant)
        (spit (str/join "/" [dir file])
              (str (contents installer-hashes variant) "\n")))
      (throw (ex-info (str "Error creating directory " dir)
                      {:error err})))))

(defn clean-all []
  (sh "sh" "-c" "rm -rf target/*"))

Use clj as latest entrypoint instead of lein


(ns leiningen.new.onyx-app
  (:require [leiningen.new.templates :refer [renderer name-to-path ->files]]
            [leiningen.core.main :as main]))

(def render (renderer "onyx_app"))

(defn onyx-app
  "Creates a new Onyx application template"
  [name]
  (let [path (name-to-path name)
        data {:name name
              :app-name name
              :sanitized path}]
    (main/info "Generating fresh 'lein new' onyx project.")
    (->files data
             ["README.md" (render "README.md" {})]
             [".gitignore" (render "gitignore" data)]
             ["LICENSE" (render "LICENSE" data)]
             ["project.clj" (render "project.clj" data)]

             ["env/dev/user.clj" (render "user.clj" data)]

             ["resources/env-config.edn" (render "env-config.edn" data)]
             ["resources/dev-peer-config.edn" (render "dev-peer-config.edn" data)]
             ["resources/prod-peer-config.edn" (render "prod-peer-config.edn" data)]

             [(str "src/" path "/launcher/launch_prod_peers.clj") (render "launch_prod_peers.clj" data)]
             [(str "src/" path "/launcher/submit_prod_sample_job.clj") (render "submit_prod_sample_job.clj" data)]

             [(str "src/" path "/workflows/sample_workflow.clj") (render "sample_workflow.clj" data)]
             [(str "src/" path "/catalogs/sample_catalog.clj") (render "sample_catalog.clj" data)]
             [(str "src/" path "/flow_conditions/sample_flow_conditions.clj") (render "sample_flow_conditions.clj" data)]
             [(str "src/" path "/functions/sample_functions.clj") (render "sample_functions.clj" data)]
             [(str "src/" path "/lifecycles/sample_lifecycle.clj") (render "sample_lifecycle.clj" data)]
             [(str "src/" path "/dev_inputs/sample_input.clj") (render "sample_input.clj" data)]

             [(str "test/" path "/jobs/sample_job_test.clj") (render "sample_job_test.clj" data)])))

(ns leiningen.new.onyx-app
  (:require [leiningen.new.templates :refer [renderer name-to-path ->files]]
            [leiningen.core.main :as main]))

(def render (renderer "onyx_app"))

(defn onyx-app
  "Creates a new Onyx application template"
  [name]
  (let [path (name-to-path name)
        data {:name name
              :app-name name
              :sanitized path}]
    (main/info "Generating fresh 'lein new' onyx project.")
    (->files data
             ["README.md" (render "README.md" data)]
             [".gitignore" (render "gitignore" data)]
             ["LICENSE" (render "LICENSE" data)]
             ["project.clj" (render "project.clj" data)]

             ["env/dev/user.clj" (render "user.clj" data)]

             ["resources/env-config.edn" (render "env-config.edn" data)]
             ["resources/dev-peer-config.edn" (render "dev-peer-config.edn" data)]
             ["resources/prod-peer-config.edn" (render "prod-peer-config.edn" data)]

             [(str "src/" path "/launcher/launch_prod_peers.clj") (render "launch_prod_peers.clj" data)]
             [(str "src/" path "/launcher/submit_prod_sample_job.clj") (render "submit_prod_sample_job.clj" data)]

             [(str "src/" path "/workflows/sample_workflow.clj") (render "sample_workflow.clj" data)]
             [(str "src/" path "/catalogs/sample_catalog.clj") (render "sample_catalog.clj" data)]
             [(str "src/" path "/flow_conditions/sample_flow_conditions.clj") (render "sample_flow_conditions.clj" data)]
             [(str "src/" path "/functions/sample_functions.clj") (render "sample_functions.clj" data)]
             [(str "src/" path "/lifecycles/sample_lifecycle.clj") (render "sample_lifecycle.clj" data)]
             [(str "src/" path "/dev_inputs/sample_input.clj") (render "sample_input.clj" data)]

             [(str "test/" path "/jobs/sample_job_test.clj") (render "sample_job_test.clj" data)])))

Fix path.

Fix path.


;   Copyright (c) Rich Hickey, Reid Draper, and contributors.
;   All rights reserved.
;   The use and distribution terms for this software are covered by the
;   Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php)
;   which can be found in the file epl-v10.html at the root of this distribution.
;   By using this software in any fashion, you are agreeing to be bound by
;   the terms of this license.
;   You must not remove this notice, or any other, from this software.

(ns clojure.test.check
  (:require [clojure.test.check.generators :as gen]
            [clojure.test.check.clojure-test :as ct]
            [clojure.test.check.rose-tree :as rose]))

(declare shrink-loop failure)

(defn make-rng
  [seed]
  (if seed
    [seed (gen/random seed)]
    (let [non-nil-seed (System/currentTimeMillis)]
      [non-nil-seed (gen/random non-nil-seed)])))

(defn- complete
  [property num-trials seed]
  (ct/report-trial property num-trials num-trials)
  {:result true :num-tests num-trials :seed seed})

(defn not-falsey-or-exception?
  "True if the value is not falsy or an exception"
  [value]
  (and value (not (instance? Throwable value))))

(defn quick-check
  "Tests `property` `num-tests` times.

  Examples:

      (def p (for-all [a gen/pos-int] (> (* a a) a)))
      (quick-check 100 p)
  "
  [num-tests property & {:keys [seed max-size] :or {max-size 200}}]
  (let [[created-seed rng] (make-rng seed)
        size-seq (gen/make-size-range-seq max-size)]
    (loop [so-far 0
           size-seq size-seq]
      (if (== so-far num-tests)
        (complete property num-tests created-seed)
        (let [[size & rest-size-seq] size-seq
              result-map-rose (gen/call-gen property rng size)
              result-map (rose/root result-map-rose)
              result (:result result-map)
              args (:args result-map)]
          (if (not-falsey-or-exception? result)
            (do
              (ct/report-trial property so-far num-tests)
              (recur (inc so-far) rest-size-seq))
            (failure property result-map-rose so-far size created-seed)))))))

(defn- smallest-shrink
  [total-nodes-visited depth smallest]
  {:total-nodes-visited total-nodes-visited
   :depth depth
   :result (:result smallest)
   :smallest (:args smallest)})

(defn- shrink-loop
  "Shrinking a value produces a sequence of smaller values of the same type.
  Each of these values can then be shrunk. Think of this as a tree. We do a
  modified depth-first search of the tree:

  Do a non-exhaustive search for a deeper (than the root) failing example.
  Additional rules added to depth-first search:
  * If a node passes the property, you may continue searching at this depth,
  but not backtrack
  * If a node fails the property, search its children
  The value returned is the left-most failing example at the depth where a
  passing example was found."
  [rose-tree]
  (let [shrinks-this-depth (rose/children rose-tree)]
    (loop [nodes shrinks-this-depth
           current-smallest (rose/root rose-tree)
           total-nodes-visited 0
           depth 0]
      (if (empty? nodes)
        (smallest-shrink total-nodes-visited depth current-smallest)
        (let [[head & tail] nodes
              result (:result (rose/root head))]
          (if (not-falsey-or-exception? result)
            ;; this node passed the test, so now try testing its right-siblings
            (recur tail current-smallest (inc total-nodes-visited) depth)
            ;; this node failed the test, so check if it has children,
            ;; if so, traverse down them. If not, save this as the best example
            ;; seen now and then look at the right-siblings
            ;; children
            (let [children (rose/children head)]
              (if (empty? children)
                (recur tail (rose/root head) (inc total-nodes-visited) depth)
                (recur children (rose/root head) (inc total-nodes-visited) (inc depth))))))))))

(defn- failure
  [property failing-rose-tree trial-number size seed]
  (let [root (rose/root failing-rose-tree)
        result (:result root)
        failing-args (:args root)]

    (ct/report-failure property result trial-number failing-args)

    {:result result
     :seed seed
     :failing-size size
     :num-tests (inc trial-number)
     :fail (vec failing-args)
     :shrunk (shrink-loop failing-rose-tree)}))

;   Copyright (c) Rich Hickey, Reid Draper, and contributors.
;   All rights reserved.
;   The use and distribution terms for this software are covered by the
;   Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php)
;   which can be found in the file epl-v10.html at the root of this distribution.
;   By using this software in any fashion, you are agreeing to be bound by
;   the terms of this license.
;   You must not remove this notice, or any other, from this software.

(ns clojure.test.check
  (:require [clojure.test.check.generators :as gen]
            [clojure.test.check.clojure-test :as ct]
            [clojure.test.check.rose-tree :as rose]))

(declare shrink-loop failure)

(defn make-rng
  [seed]
  (if seed
    [seed (gen/random seed)]
    (let [non-nil-seed (System/currentTimeMillis)]
      [non-nil-seed (gen/random non-nil-seed)])))

(defn- complete
  [property num-trials seed]
  (ct/report-trial property num-trials num-trials)
  {:result true :num-tests num-trials :seed seed})

(defn not-falsey-or-exception?
  "True if the value is not falsy or an exception"
  [value]
  (and value (not (instance? Throwable value))))

(defn quick-check
  "Tests `property` `num-tests` times.
  Takes optional keys `:seed` and `:max-size`. The seed parameter
  can be used to re-run previous tests, as the seed used is returned
  after a test is run. The max-size can be used to control the 'size'
  of generated values. The size will start at 0, and grow up to
  max-size, as the number of tests increases. Generators will use
  the size parameter to bound their growth. This prevents, for example,
  generating a five-thousand element vector on the very first test.

  Examples:

      (def p (for-all [a gen/pos-int] (> (* a a) a)))
      (quick-check 100 p)
  "
  [num-tests property & {:keys [seed max-size] :or {max-size 200}}]
  (let [[created-seed rng] (make-rng seed)
        size-seq (gen/make-size-range-seq max-size)]
    (loop [so-far 0
           size-seq size-seq]
      (if (== so-far num-tests)
        (complete property num-tests created-seed)
        (let [[size & rest-size-seq] size-seq
              result-map-rose (gen/call-gen property rng size)
              result-map (rose/root result-map-rose)
              result (:result result-map)
              args (:args result-map)]
          (if (not-falsey-or-exception? result)
            (do
              (ct/report-trial property so-far num-tests)
              (recur (inc so-far) rest-size-seq))
            (failure property result-map-rose so-far size created-seed)))))))

(defn- smallest-shrink
  [total-nodes-visited depth smallest]
  {:total-nodes-visited total-nodes-visited
   :depth depth
   :result (:result smallest)
   :smallest (:args smallest)})

(defn- shrink-loop
  "Shrinking a value produces a sequence of smaller values of the same type.
  Each of these values can then be shrunk. Think of this as a tree. We do a
  modified depth-first search of the tree:

  Do a non-exhaustive search for a deeper (than the root) failing example.
  Additional rules added to depth-first search:
  * If a node passes the property, you may continue searching at this depth,
  but not backtrack
  * If a node fails the property, search its children
  The value returned is the left-most failing example at the depth where a
  passing example was found."
  [rose-tree]
  (let [shrinks-this-depth (rose/children rose-tree)]
    (loop [nodes shrinks-this-depth
           current-smallest (rose/root rose-tree)
           total-nodes-visited 0
           depth 0]
      (if (empty? nodes)
        (smallest-shrink total-nodes-visited depth current-smallest)
        (let [[head & tail] nodes
              result (:result (rose/root head))]
          (if (not-falsey-or-exception? result)
            ;; this node passed the test, so now try testing its right-siblings
            (recur tail current-smallest (inc total-nodes-visited) depth)
            ;; this node failed the test, so check if it has children,
            ;; if so, traverse down them. If not, save this as the best example
            ;; seen now and then look at the right-siblings
            ;; children
            (let [children (rose/children head)]
              (if (empty? children)
                (recur tail (rose/root head) (inc total-nodes-visited) depth)
                (recur children (rose/root head) (inc total-nodes-visited) (inc depth))))))))))

(defn- failure
  [property failing-rose-tree trial-number size seed]
  (let [root (rose/root failing-rose-tree)
        result (:result root)
        failing-args (:args root)]

    (ct/report-failure property result trial-number failing-args)

    {:result result
     :seed seed
     :failing-size size
     :num-tests (inc trial-number)
     :fail (vec failing-args)
     :shrunk (shrink-loop failing-rose-tree)}))

Add more docstring to `quick-check` function


;; Copyright 2014 Timothy Brooks
;;
;; Licensed under the Apache License, Version 2.0 (the "License");
;; you may not use this file except in compliance with the License.
;; You may obtain a copy of the License at
;;
;; http://www.apache.org/licenses/LICENSE-2.0
;;
;; Unless required by applicable law or agreed to in writing, software
;; distributed under the License is distributed on an "AS IS" BASIS,
;; WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
;; See the License for the specific language governing permissions and
;; limitations under the License.

(ns beehive.example-usage
  (:require [clojure.core.async :as async :refer [<! >! <!! >!! go]]
            [clj-http.client :as http]
            [beehive.async :as fa]
            [beehive.core :as beehive]
            [beehive.service :as service]))

(def api-route (str "http://www.broadbandmap.gov/broadbandmap/"
                    "census/county/%s?format=json"))

(defonce service (atom nil))
(defonce service2 (atom nil))

(defn start-service []
  (let [service-name "Service with no circuit breaker"
        num-of-threads 1
        max-concurrency 100]
    (reset! service
            (beehive/service service-name num-of-threads max-concurrency)))
  (let [service-name "Service with circuit breaker"
        num-of-threads 1
        max-concurrency 100]
    (reset! service2
            (beehive/service service-name
                             num-of-threads
                             max-concurrency
                             :breaker {:failure-percentage-threshold 20
                                       :backoff-time-millis 2000}
                             :metrics {:slots-to-track 3600
                                       :resolution 500
                                       :time-unit :milliseconds}))))

(defn lookup-state-action [county]
  (fn [] (-> (http/get (format api-route county) {:as :json})
             :body
             :Results
             :county)))

(defn handle-success [success-channel]
  (go (loop []
        (let [success-future (<! success-channel)]
          (println "Success")
          (println (:result success-future))
          (recur)))))

(defn handle-error [err-channel]
  (go (loop []
        (let [error-future (<! err-channel)]
          (println "Error")
          (println (:error error-future))
          (println (:status error-future))
          (recur)))))

(defn thing [in-channel out-channel err-channel]
  (go
    (loop []
      (let [county (<! in-channel)
            f (service/submit-action @service
                                     (lookup-state-action county)
                                     (fa/return-channels {:success out-channel
                                                          :failed err-channel})
                                     (+ 850 (rand-int 200)))]
        (when (:rejected? f)
          (println (:rejected-reason f)))
        (recur)))))

(defn run []
  (reset! service (beehive/service "example" 10 90))
  (let [in-channel (async/chan 10)
        out-channel (async/chan 10)
        err-channel (async/chan 10)]
    (thing in-channel out-channel err-channel)
    (handle-success out-channel)
    (handle-error err-channel)
    in-channel))

;; Copyright 2014 Timothy Brooks
;;
;; Licensed under the Apache License, Version 2.0 (the "License");
;; you may not use this file except in compliance with the License.
;; You may obtain a copy of the License at
;;
;; http://www.apache.org/licenses/LICENSE-2.0
;;
;; Unless required by applicable law or agreed to in writing, software
;; distributed under the License is distributed on an "AS IS" BASIS,
;; WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
;; See the License for the specific language governing permissions and
;; limitations under the License.

(ns beehive.example-usage
  (:require [clojure.core.async :as async :refer [<! >! <!! >!! go]]
            [clj-http.client :as http]
            [beehive.async :as fa]
            [beehive.core :as beehive]
            [beehive.service :as service]))

(def api-route (str "http://www.broadbandmap.gov/broadbandmap/"
                    "census/county/%s?format=json"))

(defonce service (atom nil))
(defonce service2 (atom nil))

(defn start-service []
  (let [service-name "Service with no circuit breaker"
        num-of-threads 1
        max-concurrency 100]
    (reset! service
            (beehive/service service-name num-of-threads max-concurrency)))
  (let [service-name "Service with circuit breaker"
        num-of-threads 1
        max-concurrency 100]
    (reset! service2
            (beehive/service service-name
                             num-of-threads
                             max-concurrency
                             :breaker {:failure-percentage-threshold 20
                                       :backoff-time-millis 2000}
                             :metrics {:slots-to-track 3600
                                       :resolution 500
                                       :time-unit :milliseconds}))))

(defn lookup-state-action [county]
  (fn [] (-> (http/get (format api-route county) {:as :json})
             :body
             :Results
             :county)))

(defn handle-success [success-channel]
  (go (loop []
        (let [success-future (<! success-channel)]
          (println "Success")
          (println (:result success-future))
          (recur)))))

(defn handle-error [err-channel]
  (go (loop []
        (let [error-future (<! err-channel)]
          (println "Error")
          (println (:error error-future))
          (println (:status error-future))
          (recur)))))

(defn thing [in-channel out-channel err-channel]
  (go
    (loop []
      (let [county (<! in-channel)
            f (service/submit-action @service
                                     (lookup-state-action county)
                                     (+ 850 (rand-int 200)))]
        (when (:rejected? f)
          (println (:rejected-reason f)))
        (recur)))))

(defn run []
  (reset! service (beehive/service "example" 10 90))
  (let [in-channel (async/chan 10)
        out-channel (async/chan 10)
        err-channel (async/chan 10)]
    (thing in-channel out-channel err-channel)
    (handle-success out-channel)
    (handle-error err-channel)
    in-channel))

Fix example

Fix example


(ns onyx.plugin.core-async
  (:require [clojure.core.async :refer [chan >!! <!! alts!! timeout go <! alts! close!]]
            [onyx.peer.function :as function]
            [onyx.peer.pipeline-extensions :as p-ext]
            [onyx.static.default-vals :refer [defaults]]
            [onyx.types :as t]
            [taoensso.timbre :refer [debug info] :as timbre]))

(defn inject-reader
  [event lifecycle]
  (when-not (:core.async/chan event)
    (throw (ex-info ":core.async/chan not found - add it using a :before-task-start lifecycle"
                    {:event-map-keys (keys event)})))

  (let [task (:onyx.core/task-map event)]
    (when (and (not= (:onyx/max-peers task) 1)
               (not (:core.async/allow-unsafe-concurrency? lifecycle)))
      (throw (ex-info ":onyx/max-peers must be set to 1 in the task map for core.async readers" {:task-map task}))))

  (let [pipeline (:onyx.core/pipeline event)]
    {:core.async/pending-messages (:pending-messages pipeline)
     :core.async/drained (:drained pipeline)
     :core.async/retry-ch (:retry-ch pipeline)
     :core.async/retry-count (:retry-count pipeline)}))

(defn log-retry-count
  [event lifecycle]
  (info "core.async input plugin stopping. Retry count:" @(:core.async/retry-count event))
  {})

(defn inject-writer
  [event lifecycle]
  (when-not (:core.async/chan event)
    (throw (ex-info ":core.async/chan not found - add it using a :before-task-start lifecycle"
                    {:event-map-keys (keys event)})))

  (let [task (:onyx.core/task-map event)]
    (when (and (not= (:onyx/max-peers task) 1)
               (not (:core.async/allow-unsafe-concurrency? lifecycle)))
      (throw (ex-info ":onyx/max-peers must be set to 1 in the task map for core.async writers" {:task-map task}))))

  {})

(def reader-calls
  {:lifecycle/before-task-start inject-reader
   :lifecycle/after-task-stop log-retry-count})

(def writer-calls
  {:lifecycle/before-task-start inject-writer})

(defrecord CoreAsyncInput [max-pending batch-size batch-timeout pending-messages
                           drained retry-ch retry-count]
  p-ext/Pipeline
  (write-batch
    [this event]
    (function/write-batch event))

  (read-batch [_ {:keys [core.async/chan] :as event}]
    (let [pending (count @pending-messages)
          max-segments (min (- max-pending pending) batch-size)
          ;; We reuse a single timeout channel. This allows us to
          ;; continually block against one thread that is continually
          ;; expiring. This property lets us take variable amounts of
          ;; time when reading each segment and still allows us to return
          ;; within the predefined batch timeout limit.
          timeout-ch (timeout batch-timeout)
          batch (if (pos? max-segments)
                  (loop [segments [] cnt 0]
                    (if (= cnt max-segments)
                      segments
                      (if-let [message (first (alts!! [retry-ch chan timeout-ch] :priority true))]
                        (recur (conj segments
                                     (t/input (java.util.UUID/randomUUID)
                                              message))
                               (inc cnt))
                        segments)))
                  (<!! timeout-ch))]
      (doseq [m batch]
        (swap! pending-messages assoc (:id m) (:message m)))
      (when (and (= 1 (count @pending-messages))
                 (= (count batch) 1)
                 (= (:message (first batch)) :done))
        (reset! drained true))
      {:onyx.core/batch batch}))

  p-ext/PipelineInput

  (ack-segment [_ _ message-id]
    (swap! pending-messages dissoc message-id))

  (retry-segment
    [_ _ message-id]
    (when-let [msg (get @pending-messages message-id)]
      (swap! pending-messages dissoc message-id)
      (when-not (= msg :done)
        (swap! retry-count inc))
      (>!! retry-ch msg)))

  (pending?
    [_ _ message-id]
    (get @pending-messages message-id))

  (drained?
    [_ _]
    @drained))

(defn input [pipeline-data]
  (let [catalog-entry (:onyx.core/task-map pipeline-data)
        max-pending (or (:onyx/max-pending catalog-entry) (:onyx/max-pending defaults))
        batch-size (:onyx/batch-size catalog-entry)
        batch-timeout (or (:onyx/batch-timeout catalog-entry) (:onyx/batch-timeout defaults))]
    (->CoreAsyncInput max-pending batch-size batch-timeout
                      (atom {}) (atom false) (chan 10000) (atom 0))))

(defrecord CoreAsyncOutput []
  p-ext/Pipeline
  (read-batch
    [_ event]
    (function/read-batch event))

  (write-batch
    [_ {:keys [onyx.core/results core.async/chan] :as event}]
    (doseq [msg (mapcat :leaves (:tree results))]
      (>!! chan (:message msg)))
    {})

  (seal-resource
    [_ {:keys [core.async/chan]}]
    (>!! chan :done)))

(defn output [pipeline-data]
  (->CoreAsyncOutput))

(defn take-segments!
  "Takes segments off the channel until :done is found.
   Returns a seq of segments, including :done."
  ([ch] (take-segments! ch nil))
  ([ch timeout-ms]
   (when-let [tmt (if timeout-ms
                    (timeout timeout-ms)
                    (chan))]
     (loop [ret []]
       (let [[v c] (alts!! [ch tmt] :priority true)]
         (if (= c tmt)
           ret
           (if (and v (not= v :done))
             (recur (conj ret v))
             (conj ret :done))))))))

(ns onyx.plugin.core-async
  (:require [clojure.core.async :refer [chan >!! <!! alts!! timeout go <! alts! close!]]
            [onyx.peer.function :as function]
            [onyx.peer.pipeline-extensions :as p-ext]
            [onyx.static.default-vals :refer [defaults]]
            [onyx.types :as t]
            [taoensso.timbre :refer [debug info] :as timbre]))

(defn inject-reader
  [event lifecycle]
  (when-not (:core.async/chan event)
    (throw (ex-info ":core.async/chan not found - add it using a :before-task-start lifecycle"
                    {:event-map-keys (keys event)})))

  (let [task (:onyx.core/task-map event)]
    (when (and (not= (:onyx/max-peers task) 1)
               (not (:core.async/allow-unsafe-concurrency? lifecycle)))
      (throw (ex-info ":onyx/max-peers must be set to 1 in the task map for core.async readers" {:task-map task}))))

  (let [pipeline (:onyx.core/pipeline event)]
    {:core.async/pending-messages (:pending-messages pipeline)
     :core.async/drained (:drained pipeline)
     :core.async/retry-ch (:retry-ch pipeline)
     :core.async/retry-count (:retry-count pipeline)}))

(defn log-retry-count
  [event lifecycle]
  (info "core.async input plugin stopping. Retry count:" @(:core.async/retry-count event))
  {})

(defn inject-writer
  [event lifecycle]
  (when-not (:core.async/chan event)
    (throw (ex-info ":core.async/chan not found - add it using a :before-task-start lifecycle"
                    {:event-map-keys (keys event)})))

  (let [task (:onyx.core/task-map event)]
    (when (and (not= (:onyx/max-peers task) 1)
               (not (:core.async/allow-unsafe-concurrency? lifecycle)))
      (throw (ex-info ":onyx/max-peers must be set to 1 in the task map for core.async writers" {:task-map task}))))

  {})

(def reader-calls
  {:lifecycle/before-task-start inject-reader
   :lifecycle/after-task-stop log-retry-count})

(def writer-calls
  {:lifecycle/before-task-start inject-writer})

(defrecord CoreAsyncInput [max-pending batch-size batch-timeout pending-messages
                           drained retry-ch retry-count]
  p-ext/Pipeline
  (write-batch
    [this event]
    (function/write-batch event))

  (read-batch [_ {:keys [core.async/chan] :as event}]
    (let [pending (count @pending-messages)
          max-segments (min (- max-pending pending) batch-size)
          ;; We reuse a single timeout channel. This allows us to
          ;; continually block against one thread that is continually
          ;; expiring. This property lets us take variable amounts of
          ;; time when reading each segment and still allows us to return
          ;; within the predefined batch timeout limit.
          timeout-ch (timeout batch-timeout)
          batch (if (pos? max-segments)
                  (loop [segments [] cnt 0]
                    (if (= cnt max-segments)
                      segments
                      (if-let [message (first (alts!! [retry-ch chan timeout-ch] :priority true))]
                        (recur (conj segments
                                     (t/input (java.util.UUID/randomUUID)
                                              message))
                               (inc cnt))
                        segments)))
                  (<!! timeout-ch))]
      (doseq [m batch]
        (swap! pending-messages assoc (:id m) (:message m)))
      (when (and (= 1 (count @pending-messages))
                 (= (count batch) 1)
                 (= (:message (first batch)) :done)
                 (zero? (count (.buf retry-ch))))
        (reset! drained true))
      {:onyx.core/batch batch}))

  p-ext/PipelineInput

  (ack-segment [_ _ message-id]
    (swap! pending-messages dissoc message-id))

  (retry-segment
    [_ _ message-id]
    (when-let [msg (get @pending-messages message-id)]
      (when-not (= msg :done)
        (swap! retry-count inc))
      (>!! retry-ch msg)
      (swap! pending-messages dissoc message-id)))

  (pending?
    [_ _ message-id]
    (get @pending-messages message-id))

  (drained?
    [_ _]
    @drained))

(defn input [pipeline-data]
  (let [catalog-entry (:onyx.core/task-map pipeline-data)
        max-pending (or (:onyx/max-pending catalog-entry) (:onyx/max-pending defaults))
        batch-size (:onyx/batch-size catalog-entry)
        batch-timeout (or (:onyx/batch-timeout catalog-entry) (:onyx/batch-timeout defaults))]
    (->CoreAsyncInput max-pending batch-size batch-timeout
                      (atom {}) (atom false) (chan 10000) (atom 0))))

(defrecord CoreAsyncOutput []
  p-ext/Pipeline
  (read-batch
    [_ event]
    (function/read-batch event))

  (write-batch
    [_ {:keys [onyx.core/results core.async/chan] :as event}]
    (doseq [msg (mapcat :leaves (:tree results))]
      (>!! chan (:message msg)))
    {})

  (seal-resource
    [_ {:keys [core.async/chan]}]
    (>!! chan :done)))

(defn output [pipeline-data]
  (->CoreAsyncOutput))

(defn take-segments!
  "Takes segments off the channel until :done is found.
   Returns a seq of segments, including :done."
  ([ch] (take-segments! ch nil))
  ([ch timeout-ms]
   (when-let [tmt (if timeout-ms
                    (timeout timeout-ms)
                    (chan))]
     (loop [ret []]
       (let [[v c] (alts!! [ch tmt] :priority true)]
         (if (= c tmt)
           ret
           (if (and v (not= v :done))
             (recur (conj ret v))
             (conj ret :done))))))))

Fix race condition in core.async plugin retries