(ns cljss.core
  (:require [cljss.utils :refer [build-css escape-val]]
            [cljss.font-face :as ff]
            [cljss.inject-global :as ig]
            [clojure.string :as cstr]))

(defn- varid [cls idx [rule]]
  [rule (str "--var-" cls "-" idx)])

(defn- dynamic? [[_ value]]
  (not (or (string? value)
           (number? value))))

(defn- pseudo? [[rule value]]
  (and (re-matches #"&:.*" (name rule))
       (map? value)))

(defn- status? [[rule value]]
  (and (re-matches #"^.*\?$" (name rule))
       (map? value)))

(defn- collect-styles [cls idx styles]
  (let [dynamic (filterv dynamic? styles)
        static (->> styles
                    (filterv (comp not dynamic?))
                    (mapv (fn [[rule value]]
                            [rule
                             (if (number? value)
                               (str value "px")
                               value)])))
        [vars idx]
        (reduce
          (fn [[vars idx] ds]
            [(conj vars (varid cls idx ds))
             (inc idx)])
          [[] idx]
          dynamic)
        vals (mapv (fn [[_ var] [_ exp]] [var `(let [e# ~exp] (if (number? e#) (cljs.core/str e# "px") e#))])
                   vars
                   dynamic)
        static (->> vars
                    (map (fn [[rule var]] [rule (str "var(" var ")")]))
                    (concat static)
                    (build-css cls))]
    [static vals idx]))

(defn build-styles [cls styles]
  (let [pseudo (filterv pseudo? styles)
        styles (filterv (comp not pseudo?) styles)
        [static vals idx] (collect-styles cls 0 styles)
        pstyles (->> pseudo
                     (map (fn [[rule styles]]
                            (collect-styles (str cls (subs (name rule) 1)) idx styles))))
        static (->> pstyles
                    (map first)
                    (apply str)
                    (str static))
        vals (->> pstyles
                  (mapcat second)
                  (into vals))]
    [static vals]))

(defn- ->status-styles [styles]
  (let [status (filterv status? styles)
        sprops (keys status)]
    (->> status
         (map (fn [[prop styles]]
                (->> styles
                     (map (fn [[rule value]] [rule prop value])))))
         (mapcat identity)
         (group-by first)
         (map (fn [[rule states]]
                (let [svals (map last states)
                      args (mapv (fn [_] (gensym "var")) svals)]
                  [rule
                   `(with-meta
                      (fn ~args
                        (cond ~@(->> svals
                                     (map-indexed (fn [idx value]
                                                    [(nth args idx) value]))
                                     (mapcat identity)
                                     ((fn [coll] (concat coll [:else (get styles rule)]))))))
                      (list ~@(mapv second states)))])))
         (into {})
         (merge styles)
         (#(apply dissoc % sprops)))))

(defmacro var->cls-name [sym]
  `(-> ~'&env :ns :name (clojure.core/str "/" ~sym) (clojure.string/replace "." "_") (clojure.string/replace "/" "__")))

(defmacro defstyles
  "Takes var name, a vector of arguments and a hash map of styles definition.
   Generates class name, static and dynamic parts of styles.
   Returns a function that calls `cljss.core/css` to inject styles at runtime
   and returns generated class name."
  [var args styles]
  (let [cls-name# (var->cls-name var)
        [static# vals#] (build-styles cls-name# styles)]
    `(defn ~var ~args
       (cljss.core/css ~cls-name# ~static# ~vals#))))

(defn- vals->array [vals]
  (let [arrseq (mapv (fn [[var val]] `(cljs.core/array ~var ~val)) vals)]
    `(cljs.core/array ~@arrseq)))

(defn ->styled
  "Takes var name, HTML tag name and a hash map of styles definition.
   Returns a var bound to the result of calling `cljss.core/styled`,
   which produces React element and injects styles."
  [tag styles cls]
  (let [tag (name tag)
        styles (->status-styles styles)
        [static values] (build-styles cls styles)
        values (vals->array values)
        attrs (->> styles vals (filterv keyword?))]
    [tag static values `(cljs.core/array ~@attrs)]))

(defmacro make-styled []
  '(defn styled [cls static vars attrs create-element]
     (let [clsn (str cls "-" (gensym))
           static (if ^boolean goog.DEBUG
                    (clojure.string/replace static cls clsn)
                    static)
           vars (if ^boolean goog.DEBUG
                  (->> vars (map (fn [[k v]] [(clojure.string/replace k cls clsn) v])))
                  vars)
           cls (if ^boolean goog.DEBUG clsn cls)]
       (fn [props & children]
         (let [[props children] (if (map? props)
                                  (array props children)
                                  (array {} (apply array props children)))
               var-class (->> vars
                              (map (fn [[cls v]]
                                     (cond
                                       (and (ifn? v) (satisfies? IWithMeta v))
                                       (->> v meta list flatten (select-keys props) vals (apply v) (list cls))

                                       (ifn? v)
                                       (list cls (v props))

                                       :else (list cls v))))
                              (map (fn [[k v]]
                                     [k (if (number? v)
                                          (str v "px")
                                          v)]))
                              (cljss.core/css cls static))
               meta-attrs (->> vars
                               (map second)
                               (filter #(satisfies? IWithMeta %))
                               (map meta)
                               flatten
                               set)
               className (:className props)
               className (str (when className (str className " ")) var-class)
               props (assoc props :className className)
               props (apply dissoc props (concat attrs meta-attrs))]
           (create-element props children))))))

(defn- keyframes-styles [idx styles]
  (let [dynamic (filterv dynamic? styles)
        static (filterv (comp not dynamic?) styles)
        [vars idx]
        (reduce
          (fn [[vars idx] [rule]]
            [(conj vars [rule idx])
             (inc idx)])
          [[] idx]
          dynamic)
        vals (mapv (fn [[_ var] [_ exp]] [(str "var(" var ")") exp]) vars dynamic)
        static (->> vars
                    (map (fn [[rule var]] [rule (str "var(" var ")")]))
                    (concat static)
                    (map (fn [[rule val]] (str (name rule) ":" (escape-val rule val) ";")))
                    (cstr/join "")
                    (#(str "{" % "}")))]
    [static vals idx]))

(defn- ->ks-key [k]
  (cond
    (keyword? k) (name k)
    (number? k) (str k "%")
    (vector? k) (->> k (map ->ks-key) (cstr/join ","))
    :else k))

(defn- build-keyframes [keyframes]
  (let [[ks [statics vals]]
        (->> keyframes
             (reduce
               (fn [[ks [static vals idx]] [k styles]]
                 (let [[s v idx] (keyframes-styles idx styles)]
                   [(conj ks (->ks-key k))
                    [(conj static s) (into vals v) idx]]))
               [[] [[] [] 1]]))]
    [(->> (interleave ks statics)
          (apply str))
     `(cljs.core/array ~@(map (fn [v] `(cljs.core/array ~@v)) vals))]))

(defmacro defkeyframes
  "Takes var name, a vector of arguments and a hash map of CSS keyframes definition.
  Returns a function that calls `cljss.core/css-keyframes` to inject styles at runtime\n
  and returns generated CSS animation name that can be used in CSS `animation` rule.

  (defkeyframes spin [start end]\n    {:from {:transform (str \"rotate(\" start \"deg)\")}\n     :to   {:transform (str \"rotate(\" end \"deg)\")}})

  (defstyled Spinner :div\n    {:animation (str (spin 0 180) \" 1s ease infinite\")})"
  [var args keyframes]
  (let [cls# (var->cls-name var)
        [keyframes# vals#] (build-keyframes keyframes)]
    `(defn ~var ~args
       (cljss.core/css-keyframes ~cls# ~keyframes# ~vals#))))

(defmacro font-face
  "Takes a hash of font descriptors and produces CSS string of @font-face declaration.
  Returns a function that injects styles at runtime."
  [descriptors]
  (let [css# (ff/font-face descriptors)
        cls# (hash css#)]
    `(cljss.core/css ~cls# ~css# [])))

(defmacro inject-global
  "Takes a hash of global styles definitions and produces CSS string.
  Returns a sequence of calls to inject styles at runtime."
  [css]
  (let [css (ig/inject-global css)]
    `(do ~@(->> css (map (fn [[cls# css#]] `(cljss.core/css ~cls# ~css# [])))))))

(ns cljss.core
  (:require [cljss.utils :refer [build-css escape-val]]
            [cljss.font-face :as ff]
            [cljss.inject-global :as ig]
            [clojure.string :as cstr]))

(defn- varid [cls idx [rule]]
  [rule (str "--var-" cls "-" idx)])

(defn- dynamic? [[_ value]]
  (not (or (string? value)
           (number? value))))

(defn- pseudo? [[rule value]]
  (and (re-matches #"&:.*" (name rule))
       (map? value)))

(defn- status? [[rule value]]
  (and (re-matches #"^.*\?$" (name rule))
       (map? value)))

(defn- collect-styles [cls idx styles]
  (let [dynamic (filterv dynamic? styles)
        static  (filterv (comp not dynamic?) styles)
        [vars idx]
        (reduce
          (fn [[vars idx] ds]
            [(conj vars (varid cls idx ds))
             (inc idx)])
          [[] idx]
          dynamic)
        vals    (mapv (fn [[_ var] [_ exp]] [var exp]) vars dynamic)
        static  (->> vars
                     (map (fn [[rule var]] [rule (str "var(" var ")")]))
                     (concat static)
                     (build-css cls))]
    [static vals idx]))

(defn build-styles [cls styles]
  (let [pseudo  (filterv pseudo? styles)
        styles  (filterv (comp not pseudo?) styles)
        [static vals idx] (collect-styles cls 0 styles)
        pstyles (->> pseudo
                     (map (fn [[rule styles]]
                            (collect-styles (str cls (subs (name rule) 1)) idx styles))))
        static  (->> pstyles
                     (map first)
                     (apply str)
                     (str static))
        vals    (->> pstyles
                     (mapcat second)
                     (into vals))]
    [static vals]))

(defn- ->status-styles [styles]
  (let [status (filterv status? styles)
        sprops (keys status)]
    (->> status
         (map (fn [[prop styles]]
                (->> styles
                     (map (fn [[rule value]] [rule prop value])))))
         (mapcat identity)
         (group-by first)
         (map (fn [[rule states]]
                (let [svals (map last states)
                      args  (mapv (fn [_] (gensym "var")) svals)]
                  [rule
                   `(with-meta
                      (fn ~args
                        (cond ~@(->> svals
                                     (map-indexed (fn [idx value]
                                                    [(nth args idx) value]))
                                     (mapcat identity)
                                     ((fn [coll] (concat coll [:else (get styles rule)]))))))
                      (list ~@(mapv second states)))])))
         (into {})
         (merge styles)
         (#(apply dissoc % sprops)))))

(defmacro var->cls-name [sym]
  `(-> ~'&env :ns :name (clojure.core/str "/" ~sym) (clojure.string/replace "." "_") (clojure.string/replace "/" "__")))

(defmacro defstyles
  "Takes var name, a vector of arguments and a hash map of styles definition.
   Generates class name, static and dynamic parts of styles.
   Returns a function that calls `cljss.core/css` to inject styles at runtime
   and returns generated class name."
  [var args styles]
  (let [cls-name# (var->cls-name var)
        [static# vals#] (build-styles cls-name# styles)]
    `(defn ~var ~args
       (cljss.core/css ~cls-name# ~static# ~vals#))))

(defn- vals->array [vals]
  (let [arrseq (mapv (fn [[var val]] `(cljs.core/array ~var ~val)) vals)]
    `(cljs.core/array ~@arrseq)))

(defn ->styled
  "Takes var name, HTML tag name and a hash map of styles definition.
   Returns a var bound to the result of calling `cljss.core/styled`,
   which produces React element and injects styles."
  [tag styles cls]
  (let [tag    (name tag)
        styles (->status-styles styles)
        [static values] (build-styles cls styles)
        values (vals->array values)
        attrs  (->> styles vals (filterv keyword?))]
    [tag static values `(cljs.core/array ~@attrs)]))

(defmacro make-styled []
  '(defn styled [cls static vars attrs create-element]
     (let [clsn   (str cls "-" (gensym))
           static (if ^boolean goog.DEBUG
                    (clojure.string/replace static cls clsn)
                    static)
           vars   (if ^boolean goog.DEBUG
                    (->> vars (map (fn [[k v]] [(clojure.string/replace k cls clsn) v])))
                    vars)
           cls    (if ^boolean goog.DEBUG clsn cls)]
       (fn [props & children]
         (let [[props children] (if (map? props)
                                  (array props children)
                                  (array {} (apply array props children)))
               var-class  (->> vars
                               (map (fn [[cls v]]
                                      (cond
                                        (and (ifn? v) (satisfies? IWithMeta v))
                                        (->> v meta list flatten (select-keys props) vals (apply v) (list cls))

                                        (ifn? v)
                                        (list cls (v props))

                                        :else (list cls v))))
                               (cljss.core/css cls static))
               meta-attrs (->> vars
                               (map second)
                               (filter #(satisfies? IWithMeta %))
                               (map meta)
                               flatten
                               set)
               className  (:className props)
               className  (str (when className (str className " ")) var-class)
               props      (assoc props :className className)
               props      (apply dissoc props (concat attrs meta-attrs))]
           (create-element props children))))))

(defn- keyframes-styles [idx styles]
  (let [dynamic (filterv dynamic? styles)
        static  (filterv (comp not dynamic?) styles)
        [vars idx]
        (reduce
          (fn [[vars idx] [rule]]
            [(conj vars [rule idx])
             (inc idx)])
          [[] idx]
          dynamic)
        vals    (mapv (fn [[_ var] [_ exp]] [(str "var(" var ")") exp]) vars dynamic)
        static  (->> vars
                     (map (fn [[rule var]] [rule (str "var(" var ")")]))
                     (concat static)
                     (map (fn [[rule val]] (str (name rule) ":" (escape-val rule val) ";")))
                     (cstr/join "")
                     (#(str "{" % "}")))]
    [static vals idx]))

(defn- ->ks-key [k]
  (cond
    (keyword? k) (name k)
    (number? k) (str k "%")
    (vector? k) (->> k (map ->ks-key) (cstr/join ","))
    :else k))

(defn- build-keyframes [keyframes]
  (let [[ks [statics vals]]
        (->> keyframes
             (reduce
               (fn [[ks [static vals idx]] [k styles]]
                 (let [[s v idx] (keyframes-styles idx styles)]
                   [(conj ks (->ks-key k))
                    [(conj static s) (into vals v) idx]]))
               [[] [[] [] 1]]))]
    [(->> (interleave ks statics)
          (apply str))
     `(cljs.core/array ~@(map (fn [v] `(cljs.core/array ~@v)) vals))]))

(defmacro defkeyframes
  "Takes var name, a vector of arguments and a hash map of CSS keyframes definition.
  Returns a function that calls `cljss.core/css-keyframes` to inject styles at runtime\n
  and returns generated CSS animation name that can be used in CSS `animation` rule.

  (defkeyframes spin [start end]\n    {:from {:transform (str \"rotate(\" start \"deg)\")}\n     :to   {:transform (str \"rotate(\" end \"deg)\")}})

  (defstyled Spinner :div\n    {:animation (str (spin 0 180) \" 1s ease infinite\")})"
  [var args keyframes]
  (let [cls# (var->cls-name var)
        [keyframes# vals#] (build-keyframes keyframes)]
    `(defn ~var ~args
       (cljss.core/css-keyframes ~cls# ~keyframes# ~vals#))))

(defmacro font-face
  "Takes a hash of font descriptors and produces CSS string of @font-face declaration.
  Returns a function that injects styles at runtime."
  [descriptors]
  (let [css# (ff/font-face descriptors)
        cls# (hash css#)]
    `(cljss.core/css ~cls# ~css# [])))

(defmacro inject-global
  "Takes a hash of global styles definitions and produces CSS string.
  Returns a sequence of calls to inject styles at runtime."
  [css]
  (let [css (ig/inject-global css)]
    `(do ~@(->> css (map (fn [[cls# css#]] `(cljss.core/css ~cls# ~css# [])))))))

revert px vals conversion

revert px vals conversion


(ns datemo.arb
  (:require [clojure.pprint :refer [pprint]])
  (:use hickory.core))

(defn html->hiccup
  ([html] (as-hiccup (parse html)))
  ([html as-fragment]
   (if (false? as-fragment)
     (html->hiccup html)
     (let [result (map as-hiccup (parse-fragment html))]
       (if (not= 1 (count result))
         (into [:div {}] result)
         (first result))))))

(defn hiccup->arb [hiccup]
  (let [[tag attrs & value] hiccup]
    (if (or (nil? value) (and (= 1 (count value) (string? (first value)))))
      [:arb {:original-tag tag} (first value)]
      (loop [values [], items value]
        (if (= 0 (count items))
          (into [:arb {:original-tag tag}] values)
          (if (string? (first items))
            (recur (conj values (first items)) (next items))
            (recur (conj values (hiccup->arb (first items))) (next items))))))))

(defn html->arb
  ([html] (html->arb html true))
  ([html as-fragment]
   (if (false? as-fragment)
    (hiccup->arb (html->hiccup html)))
    (hiccup->arb (html->hiccup html as-fragment))))

(defn arb->tx [arb]
  (let [[arb-tag metadata & value] arb]
    (if (or (string? (first value)) (nil? (first value)))
      {:arb/metadata [{:metadata/html-tag (metadata :original-tag)}]
       :arb/value [{:content/text (first value)}]}
      (loop [values []
             items value]
        (if (= 1 (count items))
          {:arb/metadata [{:metadata/html-tag (metadata :original-tag)}]
           :arb/value (conj values (arb->tx (first items)))}
          (recur (conj values (arb->tx (first items))) (next items)))))))

(defn html->tx [html]
  (-> html (html->arb) (arb->tx)))

(defn tx->arb [tx]
  (let [{metadata :arb/metadata value :arb/value} tx]
    (if (and (= 1 (count value)) (not (nil? (:content/text (first value)))))
      [:arb
       {:original-tag (:metadata/html-tag (first metadata))}
       (:content/text (first value))]
      (loop [arbs [], items value]
        (if (= 0 (count items))
          (into
            [:arb {:original-tag (:metadata/html-tag (first metadata))}]
            arbs)
          (recur (conj arbs (tx->arb (first items))) (next items)))))))

(defn arb->hiccup [arb]
  (let [[arb-tag metadata & value] arb]
    (if (and (string? (first value)) (= 1 (count value)))
      [(:original-tag metadata) {} (first value)]
      (loop [hiccups [], items value]
        (if (= 0 (count items))
          (into [(:original-tag metadata) {}] hiccups)
          (if (string? (first items))
            (recur (conj hiccups (first items)) (next items))
            (recur (conj hiccups (arb->hiccup (first items))) (next items))))))))

(defn tx->html [tx]
  (-> tx (tx->arb) (arb->hiccup)))

Add arb->tx fn

Add arb->tx fn


(ns examples.fx
  (:use overtone.live))

; All of these are based off the compander ugen.  Of course you can just use it
; directly in your synths, but it's nice to be able to stick on

;; This file has some demos to show you what the fx in overtone.studio.fx do.  These
;; are setup so you can experiment with the parameters by moving the mouse around.

;; First a fat synth to use as our source sound

(defsynth bizzle [out-bus 10 amp 0.5]
  (out out-bus
       (* amp
          (+ (* (decay2 (* (impulse 10 0)
                           (+ (* (lf-saw:kr 0.3 0) -0.3) 0.3))
                        0.001)
                0.3)
             (apply + (pulse [80 81]))))))

; Give it a try
(def biz (bizzle 0))
(kill biz)

;; Next, create a bus to connect the source synth with the fx synth:
(def b (audio-bus))

; All of these are based off the compander ugen.  Of course you can just use it
; directly in your synths, but it's nice to be able to stick on
(defsynth compressor-demo [in-bus 10]
  (let [source (in in-bus)]
    (out 0 (pan2 (compander source source (mouse-y:kr 0.0 1) 1 0.5 0.01 0.01)))))

;; (bizzle b)
;; (compressor-demo b)
;; (stop)

(defsynth limiter-demo [in-bus 10]
  (let [source (in in-bus)]
    (out 0 (pan2 (compander source source (mouse-y:kr 0.0 1) 1 0.1 0.01 0.01)))))

(defsynth sustainer-demo [in-bus 10]
  (let [source (in in-bus)]
    (out 0 (pan2 (compander source source (mouse-y:kr 0.0 1) 0.1 1 0.01 0.01)))))
;;(bizzle b)
;;(limiter-demo b)
;;(stop)

;;(bizzle b)
;;(sustainer-demo b)
;;(stop)

; Here is a different sample synth to try out the reverb and echo effects
(defsynth pling [out-bus 10
                 rate 0.3 amp 0.5]
  (out out-bus
       (* (decay (impulse rate) 0.25)
          (* amp (lf-cub 1200 0)))))

;(def p (pling 0))
;(kill p)

(defsynth reverb-demo [in-bus 10]
  (out 0 (pan2 (free-verb (in in-bus) 0.5 (mouse-y:kr 0.0 1) (mouse-x:kr 0.0 1)))))
;(pling)
;(reverb-demo)
;(stop)

(defsynth echo-demo [in-bus 10]
  (let [source (in in-bus)
        echo (comb-n source 0.5 (mouse-x:kr 0 1) (mouse-y:kr 0 1))]
    (out 0 (pan2 (+ echo (in in-bus) 0)))))

;(pling)
;(echo-demo)
;(stop)
; If you have a microphone or some other source of external input, you can read it in
; and then run it through fx like this.
(defsynth ext-source [out-bus 10]
  (out out-bus (in (num-output-buses:ir))))

; This sound comes with supercollider, otherwise replace with another wav or aiff file
(def nasa (load-sample "a11wlk01-44_1.aiff"))

(defsynth simple-sound
  []
  (let [input (pan2 (play-buf 1 nasa) -0.5)]
    (out 0 input)))

; From Designing Sound in SuperCollider
(defsynth schroeder-reverb
  []
  (let [input (pan2 (play-buf 1 nasa) -0.5)
        delrd (local-in 4)
        output (+ input [(first delrd) (second delrd)])
        sig [(+ (first output) (second output)) (- (first output) (second output))
             (+ (nth delrd 2) (nth delrd 3)) (- (nth delrd 2) (nth delrd 3))]
        sig [(+ (nth sig 0) (nth sig 2)) (+ (nth sig 1) (nth sig 3))
             (- (nth sig 0) (nth sig 2)) (- (nth sig 0) (nth sig 2))]
        sig (* sig [0.4 0.37 0.333 0.3])
        deltimes (- (* [101 143 165 177] 0.001) (control-dur))
        lout (local-out (delay-c sig deltimes deltimes))
        ]
    (out 0 output)))

(ns examples.fx
  (:use overtone.live))

; All of these are based off the compander ugen.  Of course you can just use it
; directly in your synths, but it's nice to be able to stick on

;; This file has some demos to show you what the fx in overtone.studio.fx do.  These
;; are setup so you can experiment with the parameters by moving the mouse around.

;; First a fat synth to use as our source sound

(defsynth bizzle [out-bus 10 amp 0.5]
  (out out-bus
       (* amp
          (+ (* (decay2 (* (impulse 10 0)
                           (+ (* (lf-saw:kr 0.3 0) -0.3) 0.3))
                        0.001)
                0.3)
             (apply + (pulse [80 81]))))))

; Give it a try
(def biz (bizzle 0))
(kill biz)

;; Next, create a bus to connect the source synth with the fx synth:
(def b (audio-bus))

; All of these are based off the compander ugen.  Of course you can just use it
; directly in your synths, but it's nice to be able to stick on
(defsynth compressor-demo [in-bus 10]
  (let [source (in in-bus)]
    (out 0 (pan2 (compander source source (mouse-y:kr 0.0 1) 1 0.5 0.01 0.01)))))

;; (bizzle b)
;; (compressor-demo b)
;; (stop)

(defsynth limiter-demo [in-bus 10]
  (let [source (in in-bus)]
    (out 0 (pan2 (compander source source (mouse-y:kr 0.0 1) 1 0.1 0.01 0.01)))))

(defsynth sustainer-demo [in-bus 10]
  (let [source (in in-bus)]
    (out 0 (pan2 (compander source source (mouse-y:kr 0.0 1) 0.1 1 0.01 0.01)))))
;;(bizzle b)
;;(limiter-demo b)
;;(stop)

;;(bizzle b)
;;(sustainer-demo b)
;;(stop)

; Here is a different sample synth to try out the reverb and echo effects
(defsynth pling [out-bus 10
                 rate 0.3 amp 0.5]
  (out out-bus
       (* (decay (impulse rate) 0.25)
          (* amp (lf-cub 1200 0)))))

;(def p (pling 0))
;(kill p)

(defsynth reverb-demo [in-bus 10]
  (out 0 (pan2 (free-verb (in in-bus) 0.5 (mouse-y:kr 0.0 1) (mouse-x:kr 0.0 1)))))
;(pling)
;(reverb-demo)
;(stop)

(defsynth echo-demo [in-bus 10]
  (let [source (in in-bus)
        echo (comb-n source 0.5 (mouse-x:kr 0 1) (mouse-y:kr 0 1))]
    (out 0 (pan2 (+ echo (in in-bus) 0)))))

;(pling)
;(echo-demo)
;(stop)
; If you have a microphone or some other source of external input, you can read it in
; and then run it through fx like this.
(defsynth ext-source [out-bus 10]
  (out out-bus (in (num-output-buses:ir))))

;; Fetch a spoken countdown from freesound.org
(def count-down (sample (freesound-path 71128)))

;; Play it unmodified:
;;(count-down)

;; From Designing Sound in SuperCollider
(defsynth schroeder-reverb
  []
  (let [input (pan2 (play-buf 1 count-down) -0.5)
        delrd (local-in 4)
        output (+ input [(first delrd) (second delrd)])
        sig [(+ (first output) (second output)) (- (first output) (second output))
             (+ (nth delrd 2) (nth delrd 3)) (- (nth delrd 2) (nth delrd 3))]
        sig [(+ (nth sig 0) (nth sig 2)) (+ (nth sig 1) (nth sig 3))
             (- (nth sig 0) (nth sig 2)) (- (nth sig 0) (nth sig 2))]
        sig (* sig [0.4 0.37 0.333 0.3])
        deltimes (- (* [101 143 165 177] 0.001) (control-dur))
        lout (local-out (delay-c sig deltimes deltimes))
        ]
    (out 0 output)))

;;Spooky!
;;(schroeder-reverb)

Replace SC sample with something from freesound. Also modify the example now that samples can be used as buffers.


(ns graphql-clj.resolver-test
  (:use graphql-clj.resolver)
  (:require [clojure.test :refer :all]))

(deftest test-default-resolver
  (testing "default resolver with value"
    (let [type-name "NoNameType"
          field-name "testfield"
          test-field-value "testvalue"
          resolver (default-resolver-fn type-name field-name)
          result (resolver nil {:testfield test-field-value})]
      (is (= test-field-value result)))))

(deftest test-schema-introspection-resolver
  (let [schema-resolver (schema-introspection-resolver-fn nil)]
    (testing "testing __schema"
      (is (not (nil? (schema-resolver "QueryRoot" "__schema")))))))

(deftest test-create-resolver-fn
  (testing "test create resolver fn"
    (let [resolver-fn (create-resolver-fn nil nil)]
      (testing "testing __schema"
        (is (not (nil? (resolver-fn "QueryRoot" "__schema")))))
      (testing "testing default field resolver"
        (let [resolver (resolver-fn "User" "fullname")]
          (is (= "Test User Fullname"
                 (resolver nil {:fullname "Test User Fullname"}))))))))

(ns graphql-clj.resolver-test
  (:use graphql-clj.resolver)
  (:require [clojure.test :refer :all]
            [graphql-clj.parser :as parser]
            [graphql-clj.type :as type]
            [graphql-clj.introspection :as introspection]))

(def test-schema (type/create-schema nil (parser/parse introspection/introspection-schema)))

(deftest test-default-resolver
  (testing "default resolver with value"
    (let [type-name "NoNameType"
          field-name "testfield"
          test-field-value "testvalue"
          resolver (default-resolver-fn type-name field-name)
          result (resolver nil {:testfield test-field-value})]
      (is (= test-field-value result)))))

(deftest test-schema-introspection-resolver
  (let [schema-resolver (schema-introspection-resolver-fn test-schema)]
    (testing "testing __schema"
      (is (not (nil? (schema-resolver "Query" "__schema")))))))

(deftest test-create-resolver-fn
  (testing "test create resolver fn"
    (let [resolver-fn (create-resolver-fn test-schema nil)]
      (testing "testing __schema"
        (is (not (nil? (resolver-fn "Query" "__schema")))))
      (testing "testing default field resolver"
        (let [resolver (resolver-fn "User" "fullname")]
          (is (= "Test User Fullname"
                 (resolver nil {:fullname "Test User Fullname"}))))))))

fix test cases

fix test cases


(ns babel.italiano.benchmark
  (:refer-clojure :exclude [get-in])
  (:require [babel.italiano :refer [analyze generate parse]]
            [babel.italiano.grammar :refer [small medium np-grammar]]
            [babel.italiano.lexicon :refer [lexicon]]
            [babel.italiano.morphology :as morph :refer [analyze-regular fo replace-patterns]]
            [babel.italiano.morphology.nouns :as nouns]
            [babel.italiano.morphology.verbs :as verbs]
            [babel.parse :as parse]
            #?(:cljs [cljs.test :refer-macros [deftest is]])
            #?(:clj [clojure.tools.logging :as log])
            #?(:cljs [babel.logjs :as log])
            [clojure.repl :refer [doc]]
            [clojure.string :as string]
            [dag_unify.core :refer [get-in strip-refs]]))

(defn exception [error-string]
  #?(:clj
     (throw (Exception. error-string)))
  #?(:cljs
     (throw (js/Error. error-string))))

(defn run-benchmark
  ([]
   (run-benchmark 10))

  ([times]
   (count (take (Integer/parseInt times)
                (repeatedly #(let [debug (println "starting generation..")
                                   expr (time (generate {:comp {:synsem {:agr {:person :3rd}}}
                                                         :synsem {:cat :verb}}))]
                               (println (str "generated: " (fo expr)))
                               (println (str "starting parsing.."))
                               ;; take the first parse in order to force evaluation of parsing so that (time ..)'s return value is meaningful.
                               (let [parses (time (take 1 (reduce concat (map :parses (parse (fo expr))))))]
                                 (if (empty? parses)
                                   (throw (exception (str "could not parse: " (fo expr) " with semantics:"
                                                          (strip-refs (get-in expr [:synsem :sem]))))))

                                 (println (str "parsed: " (fo (first parses))))
                                 (println ""))))))))
(defn -main [times]
  (run-benchmark times))

;; lein run -m babel.italiano.benchmark/parse-mark 20 "i gatti neri hanno bevuto il vino rosso"
;; lein run -m babel.italiano.benchmark/parse-mark 20 "gli uomini alti hanno bevuto il vino rosso alla casa rossa"
(defn parse-mark [times expr]
  (count (take (Integer. times)
               (repeatedly
                #(println (with-out-str
                            (time (mapcat :parses (parse expr)))))))))

(ns babel.italiano.benchmark
  (:refer-clojure :exclude [get-in])
  (:require [babel.italiano :refer [analyze generate parse]]
            [babel.italiano.grammar :refer [small lexicon medium np-grammar]]
            [babel.italiano.morphology :as morph :refer [analyze-regular fo replace-patterns]]
            [babel.italiano.morphology.nouns :as nouns]
            [babel.italiano.morphology.verbs :as verbs]
            [babel.parse :as parse]
            #?(:cljs [cljs.test :refer-macros [deftest is]])
            #?(:clj [clojure.tools.logging :as log])
            #?(:cljs [babel.logjs :as log])
            [clojure.repl :refer [doc]]
            [clojure.string :as string]
            [dag_unify.core :refer [get-in strip-refs]]))

(defn exception [error-string]
  #?(:clj
     (throw (Exception. error-string)))
  #?(:cljs
     (throw (js/Error. error-string))))

(defn run-benchmark
  ([]
   (run-benchmark 10))

  ([times]
   (count (take (Integer/parseInt times)
                (repeatedly #(let [debug (println "starting generation..")
                                   expr (time (generate {:comp {:synsem {:agr {:person :3rd}}}
                                                         :synsem {:cat :verb}}))]
                               (println (str "generated: " (fo expr)))
                               (println (str "starting parsing.."))
                               ;; take the first parse in order to force evaluation of parsing so that (time ..)'s return value is meaningful.
                               (let [parses (time (take 1 (reduce concat (map :parses (parse (fo expr))))))]
                                 (if (empty? parses)
                                   (throw (exception (str "could not parse: " (fo expr) " with semantics:"
                                                          (strip-refs (get-in expr [:synsem :sem]))))))

                                 (println (str "parsed: " (fo (first parses))))
                                 (println ""))))))))
(defn -main [times]
  (run-benchmark times))

;; lein run -m babel.italiano.benchmark/parse-mark 20 "i gatti neri hanno bevuto il vino rosso"
;; lein run -m babel.italiano.benchmark/parse-mark 20 "gli uomini alti hanno bevuto il vino rosso alla casa rossa"
(defn parse-mark [times expr]
  (count (take (Integer. times)
               (repeatedly
                #(println (with-out-str
                            (time (mapcat :parses (parse expr)))))))))

fix location of babel.italiano.grammar/lexicon


(ns bogo-clojure.bg-websocket
  (:gen-class)
  (:require [bogo-clojure.core :as bogo]
            [clojure.string :as string])
  (:use org.httpkit.server))

(defn process!
  [channel data]
  (let [[old-string key] (string/split-lines data)
        new-string (bogo/process-key old-string key)]
    (println old-string key new-string)
    (send! channel new-string)
    ))
(defn handler [req]
  (with-channel req channel
    (on-close channel (fn [status]
                        (println "channel closed")))
    (if (websocket? channel)
      (println "WebSocket channel")
      (println "HTTP channel"))
    (on-receive channel (fn [data]
                          (process! channel data)))))

(defn -main
  [& args]
  (run-server handler {:port 8080}))

(ns bogo-clojure.bg-websocket
  (:gen-class)
  (:require [bogo-clojure.core :as bogo]
            [bogo-clojure.bg-typemode :refer :all]
            [clojure.string :as string])
  (:use org.httpkit.server))

(def typemode (atom TELEX))

(defn process!
  [channel data]
  (let [[old-string key] (string/split-lines data)
        new-string (bogo/process-key old-string key TELEX)]
    (println old-string key new-string)
    (send! channel new-string)
    ))

(defn handler [req]
  (with-channel req channel
    (on-close channel (fn [status]
                        (println "channel closed")))
    (if (websocket? channel)
      (println "WebSocket channel")
      (println "HTTP channel"))
    (on-receive channel (fn [data]
                          (process! channel data)))))

(defn -main
  [& args]
  (if (not (empty? args))
    (reset! typemode (eval (symbol "bogo-clojure.bg-typemode" (string/uppercase (string/join args)))))
    true)
  (run-server handler {:port 8080}))

Enable typemode selection through main program arguments


(ns netrunner.gameboard
  (:require-macros [cljs.core.async.macros :refer [go]])
  (:require [om.core :as om :include-macros true]
            [sablono.core :as sab :include-macros true]
            [cljs.core.async :refer [chan put! <!] :as async]
            [netrunner.main :refer [app-state]]
            [netrunner.auth :refer [avatar] :as auth]
            [netrunner.cardbrowser :refer [image-url] :as cb]))

(def game-state (atom {}))

(defn init-game [game side]
  (swap! game-state merge game)
  (swap! game-state assoc :side side))

(def zoom-channel (chan))
(def socket (.connect js/io (str js/iourl "/lobby")))
(def socket-channel (chan))
(.on socket "netrunner" #(put! socket-channel (js->clj % :keywordize-keys true)))

(go (while true
      (let [msg (<! socket-channel)]
        (case (:type msg)
          "state" (swap! game-state merge (:state msg))
          nil))))

(defn send [msg]
  (.emit socket "netrunner" (clj->js msg)))

(defn send-command
  ([command] (send-command command nil))
  ([command args]
     (send {:action "do" :gameid (:gameid @game-state) :side (:side @game-state)
            :command command :args args})))

(defn send-msg [event owner]
  (.preventDefault event)
  (let [input (om/get-node owner "msg-input")
        text (.-value input)]
    (when-not (empty? text)
      (send-command "say" {:text text})
      (aset input "value" "")
      (.focus input))))

(defn log-pane [messages owner]
  (reify
    om/IDidUpdate
    (did-update [this prev-props prev-state]
      (let [div (om/get-node owner "msg-list")]
        (aset div "scrollTop" (.-scrollHeight div))))

    om/IRenderState
    (render-state [this state]
      (sab/html
       [:div.log
        [:div.panel.blue-shade {:ref "msg-list"}
         (for [msg messages]
           (if (= (:user msg) "__system__")
             [:div.system (:text msg)]
             [:div.message
              (om/build avatar (:user msg) {:opts {:size 38}})
              [:div.content
               [:div.username (get-in msg [:user :username])]
               [:div (:text msg)]]]))]
        [:form {:on-submit #(send-msg % owner)}
         [:input {:ref "msg-input" :placeholder "Say something"}]]]))))

(defn card-view [cursor]
  (om/component
   (sab/html
    [:div.blue-shade.card {:on-mouse-enter #(put! zoom-channel cursor)
                           :on-mouse-leave #(put! zoom-channel false)}
     [:img.card.bg {:src (image-url cursor) :onError #(-> % .-target js/$ .hide)}]])))

(defn label [cursor owner opts]
  (om/component
   (sab/html
    (let [fn (or (:fn opts) count)]
      [:div.header {:class (when (> (count cursor) 0) "darkbg")}
       (str (:name opts) " (" (fn cursor) ")")]))))

(defn hand-view [{:keys [identity hand max-hand-size user] :as cursor}]
  (om/component
   (sab/html
    (let [side (:side identity)
          size (count hand)]
      [:div.panel.blue-shade.hand {:class (when (> size 6) "squeeze")}
       (om/build label hand {:opts {:name (if (= side "Corp") "HQ" "Grip")}})
       (map-indexed
        (fn [i card]
          (sab/html
           [:div.card-wrapper {:style {:left (* (/ 320 (dec size)) i)}}
            (if (= user (:user @app-state))
              [:div {:on-click #(send-command "play" {:card @card})}
               (om/build card-view card)]
              [:img.card {:src (str "/img/" (.toLowerCase side) ".png")}])]))
        hand)]))))

(defmulti deck-view #(get-in % [:identity :side]))

(defmethod deck-view "Runner" [{:keys [deck] :as cursor}]
  (om/component
   (sab/html
    [:div.panel.blue-shade.deck {}
     (om/build label deck {:opts {:name "Stack"}})
     (when (> (count deck) 0)
       [:img.card.bg {:src "/img/runner.png"}])])))

(defmethod deck-view "Corp" [{:keys [deck] :as cursor}]
  (om/component
   (sab/html
    [:div.panel.blue-shade.deck {}
     (om/build label deck {:opts {:name "R&D"}})
     (when (> (count deck) 0)
       [:img.card.bg {:src "/img/corp.png"}])])))

(defmulti discard-view #(get-in % [:identity :side]))

(defmethod discard-view "Runner" [{:keys [discard] :as cursor}]
  (om/component
   (sab/html
    [:div.panel.blue-shade.discard
     (om/build label discard {:opts {:name "Heap"}})
     (when-not (empty? discard)
       (om/build card-view (first discard)))])))

(defmethod discard-view "Corp" [{:keys [discard] :as cursor}]
  (om/component
   (sab/html
    [:div.panel.blue-shade.discard
     (om/build label discard {:opts {:name "Archive"}})
     (when-not (empty? discard)
       (om/build card-view (first discard)))])))

(defn rfg-view [{:keys [rfg] :as cursor}]
  (om/component
   (sab/html
    (when (> (count (:rfg cursor)) 0)
      [:div.panel.blue-shade.rfg
       (om/build label rfg {:opts {:name "Removed"}})]))))

(defn scored-view [{:keys [rfg] :as cursor}]
  (om/component
   (sab/html
    [:div.panel.blue-shade.scored
     (om/build label rfg {:opts {:name "Scored"}})])))

(defmulti stats-view #(get-in % [:identity :side]))

(defmethod stats-view "Runner" [{:keys [user click credit memory link tag brain-damage max-hand-size]} owner]
  (om/component
   (sab/html
    [:div.panel.blue-shade {}
     [:h4.ellipsis (om/build avatar user {:opts {:size 22}}) (:username user)]
     [:div (str click " Click" (if (> click 1) "s" ""))]
     [:div (str credit " Credit" (if (> credit 1) "s" ""))]
     [:div (str memory " Memory Unit" (if (> memory 1) "s" ""))]
     [:div (str link " Link" (if (> link 1) "s" ""))]
     (when (> tag 0)
       [:div (str tag " Tag" (if (> tag 1) "s" ""))])
     (when (> brain-damage 0)
       [:div (str brain-damage " Brain Damage" (if (> brain-damage 1) "s" ""))])
     (when-not (= max-hand-size 5)
       [:div (str max-hand-size " Max hand size")])])))

(defmethod stats-view "Corp" [{:keys [user click credit bad-publicity max-hand-size]} owner]
  (om/component
   (sab/html
    [:div.panel.blue-shade {}
     [:h4.ellipsis (om/build avatar user {:opts {:size 22}}) (:username user)]
     [:div (str click " Click" (if (> click 1) "s" ""))]
     [:div (str credit " Credit" (if (> credit 1) "s" ""))]
     (when (> bad-publicity 0)
       [:div (str bad-publicity " Bad Publicit" (if (> bad-publicity 1) "ies" "y"))])
     (when-not (= max-hand-size 5)
       [:div (str max-hand-size " Max hand size")])])))

(defmulti board #(get-in % [:identity :side]))

(defmethod board "Corp" [cursor]
  (om/component
   (sab/html
    [:div {}])))

(defmethod board "Runner" [cursor]
  (om/component
   (sab/html
    [:div {}])))

(defn zones [cursor]
  (om/component
   (sab/html
    [:div.dashboard
     (om/build hand-view cursor)
     (om/build discard-view cursor)
     (om/build deck-view cursor)
     [:div.panel.blue-shade.identity
      (om/build card-view (:identity cursor))]])))

(defn cond-button [text command cond]
  (sab/html
   (if cond
     [:button.disabled text]
     [:button {:on-click #(send-command command)} text])))

(defn gameboard [{:keys [side gameid] :as cursor} owner]
  (reify
    om/IWillMount
    (will-mount [this]
      (go (while true
            (let [card (<! zoom-channel)]
              (om/set-state! owner :zoom card)))))

    om/IRenderState
    (render-state [this state]
      (sab/html
       (let [me (if (= side :corp) (:corp cursor) (:runner cursor))
             opponent (if (= side :corp) (:runner cursor) (:corp cursor))]
         (when (> gameid 0)
           [:div.gameboard
            [:div.mainpane
             (om/build zones opponent)

             [:div.centralpane
              [:div.button-pane.panel.blue-shade
               (if-not (:keep me)
                 [:div
                  [:h4 "Keep hand?"]
                  [:button {:on-click #(send-command "keep")} "Keep hand"]
                  [:button {:on-click #(send-command "mulligan")} "Mulligan"]]
                 (when-not (:keep opponent)
                   [:h4 "Waiting for opponent's mulligan choice."]))

               (when (and (:keep me) (:keep opponent))
                 [:div
                  (when (= side :runner)
                    (cond-button "Remove Tag" "remove-tag"
                                 (or (< (:click me) 1) (< (:credit me) 2) (< (:tag me) 1))))
                  (when (= side :corp)
                    (cond-button "Purge" "purge" (< (:click me) 3)))
                  (cond-button "Draw" "draw" (< (:click me) 1))
                  (cond-button "Take Credit" "credit" (< (:click me) 1))])]

              [:div.leftpane
               [:div
                (om/build stats-view opponent)
                (om/build scored-view opponent)
                (om/build rfg-view opponent)]
               [:div
                (om/build rfg-view opponent)
                (om/build scored-view me)
                (om/build stats-view me)]]

              [:div.board
               (om/build board me)]]
             (om/build zones me)]
            [:div.rightpane {}
             [:div.card-zoom
              (when-let [card (om/get-state owner :zoom)]
                [:img.card.bg {:src (image-url card)}])]
             (om/build log-pane (:log cursor))]]))))))

(om/root gameboard game-state {:target (. js/document (getElementById "gameboard"))})

(ns netrunner.gameboard
  (:require-macros [cljs.core.async.macros :refer [go]])
  (:require [om.core :as om :include-macros true]
            [sablono.core :as sab :include-macros true]
            [cljs.core.async :refer [chan put! <!] :as async]
            [netrunner.main :refer [app-state]]
            [netrunner.auth :refer [avatar] :as auth]
            [netrunner.cardbrowser :refer [image-url] :as cb]))

(def game-state (atom {}))

(defn init-game [game side]
  (swap! game-state merge game)
  (swap! game-state assoc :side side))

(def zoom-channel (chan))
(def socket (.connect js/io (str js/iourl "/lobby")))
(def socket-channel (chan))
(.on socket "netrunner" #(put! socket-channel (js->clj % :keywordize-keys true)))

(go (while true
      (let [msg (<! socket-channel)]
        (case (:type msg)
          "state" (swap! game-state merge (:state msg))
          nil))))

(defn send [msg]
  (.emit socket "netrunner" (clj->js msg)))

(defn send-command
  ([command] (send-command command nil))
  ([command args]
     (send {:action "do" :gameid (:gameid @game-state) :side (:side @game-state)
            :command command :args args})))

(defn send-msg [event owner]
  (.preventDefault event)
  (let [input (om/get-node owner "msg-input")
        text (.-value input)]
    (when-not (empty? text)
      (send-command "say" {:text text})
      (aset input "value" "")
      (.focus input))))

(defn log-pane [messages owner]
  (reify
    om/IDidUpdate
    (did-update [this prev-props prev-state]
      (let [div (om/get-node owner "msg-list")]
        (aset div "scrollTop" (.-scrollHeight div))))

    om/IRenderState
    (render-state [this state]
      (sab/html
       [:div.log
        [:div.panel.blue-shade {:ref "msg-list"}
         (for [msg messages]
           (if (= (:user msg) "__system__")
             [:div.system (:text msg)]
             [:div.message
              (om/build avatar (:user msg) {:opts {:size 38}})
              [:div.content
               [:div.username (get-in msg [:user :username])]
               [:div (:text msg)]]]))]
        [:form {:on-submit #(send-msg % owner)}
         [:input {:ref "msg-input" :placeholder "Say something"}]]]))))

(defn card-view [cursor]
  (om/component
   (sab/html
    [:div.blue-shade.card {:on-mouse-enter #(put! zoom-channel cursor)
                           :on-mouse-leave #(put! zoom-channel false)}
     [:img.card.bg {:src (image-url cursor) :onError #(-> % .-target js/$ .hide)}]])))

(defn label [cursor owner opts]
  (om/component
   (sab/html
    (let [fn (or (:fn opts) count)]
      [:div.header {:class (when (> (count cursor) 0) "darkbg")}
       (str (:name opts) " (" (fn cursor) ")")]))))

(defn hand-view [{:keys [identity hand max-hand-size user] :as cursor}]
  (om/component
   (sab/html
    (let [side (:side identity)
          size (count hand)]
      [:div.panel.blue-shade.hand {:class (when (> size 6) "squeeze")}
       (om/build label hand {:opts {:name (if (= side "Corp") "HQ" "Grip")}})
       (map-indexed
        (fn [i card]
          (sab/html
           [:div.card-wrapper {:style {:left (* (/ 320 (dec size)) i)}}
            (if (= user (:user @app-state))
              [:div {:on-click #(send-command "play" {:card @card})}
               (om/build card-view card)]
              [:img.card {:src (str "/img/" (.toLowerCase side) ".png")}])]))
        hand)]))))

(defmulti deck-view #(get-in % [:identity :side]))

(defmethod deck-view "Runner" [{:keys [deck] :as cursor}]
  (om/component
   (sab/html
    [:div.panel.blue-shade.deck {}
     (om/build label deck {:opts {:name "Stack"}})
     (when (> (count deck) 0)
       [:img.card.bg {:src "/img/runner.png"}])])))

(defmethod deck-view "Corp" [{:keys [deck] :as cursor}]
  (om/component
   (sab/html
    [:div.panel.blue-shade.deck {}
     (om/build label deck {:opts {:name "R&D"}})
     (when (> (count deck) 0)
       [:img.card.bg {:src "/img/corp.png"}])])))

(defmulti discard-view #(get-in % [:identity :side]))

(defmethod discard-view "Runner" [{:keys [discard] :as cursor}]
  (om/component
   (sab/html
    [:div.panel.blue-shade.discard
     (om/build label discard {:opts {:name "Heap"}})
     (when-not (empty? discard)
       (om/build card-view (last discard)))])))

(defmethod discard-view "Corp" [{:keys [discard] :as cursor}]
  (om/component
   (sab/html
    [:div.panel.blue-shade.discard
     (om/build label discard {:opts {:name "Archive"}})
     (when-not (empty? discard)
       (om/build card-view (last discard)))])))

(defn rfg-view [{:keys [rfg] :as cursor}]
  (om/component
   (sab/html
    (when (> (count (:rfg cursor)) 0)
      [:div.panel.blue-shade.rfg
       (om/build label rfg {:opts {:name "Removed"}})]))))

(defn scored-view [{:keys [rfg] :as cursor}]
  (om/component
   (sab/html
    [:div.panel.blue-shade.scored
     (om/build label rfg {:opts {:name "Scored"}})])))

(defmulti stats-view #(get-in % [:identity :side]))

(defmethod stats-view "Runner" [{:keys [user click credit memory link tag brain-damage max-hand-size]} owner]
  (om/component
   (sab/html
    [:div.panel.blue-shade {}
     [:h4.ellipsis (om/build avatar user {:opts {:size 22}}) (:username user)]
     [:div (str click " Click" (if (> click 1) "s" ""))]
     [:div (str credit " Credit" (if (> credit 1) "s" ""))]
     [:div (str memory " Memory Unit" (if (> memory 1) "s" ""))]
     [:div (str link " Link" (if (> link 1) "s" ""))]
     (when (> tag 0)
       [:div (str tag " Tag" (if (> tag 1) "s" ""))])
     (when (> brain-damage 0)
       [:div (str brain-damage " Brain Damage" (if (> brain-damage 1) "s" ""))])
     (when-not (= max-hand-size 5)
       [:div (str max-hand-size " Max hand size")])])))

(defmethod stats-view "Corp" [{:keys [user click credit bad-publicity max-hand-size]} owner]
  (om/component
   (sab/html
    [:div.panel.blue-shade {}
     [:h4.ellipsis (om/build avatar user {:opts {:size 22}}) (:username user)]
     [:div (str click " Click" (if (> click 1) "s" ""))]
     [:div (str credit " Credit" (if (> credit 1) "s" ""))]
     (when (> bad-publicity 0)
       [:div (str bad-publicity " Bad Publicit" (if (> bad-publicity 1) "ies" "y"))])
     (when-not (= max-hand-size 5)
       [:div (str max-hand-size " Max hand size")])])))

(defmulti board #(get-in % [:identity :side]))

(defmethod board "Corp" [cursor]
  (om/component
   (sab/html
    [:div {}])))

(defmethod board "Runner" [cursor]
  (om/component
   (sab/html
    [:div {}])))

(defn zones [cursor]
  (om/component
   (sab/html
    [:div.dashboard
     (om/build hand-view cursor)
     (om/build discard-view cursor)
     (om/build deck-view cursor)
     [:div.panel.blue-shade.identity
      (om/build card-view (:identity cursor))]])))

(defn cond-button [text command cond]
  (sab/html
   (if cond
     [:button.disabled text]
     [:button {:on-click #(send-command command)} text])))

(defn gameboard [{:keys [side gameid] :as cursor} owner]
  (reify
    om/IWillMount
    (will-mount [this]
      (go (while true
            (let [card (<! zoom-channel)]
              (om/set-state! owner :zoom card)))))

    om/IRenderState
    (render-state [this state]
      (sab/html
       (let [me (if (= side :corp) (:corp cursor) (:runner cursor))
             opponent (if (= side :corp) (:runner cursor) (:corp cursor))]
         (when (> gameid 0)
           [:div.gameboard
            [:div.mainpane
             (om/build zones opponent)

             [:div.centralpane
              [:div.button-pane.panel.blue-shade
               (if-not (:keep me)
                 [:div
                  [:h4 "Keep hand?"]
                  [:button {:on-click #(send-command "keep")} "Keep hand"]
                  [:button {:on-click #(send-command "mulligan")} "Mulligan"]]
                 (when-not (:keep opponent)
                   [:h4 "Waiting for opponent's mulligan choice."]))

               (when (and (:keep me) (:keep opponent))
                 [:div
                  (when (= side :runner)
                    (cond-button "Remove Tag" "remove-tag"
                                 (or (< (:click me) 1) (< (:credit me) 2) (< (:tag me) 1))))
                  (when (= side :corp)
                    (cond-button "Purge" "purge" (< (:click me) 3)))
                  (cond-button "Draw" "draw" (< (:click me) 1))
                  (cond-button "Take Credit" "credit" (< (:click me) 1))])]

              [:div.leftpane
               [:div
                (om/build stats-view opponent)
                (om/build scored-view opponent)
                (om/build rfg-view opponent)]
               [:div
                (om/build rfg-view opponent)
                (om/build scored-view me)
                (om/build stats-view me)]]

              [:div.board
               (om/build board me)]]
             (om/build zones me)]
            [:div.rightpane {}
             [:div.card-zoom
              (when-let [card (om/get-state owner :zoom)]
                [:img.card.bg {:src (image-url card)}])]
             (om/build log-pane (:log cursor))]]))))))

(om/root gameboard game-state {:target (. js/document (getElementById "gameboard"))})

fix issue with discard pile card display


(ns active.clojure.lens)

(defprotocol Lens
  "Protocol for types that can be used as a lens, defined by a
   function to yank some value out of a given data value, and a function
   to shove an updated value back in."
  (-yank [lens data])
  (-shove [lens data v]))

;; TODO document lens laws

(defn yank
  "Yank a value from the given data value, as defined by the given
   lens."
  [data lens]
  (-yank lens data))

(defn shove
  "Shove a new value v into the given data value, as defined by the
   given lens, and return the updated data structure."
  [data lens v]
  (-shove lens data v))

;; Keywords are lenses over a map (or object), focusing on the value associated with that keyword.
(extend-type #+clj clojure.lang.Keyword #+cljs cljs.core.Keyword
  Lens
  (-yank [kw data] (kw data))
  (-shove [kw data v] (assoc data kw v)))

(defrecord ExplicitLens
    ^{:private true}
  [yanker shover]
  Lens
  (-yank [lens data] (yanker data))
  (-shove [lens data v] (shover data v)))

(defn lens
  "Returns a new lens defined by the given yanker function, which takes a data
   structure and must return the focused value, and the given shover function
   which takes a data structure and the new value in the focus."
  [yank shove]
  (ExplicitLens. yank shove))

(defn xmap
  "Returns a \"view lens\", that transforms a whole data structure
   to something else (f) and back (g)."
  [f g]
  (lens f #(g %2)))

(defrecord IdentityLens []
  Lens
  (-yank [_ data] data)
  (-shove [_ data v] v))

(def
  ^{:doc "Identity lens, that just show a data structure as it is.
          It's also the neutral element of lens concatenation
          reacl.lens/>>."}
  id (xmap identity identity))

(defn- >>2
  [l1 l2]
  (lens (fn [data] (yank (yank data l1) l2))
        (fn [data v] (shove data l1 (shove (yank data l1) l2 v)))))

(defn >>
  "Returns a concatenation of two or more lenses, so that the combination shows the
   value of the last one, in a data structure that the first one is put
   over."
  [l1 & lmore]
  (assert (not-any? #(not (satisfies? Lens %)) (cons l1 lmore)))
  (loop [res l1
         lmore lmore]
    (if (empty? lmore)
      res
      (recur (>>2 res (first lmore)) (rest lmore)))))

(defn default
  "Returns a lens that shows nil as the given value, but does not change any other value."
  [v]
  (xmap #(if (nil? %) v %)
        #(if (= v %) nil %)))

(defn- consx [v coll]
  (if (and (nil? v) (empty? coll))
    coll
    (cons v coll)))

(def
  ^{:doc "A lens focusing on the first element in a collection. It
  yanks nil if the collection is empty, and will not insert nil into an empty collection."}
  head
  (lens #(first %)
        #(consx %2 (rest %1))))

(def
  ^{:doc
  "A lens focusing on the first element in a non-empty
  collection. Behaviour on an empty collection is undefined."}
  nel-head
  (lens #(first %)
        #(cons %2 (rest %1))))

(def
  ^{:doc "A lens focusing on the all but the first element in a collection.
  Note that nil will be prepended when shoving into an empty collection."}
  tail
  (lens #(rest %)
        #(consx (first %1) %2)))

(def
  ^{:doc "A lens focusing on the all but the first element in a non-empty collection.
  Behaviour on an empty collection is undefined."}
  nel-tail
  (lens #(rest %)
        #(cons (first %1) %2)))

(defn pos
  "A lens over the nth element in a collection. Note that when shoving a
  new value nils may be added before the given position, if the the collection is smaller."
  [n]
  (assert (number? n))
  (assert (>= n 0))
  ;; there are probably more efficient implementations:
  (if (= n 0)
    head
    (>> tail (pos (- n 1)))))

(def ^{:doc "A lens that views a sequence as a set."}
  as-set
  (xmap set seq))

(defn contains
  "Returns a lens showing the membership of the given value in a set."
  [v]
  (lens #(contains? % v)
        #(if %2
           (conj %1 v)
           (disj %1 v))))

(def ^{:doc "A lens that views a sequence of pairs as a map."}
  as-map
  (xmap #(into {} %) seq))

(defn member
  "Returns a lens showing the value mapped to the given key in a map,
  not-found or nil if key is not present. Note that when not-found (or
  nil) is shoved into the map, the association is removed."
  [key & [not-found]]
  (lens #(get % key not-found)
        #(if (= %2 not-found)
           (dissoc %1 key)
           (assoc %1 key %2))))

(def ^{:doc "A trivial lens that just shows nil over anything, and does never change anything."}
  void
  (lens (constantly nil) (fn [data _] data)))

(defn is
  "Returns a lens showing if a data structure equals the non-nil value v."
  [v]
  (assert (not (nil? v)))
  (lens #(= % v)
        #(if %2
           v
           (if (= %1 v)
             nil
             %1))))

(defn **
  "Return the product of several lenses, which means that each lens is
  held over an element of a collection in the order they appear in the
  argument list."
  [& lenses]
  (lens (fn [data] (map #(yank %1 %2)
                       data lenses))
        (fn [data v] (map #(shove %1 %2 %3)
                         data lenses v))))

#+cljs
(comment not very general: defn repeated
  [n]
  (lens #(take n (repeat %))
        (fn [data v]
          (or (some #(not (= % data))
                    v)
              data))))

(defn ++
  "Returns a lens over some data structure that shows a sequence of
  elements that each of the given lenses show on that. Note that the
  behaviour is undefined if those lenses do not show distrinct parts
  of the data structure."
  [& lenses]
  (lens (fn [data] (map #(yank %1 %2)
                       (repeat data)
                       lenses))
        (fn [data v] (reduce (fn [data [l v]] (shove data l v))
                            data
                            (map vector lenses v)))))

(defn at-index
  "Returns a lens that focuses on the value at position n in a sequence.
  The sequence must have >= n elements."
  [n]
  (lens (fn [coll] (nth coll n))
        (fn [coll v]
          (let [[front back] (split-at n coll)]
            (concat front
                    [v]
                    (rest back))))))

(defn at-key
  [extract-key key]
  (lens (fn [coll]
          (some (fn [el]
                  (and (= key (extract-key el))
                       el))
                coll))
        (fn [coll v]
          (map (fn [el]
                 (if (= key (extract-key el))
                   v
                   el))
               coll))))

(defn map-keyed
  [extract-key f coll]
  (map (fn [el]
         (let [key (extract-key el)]
           (f el key (at-key extract-key key))))
       coll))

(defrecord Path
    [path]
  Lens
  (-yank [this data]
    (reduce yank data path))
  (-shove [this data v]
    (letfn [(u [data path]
              (if-let [[p & ps] path]
                (shove data p (u (yank data p) ps))
                v))]
      (u data (seq path)))))

(defn in
  [& accessors]
  (Path. accessors))

(ns active.clojure.lens)

(defprotocol Lens
  "Protocol for types that can be used as a lens, defined by a
   function to yank some value out of a given data value, and a function
   to shove an updated value back in."
  (-yank [lens data])
  (-shove [lens data v]))

;; TODO document lens laws

(defn yank
  "Yank a value from the given data value, as defined by the given
   lens."
  [data lens]
  (-yank lens data))

(defn shove
  "Shove a new value v into the given data value, as defined by the
   given lens, and return the updated data structure."
  [data lens v]
  (-shove lens data v))

;; Keywords are lenses over a map (or object), focusing on the value associated with that keyword.
(extend-type #+clj clojure.lang.Keyword #+cljs cljs.core.Keyword
  Lens
  (-yank [kw data] (kw data))
  (-shove [kw data v] (assoc data kw v)))

(defrecord ExplicitLens
    ^{:private true}
  [yanker shover]
  Lens
  (-yank [lens data] (yanker data))
  (-shove [lens data v] (shover data v)))

(defn lens
  "Returns a new lens defined by the given yanker function, which takes a data
   structure and must return the focused value, and the given shover function
   which takes a data structure and the new value in the focus."
  [yank shove]
  (ExplicitLens. yank shove))

(defn xmap
  "Returns a \"view lens\", that transforms a whole data structure
   to something else (f) and back (g)."
  [f g]
  (lens f #(g %2)))

(defrecord IdentityLens []
  Lens
  (-yank [_ data] data)
  (-shove [_ data v] v))

(def
  ^{:doc "Identity lens, that just show a data structure as it is.
          It's also the neutral element of lens concatenation
          reacl.lens/>>."}
  id (xmap identity identity))

(defn- >>2
  [l1 l2]
  (lens (fn [data] (yank (yank data l1) l2))
        (fn [data v] (shove data l1 (shove (yank data l1) l2 v)))))

(defn >>
  "Returns a concatenation of two or more lenses, so that the combination shows the
   value of the last one, in a data structure that the first one is put
   over."
  [l1 & lmore]
  (assert (not-any? #(not (satisfies? Lens %)) (cons l1 lmore)))
  (loop [res l1
         lmore lmore]
    (if (empty? lmore)
      res
      (recur (>>2 res (first lmore)) (rest lmore)))))

(defn default
  "Returns a lens that shows nil as the given value, but does not change any other value."
  [v]
  (xmap #(if (nil? %) v %)
        #(if (= v %) nil %)))

(defn- consx [v coll]
  (if (and (nil? v) (empty? coll))
    coll
    (cons v coll)))

(def
  ^{:doc "A lens focusing on the first element in a collection. It
  yanks nil if the collection is empty, and will not insert nil into an empty collection."}
  head
  (lens #(first %)
        #(consx %2 (rest %1))))

(def
  ^{:doc
  "A lens focusing on the first element in a non-empty
  collection. Behaviour on an empty collection is undefined."}
  nel-head
  (lens #(first %)
        #(cons %2 (rest %1))))

(def
  ^{:doc "A lens focusing on the all but the first element in a collection.
  Note that nil will be prepended when shoving into an empty collection."}
  tail
  (lens #(rest %)
        #(consx (first %1) %2)))

(def
  ^{:doc "A lens focusing on the all but the first element in a non-empty collection.
  Behaviour on an empty collection is undefined."}
  nel-tail
  (lens #(rest %)
        #(cons (first %1) %2)))

(defn pos
  "A lens over the nth element in a collection. Note that when shoving a
  new value nils may be added before the given position, if the the collection is smaller."
  [n]
  (assert (number? n))
  (assert (>= n 0))
  ;; there are probably more efficient implementations:
  (if (= n 0)
    head
    (>> tail (pos (- n 1)))))

(def ^{:doc "A lens that views a sequence as a set."}
  as-set
  (lens set
        ; this is needed to abide the second lens law
        #(if (= (set %1) %2)
           %1
           (seq %2))))

(defn contains
  "Returns a lens showing the membership of the given value in a set."
  [v]
  (lens #(contains? % v)
        #(if %2
           (conj %1 v)
           (disj %1 v))))

(def ^{:doc "A lens that views a sequence of pairs as a map."}
  as-map
  (xmap #(into {} %) seq))

(defn member
  "Returns a lens showing the value mapped to the given key in a map,
  not-found or nil if key is not present. Note that when not-found (or
  nil) is shoved into the map, the association is removed."
  [key & [not-found]]
  (lens #(get % key not-found)
        #(if (= %2 not-found)
           (dissoc %1 key)
           (assoc %1 key %2))))

(def ^{:doc "A trivial lens that just shows nil over anything, and does never change anything."}
  void
  (lens (constantly nil) (fn [data _] data)))

(defn is
  "Returns a lens showing if a data structure equals the non-nil value v."
  [v]
  (assert (not (nil? v)))
  (lens #(= % v)
        #(if %2
           v
           (if (= %1 v)
             nil
             %1))))

(defn **
  "Return the product of several lenses, which means that each lens is
  held over an element of a collection in the order they appear in the
  argument list."
  [& lenses]
  (lens (fn [data] (map #(yank %1 %2)
                       data lenses))
        (fn [data v] (map #(shove %1 %2 %3)
                         data lenses v))))

#+cljs
(comment not very general: defn repeated
  [n]
  (lens #(take n (repeat %))
        (fn [data v]
          (or (some #(not (= % data))
                    v)
              data))))

(defn ++
  "Returns a lens over some data structure that shows a sequence of
  elements that each of the given lenses show on that. Note that the
  behaviour is undefined if those lenses do not show distrinct parts
  of the data structure."
  [& lenses]
  (lens (fn [data] (map #(yank %1 %2)
                       (repeat data)
                       lenses))
        (fn [data v] (reduce (fn [data [l v]] (shove data l v))
                            data
                            (map vector lenses v)))))

(defn at-index
  "Returns a lens that focuses on the value at position n in a sequence.
  The sequence must have >= n elements."
  [n]
  (lens (fn [coll] (nth coll n))
        (fn [coll v]
          (let [[front back] (split-at n coll)]
            (concat front
                    [v]
                    (rest back))))))

(defn at-key
  [extract-key key]
  (lens (fn [coll]
          (some (fn [el]
                  (and (= key (extract-key el))
                       el))
                coll))
        (fn [coll v]
          (map (fn [el]
                 (if (= key (extract-key el))
                   v
                   el))
               coll))))

(defn map-keyed
  [extract-key f coll]
  (map (fn [el]
         (let [key (extract-key el)]
           (f el key (at-key extract-key key))))
       coll))

(defrecord Path
    [path]
  Lens
  (-yank [this data]
    (reduce yank data path))
  (-shove [this data v]
    (letfn [(u [data path]
              (if-let [[p & ps] path]
                (shove data p (u (yank data p) ps))
                v))]
      (u data (seq path)))))

(defn in
  [& accessors]
  (Path. accessors))

Make the as-set lens abide the second lens law.


(set-env!
  :source-paths #{"src"}
  :resource-paths #{"resources"}
  :dependencies '[[perun "0.4.1-SNAPSHOT"]
                  [hiccup "1.0.5"]
                  [pandeiro/boot-http "0.6.3-SNAPSHOT"]])

(require '[io.perun :refer :all]
         '[io.perun.example.index :as index-view]
         '[io.perun.example.post :as post-view]
         '[pandeiro.boot-http :refer [serve]])

(deftask build
  "Build test blog. This task is just for testing different plugins together."
  []
  (comp
        (global-metadata)
        (markdown)
        (draft)
        (print-meta)
        (slug)
        (ttr)
        (word-count)
        (permalink)
        (build-date)
        (gravatar :source-key :author-email :target-key :author-gravatar)
        (render :renderer 'io.perun.example.post/render)
        (collection :renderer 'io.perun.example.index/render :page "index.html")
        (static :renderer 'io.perun.example.about/render :page "about.html")
        (inject-scripts :scripts #{"start.js"})
        (sitemap)
        (rss :description "Hashobject blog")
        (atom-feed :filterer :original)
        (debug)
        (notify)))

(deftask dev
  []
  (comp (watch)
        (build)
        (serve :resource-root "public")))

(set-env!
  :source-paths #{"src"}
  :resource-paths #{"resources"}
  :dependencies '[[perun "0.4.1-SNAPSHOT"]
                  [hiccup "1.0.5"]
                  [pandeiro/boot-http "0.6.3-SNAPSHOT"]])

(require '[io.perun :refer :all]
         '[io.perun.example.index :as index-view]
         '[io.perun.example.post :as post-view]
         '[pandeiro.boot-http :refer [serve]])

(deftask build
  "Build test blog. This task is just for testing different plugins together."
  []
  (comp
        (global-metadata)
        (markdown)
        (draft)
        (print-meta)
        (slug)
        (ttr)
        (word-count)
        (permalink)
        (build-date)
        (gravatar :source-key :author-email :target-key :author-gravatar)
        (render :renderer 'io.perun.example.post/render)
        (collection :renderer 'io.perun.example.index/render :page "index.html")
        (static :renderer 'io.perun.example.about/render :page "about.html")
        (inject-scripts :scripts #{"start.js"})
        (sitemap)
        (rss :description "Hashobject blog")
        (atom-feed :filterer :original)
        (print-meta)
        (notify)))

(deftask dev
  []
  (comp (watch)
        (build)
        (serve :resource-root "public")))

remove incorrect task

remove incorrect task


(ns pericles.routes
  (:require [compojure.core :refer :all]
            [compojure.route :as route]
            [ring.middleware.defaults :refer [wrap-defaults api-defaults]]
            [gpio.core :as gpio]
            [pericles.gpio :refer [port]]
            [pericles.handlers :as handlers]))

(defroutes api-routes
  (GET "/" [] "Hello world!")
  (GET "/readPort" [] (gpio/read-value @port))
  (GET "/writePort" [value] (gpio/write-value! @port value))
  (route/not-found "Not found!"))

(def app (-> #'api-routes
             (wrap-defaults api-defaults)
             handlers/wrap-catch-exceptions
             handlers/wrap-log-request))

(ns pericles.routes
  (:require [compojure.core :refer :all]
            [compojure.route :as route]
            [ring.middleware.defaults :refer [wrap-defaults api-defaults]]
            [gpio.core :as gpio]
            [pericles.gpio :refer [port]]
            [pericles.handlers :as handlers]))

(defroutes api-routes
  (GET "/" [] "Hello world!")
  (GET "/readPort" [] (name (gpio/read-value @port)))
  (GET "/writePort" [value] (gpio/write-value! @port value))
  (route/not-found "Not found!"))

(def app (-> #'api-routes
             (wrap-defaults api-defaults)
             handlers/wrap-catch-exceptions
             handlers/wrap-log-request))

Return string when reading

Return string when reading


(ns pharrellel-test
  (:require [clojure.test :as t]
            [clojure.stacktrace :as stack])
  (:import java.util.concurrent.LinkedBlockingQueue
           java.util.AbstractQueue))

(def ^{:dynamic true} *result-queue* nil)

(defmacro with-test-out-str
  "Evaluates exprs in a context in which *out* and *test-out* are bound to a
  fresh StringWriter.  Returns the string created by any nested printing
  calls."
  {:added "1.0"}
  [& body]
  `(let [s# (new java.io.StringWriter)]
     (binding [t/*test-out* s#
               *out* s#]
       ~@body
       (str s#))))

(defmacro with-test-out [& body]
  `(let [x# (with-test-out-str ~@body)]
     (.put *result-queue* x#)))

;; monkeypatch all of these, they're done dumbly

(defmethod t/report :default [m]
  (with-test-out (prn m)))

(defmethod t/report :pass [m]
  (with-test-out (t/inc-report-counter :pass)))

(defmethod t/report :fail [m]
  (with-test-out
    (t/inc-report-counter :fail)
    (println "\nFAIL in" (t/testing-vars-str m))
    (when-let [message (:message m)] (println message))
    (println "expected:" (pr-str (:expected m)))
    (println "  actual:" (pr-str (:actual m)))))

(defmethod t/report :error [m]
  (with-test-out
   (t/inc-report-counter :error)
   (println "\nERROR in" (t/testing-vars-str m))
   (when-let [message (:message m)] (println message))
   (println "expected:" (pr-str (:expected m)))
   (print "  actual: ")
   (let [actual (:actual m)]
     (if (instance? Throwable actual)
       (stack/print-cause-trace actual t/*stack-trace-depth*)
       (prn actual)))))

(defmethod t/report :summary [m]
  (with-test-out
   (println "\nRan" (:test m) "tests containing"
            (+ (:pass m) (:fail m) (:error m)) "assertions.")
   (println (:fail m) "failures," (:error m) "errors.")))

(defmethod t/report :begin-test-ns [m]
  (with-test-out
   (println "\nTesting" (ns-name (:ns m)))))

;; Ignore these message types:
(defmethod t/report :end-test-ns [m])
(defmethod t/report :begin-test-var [m])
(defmethod t/report :end-test-var [m])

(def ^{:dynamic true} *parallelism* 4)

(defn gather-tests-from-ns [^AbstractQueue queue n]
  (let [once-fixture-fn (t/join-fixtures (::once-fixtures (meta n)))
        each-fixture-fn (t/join-fixtures (::each-fixtures (meta n)))]
    (doseq [v (vals (ns-interns n))]
      (when (:test (meta v))
        (.put queue [v each-fixture-fn once-fixture-fn])))))

(defn test-var [^AbstractQueue result-queue v]
  (when-let [t (:test (meta v))]
    (try (t)
      (catch Throwable e
        (t/do-report
          {:type :error, :message "Uncaught exception, not in assertion."
           :expected nil, :actual e})))))

(defn run-worker [results tests-to-run worker-id finished]
  (future
    (try
      (binding [*result-queue* results]
        (loop []
          (if-let [[tvar each-fixture once-fixture] (.poll tests-to-run)]
            (do
              (once-fixture
                (fn []
                  (each-fixture
                    #(test-var results tvar))))
              (println "finished running " tvar)
              (recur))
            (do
              (println "finished on " worker-id)
              (deliver (nth finished worker-id) 1)))))
      (catch Throwable e
        (.printStackTrace e))
      (finally (deliver (nth finished worker-id) 1)))))

(defn run-gathered-tests [^AbstractQueue tests-to-run]
  (let [results (LinkedBlockingQueue.)
        finished (into [] (map (fn [_] (promise)) (range *parallelism*)))]
    (dotimes [worker-id *parallelism*]
      (run-worker results tests-to-run worker-id finished))
    (doseq [n finished]
      (deref n))
    (doseq [r (iterator-seq (.iterator results))]
      (println r))))

(defn gather-tests [ns-re]
  (let [queue (LinkedBlockingQueue.)]
    (doseq [n (filter #(re-matches ns-re (name (ns-name %))) (all-ns))]
      (gather-tests-from-ns queue n))
    queue))

(defn run-tests [ns-re]
  (-> (gather-tests ns-re)
    run-gathered-tests))

(defn -main [& args]
  (run-tests #"pharrellel-test.*"))

(ns pharrellel-test
  (:require [clojure.test :as t]
            [clojure.stacktrace :as stack])
  (:import java.util.concurrent.LinkedBlockingQueue
           java.util.AbstractQueue))

(def ^{:dynamic true} *result-queue* nil)

(defmacro with-test-out-str
  "Evaluates exprs in a context in which *out* and *test-out* are bound to a
  fresh StringWriter.  Returns the string created by any nested printing
  calls."
  {:added "1.0"}
  [& body]
  `(let [s# (new java.io.StringWriter)]
     (binding [t/*test-out* s#
               *out* s#]
       ~@body
       (str s#))))

(defmacro with-test-out [& body]
  `(let [x# (with-test-out-str ~@body)]
     (.put *result-queue* x#)))

;; monkeypatch all of these, they're done dumbly

(defmethod t/report :default [m]
  (with-test-out (prn m)))

(defmethod t/report :pass [m]
  (with-test-out (t/inc-report-counter :pass)))

(defmethod t/report :fail [m]
  (with-test-out
    (t/inc-report-counter :fail)
    (println "\nFAIL in" (t/testing-vars-str m))
    (when-let [message (:message m)] (println message))
    (println "expected:" (pr-str (:expected m)))
    (println "  actual:" (pr-str (:actual m)))))

(defmethod t/report :error [m]
  (with-test-out
   (t/inc-report-counter :error)
   (println "\nERROR in" (t/testing-vars-str m))
   (when-let [message (:message m)] (println message))
   (println "expected:" (pr-str (:expected m)))
   (print "  actual: ")
   (let [actual (:actual m)]
     (if (instance? Throwable actual)
       (stack/print-cause-trace actual t/*stack-trace-depth*)
       (prn actual)))))

(defmethod t/report :summary [m]
  (with-test-out
   (println "\nRan" (:test m) "tests containing"
            (+ (:pass m) (:fail m) (:error m)) "assertions.")
   (println (:fail m) "failures," (:error m) "errors.")))

(defmethod t/report :begin-test-ns [m]
  (with-test-out
   (println "\nTesting" (ns-name (:ns m)))))

;; Ignore these message types:
(defmethod t/report :end-test-ns [m])
(defmethod t/report :begin-test-var [m])
(defmethod t/report :end-test-var [m])

(def ^{:dynamic true} *parallelism* 4)

(defn gather-tests-from-ns [^AbstractQueue queue n]
  (let [once-fixture-fn (t/join-fixtures (::once-fixtures (meta n)))
        each-fixture-fn (t/join-fixtures (::each-fixtures (meta n)))]
    (doseq [v (vals (ns-interns n))]
      (when (:test (meta v))
        (.put queue [v each-fixture-fn once-fixture-fn])))))

(defn test-var [^AbstractQueue result-queue v]
  (when-let [t (:test (meta v))]
    (try (t)
      (catch Throwable e
        (t/do-report
          {:type :error, :message "Uncaught exception, not in assertion."
           :expected nil, :actual e})))))

(defn run-worker [results tests-to-run worker-id finished]
  (future
    (try
      (binding [*result-queue* results]
        (loop []
          (if-let [[tvar each-fixture once-fixture] (.poll tests-to-run)]
            (do
              (once-fixture
                (fn []
                  (each-fixture
                    #(test-var results tvar))))
              (recur))
            (do
              (deliver (nth finished worker-id) 1)))))
      (catch Throwable e
        (.printStackTrace e))
      (finally (deliver (nth finished worker-id) 1)))))

(defn run-gathered-tests [^AbstractQueue tests-to-run]
  (let [results (LinkedBlockingQueue.)
        finished (into [] (map (fn [_] (promise)) (range *parallelism*)))]
    (dotimes [worker-id *parallelism*]
      (run-worker results tests-to-run worker-id finished))
    (doseq [n finished]
      (deref n))
    (doseq [r (iterator-seq (.iterator results))]
      (println r))))

(defn gather-tests [ns-re]
  (let [queue (LinkedBlockingQueue.)]
    (doseq [n (filter #(re-matches ns-re (name (ns-name %))) (all-ns))]
      (gather-tests-from-ns queue n))
    queue))

(defn run-tests [ns-re]
  (-> (gather-tests ns-re)
    run-gathered-tests))

(defn -main [& args]
  (run-tests #"pharrellel-test.*"))

remove printlns

remove printlns


(ns cawala.api.mutations
  (:require
   [taoensso.timbre :as timbre]
   [com.wsscode.pathom.core :as p]
   [com.wsscode.pathom.connect :as pc]
   [cawala.api.read :as r]
   [fulcro.server :refer [defmutation]]))

;; Place your server mutations here
#_(defmutation delete-person
  "Server Mutation: Handles deleting a person on the server"
  [{:keys [person-id]}]
  (action [{:keys [state]}]
          (timbre/info "Server deleting person" person-id)
          (swap! people-db dissoc person-id)))

(def delete-person r/delete-person)

#_(pc/defmutation delete-person [{::keys [db]} {:keys [person-id]}]
    {::pc/params [:person-id]
     ::pc/sym 'cawala.api.mutations/delete-person}
    (do
      (timbre/info "Server deleting person" person-id)
      (swap! db dissoc person-id)
      nil))

(ns cawala.api.mutations
  (:require
   [taoensso.timbre :as timbre]
   [com.wsscode.pathom.core :as p]
   [com.wsscode.pathom.connect :as pc]
   [cawala.api.read :as r]
   #_[fulcro.server :refer [defmutation]]))

;; Place your server mutations here
#_(defmutation delete-person
  "Server Mutation: Handles deleting a person on the server"
  [{:keys [person-id]}]
  (action [{:keys [state]}]
          (timbre/info "Server deleting person" person-id)
          (swap! people-db dissoc person-id)))

(def delete-person r/delete-person)

#_(pc/defmutation delete-person [{::keys [db]} {:keys [person-id]}]
    {::pc/params [:person-id]
     ::pc/sym 'cawala.api.mutations/delete-person}
    (do
      (timbre/info "Server deleting person" person-id)
      (swap! db dissoc person-id)
      nil))

Make sure to use the correct defmutation


;; This Source Code Form is subject to the terms of the Mozilla Public
;; License, v. 2.0. If a copy of the MPL was not distributed with this
;; file, You can obtain one at http://mozilla.org/MPL/2.0/.
;;
;; Copyright (c) 2016 Andrey Antukh <niwi@niwi.nz>

(ns uxbox.frontend.icons
  (:require [clojure.spec :as s]
            [promesa.core :as p]
            [catacumba.http :as http]
            [storages.core :as st]
            [uxbox.schema :as us]
            [uxbox.services :as sv]
            [uxbox.util.response :refer (rsp)]
            [uxbox.util.uuid :as uuid]
            [uxbox.util.paths :as paths]))

;; --- Constants & Config

(s/def ::collection (s/nilable ::us/uuid-string))

(s/def ::width (s/and number? pos?))
(s/def ::height (s/and number? pos?))
(s/def ::view-box (s/and (s/coll-of number?)
                         #(= 4 (count %))
                         vector?))

(s/def ::mimetype string?)
(s/def ::metadata
  (s/keys :opt-un [::width ::height ::view-box ::mimetype]))

(s/def ::content string?)

;; --- Create Collection

(s/def ::create-collection
  (s/keys :req-un [::us/name] :opt-un [::us/id]))

(defn create-collection
  [{user :identity data :data}]
  (let [data (us/conform ::create-collection data)
        message (assoc data
                       :type :create-icon-collection
                       :user user)]
    (->> (sv/novelty message)
         (p/map (fn [result]
                  (let [loc (str "/api/library/icons/" (:id result))]
                    (http/created loc (rsp result))))))))

;; --- Update Collection

(s/def ::update-collection
  (s/merge ::create-collection (s/keys :req-un [::us/version])))

(defn update-collection
  [{user :identity params :route-params data :data}]
  (let [data (us/conform ::update-collection data)
        message (assoc data
                       :id (uuid/from-string (:id params))
                       :type :update-icon-collection
                       :user user)]
    (-> (sv/novelty message)
        (p/then #(http/ok (rsp %))))))

;; --- Delete Collection

(defn delete-collection
  [{user :identity params :route-params}]
  (let [message {:id (uuid/from-string (:id params))
                 :type :delete-icon-collection
                 :user user}]
    (-> (sv/novelty message)
        (p/then (fn [v] (http/no-content))))))

;; --- List collections

(defn list-collections
  [{user :identity}]
  (let [params {:user user
                :type :list-icon-collections}]
    (-> (sv/query params)
        (p/then #(http/ok (rsp %))))))

;; --- Retrieve Icon

(s/def ::retrieve-icon
  (s/keys :req-un [::us/id]))

(defn retrieve-icon
  [{user :identity params :route-params}]
  (let [params (us/conform ::retrieve-icon params)
        params (assoc params :user user :type :retrieve-icon)]
    (->> (sv/query params)
         (p/map rsp)
         (p/map http/ok))))

;; --- Create Icon

(s/def ::create-icon
  (s/keys :req-un [::metadata ::us/name ::metadata ::content]
          :opt-un [::us/id ::collection]))

(defn create-icon
  [{user :identity data :data :as request}]
  (let [{:keys [id name content metadata collection]} (us/conform ::create-icon data)
        id (or id (uuid/random))]
    (->> (sv/novelty {:id id
                      :type :create-icon
                      :user user
                      :name name
                      :metadata metadata
                      :content content})
         (p/map (fn [entry]
                  (let [loc (str "/api/library/icons/" (:id entry))]
                    (http/created loc (rsp entry))))))))

;; --- Update Icon

(s/def ::update-icon
  (s/keys :req-un [::us/name ::us/version] :opt-un [::us/id]))

(defn update-icon
  [{user :identity params :route-params data :data}]
  (let [data (us/conform ::update-icon data)
        message (assoc data
                       :id (uuid/from-string (:id params))
                       :type :update-icon
                       :user user)]
    (->> (sv/novelty message)
         (p/map #(http/ok (rsp %))))))

;; --- Delete Icon

(defn delete-icon
  [{user :identity params :route-params}]
  (let [message {:id (uuid/from-string (:id params))
                 :type :delete-icon
                 :user user}]
    (->> (sv/novelty message)
         (p/map (fn [v] (http/no-content))))))

;; --- List collections

(s/def ::list-icons
  (s/keys :opt-un [::us/id]))

(defn list-icons
  [{user :identity route-params :route-params}]
  (let [{:keys [id]} (us/conform ::list-icons route-params)
        params {:collection id
                :type :list-icons
                :user user}]
    (->> (sv/query params)
         (p/map rsp)
         (p/map http/ok))))

;; This Source Code Form is subject to the terms of the Mozilla Public
;; License, v. 2.0. If a copy of the MPL was not distributed with this
;; file, You can obtain one at http://mozilla.org/MPL/2.0/.
;;
;; Copyright (c) 2016 Andrey Antukh <niwi@niwi.nz>

(ns uxbox.frontend.icons
  (:require [clojure.spec :as s]
            [promesa.core :as p]
            [catacumba.http :as http]
            [storages.core :as st]
            [uxbox.schema :as us]
            [uxbox.services :as sv]
            [uxbox.util.response :refer (rsp)]
            [uxbox.util.uuid :as uuid]
            [uxbox.util.paths :as paths]))

;; --- Constants & Config

(s/def ::collection (s/nilable ::us/uuid-string))

(s/def ::width (s/and number? pos?))
(s/def ::height (s/and number? pos?))
(s/def ::view-box (s/and (s/coll-of number?)
                         #(= 4 (count %))
                         vector?))

(s/def ::mimetype string?)
(s/def ::metadata
  (s/keys :opt-un [::width ::height ::view-box ::mimetype]))

(s/def ::content string?)

;; --- Create Collection

(s/def ::create-collection
  (s/keys :req-un [::us/name] :opt-un [::us/id]))

(defn create-collection
  [{user :identity data :data}]
  (let [data (us/conform ::create-collection data)
        message (assoc data
                       :type :create-icon-collection
                       :user user)]
    (->> (sv/novelty message)
         (p/map (fn [result]
                  (let [loc (str "/api/library/icons/" (:id result))]
                    (http/created loc (rsp result))))))))

;; --- Update Collection

(s/def ::update-collection
  (s/merge ::create-collection (s/keys :req-un [::us/version])))

(defn update-collection
  [{user :identity params :route-params data :data}]
  (let [data (us/conform ::update-collection data)
        message (assoc data
                       :id (uuid/from-string (:id params))
                       :type :update-icon-collection
                       :user user)]
    (-> (sv/novelty message)
        (p/then #(http/ok (rsp %))))))

;; --- Delete Collection

(defn delete-collection
  [{user :identity params :route-params}]
  (let [message {:id (uuid/from-string (:id params))
                 :type :delete-icon-collection
                 :user user}]
    (-> (sv/novelty message)
        (p/then (fn [v] (http/no-content))))))

;; --- List collections

(defn list-collections
  [{user :identity}]
  (let [params {:user user
                :type :list-icon-collections}]
    (-> (sv/query params)
        (p/then #(http/ok (rsp %))))))

;; --- Create Icon

(s/def ::create-icon
  (s/keys :req-un [::metadata ::us/name ::metadata ::content]
          :opt-un [::us/id ::collection]))

(defn create-icon
  [{user :identity data :data :as request}]
  (let [{:keys [id name content metadata collection]} (us/conform ::create-icon data)
        id (or id (uuid/random))]
    (->> (sv/novelty {:id id
                      :type :create-icon
                      :user user
                      :name name
                      :metadata metadata
                      :content content})
         (p/map (fn [entry]
                  (let [loc (str "/api/library/icons/" (:id entry))]
                    (http/created loc (rsp entry))))))))

;; --- Update Icon

(s/def ::update-icon
  (s/keys :req-un [::us/name ::us/version] :opt-un [::us/id]))

(defn update-icon
  [{user :identity params :route-params data :data}]
  (let [data (us/conform ::update-icon data)
        message (assoc data
                       :id (uuid/from-string (:id params))
                       :type :update-icon
                       :user user)]
    (->> (sv/novelty message)
         (p/map #(http/ok (rsp %))))))

;; --- Delete Icon

(defn delete-icon
  [{user :identity params :route-params}]
  (let [message {:id (uuid/from-string (:id params))
                 :type :delete-icon
                 :user user}]
    (->> (sv/novelty message)
         (p/map (fn [v] (http/no-content))))))

;; --- List collections

(s/def ::list-icons
  (s/keys :opt-un [::us/id]))

(defn list-icons
  [{user :identity route-params :route-params}]
  (let [{:keys [id]} (us/conform ::list-icons route-params)
        params {:collection id
                :type :list-icons
                :user user}]
    (->> (sv/query params)
         (p/map rsp)
         (p/map http/ok))))

Remove `retrieve-icon` handler.

Remove `retrieve-icon` handler.