;; 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/.

(ns datomish.transact.bootstrap)

(def symbolic-schema
  {:db/ident             {:db/valueType   :db.type/keyword
                          :db/cardinality :db.cardinality/one
                          :db/unique      :db.unique/identity}
   :db.install/partition {:db/valueType   :db.type/ref
                          :db/cardinality :db.cardinality/many}
   :db.install/valueType {:db/valueType   :db.type/ref
                          :db/cardinality :db.cardinality/many}
   :db.install/attribute {:db/valueType   :db.type/ref
                          :db/cardinality :db.cardinality/many}
   ;; TODO: support user-specified functions in the future.
   ;; :db.install/function {:db/valueType :db.type/ref
   ;;                       :db/cardinality :db.cardinality/many}
   :db/txInstant         {:db/valueType   :db.type/long
                          :db/cardinality :db.cardinality/one
                          :db/index       true}
   :db/valueType         {:db/valueType   :db.type/ref
                          :db/cardinality :db.cardinality/one}
   :db/cardinality       {:db/valueType   :db.type/ref
                          :db/cardinality :db.cardinality/one}
   :db/doc               {:db/valueType   :db.type/string
                          :db/cardinality :db.cardinality/one}
   :db/unique            {:db/valueType   :db.type/ref
                          :db/cardinality :db.cardinality/one}
   :db/isComponent       {:db/valueType   :db.type/boolean
                          :db/cardinality :db.cardinality/one}
   :db/index             {:db/valueType   :db.type/boolean
                          :db/cardinality :db.cardinality/one}
   :db/fulltext          {:db/valueType   :db.type/boolean
                          :db/cardinality :db.cardinality/one}
   :db/noHistory         {:db/valueType   :db.type/boolean
                          :db/cardinality :db.cardinality/one}
   })

(def idents
  {:db/ident             1
   :db.part/db           2
   :db/txInstant         3
   :db.install/partition 4
   :db.install/valueType 5
   :db.install/attribute 6
   :db/valueType         7
   :db/cardinality       8
   :db/unique            9
   :db/isComponent       10
   :db/index             11
   :db/fulltext          12
   :db/noHistory         13
   :db/add               14
   :db/retract           15
   :db.part/user         16
   :db.part/tx           17
   :db/excise            18
   :db.excise/attrs      19
   :db.excise/beforeT    20
   :db.excise/before     21
   :db.alter/attribute   22
   :db.type/ref          23
   :db.type/keyword      24
   :db.type/long         25
   :db.type/double       26
   :db.type/string       27
   :db.type/boolean      28
   :db.type/instant      29
   :db.type/bytes        30
   :db.cardinality/one   31
   :db.cardinality/many  32
   :db.unique/value      33
   :db.unique/identity   34
   :db/doc               35
   })

(def parts
  {:db.part/db   {:start 0 :idx (inc (apply max (vals idents)))}
   :db.part/user {:start 0x10000 :idx 0x10000}
   :db.part/tx   {:start 0x10000000 :idx 0x10000000}
   })

(defn tx-data []
  (concat
    (map (fn [[ident entid]] [:db/add entid :db/ident ident]) idents)
    ;; TODO: install partitions as well, like (map (fn [[ident entid]] [:db/add :db.part/db :db.install/partition ident])).
    (map (fn [[ident attrs]] (assoc attrs :db/id ident)) symbolic-schema)
    (map (fn [[ident attrs]] [:db/add :db.part/db :db.install/attribute (get idents ident)]) symbolic-schema) ;; TODO: fail if nil.
    ))

;; 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/.

(ns datomish.transact.bootstrap)

(def symbolic-schema
  {:db/ident             {:db/valueType   :db.type/keyword
                          :db/cardinality :db.cardinality/one
                          :db/unique      :db.unique/identity}
   :db.install/partition {:db/valueType   :db.type/ref
                          :db/cardinality :db.cardinality/many}
   :db.install/valueType {:db/valueType   :db.type/ref
                          :db/cardinality :db.cardinality/many}
   :db.install/attribute {:db/valueType   :db.type/ref
                          :db/cardinality :db.cardinality/many}
   ;; TODO: support user-specified functions in the future.
   ;; :db.install/function {:db/valueType :db.type/ref
   ;;                       :db/cardinality :db.cardinality/many}
   :db/txInstant         {:db/valueType   :db.type/long
                          :db/cardinality :db.cardinality/one
                          :db/index       true}
   :db/valueType         {:db/valueType   :db.type/ref
                          :db/cardinality :db.cardinality/one}
   :db/cardinality       {:db/valueType   :db.type/ref
                          :db/cardinality :db.cardinality/one}
   :db/doc               {:db/valueType   :db.type/string
                          :db/cardinality :db.cardinality/one}
   :db/unique            {:db/valueType   :db.type/ref
                          :db/cardinality :db.cardinality/one}
   :db/isComponent       {:db/valueType   :db.type/boolean
                          :db/cardinality :db.cardinality/one}
   :db/index             {:db/valueType   :db.type/boolean
                          :db/cardinality :db.cardinality/one}
   :db/fulltext          {:db/valueType   :db.type/boolean
                          :db/cardinality :db.cardinality/one}
   :db/noHistory         {:db/valueType   :db.type/boolean
                          :db/cardinality :db.cardinality/one}
   :db.alter/attribute   {:db/valueType   :db.type/ref
                          :db/cardinality :db.cardinality/many}
   })

(def idents
  {:db/ident             1
   :db.part/db           2
   :db/txInstant         3
   :db.install/partition 4
   :db.install/valueType 5
   :db.install/attribute 6
   :db/valueType         7
   :db/cardinality       8
   :db/unique            9
   :db/isComponent       10
   :db/index             11
   :db/fulltext          12
   :db/noHistory         13
   :db/add               14
   :db/retract           15
   :db.part/user         16
   :db.part/tx           17
   :db/excise            18
   :db.excise/attrs      19
   :db.excise/beforeT    20
   :db.excise/before     21
   :db.alter/attribute   22
   :db.type/ref          23
   :db.type/keyword      24
   :db.type/long         25
   :db.type/double       26
   :db.type/string       27
   :db.type/boolean      28
   :db.type/instant      29
   :db.type/bytes        30
   :db.cardinality/one   31
   :db.cardinality/many  32
   :db.unique/value      33
   :db.unique/identity   34
   :db/doc               35
   })

(def parts
  {:db.part/db   {:start 0 :idx (inc (apply max (vals idents)))}
   :db.part/user {:start 0x10000 :idx 0x10000}
   :db.part/tx   {:start 0x10000000 :idx 0x10000000}
   })

(defn tx-data []
  (concat
    (map (fn [[ident entid]] [:db/add entid :db/ident ident]) idents)
    ;; TODO: install partitions as well, like (map (fn [[ident entid]] [:db/add :db.part/db :db.install/partition ident])).
    (map (fn [[ident attrs]] (assoc attrs :db/id ident)) symbolic-schema)
    (map (fn [[ident attrs]] [:db/add :db.part/db :db.install/attribute (get idents ident)]) symbolic-schema) ;; TODO: fail if nil.
    ))

Add db.alter/attribute to the bootstrap schema.


;;;
;;;   Copyright 2015 Ruediger Gad
;;;
;;;   This software is released under the terms of the Eclipse Public License
;;;   (EPL) 1.0. You can find a copy of the EPL at:
;;;   http://opensource.org/licenses/eclipse-1.0.php
;;;

(ns
  ^{:author "Ruediger Gad",
    :doc "Helper that are primarily used during experiments"}
  dsbdp.experiment-helper
  (:require
    [clojure.walk :refer :all]
    [clojure.pprint :refer :all]
    [dsbdp.byte-array-conversion :refer :all]
    [dsbdp.data-processing-dsl :refer :all]
    [dsbdp.processing-fn-utils :refer :all]
    [opennlp.nlp :refer :all]
    [opennlp.treebank :refer :all]

    )
  (:import
    (dsbdp ExperimentHelper)
    (java.util HashMap Map)
    (org.apache.commons.math3.util CombinatoricsUtils)))

(def pcap-byte-array-test-data
  "The byte array representation of a UDP packet for being used as dummy data."
  (byte-array
    (map byte [-5 -106 -57 84   15 -54 14 0   58 0 0 0   58 0 0 0                ; 16 byte pcap header
               -1 -2 -3 -14 -15 -16 1 2 3 4 5 6 8 0                              ; 14 byte Ethernet header
               69 0 0 44   0 3 64 0   7 17 115 -57   1 2 3 4   -4 -3 -2 -1       ; 20 byte IP header
               8 0 16 0 0 16 -25 -26                                              ; 8 byte UDP header
               97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112])))  ; 16 byte data "abcdefghijklmnop"

(def get-sentences (make-sentence-detector "resources/opennlp/models/en-sent.bin"))
(def tokenize (make-tokenizer "resources/opennlp/models/en-token.bin"))
(def pos-tag (make-pos-tagger "resources/opennlp/models/en-pos-maxent.bin"))
(def chunker (make-treebank-chunker "resources/opennlp/models/en-chunker.bin"))

(defn create-no-op-proc-fns
  [n]
  (create-proc-fn-vec-from-template
    '(fn [_ _] 0)
    '(fn [_ _] 1)
    n))

(defn create-inc-proc-fns
  [n]
  (create-proc-fn-vec-from-template
    '(fn [i _] (inc i))
    '(fn [_ o] (inc o))
    n))

(defn create-hashmap-inc-put-proc-fns
  [n]
  (let [o-sym 'o]
    (let [o-meta (vary-meta o-sym assoc :tag 'java.util.Map)]
     (create-proc-fn-vec-from-template
       '(fn [i _] (doto (java.util.HashMap.) (.put (str :_idx_) (inc i))))
       '(fn [_ o-meta] (.put o-meta (str :_idx_) (inc (.get o-meta (str (dec :_idx_))))))
       n))))

(defn factorial
  ([n]
    (factorial 1N 1N n))
  ([result i n]
    (if (<= i n)
      (recur (* result i) (inc i) n)
      result)))

(defn create-factorial-proc-fns
  [n]
  (create-proc-fn-vec-from-template
    '(fn [i _] (dsbdp.experiment-helper/factorial i))
    '(fn [i _] (dsbdp.experiment-helper/factorial i))
     n))

(defn create-busy-sleep-proc-fns
  [n]
  (create-proc-fn-vec-from-template
    '(fn [i _] (dsbdp.ExperimentHelper/busySleep ^long (i :_idx_)) 0)
    '(fn [i _] (dsbdp.ExperimentHelper/busySleep ^long (i :_idx_)) 0)
     n))

(def sample-pcap-processing-definition-rules
  [['timestamp '(timestamp-str-be 0) :string]
   ['capture-length '(int32be 8)]
   ['eth-src '(eth-mac-addr-str 22) :string]
   ['eth-dst '(eth-mac-addr-str 16) :string]
   ['ip-src '(ipv4-addr-str 42) :string]
   ['ip-dst '(ipv4-addr-str 46) :string]
   ['ip-ver '(int4h 30)]
   ['ip-length '(float (/ (int16 32) 65535))]
   ['ip-id '(float (/ (int16 34) 65535))]
   ['ip-ttl '(float (/ (int8 38) 255))]
   ['ip-protocol '(float (/ (int8 39) 255))]
   ['ip-checksum '(float (/ (int16 40) 65535))]
   ['udp-src '(float (/ (int16 50) 65535))]
   ['udp-dst '(float (/ (int16 52) 65535))]
   ['udp-length '(float (/ (int16 54) 65535))]
   ['udp-checksum '(float (/ (int16 56) 65535))]
   ['udp-payload '(ba-to-str 58 16) :string]])

(def sample-pcap-processing-definition-json
  {:output-type :json-str
   :rules sample-pcap-processing-definition-rules})

(def sample-pcap-processing-definition-clj-map
  {:output-type :clj-map
   :rules sample-pcap-processing-definition-rules})

(def sample-pcap-processing-definition-java-map
  {:output-type :java-map
   :rules sample-pcap-processing-definition-rules})

(defn opennlp-single-sentence-direct-test-fn
  [sentence]
  (phrases (chunker (pos-tag (tokenize sentence)))))

(defn opennlp-multi-sentence-direct-test-fn
  [in-str]
  (doseq [sentence (get-sentences in-str)]
    (opennlp-single-sentence-direct-test-fn sentence)))

(def opennlp-single-sentence-inc-test-fns
  [(fn [in _] (tokenize in))
   (fn [_ out] (pos-tag out))
   (fn [_ out] (chunker out))
   (fn [_ out] (phrases out))])

;;;
;;;   Copyright 2015 Ruediger Gad
;;;
;;;   This software is released under the terms of the Eclipse Public License
;;;   (EPL) 1.0. You can find a copy of the EPL at:
;;;   http://opensource.org/licenses/eclipse-1.0.php
;;;

(ns
  ^{:author "Ruediger Gad",
    :doc "Helper that are primarily used during experiments"}
  dsbdp.experiment-helper
  (:require
    [clojure.walk :refer :all]
    [clojure.pprint :refer :all]
    [dsbdp.byte-array-conversion :refer :all]
    [dsbdp.data-processing-dsl :refer :all]
    [dsbdp.processing-fn-utils :refer :all]
    [opennlp.nlp :refer :all]
    [opennlp.treebank :refer :all])
  (:import
    (dsbdp ExperimentHelper)
    (java.util HashMap Map)
    (org.apache.commons.math3.util CombinatoricsUtils)))

(def pcap-byte-array-test-data
  "The byte array representation of a UDP packet for being used as dummy data."
  (byte-array
    (map byte [-5 -106 -57 84   15 -54 14 0   58 0 0 0   58 0 0 0                ; 16 byte pcap header
               -1 -2 -3 -14 -15 -16 1 2 3 4 5 6 8 0                              ; 14 byte Ethernet header
               69 0 0 44   0 3 64 0   7 17 115 -57   1 2 3 4   -4 -3 -2 -1       ; 20 byte IP header
               8 0 16 0 0 16 -25 -26                                              ; 8 byte UDP header
               97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112])))  ; 16 byte data "abcdefghijklmnop"

(def get-sentences (make-sentence-detector "resources/opennlp/models/en-sent.bin"))
(def tokenize (make-tokenizer "resources/opennlp/models/en-token.bin"))
(def pos-tag (make-pos-tagger "resources/opennlp/models/en-pos-maxent.bin"))
(def chunker (make-treebank-chunker "resources/opennlp/models/en-chunker.bin"))

(defn create-no-op-proc-fns
  [n]
  (create-proc-fn-vec-from-template
    '(fn [_ _] 0)
    '(fn [_ _] 1)
    n))

(defn create-inc-proc-fns
  [n]
  (create-proc-fn-vec-from-template
    '(fn [i _] (inc i))
    '(fn [_ o] (inc o))
    n))

(defn create-hashmap-inc-put-proc-fns
  [n]
  (let [o-sym 'o]
    (let [o-meta (vary-meta o-sym assoc :tag 'java.util.Map)]
     (create-proc-fn-vec-from-template
       '(fn [i _] (doto (java.util.HashMap.) (.put (str :_idx_) (inc i))))
       '(fn [_ o-meta] (.put o-meta (str :_idx_) (inc (.get o-meta (str (dec :_idx_))))))
       n))))

(defn factorial
  ([n]
    (factorial 1N 1N n))
  ([result i n]
    (if (<= i n)
      (recur (* result i) (inc i) n)
      result)))

(defn create-factorial-proc-fns
  [n]
  (create-proc-fn-vec-from-template
    '(fn [i _] (dsbdp.experiment-helper/factorial i))
    '(fn [i _] (dsbdp.experiment-helper/factorial i))
     n))

(defn create-busy-sleep-proc-fns
  [n]
  (create-proc-fn-vec-from-template
    '(fn [i _] (dsbdp.ExperimentHelper/busySleep ^long (i :_idx_)) 0)
    '(fn [i _] (dsbdp.ExperimentHelper/busySleep ^long (i :_idx_)) 0)
     n))

(def sample-pcap-processing-definition-rules
  [['timestamp '(timestamp-str-be 0) :string]
   ['capture-length '(int32be 8)]
   ['eth-src '(eth-mac-addr-str 22) :string]
   ['eth-dst '(eth-mac-addr-str 16) :string]
   ['ip-src '(ipv4-addr-str 42) :string]
   ['ip-dst '(ipv4-addr-str 46) :string]
   ['ip-ver '(int4h 30)]
   ['ip-length '(float (/ (int16 32) 65535))]
   ['ip-id '(float (/ (int16 34) 65535))]
   ['ip-ttl '(float (/ (int8 38) 255))]
   ['ip-protocol '(float (/ (int8 39) 255))]
   ['ip-checksum '(float (/ (int16 40) 65535))]
   ['udp-src '(float (/ (int16 50) 65535))]
   ['udp-dst '(float (/ (int16 52) 65535))]
   ['udp-length '(float (/ (int16 54) 65535))]
   ['udp-checksum '(float (/ (int16 56) 65535))]
   ['udp-payload '(ba-to-str 58 16) :string]])

(def sample-pcap-processing-definition-json
  {:output-type :json-str
   :rules sample-pcap-processing-definition-rules})

(def sample-pcap-processing-definition-clj-map
  {:output-type :clj-map
   :rules sample-pcap-processing-definition-rules})

(def sample-pcap-processing-definition-java-map
  {:output-type :java-map
   :rules sample-pcap-processing-definition-rules})

(defn opennlp-single-sentence-direct-test-fn
  [sentence]
  (phrases (chunker (pos-tag (tokenize sentence)))))

(defn opennlp-multi-sentence-direct-test-fn
  [in-str]
  (doseq [sentence (get-sentences in-str)]
    (opennlp-single-sentence-direct-test-fn sentence)))

(def opennlp-single-sentence-inc-test-fns
  [(fn [in _] (tokenize in))
   (fn [_ out] (pos-tag out))
   (fn [_ out] (chunker out))
   (fn [_ out] (phrases out))])

Remove empty lines.

Remove empty lines.


(ns org.dada.core.SimpleModelView
  (:use
   [clojure.contrib logging]
   [org.dada.core counted-set]
   )
  ;; (:require
  ;;  [org.dada.core BaseModelView]
  ;;  )
  (:import
   [java.util Collection]
   [org.dada.core Data Metadata RemoteModel Update View]
   )
  (:gen-class
   ;;:extends org.dada.core.BaseModelView
   :implements [org.dada.core.ModelView java.io.Serializable]
   :constructors {[String org.dada.core.Metadata]
		  ;;[String org.dada.core.Metadata]
		  []
		  }
   :methods [[writeReplace [] Object]]
   :init init
   :state state
   )
  )

;; TODO: consider supporting indexing on mutable keys - probably not a good idea ?

(defn -init [#^String name #^Metadata metadata]

  [ ;; super ctor args
   ;;[name metadata]
   []
   ;; instance state
   (let [key-getter (.getPrimaryGetter metadata)
	 version-comparator (.getVersionComparator metadata)
	 key-fn (fn [value] (.get key-getter value))

	 process-addition
	 (fn [[extant extinct views i a d] #^Update addition]
	   (let [new (.getNewValue addition)
		 key (key-fn new)
		 current (extant key)]
	     (if (nil? current)
	       ;; insertion...
	       (let [removed (extinct key)]
		 (if (nil? removed)
		   ;; first time seen
		   [(assoc extant key new) extinct views (cons (Update. nil new) i) a d] ;insertion
		   ;; already deleted
		   (if (< (.compareTo version-comparator removed new) 0)
		     ;; later version - reinstated
		     [(assoc extant key new) (dissoc extinct key) views (cons (Update. nil new) i) a d]
		     (do
		       ;; out of order or duplicate version - ignored
		       ;;(println "WARN: OUT OF ORDER INSERT" current new)
		       [extant extinct views i a d]))
		   )
		 )
	       ;; alteration...
	       (if (or (not version-comparator)(< (.compareTo version-comparator current new) 0))
		 ;; later version - accepted
		 [(assoc extant key new) extinct views i (cons (Update. current new) a) d] ;alteration
		 (do
		   ;; out of order or duplicate version - ignored
		   ;;(println "WARN: OUT OF ORDER UPDATE" current new)
		   [extant extinct views i a d]))
	       )))

	 process-deletion
	 (fn [[extant extinct views i a d] #^Update deletion]
	   (let [old (.getOldValue deletion)
		 new (.getNewValue deletion)
		 key (key-fn old)
		 current (extant key)
		 latest (or new old)]
	     (if (nil? current)
	       (let [removed (extinct key)]
		 (if (nil? removed)
		   ;; neither extant or extinct - mark extinct
		   ;; we will remember the id in case we get an out of order insertion later
		   [extant (assoc extinct key latest) views i a (conj d (Update. nil new))]
		   (if (< (.compareTo version-comparator removed latest) 0)
		     ;; later version - accepted
		     [extant (assoc extinct key new) views i a (cons (Update. removed new) d)]
		     (do
		       ;; earlier version - ignored
		       (warn ["out of order deletion - ignored" removed latest])
		       [extant extinct views i a d]))))
	       (if (<= (.compareTo version-comparator current old) 0)
		 ;; deletion of current or later version - accepted
		 [(dissoc extant key) (assoc extinct key latest) views i a (cons (Update. current new) d)]
		 (do
		   ;; earlier version - ignored
		   (warn ["out of order deletion - ignored" current new])
		   [extant extinct views i a d])))))

	 ;; TODO: perhaps we should raise the granularity at which we
	 ;; compare-and-swap, in order to avoid starvation of larger
	 ;; batches...
	 swap-state-fn (fn [[extant extinct views] insertions alterations deletions]
			 (reduce process-deletion
				 (reduce process-addition
					 (reduce process-addition
						 [extant extinct views '() '() '()]
						 insertions)
					 alterations)
				 deletions))

	 mutable-state (atom [{} {} {}]) ;extant, extinct, views

	 update-fn
	 (fn [inputs]
	   ;;(println "UPDATE ->" @mutable-state)
	   (let [[_ _ _ i a d] (apply swap! mutable-state swap-state-fn inputs)]
	     ;;(println "UPDATE <-" @mutable-state)
	     [i a d]))

	 getData-fn
	 (fn []
	   ;;(println "GET DATA ->" @mutable-state)
	   (let [[extant extinct] @mutable-state]
	     (Data. (vals extant) (vals extinct))))
	 ]

     [[
       name
       metadata
       update-fn
       getData-fn
       ]
      mutable-state])
   ])
;;--------------------------------------------------------------------------------

(defn -getName [#^org.dada.core.SimpleModelView this]
  (let [[[_name]] (.state this)]
    _name))

(defn -getMetadata [#^org.dada.core.SimpleModelView this]
  (let [[[_ metadata]] (.state this)]
    metadata))

(defn -find [#^org.dada.core.SimpleModelView this key]
  (let [[_ mutable] (.state this)
	[extant] @mutable]
    (extant key)))

(defn #^Data -registerView [#^org.dada.core.SimpleModelView this #^View view]
  (let [[_ mutable] (.state this)
	[extant extinct] @mutable]
    ;; N.B. does not check to see if View is already Registered
    ;;(println "VIEW ->" @mutable)
    (swap! mutable (fn [state view] (assoc state 2 (counted-set-inc (state 2) view))) view)
    ;;(println "VIEW <-" @mutable)
    (Data. (vals extant) (vals extinct))
    )
  )

(defn #^Data -deregisterView [#^org.dada.core.SimpleModelView this #^View view]
  (let [[_ mutable] (.state this)
	[extant extinct] @mutable]
    ;;(println "UNVIEW ->" @mutable)
    (swap! mutable (fn [state view] (assoc state 2 (counted-set-dec (state 2) view))) view)
    ;;(println "UNVIEW <-" @mutable)
    (Data. (vals extant) (vals extinct))
    ))

(defn -notifyUpdate [#^org.dada.core.SimpleModelView this insertions alterations deletions]
  (let [[_ mutable] (.state this)
	[_ _ views] @mutable]
    ;;(println "NOTIFY ->" @mutable)
    (if (and (empty? insertions) (empty? alterations) (empty? deletions))
      (warn "empty event raised" (.getStackTrace (Exception.)))
      (dorun (map (fn [#^View view]	;dirty - side-effects
		    (try (.update view insertions alterations deletions)
			 (catch Throwable t (error "View notification failure" t))))
		  (counted-set-vals views))))))

;;--------------------------------------------------------------------------------

(defn -getData [#^org.dada.core.SimpleModelView this]
  (let [[[_ _ _ getData-fn]] (.state this)]
    (getData-fn)))

(defn -update [#^org.dada.core.SimpleModelView this & inputs]
  (let [[[_ _ update-fn] mutable] (.state this)
	[_ _ views] @mutable
	[#^Collection i #^Collection a #^Collection d] (update-fn inputs)]
    (if (not (and (empty? i) (empty? a) (empty? d)))
      (-notifyUpdate this i a d))
    ))

;;--------------------------------------------------------------------------------

(defn #^{:private true} -writeReplace [#^org.dada.core.SimpleModelView this]
  (let [[[name metadata]] (.state this)]
      (RemoteModel. name metadata)))

(defn #^String -toString [#^org.dada.core.SimpleModelView this]
  (let [[[name metadata]] (.state this)]
    name))

(ns org.dada.core.SimpleModelView
  (:use
   [clojure.contrib logging]
   [org.dada.core counted-set]
   )
  ;; (:require
  ;;  [org.dada.core BaseModelView]
  ;;  )
  (:import
   [java.util Collection]
   [org.dada.core Data Metadata RemoteModel Update View]
   )
  (:gen-class
   ;;:extends org.dada.core.BaseModelView
   :implements [org.dada.core.ModelView java.io.Serializable]
   :constructors {[String org.dada.core.Metadata]
		  ;;[String org.dada.core.Metadata]
		  []
		  }
   :methods [[writeReplace [] Object]]
   :init init
   :state state
   )
  )

;; TODO: consider supporting indexing on mutable keys - probably not a good idea ?

(defn -init [#^String name #^Metadata metadata]

  [ ;; super ctor args
   ;;[name metadata]
   []
   ;; instance state
   (let [key-getter (.getPrimaryGetter metadata)
	 version-comparator (.getVersionComparator metadata)
	 key-fn (fn [value] (.get key-getter value))

	 process-addition
	 (fn [[extant extinct views i a d] #^Update addition]
	   (let [new (.getNewValue addition)
		 key (key-fn new)
		 current (extant key)]
	     (if (nil? current)
	       ;; insertion...
	       (let [removed (extinct key)]
		 (if (nil? removed)
		   ;; first time seen
		   [(assoc extant key new) extinct views (cons (Update. nil new) i) a d] ;insertion
		   ;; already deleted
		   (if (< (.compareTo version-comparator removed new) 0)
		     ;; later version - reinstated
		     [(assoc extant key new) (dissoc extinct key) views (cons (Update. nil new) i) a d]
		     (do
		       ;; out of order or duplicate version - ignored
		       (debug ["out of order insertion" current new])
		       [extant extinct views i a d]))
		   )
		 )
	       ;; alteration...
	       (if (or (not version-comparator)(< (.compareTo version-comparator current new) 0))
		 ;; later version - accepted
		 [(assoc extant key new) extinct views i (cons (Update. current new) a) d] ;alteration
		 (do
		   ;; out of order or duplicate version - ignored
		   (debug ["out of order update" current new])
		   [extant extinct views i a d]))
	       )))

	 process-deletion
	 (fn [[extant extinct views i a d] #^Update deletion]
	   (let [old (.getOldValue deletion)
		 new (.getNewValue deletion)
		 key (key-fn old)
		 current (extant key)
		 latest (or new old)]
	     (if (nil? current)
	       (let [removed (extinct key)]
		 (if (nil? removed)
		   ;; neither extant or extinct - mark extinct
		   ;; we will remember the id in case we get an out of order insertion later
		   [extant (assoc extinct key latest) views i a (conj d (Update. nil new))]
		   (if (< (.compareTo version-comparator removed latest) 0)
		     ;; later version - accepted
		     [extant (assoc extinct key new) views i a (cons (Update. removed new) d)]
		     (do
		       ;; earlier version - ignored
		       (debug ["out of order deletion - ignored" removed latest])
		       [extant extinct views i a d]))))
	       (if (<= (.compareTo version-comparator current old) 0)
		 ;; deletion of current or later version - accepted
		 [(dissoc extant key) (assoc extinct key latest) views i a (cons (Update. current new) d)]
		 (do
		   ;; earlier version - ignored
		   (debug ["out of order deletion - ignored" current new])
		   [extant extinct views i a d])))))

	 ;; TODO: perhaps we should raise the granularity at which we
	 ;; compare-and-swap, in order to avoid starvation of larger
	 ;; batches...
	 swap-state-fn (fn [[extant extinct views] insertions alterations deletions]
			 (reduce process-deletion
				 (reduce process-addition
					 (reduce process-addition
						 [extant extinct views '() '() '()]
						 insertions)
					 alterations)
				 deletions))

	 mutable-state (atom [{} {} {}]) ;extant, extinct, views

	 update-fn
	 (fn [inputs]
	   ;;(println "UPDATE ->" @mutable-state)
	   (let [[_ _ _ i a d] (apply swap! mutable-state swap-state-fn inputs)]
	     ;;(println "UPDATE <-" @mutable-state)
	     [i a d]))

	 getData-fn
	 (fn []
	   ;;(println "GET DATA ->" @mutable-state)
	   (let [[extant extinct] @mutable-state]
	     (Data. (vals extant) (vals extinct))))
	 ]

     [[
       name
       metadata
       update-fn
       getData-fn
       ]
      mutable-state])
   ])
;;--------------------------------------------------------------------------------

(defn -getName [#^org.dada.core.SimpleModelView this]
  (let [[[_name]] (.state this)]
    _name))

(defn -getMetadata [#^org.dada.core.SimpleModelView this]
  (let [[[_ metadata]] (.state this)]
    metadata))

(defn -find [#^org.dada.core.SimpleModelView this key]
  (let [[_ mutable] (.state this)
	[extant] @mutable]
    (extant key)))

(defn #^Data -registerView [#^org.dada.core.SimpleModelView this #^View view]
  (let [[_ mutable] (.state this)
	[extant extinct] @mutable]
    ;; N.B. does not check to see if View is already Registered
    ;;(println "VIEW ->" @mutable)
    (swap! mutable (fn [state view] (assoc state 2 (counted-set-inc (state 2) view))) view)
    ;;(println "VIEW <-" @mutable)
    (Data. (vals extant) (vals extinct))
    )
  )

(defn #^Data -deregisterView [#^org.dada.core.SimpleModelView this #^View view]
  (let [[_ mutable] (.state this)
	[extant extinct] @mutable]
    ;;(println "UNVIEW ->" @mutable)
    (swap! mutable (fn [state view] (assoc state 2 (counted-set-dec (state 2) view))) view)
    ;;(println "UNVIEW <-" @mutable)
    (Data. (vals extant) (vals extinct))
    ))

(defn -notifyUpdate [#^org.dada.core.SimpleModelView this insertions alterations deletions]
  (let [[_ mutable] (.state this)
	[_ _ views] @mutable]
    ;;(println "NOTIFY ->" @mutable)
    (if (and (empty? insertions) (empty? alterations) (empty? deletions))
      (warn "empty event raised" (.getStackTrace (Exception.)))
      (dorun (map (fn [#^View view]	;dirty - side-effects
		    (try (.update view insertions alterations deletions)
			 (catch Throwable t (error "View notification failure" t))))
		  (counted-set-vals views))))))

;;--------------------------------------------------------------------------------

(defn -getData [#^org.dada.core.SimpleModelView this]
  (let [[[_ _ _ getData-fn]] (.state this)]
    (getData-fn)))

(defn -update [#^org.dada.core.SimpleModelView this & inputs]
  (let [[[_ _ update-fn] mutable] (.state this)
	[_ _ views] @mutable
	[#^Collection i #^Collection a #^Collection d] (update-fn inputs)]
    (if (not (and (empty? i) (empty? a) (empty? d)))
      (-notifyUpdate this i a d))
    ))

;;--------------------------------------------------------------------------------

(defn #^{:private true} -writeReplace [#^org.dada.core.SimpleModelView this]
  (let [[[name metadata]] (.state this)]
      (RemoteModel. name metadata)))

(defn #^String -toString [#^org.dada.core.SimpleModelView this]
  (let [[[name metadata]] (.state this)]
    name))

downgrade warning

downgrade warning


(ns mikron.schema-generators
  (:require [clojure.test.check.generators :as tc.gen]
            [macrowbar.core :as macrowbar]
            [mikron.math :as math]
            [mikron.compiler.schema :as compiler.schema]
            [mikron.runtime.processor.common :as runtime.processor.common]))

(def simple-string-generator
  (tc.gen/fmap (fn [string]
                 (if (> (count string) 5)
                   (.substring string 0 5)
                   string))
               (tc.gen/not-empty tc.gen/string-alphanumeric)))

(def simple-symbol-generator
  (tc.gen/fmap symbol simple-string-generator))

(def simple-keyword-generator
  (tc.gen/fmap keyword simple-string-generator))

(defmulti scalar-schema-generator
  (fn [schema-name] schema-name)
  :hierarchy #'compiler.schema/extended-hierarchy)

(defmethod scalar-schema-generator :simple [schema-name]
  (tc.gen/return [schema-name {}]))

(defmethod scalar-schema-generator :enum [_]
  (tc.gen/fmap (fn [enum-values]
                 [:enum {} enum-values])
               (tc.gen/not-empty (tc.gen/set simple-keyword-generator))))

(defmulti compound-schema-generator
  (fn [schema-name inner-generator] schema-name)
  :hierarchy #'compiler.schema/extended-hierarchy)

(defmethod compound-schema-generator :optional [_ inner-generator]
  (tc.gen/fmap (fn [schema]
                 [:optional {} schema])
               inner-generator))

(defrecord Box [value])

(defn box ^Box [value]
  (->Box value))

(defn unbox [^Box box]
  (.-value box))

(defmethod compound-schema-generator :wrapped [_ inner-generator]
  (tc.gen/fmap (fn [schema]
                 [:wrapped {} unbox box schema])
               inner-generator))

(defmethod compound-schema-generator :multi [_ inner-generator]
  (tc.gen/fmap (fn [schema]
                 [:multi {} any? {true schema}])
               inner-generator))

(defmethod compound-schema-generator :coll [schema-name inner-generator]
  (tc.gen/fmap (fn [schema]
                 [schema-name {} schema])
               inner-generator))

(defmethod compound-schema-generator :map [_ inner-generator]
  (tc.gen/fmap (fn [[key-schema value-schema]]
                 [:map {} key-schema value-schema])
               (tc.gen/tuple inner-generator inner-generator)))

(defmethod compound-schema-generator :record [_ inner-generator]
  (tc.gen/fmap (fn [schemas]
                 [:record {} schemas])
               (tc.gen/map simple-keyword-generator inner-generator)))

(defmethod compound-schema-generator :tuple [_ inner-generator]
  (tc.gen/fmap (fn [schemas]
                 [:tuple {} schemas])
               (tc.gen/vector inner-generator)))

(def schema-generator*
  (tc.gen/recursive-gen
    (fn [inner-generator]
      (->> (compiler.schema/leaf-descendants compiler.schema/extended-hierarchy :compound)
           (map (fn [schema]
                  (compound-schema-generator schema inner-generator)))
           (tc.gen/one-of)))
    (let [scalar-schemas (disj (compiler.schema/leaf-descendants compiler.schema/extended-hierarchy :scalar)
                               :binary
                               #?(:cljs :float))]
      (->> scalar-schemas
           (map scalar-schema-generator)
           (tc.gen/one-of)))))

(def ^:const scalar-schema-size 1)
(def ^:const max-schema-size 1000)
(def ^:const coll-schema-size-multiplier 30)

(defmulti schema-size
  compiler.schema/schema-name
  :hierarchy #'compiler.schema/extended-hierarchy)

(defmethod schema-size :scalar [_]
  scalar-schema-size)

(defmethod schema-size :optional [[_ _ schema']]
  (schema-size schema'))

(defmethod schema-size :wrapped [[_ _ _ _ schema']]
  (schema-size schema'))

(defmethod schema-size :multi [[_ _ _ schemas']]
  (let [schema-sizes (map schema-size (vals schemas'))]
    (/ (reduce + schema-sizes)
       (count schema-sizes))))

(defmethod schema-size :coll [[_ _ schema']]
  (* coll-schema-size-multiplier (schema-size schema')))

(defmethod schema-size :map [[_ _ key-schema' value-schema']]
  (* coll-schema-size-multiplier (+ (schema-size key-schema')
                                    (schema-size value-schema'))))

(defmethod schema-size :record [[_ _ schemas']]
  (->> schemas'
       (vals)
       (map schema-size)
       (reduce +)))

(defmethod schema-size :tuple [[_ _ schemas']]
  (->> schemas'
       (map schema-size)
       (reduce +)))

(def schema-generator
  (tc.gen/such-that (fn [schema]
                      (< (schema-size schema) max-schema-size))
                    schema-generator*))

(defn bounds [bytes signed?]
  {:min (math/lower-bound bytes signed?)
   :max (dec (math/upper-bound bytes signed?))})

(defmulti value-generator
  compiler.schema/schema-name
  :hierarchy #'compiler.schema/extended-hierarchy)

(defmethod value-generator :byte [_]
  (tc.gen/large-integer* (bounds 1 true)))

(defmethod value-generator :ubyte [_]
  (tc.gen/large-integer* (bounds 1 false)))

(defmethod value-generator :short [_]
  (tc.gen/large-integer* (bounds 2 true)))

(defmethod value-generator :ushort [_]
  (tc.gen/large-integer* (bounds 2 false)))

(defmethod value-generator :int [_]
  (tc.gen/large-integer* (bounds 4 true)))

(defmethod value-generator :uint [_]
  (tc.gen/large-integer* (bounds 4 false)))

(defmethod value-generator :long [_]
  (tc.gen/large-integer* (bounds 8 true)))

(defmethod value-generator :varint [_]
  (value-generator [:long]))

(defmethod value-generator :float [_]
  (tc.gen/fmap unchecked-float
               (tc.gen/double* {:infinite? true :NaN? false})))

(defmethod value-generator :double [schema]
  (tc.gen/double* {:infinite? true :NaN? false}))

(defmethod value-generator :char [_]
  (tc.gen/fmap runtime.processor.common/int->char
               (tc.gen/large-integer* (bounds 2 false))))

(defmethod value-generator :boolean [schema]
  tc.gen/boolean)

(defmethod value-generator :nil [_]
  (tc.gen/return nil))

(defmethod value-generator :binary [schema]
  (tc.gen/fmap runtime.processor.common/byte-seq->binary
               (tc.gen/vector (tc.gen/large-integer* (bounds 1 true)))))

(defmethod value-generator :string [_]
  simple-string-generator)

(defmethod value-generator :keyword [_]
  simple-keyword-generator)

(defmethod value-generator :symbol [_]
  simple-symbol-generator)

(defmethod value-generator :any [_]
  (tc.gen/return nil))

(defmethod value-generator :enum [[_ _ enum-values]]
  (tc.gen/elements enum-values))

(defmethod value-generator :optional [[_ _ schema']]
  (tc.gen/one-of [(value-generator [:nil {}])
                  (value-generator schema')]))

(defmethod value-generator :wrapped [[_ _ _ post schema']]
  (tc.gen/fmap post (value-generator schema')))

(defmethod value-generator :multi [[_ _ _ schemas']]
  (tc.gen/one-of (map value-generator (vals schemas'))))

(defmethod value-generator :list [[_ _ schema']]
  (tc.gen/list (value-generator schema')))

(defmethod value-generator :vector [[_ _ schema']]
  (tc.gen/vector (value-generator schema')))

(defmethod value-generator :set [[_ _ schema']]
  (tc.gen/set (value-generator schema')))

(defmethod value-generator :map [[_ _ key-schema value-schema]]
  (tc.gen/map (value-generator key-schema)
              (value-generator value-schema)))

(defmethod value-generator :record [[_ _ schemas]]
  (let [schemas' (sort schemas)]
    (->> schemas'
         (map (comp value-generator second))
         (apply tc.gen/tuple)
         (tc.gen/fmap (fn [values]
                        (zipmap (map first schemas') values))))))

(defmethod value-generator :tuple [[_ _ schemas]]
  (apply tc.gen/tuple (map value-generator schemas)))

(ns mikron.schema-generators
  (:require [clojure.test.check.generators :as tc.gen]
            [macrowbar.core :as macrowbar]
            [mikron.math :as math]
            [mikron.compiler.schema :as compiler.schema]
            [mikron.runtime.processor.common :as runtime.processor.common]))

(def simple-string-generator
  (tc.gen/fmap (fn [string]
                 (if (> (count string) 5)
                   (.substring string 0 5)
                   string))
               (tc.gen/not-empty tc.gen/string-alphanumeric)))

(def simple-symbol-generator
  (tc.gen/fmap symbol simple-string-generator))

(def simple-keyword-generator
  (tc.gen/fmap keyword simple-string-generator))

(defmulti scalar-schema-generator
  (fn [schema-name] schema-name)
  :hierarchy #'compiler.schema/extended-hierarchy)

(defmethod scalar-schema-generator :simple [schema-name]
  (tc.gen/return [schema-name {}]))

(defmethod scalar-schema-generator :enum [_]
  (tc.gen/fmap (fn [enum-values]
                 [:enum {} enum-values])
               (tc.gen/not-empty (tc.gen/set simple-keyword-generator))))

(defmulti compound-schema-generator
  (fn [schema-name inner-generator] schema-name)
  :hierarchy #'compiler.schema/extended-hierarchy)

(defmethod compound-schema-generator :optional [_ inner-generator]
  (tc.gen/fmap (fn [schema]
                 [:optional {} schema])
               inner-generator))

(defrecord Box2 [value])

(defn box ^Box2 [value]
  (->Box2 value))

(defn unbox [^Box2 box]
  (.-value box))

(defmethod compound-schema-generator :wrapped [_ inner-generator]
  (tc.gen/fmap (fn [schema]
                 [:wrapped {} unbox box schema])
               inner-generator))

(defmethod compound-schema-generator :multi [_ inner-generator]
  (tc.gen/fmap (fn [schema]
                 [:multi {} any? {true schema}])
               inner-generator))

(defmethod compound-schema-generator :coll [schema-name inner-generator]
  (tc.gen/fmap (fn [schema]
                 [schema-name {} schema])
               inner-generator))

(defmethod compound-schema-generator :map [_ inner-generator]
  (tc.gen/fmap (fn [[key-schema value-schema]]
                 [:map {} key-schema value-schema])
               (tc.gen/tuple inner-generator inner-generator)))

(defmethod compound-schema-generator :record [_ inner-generator]
  (tc.gen/fmap (fn [schemas]
                 [:record {} schemas])
               (tc.gen/map simple-keyword-generator inner-generator)))

(defmethod compound-schema-generator :tuple [_ inner-generator]
  (tc.gen/fmap (fn [schemas]
                 [:tuple {} schemas])
               (tc.gen/vector inner-generator)))

(def schema-generator*
  (tc.gen/recursive-gen
    (fn [inner-generator]
      (->> (compiler.schema/leaf-descendants compiler.schema/extended-hierarchy :compound)
           (map (fn [schema]
                  (compound-schema-generator schema inner-generator)))
           (tc.gen/one-of)))
    (let [scalar-schemas (disj (compiler.schema/leaf-descendants compiler.schema/extended-hierarchy :scalar)
                               :binary
                               #?(:cljs :float))]
      (->> scalar-schemas
           (map scalar-schema-generator)
           (tc.gen/one-of)))))

(def ^:const scalar-schema-size 1)
(def ^:const max-schema-size 1000)
(def ^:const coll-schema-size-multiplier 30)

(defmulti schema-size
  compiler.schema/schema-name
  :hierarchy #'compiler.schema/extended-hierarchy)

(defmethod schema-size :scalar [_]
  scalar-schema-size)

(defmethod schema-size :optional [[_ _ schema']]
  (schema-size schema'))

(defmethod schema-size :wrapped [[_ _ _ _ schema']]
  (schema-size schema'))

(defmethod schema-size :multi [[_ _ _ schemas']]
  (let [schema-sizes (map schema-size (vals schemas'))]
    (/ (reduce + schema-sizes)
       (count schema-sizes))))

(defmethod schema-size :coll [[_ _ schema']]
  (* coll-schema-size-multiplier (schema-size schema')))

(defmethod schema-size :map [[_ _ key-schema' value-schema']]
  (* coll-schema-size-multiplier (+ (schema-size key-schema')
                                    (schema-size value-schema'))))

(defmethod schema-size :record [[_ _ schemas']]
  (->> schemas'
       (vals)
       (map schema-size)
       (reduce +)))

(defmethod schema-size :tuple [[_ _ schemas']]
  (->> schemas'
       (map schema-size)
       (reduce +)))

(def schema-generator
  (tc.gen/such-that (fn [schema]
                      (< (schema-size schema) max-schema-size))
                    schema-generator*))

(defn bounds [bytes signed?]
  {:min (math/lower-bound bytes signed?)
   :max (dec (math/upper-bound bytes signed?))})

(defmulti value-generator
  compiler.schema/schema-name
  :hierarchy #'compiler.schema/extended-hierarchy)

(defmethod value-generator :byte [_]
  (tc.gen/large-integer* (bounds 1 true)))

(defmethod value-generator :ubyte [_]
  (tc.gen/large-integer* (bounds 1 false)))

(defmethod value-generator :short [_]
  (tc.gen/large-integer* (bounds 2 true)))

(defmethod value-generator :ushort [_]
  (tc.gen/large-integer* (bounds 2 false)))

(defmethod value-generator :int [_]
  (tc.gen/large-integer* (bounds 4 true)))

(defmethod value-generator :uint [_]
  (tc.gen/large-integer* (bounds 4 false)))

(defmethod value-generator :long [_]
  (tc.gen/large-integer* (bounds 8 true)))

(defmethod value-generator :varint [_]
  (value-generator [:long]))

(defmethod value-generator :float [_]
  (tc.gen/fmap unchecked-float
               (tc.gen/double* {:infinite? true :NaN? false})))

(defmethod value-generator :double [schema]
  (tc.gen/double* {:infinite? true :NaN? false}))

(defmethod value-generator :char [_]
  (tc.gen/fmap runtime.processor.common/int->char
               (tc.gen/large-integer* (bounds 2 false))))

(defmethod value-generator :boolean [schema]
  tc.gen/boolean)

(defmethod value-generator :nil [_]
  (tc.gen/return nil))

(defmethod value-generator :binary [schema]
  (tc.gen/fmap runtime.processor.common/byte-seq->binary
               (tc.gen/vector (tc.gen/large-integer* (bounds 1 true)))))

(defmethod value-generator :string [_]
  simple-string-generator)

(defmethod value-generator :keyword [_]
  simple-keyword-generator)

(defmethod value-generator :symbol [_]
  simple-symbol-generator)

(defmethod value-generator :any [_]
  (tc.gen/return nil))

(defmethod value-generator :enum [[_ _ enum-values]]
  (tc.gen/elements enum-values))

(defmethod value-generator :optional [[_ _ schema']]
  (tc.gen/one-of [(value-generator [:nil {}])
                  (value-generator schema')]))

(defmethod value-generator :wrapped [[_ _ _ post schema']]
  (tc.gen/fmap post (value-generator schema')))

(defmethod value-generator :multi [[_ _ _ schemas']]
  (tc.gen/one-of (map value-generator (vals schemas'))))

(defmethod value-generator :list [[_ _ schema']]
  (tc.gen/list (value-generator schema')))

(defmethod value-generator :vector [[_ _ schema']]
  (tc.gen/vector (value-generator schema')))

(defmethod value-generator :set [[_ _ schema']]
  (tc.gen/set (value-generator schema')))

(defmethod value-generator :map [[_ _ key-schema value-schema]]
  (tc.gen/map (value-generator key-schema)
              (value-generator value-schema)))

(defmethod value-generator :record [[_ _ schemas]]
  (let [schemas' (sort schemas)]
    (->> schemas'
         (map (comp value-generator second))
         (apply tc.gen/tuple)
         (tc.gen/fmap (fn [values]
                        (zipmap (map first schemas') values))))))

(defmethod value-generator :tuple [[_ _ schemas]]
  (apply tc.gen/tuple (map value-generator schemas)))

Rename Box to Box2 (avoid clash with cljs.core/Box)


(ns sinusoides.components
  (:require-macros [cljs.core.async.macros :refer [go]])
  (:require [sinusoides.util :as util]
            [sinusoides.routes :as routes]
            [cljs.core.match :refer-macros [match]]
            [om.core :as om :include-macros true]
            [sablono.core :as html :refer-macros [html]]
            [cljs.core.match]))

(defn render-init []
  (html [:div "Initializing..."]))

(defn render-not-found []
  (html [:div "Not found"]))

(defn render-main []
  (html
    [:div {:id "backlink-nohover"}
     [:div {:id "main-block" :class "links"}
      [:div {:id "main-pre-text"}
       "What " [:a {:href (routes/do)} "do"] " you "]
      [:div {:id "main-post-text"}
       [:a {:href (routes/think)} "think"]
       " I " [:a {:href (routes/am)} "am"] "?"]
      [:a {:href (routes/todo)} [:div {:id "barcode"}]]]]))

(defn root-view [app _]
  (reify om/IRender
    (render [_]
      (html
        [:div {:class "sinusoides"}
         (match [(om/value (:view app))]
           [[:init]] (render-init)
           [[:main]] (render-main)
           :else (render-not-found))]))))

(defn init-components! [state]
  (om/root root-view state
    {:target (.getElementById js/document "components")}))

(ns sinusoides.components
  (:require-macros [cljs.core.async.macros :refer [go]])
  (:require [sinusoides.util :as util]
            [sinusoides.routes :as routes]
            [cljs.core.match :refer-macros [match]]
            [om.core :as om :include-macros true]
            [sablono.core :as html :refer-macros [html]]
            [cljs.core.match]))

(defn render-init []
  (html [:div "Initializing..."]))

(defn render-not-found []
  (html [:div "Not found"]))

(defn render-todo []
  (html
    [:div :id "todo"
     [:a {:href (routes/main)} [:div {:id "backlink-vert"}]]
     [:div {:id "todo-block" :class "links"}
      "TO" [:a {:href (routes/do)} "DO."]]]))

(defn render-main []
  (html
    [:div {:id "backlink-nohover"}
     [:div {:id "main-block" :class "links"}
      [:div {:id "main-pre-text"}
       "What " [:a {:href (routes/do)} "do"] " you "]
      [:div {:id "main-post-text"}
       [:a {:href (routes/think)} "think"]
       " I " [:a {:href (routes/am)} "am"] "?"]
      [:a {:href (routes/todo)} [:div {:id "barcode"}]]]]))

(defn root-view [app _]
  (reify om/IRender
    (render [_]
      (html
        [:div {:class "sinusoides"}
         (match [(om/value (:view app))]
           [[:init]] (render-init)
           [[:todo]] (render-todo)
           [[:main]] (render-main)
           :else (render-not-found))]))))

(defn init-components! [state]
  (om/root root-view state
    {:target (.getElementById js/document "components")}))

Add to-do page

Add to-do page


(ns jarkeeper.views.project
  (:require [clojure.string :as string]
            [jarkeeper.views.common :as common-views]
            [hiccup.core :refer [html]]
            [hiccup.page :refer [html5 include-css include-js]]
            [hiccup.util :refer [escape-html]]))

(defn- render-deps [deps]
  (for [dep deps]
    [:tr
     [:td (first dep)]
     [:td (second dep)]
     [:td (:version-string (last dep))]
     [:td.status-column
       (if (nil? (last dep))
         [:span.status.up-to-date {:title "Up to date"}]
         [:span.status.out-of-date {:title "Out of date"}])]]))

(defn- render-stats [stats]
  [:section.summary.row
   [:ul
    [:li.small-12.large-4.columns
     [:span.number (:total stats)]
     [:span.stats-label "dependencies"]]
    [:li.small-12.large-4.columns
     [:span.status.up-to-date]
     [:span.number (:up-to-date stats)]
     [:span.stats-label "up to date"]]
    [:li.small-12.large-4.columns
     [:span.status.out-of-date]
     [:span.number (:out-of-date stats)]
     [:span.stats-label "out of date"]]]])

(defn- render-table [header items]
  [:table.small-12.columns
    [:thead
     [:tr
      [:th header]
      [:th {:width "180"} ""]
      [:th {:width "180"} ""]
      [:th {:width "90"} ""]]]
   (render-deps items)])

(defn index [project]
  (html5 {:lang "en"}
    [:head
     [:title (str "Jarkeeper: " (:name project))]
     (common-views/common-head)
     (common-views/ga)
     (include-css "/app.css")]
    [:body
      (common-views/header)
      [:article.project-content
        [:header.row
         [:h1
           [:a {:href (:github-url project)} (:name project)]
           [:span.version (:version project)]]
         [:h2 (:description project)]
         (if (> (:out-of-date (:stats project)) 0)
           [:img {:src "/images/out-of-date.png" :alt "Outdated dependencies"}]
           [:img {:src "/images/up-to-date.png"  :alt "Up to date dependencies"}])]
        [:section.dependencies.row
          (render-stats (:stats project))
          (render-table "Dependency" (:deps project))
          (if (> (count (:plugins project)) 0)
            (html
              (render-stats (:plugins-stats project))
              (render-table "Plugin" (:plugins project))))
         (for [profile (:profiles project)]
           (if (first profile)
             (html
               (render-stats (nth profile 2))
               (render-table (name (first profile)) (second profile)))))]

       [:section.installation-instructions.row
        [:h2 "Markdown with PNG image"]
        [:code
           (str "[![Dependencies Status]"
                "(http://jarkeeper.com/"
                (:repo-owner project)
                "/"
                (:repo-name project)
                "/status.png)](http://jarkeeper.com/"
                (:repo-owner project)
                "/"
                (:repo-name project)
                ")")]
        [:h2 "HTML with PNG image"]
        [:code
           (escape-html (str ""))]
        ]
       [:section.installation-instructions.row
        [:h2 "Markdown with SVG image"]
        [:code
           (str "[![Dependencies Status]"
                "(http://jarkeeper.com/"
                (:repo-owner project)
                "/"
                (:repo-name project)
                "/status.svg)](http://jarkeeper.com/"
                (:repo-owner project)
                "/"
                (:repo-name project)
                ")")]
        [:h2 "HTML with SVG image"]
        [:code
           (escape-html (str ""))]
        ]
       ]
     (common-views/common-footer)]))

Update project.clj

Update project.clj


(ns kolmogorov-music.song
  (:require [overtone.live :refer :all]
            [leipzig.melody :refer :all]
            [leipzig.scale :as scale]
            [leipzig.live :as live]
            [leipzig.chord :as chord]
            [leipzig.temperament :as temperament]
            [kolmogorov-music.champernowne :as champernowne]))

(def master-volume 0.03)

(definst buzz [freq 110 vol 1.0 dur 1.0]
  (-> (saw freq)
      (rlpf (* 4 440) (line:kr 1/10 1/20 dur))
      (* (env-gen (perc 0.01 0.5) :action FREE))
      (* vol master-volume)))

(definst sing [freq 110 dur 1.0 vol 1.0]
  (-> (sin-osc freq)
      (+ (sin-osc (* 3.01 freq)))
      (+ (* 1/4 (sin-osc (* 2.01 freq))))
      (+ (* 1/3 (sin-osc (* 1/2 freq))))
      (rlpf (line:kr 3000 500 dur) 1/50)
      (clip2 0.3)
      (* (env-gen (adsr 0.05 (* dur 1/3) 0.2) (line:kr 1 0 dur) :action FREE))
      (* vol master-volume)))

; Arrangement
(defmethod live/play-note :dux [{hertz :pitch seconds :duration}]
  (when hertz (buzz hertz seconds)))
(defmethod live/play-note :comes [{hertz :pitch seconds :duration}]
  (when hertz (sing hertz seconds)))
(defmethod live/play-note :bass [{hertz :pitch seconds :duration}]
  (when hertz (sing (* 1/2 hertz) seconds)))

(defn construct [time duration pitch part]
  {:time time
   :pitch pitch
   :duration duration
   :part part})

(defn most-behind [m]
  (first (apply min-key second m)))

(defn synchronise [m]
  (zipmap (keys m) (repeat (apply max (vals m)))) )

(defn decode
  ([state [a b c d & digits]]
   (if (zero? (* a b))
     (decode (synchronise state) digits)
     (let [part (most-behind state)
           duration (/ a b)
           pitch (+ c d)
           time (part state)]
       (cons (construct time duration pitch part)
             (lazy-seq (->> digits
                            (decode (update-in state [part] (partial + duration))))))))))

(defn tens [n]
  (apply * (repeat n 10)))

(defn code [[{:keys [duration pitch] :as note} & notes]]
  (if (nil? note)
    0
    (let [one (+ (* (tens 3) (if (ratio? duration) (numerator duration) duration))
                 (* (tens 2) (if (ratio? duration) (denominator duration) 1))
                 (* (tens 1) (quot pitch 2))
                 (* (tens 0) (- pitch (quot pitch 2))))]
      (+ (* (bigint one) (tens (* 4 (count notes)))) (code notes)))))

(def row
  (->> (phrase [3/3 3/3 2/3 1/3 3/3]
               [7 7 7 8 9])
 ;      (with (phrase [1 1 2] [0 4 0]))
       code))

(def track
  (->>
    (champernowne/word 10
                      ; 7207120772071207720712077207120772031203720312037203120312551255125412541253125312521232
                       row
                       )
    ; (decode {:dux 0 :comes 0 :bass 0})
    (decode {:dux 0})
    (wherever :pitch, :pitch (comp temperament/equal scale/A scale/minor scale/lower))
    (where :time (bpm 120))
    (where :duration (bpm 120))))

(comment

   ; Loop the track, allowing live editing.
  (live/jam (var track))
  (fx-reverb)
  (fx-chorus)
  (fx-distortion)

  )

(ns kolmogorov-music.song
  (:require [overtone.live :refer :all]
            [leipzig.melody :refer :all]
            [leipzig.scale :as scale]
            [leipzig.live :as live]
            [leipzig.chord :as chord]
            [leipzig.temperament :as temperament]
            [kolmogorov-music.champernowne :as champernowne]))

(def master-volume 0.05)

(definst buzz [freq 110 vol 1.0 dur 1.0]
  (-> (saw freq)
      (rlpf (* 4 440) (line:kr 1/10 1/20 dur))
      (* (env-gen (perc 0.01 0.5) :action FREE))
      (* vol master-volume)))

(definst sing [freq 110 dur 1.0 vol 1.0]
  (-> (sin-osc freq)
      (+ (sin-osc (* 3.01 freq)))
      (+ (* 1/4 (sin-osc (* 2.01 freq))))
      (+ (* 1/3 (sin-osc (* 1/2 freq))))
      (rlpf (line:kr 3000 500 dur) 1/50)
      (clip2 0.3)
      (* (env-gen (adsr 0.05 (* dur 1/3) 0.2) (line:kr 1 0 dur) :action FREE))
      (* vol master-volume)))

; Arrangement
(defmethod live/play-note :dux [{hertz :pitch seconds :duration}]
  (when hertz (buzz hertz seconds)))
(defmethod live/play-note :comes [{hertz :pitch seconds :duration}]
  (when hertz (sing hertz seconds)))
(defmethod live/play-note :bass [{hertz :pitch seconds :duration}]
  (when hertz (sing (* 1/2 hertz) seconds)))

(defn construct [time duration pitch part]
  {:time time
   :pitch pitch
   :duration duration
   :part part})

(defn most-behind [m]
  (first (apply min-key second m)))

(defn synchronise [m]
  (zipmap (keys m) (repeat (apply max (vals m)))) )

(defn decode
  ([state [a b c d & digits]]
   (if (zero? (* a b))
     (decode (synchronise state) digits)
     (let [part (most-behind state)
           duration (/ a b)
           pitch (+ c d)
           time (part state)]
       (cons (construct time duration pitch part)
             (lazy-seq (->> digits
                            (decode (update-in state [part] (partial + duration))))))))))

(defn tens [n]
  (apply * (repeat n 10)))

(defn code [[{:keys [duration pitch] :as note} & notes]]
  (if (nil? note)
    0
    (let [one (+ (* (tens 3) (if (ratio? duration) (numerator duration) duration))
                 (* (tens 2) (if (ratio? duration) (denominator duration) 1))
                 (* (tens 1) (quot pitch 2))
                 (* (tens 0) (- pitch (quot pitch 2))))]
      (+ (* (bigint one) (tens (* 4 (count notes)))) (code notes)))))

(def row
  (->> (phrase [3/3 3/3 2/3 1/3 3/3]
               [7 7 7 8 9])
 ;      (with (phrase [1 1 2] [0 4 0]))
       code))

(defn track []
  (->>
    (champernowne/word 10
                       ; 7207120772071207720712077207120772031203720312037203120312551255125412541253125312521232
                       row
                       )
    ; (decode {:dux 0 :comes 0 :bass 0})
    (decode {:dux 0})
    (wherever :pitch, :pitch (comp temperament/equal scale/A scale/minor scale/lower))
    (where :time (bpm 120))
    (where :duration (bpm 120))))

(comment

   ; Loop the track, allowing live editing.
  (live/play (track))
  (fx-reverb)
  (fx-chorus)
  (fx-distortion)

  )

Make track a thunk so we aren't holding the head of an infinite sequence.


(ns crate.macros)

(defmacro defpartial
  [name params & body]
  `(let [group# (swap! crate.core/group-id inc)]
     (defn ^{:crateGroup group#}
       ~name ~params
       (.setAttribute
         (crate.core/html
           ~@body)
         "crateGroup"
         group#))
     (set! (.-prototype._crateGroup ~name) group#)))

(defmacro defelem
  "Defines a function that will return a tag vector. If the first argument
  passed to the resulting function is a map, it merges it with the attribute
  map of the returned tag value."
  [name & fdecl]
  `(let [func# (fn ~@fdecl)]
    (def ~name (crate.tags/add-optional-attrs func#))))

(ns crate.macros)

(defmacro defpartial
  [name params & body]
  `(let [group# (swap! crate.core/group-id inc)]
     (defn ^{:crateGroup group#}
       ~name ~params
       (let [elem# (crate.core/html ~@body)]
         (.setAttribute elem# "crateGroup" group#)
         elem#))
     (set! (.-prototype._crateGroup ~name) group#)))

(defmacro defelem
  "Defines a function that will return a tag vector. If the first argument
  passed to the resulting function is a map, it merges it with the attribute
  map of the returned tag value."
  [name & fdecl]
  `(let [func# (fn ~@fdecl)]
    (def ~name (crate.tags/add-optional-attrs func#))))

upgrade crate macros to fix defpartial bug


(ns com.nomistech.clojure-the-language.c-800-libraries.s-800-web.ss-600-bidi-yada.sss-200-yada
  (:require [clj-http.client :as http-client]
            [com.nomistech.clojure-the-language.c-850-utils.s-100-utils :as u]
            [midje.sweet :refer :all]
            [yada.yada :as yada]))

;;;; ___________________________________________________________________________

(defn make-server [port
                   routes]
  (yada/listener routes
                 {:port port}))

(defn stop-server [server-map]
  ((:close server-map)))

(defn w-server-fun [routes
                    port
                    fun]
  (let [server-map (make-server port
                                routes)]
    (try (fun)
         (finally
           (stop-server server-map)))))

(defmacro with-server [{:keys [routes
                               port]}
                       & body]
  `(w-server-fun ~routes
                 ~port
                 (fn [] ~@body)))

;;;; ___________________________________________________________________________

;; ;;;; TODO You've grabbed some examples that had no explanations, and you have
;; ;;;; all of the following. Learn about them.
;; ;;;; - `yada/as-resource`
;; ;;;; - `yada/handler`
;; ;;;; - `yada/resource`

(defn make-routes []
  ["/"

   [["hello-as-resource"
     (yada/as-resource "Hello World!")]

    ["hello-as-handler"
     (yada/handler "Hello World!")]

    ["some-plain-text"
     (yada/resource {:produces "text/plain"
                     :response "Some plain text"})]

    ["an-edn-map-1"
     (yada/handler {:this-will-be :an-edn
                    :map          {:hello "World!"}})]

    ["an-edn-map-2"
     (yada/resource {:produces "application/edn"
                     :response {:this-will-be :an-edn
                                :map          {:hello "World!"}}})]

    ["a-json-map"
     (yada/resource {:produces "application/json"
                     :response {:this-will-be "a-json"
                                :map          {:hello "World!"}}})]

    [true (yada/as-resource nil)]]])

(defn filter-response [response]
  (u/select-keys-recursively response
                             [[:headers ["Content-Type"]]
                              [:body]]))

(def test-port 7866)

(defn make-test-url [x]
  (str "http://localhost:"
       test-port
       x))

(defn get-and-filter [endpoint]
  (-> (http-client/get endpoint)
      filter-response))

(defn get-json-and-filter [endpoint]
  (-> (http-client/get endpoint
                       {:as :json})
      filter-response))

(defn get-and-filter-using-x-and-temp-server [x]
  (with-server {:routes (make-routes)
                :port test-port}
    (-> x
        make-test-url
        get-and-filter)))

(defn get-json-and-filter-using-x-and-temp-server [x]
  (with-server {:routes (make-routes)
                :port test-port}
    (-> x
        make-test-url
        get-json-and-filter)))

;;;; ___________________________________________________________________________

(fact
  (get-and-filter-using-x-and-temp-server "/hello-as-resource")
  => {:headers {"Content-Type" "text/plain;charset=utf-8"}
      :body "Hello World!"})

(fact
  (get-and-filter-using-x-and-temp-server "/hello-as-handler")
  => {:headers {"Content-Type" "text/plain;charset=utf-8"}
      :body "Hello World!"})

(fact
  (get-and-filter-using-x-and-temp-server "/some-plain-text")
  => {:headers {"Content-Type" "text/plain"}
      :body "Some plain text"})

(fact
  (get-and-filter-using-x-and-temp-server "/an-edn-map-1")
  => {:headers {"Content-Type" "application/edn"}
      :body "{:this-will-be :an-edn, :map {:hello \"World!\"}}\n"})

(fact
  (get-and-filter-using-x-and-temp-server "/an-edn-map-2")
  => {:headers {"Content-Type" "application/edn"}
      :body "{:this-will-be :an-edn, :map {:hello \"World!\"}}\n"})

(fact
  (get-json-and-filter-using-x-and-temp-server "/a-json-map")
  => {:headers {"Content-Type" "application/json"}
      :body {:this-will-be "a-json"
             :map          {:hello "World!"}}})

(ns com.nomistech.clojure-the-language.c-800-libraries.s-800-web.ss-600-bidi-yada.sss-200-yada
  (:require [clj-http.client :as http-client]
            [com.nomistech.clojure-the-language.c-850-utils.s-100-utils :as u]
            [midje.sweet :refer :all]
            [yada.yada :as yada]))

;;;; ___________________________________________________________________________

(defn make-server [port
                   routes]
  (yada/listener routes
                 {:port port}))

(defn stop-server [server-map]
  ((:close server-map)))

(defn w-server-fun [routes
                    port
                    fun]
  (let [server-map (make-server port
                                routes)]
    (try (fun)
         (finally
           (stop-server server-map)))))

(defmacro with-server [{:keys [routes
                               port]}
                       & body]
  `(w-server-fun ~routes
                 ~port
                 (fn [] ~@body)))

;;;; ___________________________________________________________________________

;; ;;;; TODO You've grabbed some examples that had no explanations, and you have
;; ;;;; all of the following. Learn about them.
;; ;;;; - `yada/as-resource`
;; ;;;; - `yada/handler`
;; ;;;; - `yada/resource`

(defn make-test-routes []
  ["/"

   [["hello-as-resource"
     (yada/as-resource "Hello World!")]

    ["hello-as-handler"
     (yada/handler "Hello World!")]

    ["some-plain-text"
     (yada/resource {:produces "text/plain"
                     :response "Some plain text"})]

    ["an-edn-map-1"
     (yada/handler {:this-will-be :an-edn
                    :map          {:hello "World!"}})]

    ["an-edn-map-2"
     (yada/resource {:produces "application/edn"
                     :response {:this-will-be :an-edn
                                :map          {:hello "World!"}}})]

    ["a-json-map"
     (yada/resource {:produces "application/json"
                     :response {:this-will-be "a-json"
                                :map          {:hello "World!"}}})]

    [true (yada/as-resource nil)]]])

(def test-port 7866)

(defn make-test-url [path]
  (str "http://localhost:"
       test-port
       path))

(defn filter-response [response]
  (u/select-keys-recursively response
                             [[:headers ["Content-Type"]]
                              [:body]]))

(defn get-and-filter [endpoint get-options]
  (-> (http-client/get endpoint
                       get-options)
      filter-response))

(defn get-and-filter-using-path-and-temp-server [path get-options]
  (with-server {:routes (make-test-routes)
                :port test-port}
    (-> path
        make-test-url
        (get-and-filter get-options))))

;;;; ___________________________________________________________________________

(fact
  (get-and-filter-using-path-and-temp-server "/hello-as-resource"
                                             {})
  => {:headers {"Content-Type" "text/plain;charset=utf-8"}
      :body "Hello World!"})

(fact
  (get-and-filter-using-path-and-temp-server "/hello-as-handler"
                                             {})
  => {:headers {"Content-Type" "text/plain;charset=utf-8"}
      :body "Hello World!"})

(fact
  (get-and-filter-using-path-and-temp-server "/some-plain-text"
                                             {})
  => {:headers {"Content-Type" "text/plain"}
      :body "Some plain text"})

(fact
  (get-and-filter-using-path-and-temp-server "/an-edn-map-1"
                                             {})
  => {:headers {"Content-Type" "application/edn"}
      :body "{:this-will-be :an-edn, :map {:hello \"World!\"}}\n"})

(fact
  (get-and-filter-using-path-and-temp-server "/an-edn-map-2"
                                             {})
  => {:headers {"Content-Type" "application/edn"}
      :body "{:this-will-be :an-edn, :map {:hello \"World!\"}}\n"})

(fact
  (get-and-filter-using-path-and-temp-server "/a-json-map"
                                             {:as :json})
  => {:headers {"Content-Type" "application/json"}
      :body {:this-will-be "a-json"
             :map          {:hello "World!"}}})

Add yada examples -- tidy

Add yada examples -- tidy


(ns metabase.email.messages
  "Convenience functions for sending templated email messages.  Each function here should represent a single email.
   NOTE: we want to keep this about email formatting, so don't put heavy logic here RE: building data for emails."
  (:require [hiccup.core :refer [html]]
            [stencil.core :as stencil]
            [stencil.loader :as loader]
            [metabase.email :as email]
            [metabase.models.setting :as setting]
            [metabase.pulse :as p, :refer [render-pulse-section]]
            [metabase.util :as u]
            [metabase.util.quotation :as q]
            [metabase.util.urls :as url]))

;; NOTE: uncomment this in development to disable template caching
;; (loader/set-cache (clojure.core.cache/ttl-cache-factory {} :ttl 0))

;;; ### Public Interface

(defn send-new-user-email
  "Format and Send an welcome email for newly created users."
  [invited invitor join-url]
  (let [data-quote   (rand-nth q/quotations)
        company      (or (setting/get :site-name) "Unknown")
        message-body (stencil/render-file "metabase/email/new_user_invite"
                                          {:emailType       "new_user_invite"
                                           :invitedName     (:first_name invited)
                                           :invitorName     (:first_name invitor)
                                           :invitorEmail    (:email invitor)
                                           :company         company
                                           :joinUrl         join-url
                                           :quotation       (:quote data-quote)
                                           :quotationAuthor (:author data-quote)
                                           :today           (u/format-date "MMM' 'dd,' 'yyyy" (System/currentTimeMillis))
                                           :logoHeader      true})]
    (email/send-message
     :subject      (str "You're invited to join " company "'s Metabase")
     :recipients   [(:email invited)]
     :message-type :html
     :message      message-body)))

(defn send-password-reset-email
  "Format and Send an email informing the user how to reset their password."
  [email hostname password-reset-url]
  {:pre [(string? email)
         (u/is-email? email)
         (string? hostname)
         (string? password-reset-url)]}
  (let [message-body (stencil/render-file "metabase/email/password_reset"
                                          {:emailType "password_reset"
                                           :hostname hostname
                                           :passwordResetUrl password-reset-url
                                           :logoHeader true})]
    (email/send-message
     :subject      "[Metabase] Password Reset Request"
     :recipients   [email]
     :message-type :html
     :message      message-body)))

(defn send-notification-email
  "Format and Send an email informing the user about changes to objects in the system."
  [email context]
  {:pre [(string? email)
         (u/is-email? email)
         (map? context)]}
  (let [model->url-fn #(case %
                        "Card"      url/question-url
                        "Dashboard" url/dashboard-url
                        "Pulse"     url/pulse-url
                        "Segment"   url/segment-url)
        add-url       (fn [{:keys [id model] :as obj}]
                        (assoc obj :url (apply (model->url-fn model) [id])))
        data-quote    (rand-nth q/quotations)
        context       (-> context
                          (update :dependencies (fn [deps-by-model]
                                                  (for [model (sort (set (keys deps-by-model)))
                                                        deps  (mapv add-url (get deps-by-model model))]
                                                    {:model   (case model
                                                                "Card" "Saved Question"
                                                                model)
                                                     :objects deps})))
                          (assoc :emailType "notification"
                                 :logoHeader true
                                 :quotation (:quote data-quote)
                                 :quotationAuthor (:author data-quote)))
        message-body  (stencil/render-file "metabase/email/notification" context)]
    (email/send-message
      :subject      "[Metabase] Notification"
      :recipients   [email]
      :message-type :html
      :message      message-body)))

;; HACK: temporary workaround to postal requiring a file as the attachment
(defn- write-byte-array-to-temp-file
  [^bytes img-bytes]
  (let [file (doto (java.io.File/createTempFile "metabase_pulse_image_" ".png")
               .deleteOnExit)]
    (with-open [fos (java.io.FileOutputStream. file)]
      (.write fos img-bytes))
    file))

(defn- render-image [images-atom, ^bytes image-bytes]
  (str "cid:IMAGE" (or (u/first-index-satisfying (fn [^bytes item]
                                                   (java.util.Arrays/equals item image-bytes))
                                                 @images-atom)
                       (u/prog1 (count @images-atom)
                         (swap! images-atom conj image-bytes)))))

(defn render-pulse-email
  "Take a pulse object and list of results, returns an array of attachment objects for an email"
  [pulse results]
  (let [images       (atom [])
        body         (apply vector :div (for [result results]
                                          (render-pulse-section (partial render-image images) :include-buttons result)))
        data-quote   (rand-nth q/quotations)
        message-body (stencil/render-file "metabase/email/pulse"
                                          {:emailType       "pulse"
                                           :pulse           (html body)
                                           :pulseName       (:name pulse)
                                           :sectionStyle    p/section-style
                                           :colorGrey4      p/color-grey-4
                                           :quotation       (:quote data-quote)
                                           :quotationAuthor (:author data-quote)
                                           :logoFooter      true})]
    (apply vector {:type "text/html" :content message-body}
           (map-indexed (fn [idx bytes] {:type         :inline
                                         :content-id   (str "IMAGE" idx)
                                         :content-type "image/png"
                                         :content      (write-byte-array-to-temp-file bytes)})
                        @images))))

(ns metabase.email.messages
  "Convenience functions for sending templated email messages.  Each function here should represent a single email.
   NOTE: we want to keep this about email formatting, so don't put heavy logic here RE: building data for emails."
  (:require [hiccup.core :refer [html]]
            [stencil.core :as stencil]
            [stencil.loader :as loader]
            [metabase.email :as email]
            [metabase.models.setting :as setting]
            [metabase.pulse :as p, :refer [render-pulse-section]]
            [metabase.util :as u]
            [metabase.util.quotation :as q]
            [metabase.util.urls :as url]))

;; NOTE: uncomment this in development to disable template caching
;; (loader/set-cache (clojure.core.cache/ttl-cache-factory {} :ttl 0))

;;; ### Public Interface

(defn send-new-user-email
  "Format and Send an welcome email for newly created users."
  [invited invitor join-url]
  (let [data-quote   (rand-nth q/quotations)
        company      (or (setting/get :site-name) "Unknown")
        message-body (stencil/render-file "metabase/email/new_user_invite"
                                          {:emailType       "new_user_invite"
                                           :invitedName     (:first_name invited)
                                           :invitorName     (:first_name invitor)
                                           :invitorEmail    (:email invitor)
                                           :company         company
                                           :joinUrl         join-url
                                           :quotation       (:quote data-quote)
                                           :quotationAuthor (:author data-quote)
                                           :today           (u/format-date "MMM' 'dd,' 'yyyy" (System/currentTimeMillis))
                                           :logoHeader      true})]
    (email/send-message
     :subject      (str "You're invited to join " company "'s Metabase")
     :recipients   [(:email invited)]
     :message-type :html
     :message      message-body)))

(defn send-password-reset-email
  "Format and Send an email informing the user how to reset their password."
  [email hostname password-reset-url]
  {:pre [(string? email)
         (u/is-email? email)
         (string? hostname)
         (string? password-reset-url)]}
  (let [message-body (stencil/render-file "metabase/email/password_reset"
                                          {:emailType "password_reset"
                                           :hostname hostname
                                           :passwordResetUrl password-reset-url
                                           :logoHeader true})]
    (email/send-message
     :subject      "[Metabase] Password Reset Request"
     :recipients   [email]
     :message-type :html
     :message      message-body)))

(defn send-notification-email
  "Format and Send an email informing the user about changes to objects in the system."
  [email context]
  {:pre [(string? email)
         (u/is-email? email)
         (map? context)]}
  (let [model->url-fn #(case %
                        "Card"      url/question-url
                        "Dashboard" url/dashboard-url
                        "Pulse"     url/pulse-url
                        "Segment"   url/segment-url)
        add-url       (fn [{:keys [id model] :as obj}]
                        (assoc obj :url (apply (model->url-fn model) [id])))
        data-quote    (rand-nth q/quotations)
        context       (-> context
                          (update :dependencies (fn [deps-by-model]
                                                  (for [model (sort (set (keys deps-by-model)))
                                                        deps  (mapv add-url (get deps-by-model model))]
                                                    {:model   (case model
                                                                "Card" "Saved Question"
                                                                model)
                                                     :objects deps})))
                          (assoc :emailType "notification"
                                 :logoHeader true
                                 :quotation (:quote data-quote)
                                 :quotationAuthor (:author data-quote)))
        message-body  (stencil/render-file "metabase/email/notification" context)]
    (email/send-message
      :subject      "[Metabase] Notification"
      :recipients   [email]
      :message-type :html
      :message      message-body)))

;; HACK: temporary workaround to postal requiring a file as the attachment
(defn- write-byte-array-to-temp-file
  [^bytes img-bytes]
  (let [file (doto (java.io.File/createTempFile "metabase_pulse_image_" ".png")
               .deleteOnExit)]
    (with-open [fos (java.io.FileOutputStream. file)]
      (.write fos img-bytes))
    file))

(defn- render-image [images-atom, ^bytes image-bytes]
  (str "cid:IMAGE" (or (u/first-index-satisfying (fn [^bytes item]
                                                   (java.util.Arrays/equals item image-bytes))
                                                 @images-atom)
                       (u/prog1 (count @images-atom)
                         (swap! images-atom conj image-bytes)))))

(defn render-pulse-email
  "Take a pulse object and list of results, returns an array of attachment objects for an email"
  [pulse results]
  (let [images       (atom [])
        body         (apply vector :div (for [result results]
                                          (render-pulse-section (partial render-image images) :include-buttons result)))
        data-quote   (rand-nth q/quotations)
        message-body (stencil/render-file "metabase/email/pulse"
                                          {:emailType       "pulse"
                                           :pulse           (html body)
                                           :pulseName       (:name pulse)
                                           :sectionStyle    p/section-style
                                           :colorGrey4      p/color-grey-4
                                           :quotation       (:quote data-quote)
                                           :quotationAuthor (:author data-quote)
                                           :logoFooter      true})]
    (apply vector {:type "text/html; charset=utf-8" :content message-body}
           (map-indexed (fn [idx bytes] {:type         :inline
                                         :content-id   (str "IMAGE" idx)
                                         :content-type "image/png"
                                         :content      (write-byte-array-to-temp-file bytes)})
                        @images))))

Fix Unicode in pulse emails

Fix Unicode in pulse emails


(ns multicodec.codecs.mux
  "Multiplexing codec which uses the codec predicates `encodable?` and
  `decodable?` to decide which codec to use when encoding or decoding data.

  `codecs` should be a map from (arbitrary) keys to codecs with headers and
  support for the codec predicates.

  The actual codec delegated to can be determined by binding
  `*dispatched-codec*` to `nil` and checking the result after an operation."
  (:require
    [multicodec.core :as codec]
    [multicodec.header :as header]
    [multicodec.codecs.wrap :as wrap]))

;; This var can be bound to find out what codec the mux used internally when
;; encoding or decoding a value.
(def
  ^{:dynamic true
    :doc "This var can be bound to nil in a thread to discover what codec was
         actually invoked by a mux codec operation. Encoding or decoding sets
         the var to the selected subcodec's keyword."}
  *dispatched-codec*)

(defn- find-encodable
  "Finds the first codec in the map which can encode the given value. Returns a
  vector of the key and codec entry, or nil if none are found."
  [codecs value]
  (first (filter #(codec/encodable? (val %) value) codecs)))

(defn- find-decodable
  "Finds the first codec in the map which can decode the given header. Returns
  a vector of the key and codec entry, or nil if none are found."
  [codecs header]
  (first (filter #(codec/decodable? (val %) header) codecs)))

;; ## Multiplexing Codec

(defrecord MuxCodec
  [codecs]

  codec/Encoder

  (encodable?
    [this value]
    (boolean (find-encodable codecs value)))

  (encode!
    [this output value]
    (let [[codec-key codec] (find-encodable codecs value)]
      (when-not codec
        (throw (ex-info
                 (str "No codecs can encode value: " (pr-str value))
                 {:codecs (keys codecs)
                  :value value})))
      (when (thread-bound? #'*dispatched-codec*)
        (set! *dispatched-codec* codec-key))
      (codec/encode-with-header! codec output value)))

  codec/Decoder

  (decodable?
    [this header]
    (boolean (find-decodable codecs header)))

  (decode!
    [this input]
    (let [header (header/read-header! input)
          [codec-key codec] (find-decodable codecs header)]
      (when-not codec
        (throw (ex-info
                 (str "No codecs can decode header: " (pr-str header))
                 {:codecs (keys codecs)
                  :header header})))
      (when (thread-bound? #'*dispatched-codec*)
        (set! *dispatched-codec* codec-key))
      (codec/decode! codec input))))

(defn select
  "Convenience function for selecting a specific codec from a multiplexer. The
  returned codec will encode and decode as the mux would, but only for that
  subcodec."
  [mux codec-key]
  (if-let [codec (get (:codecs mux) codec-key)]
    (wrap/wrap-header codec)
    (throw (ex-info (str "Multiplexer does not contain codec for key "
                         (pr-str codec-key) " " (pr-str (keys (:codecs mux))))
                    {:codecs (keys (:codecs mux))
                     :key codec-key}))))

(defn mux-codec
  "Creates a new multiplexing codec which delegates to the given collection of
  codecs by reading and writing multicodec headers when serializing values.

  When encoding a value, the multiplexer will look for the first codec which
  reports it is `encodable?`. The selected codec's header is written first,
  then the codec is used to write the value.

  When decoding, the multiplexer tries to read a multicodec header and looks
  for the first codec which reports the header is `decodable?`. The selected
  codec is then used to read a value from the remaining data.

  As a consequence, the delegated codecs _must_ implement the codec predicates
  and _must not_ write or expect to consume their own headers!"
  [& codecs]
  (when-not (seq codecs)
    (throw (IllegalArgumentException.
             "mux-codec requires at least one codec")))
  (when-not (even? (count codecs))
    (throw (IllegalArgumentException.
             "mux-codec must be given an even number of arguments")))
  (let [codec-map (apply array-map codecs)]
    (when-let [bad-codecs (seq (remove (comp string? :header)
                                       (vals codec-map)))]
      (throw (IllegalArgumentException.
               (str "Every codec must specify a header path: "
                    (pr-str bad-codecs)))))
    (MuxCodec. codec-map)))

;; Remove automatic constructor functions.
(ns-unmap *ns* '->MuxCodec)
(ns-unmap *ns* 'map->MuxCodec)

(ns multicodec.codecs.mux
  "Multiplexing codec which uses the codec predicates `encodable?` and
  `decodable?` to decide which codec to use when encoding or decoding data.

  `codecs` should be a map from (arbitrary) keys to codecs with headers and
  support for the codec predicates.

  The actual codec delegated to can be determined by binding
  `*dispatched-codec*` to `nil` and checking the result after an operation."
  (:require
    [multicodec.core :as codec]
    [multicodec.header :as header]
    [multicodec.codecs.wrap :as wrap]))

;; This var can be bound to find out what codec the mux used internally when
;; encoding or decoding a value.
(def
  ^{:dynamic true
    :doc "This var can be bound to nil in a thread to discover what codec was
         actually invoked by a mux codec operation. Encoding or decoding sets
         the var to the selected subcodec's keyword."}
  *dispatched-codec*)

(defn- find-encodable
  "Finds the first codec in the map which can encode the given value. Only
  codecs with headers are considered. Returns a vector of the key and codec
  entry, or nil if none are found."
  [codecs value]
  (first (filter #(and (:header (val %)) (codec/encodable? (val %) value))
                 codecs)))

(defn- find-decodable
  "Finds the first codec in the map which can decode the given header. Returns
  a vector of the key and codec entry, or nil if none are found."
  [codecs header]
  (first (filter #(codec/decodable? (val %) header) codecs)))

;; ## Multiplexing Codec

(defrecord MuxCodec
  [codecs]

  codec/Encoder

  (encodable?
    [this value]
    (boolean (find-encodable codecs value)))

  (encode!
    [this output value]
    (let [[codec-key codec] (find-encodable codecs value)]
      (when-not codec
        (throw (ex-info
                 (str "No codecs can encode value: " (pr-str value))
                 {:type ::no-codec
                  :codecs (keys codecs)
                  :value value})))
      (when (thread-bound? #'*dispatched-codec*)
        (set! *dispatched-codec* codec-key))
      (codec/encode-with-header! codec output value)))

  codec/Decoder

  (decodable?
    [this header]
    (boolean (find-decodable codecs header)))

  (decode!
    [this input]
    (let [header (header/read-header! input)
          [codec-key codec] (find-decodable codecs header)]
      (when-not codec
        (throw (ex-info
                 (str "No codecs can decode header: " (pr-str header))
                 {:type ::no-codec
                  :codecs (keys codecs)
                  :header header})))
      (when (thread-bound? #'*dispatched-codec*)
        (set! *dispatched-codec* codec-key))
      (codec/decode! codec input))))

(defn select
  "Convenience function for selecting a specific codec from a multiplexer. The
  returned codec will encode and decode as the mux would, but only for that
  subcodec."
  [mux codec-key]
  (if-let [codec (get (:codecs mux) codec-key)]
    (wrap/wrap-header codec)
    (throw (ex-info (str "Multiplexer does not contain codec for key "
                         (pr-str codec-key) " " (pr-str (keys (:codecs mux))))
                    {:codecs (keys (:codecs mux))
                     :key codec-key}))))

(defn mux-codec
  "Creates a new multiplexing codec which delegates to the given collection of
  codecs by reading and writing multicodec headers when serializing values.

  When encoding a value, the multiplexer will look for the first codec which
  reports it is `encodable?`. The selected codec's header is written first,
  then the codec is used to write the value.

  When decoding, the multiplexer tries to read a multicodec header and looks
  for the first codec which reports the header is `decodable?`. The selected
  codec is then used to read a value from the remaining data.

  As a consequence, the delegated codecs _must_ implement the codec predicates
  and _must not_ write or expect to consume their own headers!"
  [& codecs]
  (when-not (seq codecs)
    (throw (IllegalArgumentException.
             "mux-codec requires at least one codec")))
  (when-not (even? (count codecs))
    (throw (IllegalArgumentException.
             "mux-codec must be given an even number of arguments")))
  (let [codec-map (apply array-map codecs)]
    (MuxCodec. codec-map)))

;; Remove automatic constructor functions.
(ns-unmap *ns* '->MuxCodec)
(ns-unmap *ns* 'map->MuxCodec)

Allow mux to contain codecs with no headers.


(ns ombs.handler.addevent
  (:require
    [ombs.dbold :as db]
    [ombs.db.payment :as dbpay]
    [ombs.core :as core]
    [ombs.funcs :as funcs]
    [ombs.validate :as isvalid]
    [noir.session :as sess]
    [noir.response :refer [redirect] ]
    [ombs.view.pages :refer [addevent] :rename {addevent addevent-page}]
    )
  )

(declare add-solid-event)
(declare add-partial-event)
(defn init-event [ {event :name price :price date :date parts :parts
                    users :participants
                    :as params} ]
  "Main function for creating new event."
  (if (isvalid/new-event? event price date)
    (do
      (if (nil? (funcs/parse-int parts))
        (add-solid-event params)
        (add-partial-event (update params :parts funcs/parse-int)))
      (redirect "/user"))
    ;if validation fails
    (addevent-page (db/get-usernames)) ))

;FIXME:
; issue, when we check one user as participant, so there, users - is value(string). When >1, users - vector.
; Solutions:
; * Form should return always vector
; * convert value to vector
(defn- add-solid-event [ {event :name price :price date :date
                          users :participants
                          :as params} ]
  "Add event in events table, with adding participants, and calculating debts."
  (println "add solid event")
  (if (isvalid/new-event? event price date)
    (do
      (db/add-event event (read-string price) (sess/get :username) date)
      (if (> (count users) 0)
        (let [party-pay (core/party-pay price users)]
          ;use 'dorun' for execute lazy function 'db/credit-payment'
          (dorun (map #(dbpay/credit-payment event date % party-pay)
                      (funcs/as-vec users))))) ; may have only one user, so create vec
      true) ; all is ok
    false)) ; validation fail

(defn- add-good [ {event :name price :price date :date users :participants parts :parts :as params} ]
  (if (db/add-goods event date parts)
    (redirect "/user")
    (addevent-page (db/get-usernames)) ))

(defn- add-partial-event [{event :name price :price date :date parts :parts
                           users :participants
                           :as params}]
  (println "add partial event")
   (if (isvalid/new-event? event price date)
      (do
        (db/add-event event (funcs/parse-int price) (sess/get :username) date parts)
        (add-good params)
        true)
      false))

(ns ombs.handler.addevent
  (:require
    [ombs.dbold :as db]
    [ombs.db.payment :as dbpay]
    [ombs.core :as core]
    [ombs.funcs :as funcs]
    [ombs.validate :as isvalid]
    [noir.session :as sess]
    [noir.response :refer [redirect] ]
    [ombs.view.pages :refer [addevent] :rename {addevent addevent-page}]
    )
  )

(declare add-solid-event)
(declare add-partial-event)
(defn init-event [ {event :name price :price date :date parts :parts
                    users :participants
                    :as params} ]
  "Main function for creating new event."
  (if (isvalid/new-event? event price date)
    (do
      (if (nil? (funcs/parse-int parts))
        (add-solid-event params)
        (add-partial-event (update params :parts funcs/parse-int)))
      (redirect "/user"))
    ;if validation fails
    (addevent-page (db/get-usernames)) ))

;FIXME:
; issue, when we check one user as participant, so there, users - is value(string). When >1, users - vector.
; Solutions:
; * Form should return always vector
; * convert value to vector
(defn- add-solid-event [ {event :name price :price date :date
                          users :participants
                          :as params} ]
  "Add event in events table, with adding participants, and calculating debts."
  (println "add solid event")
  (if (isvalid/new-event? event price date)
    (do
      (db/add-event event (read-string price) (sess/get :username) date)
      (if (> (count users) 0)
        (let [party-pay (core/party-pay price users)]
          ;use 'dorun' for execute lazy function 'db/credit-payment'
          (dorun (map #(dbpay/credit-payment event date % party-pay)
                      (funcs/as-vec users))))) ; may have only one user, so create vec
      true) ; all is ok
    false)) ; validation fail

(declare add-good)
(defn- add-partial-event [{event :name price :price date :date parts :parts
                           users :participants
                           :as params}]
  (println "add partial event")
   (if (isvalid/new-event? event price date)
      (do
        (db/add-event event (funcs/parse-int price) (sess/get :username) date parts)
        (add-good params)
        true)
      false))

(defn- add-good [ {event :name price :price date :date users :participants parts :parts :as params} ]
  (if (db/add-goods event date parts)
    (redirect "/user")
    (addevent-page (db/get-usernames)) ))

Use declare, and move add-goods down.

Use declare, and move add-goods down.