{:user {:signing {:gpg-key "8ED1CE42"}

        :dependencies [[alembic "0.2.1"]
                       [clj-stacktrace "0.2.7"]
                       [cljfmt "0.1.7"]
                       [criterium "0.4.2"]
                       [org.clojure/tools.namespace "0.2.5"]
                       [slamhound "1.5.3"]
                       [spyscope "0.1.4"]]

        :plugins [[cider/cider-nrepl "0.9.0-SNAPSHOT"]
                  [codox "0.6.6"]
                  [jonase/eastwood "0.1.4"]
                  #_[lein-ancient "0.5.5" :exclusions [commons-codec]]
                  [lein-cljsbuild "1.0.3"]
                  [lein-clojars "0.9.1"]
                  [lein-cloverage "1.0.2"]
                  [lein-difftest "2.0.0"]
                  [lein-kibit "0.0.8"]
                  [lein-marginalia "0.7.1"]
                  [lein-pprint "1.1.1"]
                  [lein-swank "1.4.4"]
                  [lein-try "0.4.3"]
                  [lein-typed "0.3.5"]
                  [refactor-nrepl "0.2.2"]]

        :injections [(require
                      '[alembic.still :refer [distill]]
                      '[clojure.repl :refer [doc source]]
                      '[clojure.tools.namespace.repl :as repl]
                      '[criterium.core :refer [bench quick-bench]]
                      'spyscope.core)]

        :aliases {"slamhound" ["run" "-m" "slam.hound"]}
        :search-page-size 50}}

{:user {:signing {:gpg-key "8ED1CE42"}

        :dependencies [[alembic "0.2.1"]
                       [clj-stacktrace "0.2.7"]
                       [cljfmt "0.1.7"]
                       [criterium "0.4.2"]
                       [org.clojure/tools.namespace "0.2.5"]
                       [slamhound "1.5.3"]
                       [spyscope "0.1.4"]]

        :plugins [[cider/cider-nrepl "0.9.0-SNAPSHOT"]
                  [codox "0.6.6"]
                  [jonase/eastwood "0.1.4"]
                  [lein-ancient "0.6.2" :exclusions [commons-codec]]
                  [lein-cljsbuild "1.0.3"]
                  [lein-clojars "0.9.1"]
                  [lein-cloverage "1.0.2"]
                  [lein-difftest "2.0.0"]
                  [lein-kibit "0.0.8"]
                  [lein-marginalia "0.7.1"]
                  [lein-pprint "1.1.1"]
                  [lein-swank "1.4.4"]
                  [lein-try "0.4.3"]
                  [lein-typed "0.3.5"]
                  [refactor-nrepl "0.2.2"]]

        :injections [(require
                      '[alembic.still :refer [distill]]
                      '[clojure.repl :refer [doc source]]
                      '[clojure.tools.namespace.repl :as repl]
                      '[criterium.core :refer [bench quick-bench]]
                      'spyscope.core)]

        :aliases {"slamhound" ["run" "-m" "slam.hound"]}
        :search-page-size 50}}

Upgrade lein-ancient

Upgrade lein-ancient


{:user {:signing {:gpg-key "james@logi.cl"}

        :dependencies [[acyclic/squiggly-clojure "0.1.2-SNAPSHOT"]
                       [alembic "0.2.1"]
                       [clj-stacktrace "0.2.7"]
                       [criterium "0.4.2"]
                       [org.clojure/tools.namespace "0.2.5"]
                       [org.clojure/tools.nrepl "0.2.7"]
                       [slamhound "1.5.3"]
                       [spyscope "0.1.5"]]

        :plugins [[cider/cider-nrepl "0.9.0-SNAPSHOT"]
                  [codox "0.6.6"]
                  [jonase/eastwood "0.1.4"]
                  [lein-clojars "0.9.1"]
                  [lein-cloverage "1.0.2"]
                  [lein-difftest "2.0.0"]
                  [lein-kibit "0.0.8"]
                  [lein-marginalia "0.7.1"]
                  [lein-pprint "1.1.1"]
                  [com.palletops/lein-shorthand "0.4.0"]
                  [lein-swank "1.4.4"]
                  [lein-try "0.4.3"]
                  [lein-typed "0.3.5"]
                  [refactor-nrepl "0.2.2"]]

        :injections [(require 'spyscope.core)]

        :shorthand {. [^:lazy alembic.still/distill
                       ^:lazy alembic.still/load-project
                       ^:lazy ^:macro alembic.still/lein
                       ^:lazy clojure.java.shell/sh
                       ^:lazy clojure.pprint/pprint
                       clojure.repl/apropos
                       clojure.repl/dir
                       clojure.repl/doc
                       clojure.repl/find-doc
                       clojure.repl/pst
                       clojure.repl/source
                       ^:lazy clojure.test/run-all-tests
                       ^:lazy clojure.test/run-tests
                       ^:lazy clojure.tools.namespace.repl/refresh
                       ^:lazy clojure.tools.namespace.repl/refresh-all
                       ^:lazy ^:macro criterium.core/bench
                       ^:lazy ^:macro criterium.core/quick-bench]}

        :aliases {"slamhound" ["run" "-m" "slam.hound"]}
        :search-page-size 50}}

{:user {:signing {:gpg-key "james@logi.cl"}

        :dependencies [[acyclic/squiggly-clojure "0.1.2-SNAPSHOT"]
                       [alembic "0.2.1"]
                       [clj-stacktrace "0.2.7"]
                       [com.cemerick/pomegranate "0.3.0"]
                       [criterium "0.4.2"]
                       [org.clojure/tools.namespace "0.2.5"]
                       [org.clojure/tools.nrepl "0.2.7"]
                       [slamhound "1.5.3"]
                       [spyscope "0.1.5"]]

        :plugins [[cider/cider-nrepl "0.9.0-SNAPSHOT"]
                  [codox "0.6.6"]
                  [jonase/eastwood "0.1.4"]
                  [lein-clojars "0.9.1"]
                  [lein-cloverage "1.0.2"]
                  [lein-difftest "2.0.0"]
                  [lein-kibit "0.0.8"]
                  [lein-marginalia "0.7.1"]
                  [lein-pprint "1.1.1"]
                  [com.palletops/lein-shorthand "0.4.0"]
                  [lein-swank "1.4.4"]
                  [lein-try "0.4.3"]
                  [lein-typed "0.3.5"]
                  [refactor-nrepl "0.2.2"]]

        :injections [(require 'spyscope.core)]

        :shorthand {. [^:lazy alembic.still/distill
                       ^:lazy alembic.still/load-project
                       ^:lazy ^:macro alembic.still/lein
                       ^:lazy cemerick.pomegranate/add-classpath
                       ^:lazy cemerick.pomegranate/get-classpath
                       ^:lazy cemerick.pomegranate/resources
                       ^:lazy clojure.java.shell/sh
                       ^:lazy clojure.pprint/pprint
                       clojure.repl/apropos
                       clojure.repl/dir
                       clojure.repl/doc
                       clojure.repl/find-doc
                       clojure.repl/pst
                       clojure.repl/source
                       ^:lazy clojure.test/run-all-tests
                       ^:lazy clojure.test/run-tests
                       ^:lazy clojure.tools.namespace.repl/refresh
                       ^:lazy clojure.tools.namespace.repl/refresh-all
                       ^:lazy ^:macro criterium.core/bench
                       ^:lazy ^:macro criterium.core/quick-bench]}

        :aliases {"slamhound" ["run" "-m" "slam.hound"]}
        :search-page-size 50}}

Add pomegranate dependency and aliases

Add pomegranate dependency and aliases


(ns aurora.compiler.datalog
  (:require [clojure.set :refer [union intersection difference subset?]]
            [aurora.compiler.match :as match])
  (:require-macros [aurora.macros :refer [fnk check deftraced]]
                   [aurora.compiler.match :refer [match]]
                   [aurora.compiler.datalog :refer [query rule]]))

;; TODO
;; conj?
;; pattern matching on sets? sorting? vectors? (sort-by, sort-arbitrary)
;; graph representation?
;; dependency ordering
;; seminaive
;; incremental assert
;; incremental retract
;; stratification
;; schemas
;; nested rows (find out the correct name for this)

;; We assume that if we rely on attr then stratification ensures no more retractions are forthcoming

;; runtime

(defrecord Knowledge [old asserted retracted])

(def empty
  (Knowledge. #{} #{} #{}))

(defn assert [kn {:keys [name] :as fact}]
  (update-in kn [:asserted] conj fact))

(defn retract [kn {:keys [name] :as fact}]
  (update-in kn [:retracted] conj fact))

;; TODO can probably just do this on assert/retract by looking at counts
(defn to-be [{:keys [old asserted retracted] :as kn}]
  ;; (old & ¬(retracted & ¬asserted)) | (asserted & ¬retracted)
  (let [actually-asserted (difference asserted retracted)
        actually-retracted (difference retracted asserted)
        to-be (difference (union old actually-asserted) actually-retracted)]
    to-be))

(defn and-now [kn]
  (Knowledge. (to-be kn) #{} #{}))

;; creating queries

(defn vars [clause]
  (condp op? clause
    '+ed (match/vars (second clause))
    '-ed (match/vars (second clause))
    'set (conj (clojure.set/difference (apply clojure.set/union (map vars (nthnext clause 3))) (nth clause 2)) (nth clause 1))
    'in #{(second clause)}
    (if (seq? clause)
      #{}
      (match/vars clause))))

(defn empty-q [kn]
  (with-meta
    #{{}}
    {::shape #{}}))

(defn debug-q [query]
  (with-meta
    (fn [kn]
      (let [facts (query kn)]
        (prn facts)
        facts))
    (meta query)))

(defn project [pattern kn-f]
  (let [return-syms (into [] (match/vars pattern))
        return-keys (map keyword return-syms)
        shape (into #{} return-keys)
        f (match/pattern pattern return-syms)]
    (with-meta
      (fn [kn]
        (into #{}
              (for [fact (kn-f kn)
                    :let [vals (f fact)]
                    :when vals]
                (zipmap return-keys vals))))
      {::shape shape})))

;; TODO hashjoin instead
(defn join [query1 query2]
  (let [shape (union (::shape (meta query1)) (::shape (meta query2)))
        join-shape (intersection (::shape (meta query1)) (::shape (meta query2)))]
    (with-meta
      (fn [kn]
        (into #{}
              (for [vals1 (query1 kn)
                    vals2 (query2 kn)
                    :when (= (select-keys vals1 join-shape) (select-keys vals2 join-shape))]
                (merge vals1 vals2))))
      {::shape shape})))

(defn filter-q [query fnk]
  (check (subset? (:aurora/selects (meta fnk)) (::shape (meta query))))
  (with-meta
    (fn [kn]
      (into #{} (filter fnk (query kn))))
    {::shape (::shape (meta query))}))

(defn map-q [fnk]
  (let [selects (:aurora/selects (meta fnk))]
    (fn [facts]
      (into #{} (map fnk (into #{} (map #(select-keys % selects) facts)))))))

(declare gen*)

(defn set-q [name-sym select-syms clauses]
  (let [vars (apply clojure.set/union (map vars clauses))
        select-keys (into [] (map keyword select-syms))
        project-syms (into [] (difference vars select-syms))
        project-keys (into [] (map keyword project-syms))
        group-f (apply juxt project-keys)
        name-key (keyword name-sym)
        shape (conj (set project-keys) name-key)
        gen (gen* clauses)]
    (with-meta
      (fn [kn]
        (into #{}
              (for [[projects selects] (group-by group-f (gen kn))]
                (assoc (zipmap project-keys projects) name-key (set (map #(clojure.core/select-keys % select-keys) selects))))))
      {::shape shape})))

(defn in-q [query name-sym set-sym]
  (let [name-key (keyword name-sym)
        set-key (keyword set-sym)]
    (fn [kn]
      (for [fact (query kn)
            elem (get fact set-key :inq-not-found)]
        (assoc fact name-key elem)))))

(defn op? [op clause]
  (and (seq? clause) (= op (first clause))))

(defn gen* [clauses]
  (reduce
   (fn [query clause]
     (debug-q
      (condp op? clause
        '+ed (join query (project (second clause) :asserted))
        '-ed (join query (project (second clause) :retracted))
        '? (filter-q query (second clause))
        'set (join query (set-q (nth clause 1) (nth clause 2) (nthnext clause 3)))
        'in (in-q query (nth clause 1) (nth clause 2))
        '+ query ;; handled later
        '- query ;; handled later
        (join query (project clause to-be)))))
   empty-q
   clauses))

(defn asserts+retracts* [clauses]
  (let [assert-fs (map #(map-q (second %)) (filter assert? clauses))
        retract-fs (map #(map-q (second %)) (filter retract? clauses))
        gen (gen* clauses)]
    (fn [kn]
      (let [facts (gen kn)
            asserts #js []
            retracts #js []]
        (doseq [assert-f assert-fs
                result (assert-f facts)]
          (.push asserts result))
        (doseq [retract-f retract-fs
                result (retract-f facts)]
          (.push retracts result))
        [asserts retracts]))))

(defn query* [clauses]
  (let [asserts+retracts (asserts+retracts* clauses)]
    (fn [kn]
      (let [[asserts retracts] (asserts+retracts kn)]
        (difference (set asserts) retracts)))))

(defn rule* [clauses]
  (let [asserts+retracts (asserts+retracts* clauses)]
    (fn [kn]
      (let [[asserts retracts] (asserts+retracts kn)]
        (reduce retract (reduce assert kn asserts) retracts)))))

(defn chain [rules]
  (fn [kn]
    (reduce #(%2 %1) kn rules)))

;; TODO this doesn't propagate deltas efficiently, needs some fast way to read changes before and after
(defn fixpoint [rule]
  (fn [kn]
    (let [new-kn (rule kn)]
      (if (= new-kn kn)
        new-kn
        (recur kn)))))

;; tests

(comment

  ((project '[a b]) (Knowledge. #{[1 2] [3 4 5] [6 7]} #{} #{}))

  ((join (project '[a b _]) (project '[_ a b])) (Knowledge. #{[1 2 3] [2 3 4] [2 4 6] [4 6 8]} #{} #{}))

  ((filter-q (project '[a b] to-be) (fnk [a b] (= a b))) (Knowledge. #{[1 2] [3 4] [6 6]} #{} #{}))

  (query* ['[a b _] '[_ a b] (list '? (fnk [a] (integer? a))) (list '+ (fnk [a b] (+ a b)))])

  ((query* ['[a b _] '[_ a b] (list '? (fnk [a] (integer? a))) (list '+ (fnk [a b] (+ a b)))]) (Knowledge. #{[1 2 3] [2 3 4] [:a :b :c] [:b :c :d]} #{} #{}))

  ((rule* ['[a b _] '[_ a b] (list '? (fnk [a] (integer? a))) (list '+ (fnk [a b] (+ a b))) (list '- (fnk [a b] (- a b)))]) (Knowledge. #{[1 2 3] [2 3 4] [:a :b :c] [:b :c :d]} #{} #{}))

  ((query [a b _]
          [_ a b]
          (? (integer? a))
          (+ (+ a b)))
   (Knowledge. #{[1 2 3] [2 3 4] [:a :b :c] [:b :c :d]} #{} #{}))

  ((rule [a b _]
         [_ a b]
         (? (integer? a))
         (+ [a a a])
         (- [b b b]))
   (Knowledge. #{[1 2 3] [2 3 4] [:a :b :c] [:b :c :d]} #{} #{}))

  ((rule [a b _]
         (+ed [_ a b])
         (? (integer? a))
         (+ [a a a])
         (- [b b b]))
   (Knowledge. #{[2 3 4] [:a :b :c] [:b :c :d]} #{[1 2 3]} #{}))

  ((rule [a b _]
         [_ a b]
         (? (integer? a))
         (+ [a a a])
         (- [b b b]))
   (Knowledge. #{[2 3 4] [:a :b :c] [:b :c :d]} #{[1 2 3]} #{[1 2 3]}))

  ((query (+ed [a b])
          (+ [a b]))
   (Knowledge. #{} #{[1 2]} #{}))

  ((set-q 'x '[b c] '[[a b c] [b c d]]) (Knowledge. #{[1 2 3] [2 3 4] [3 4 5] [2 8 9] [8 9 5]} #{} #{}))

  ((query (set x [b c]
               [a b c]
               [b c d])
          (+ [a d x]))
   (Knowledge. #{[1 2 3] [2 3 4] [3 4 5] [2 8 9] [8 9 5]} #{} #{}))

  ((query [a b c]
          [b c d]
          (set x [b c]
               [a b c]
               [b c d])
          (+ [a b c d x]))
   (Knowledge. #{[1 2 3] [2 3 4] [3 4 5] [2 8 9] [8 9 5]} #{} #{}))

  ((query [a b c]
          [b c d]
          (set x [b c]
               [a b c]
               [b c d])
          (in y x)
          (+ [a b c d y]))
   (Knowledge. #{[1 2 3] [2 3 4] [3 4 5] [2 8 9] [8 9 5]} #{} #{}))
  )

(ns aurora.compiler.datalog
  (:require [clojure.set :refer [union intersection difference subset?]]
            [aurora.compiler.match :as match])
  (:require-macros [aurora.macros :refer [fnk check deftraced]]
                   [aurora.compiler.match :refer [match]]
                   [aurora.compiler.datalog :refer [query rule]]))

;; TODO
;; conj?
;; pattern matching on sets? sorting? vectors? (sort-by, sort-arbitrary)
;; graph representation?
;; dependency ordering
;; seminaive
;; incremental assert
;; incremental retract
;; stratification
;; schemas
;; nested rows (find out the correct name for this)

;; We assume that if we rely on attr then stratification ensures no more retractions are forthcoming

;; runtime

(defrecord Knowledge [old asserted retracted])

(def empty
  (Knowledge. #{} #{} #{}))

(defn assert [kn {:keys [name] :as fact}]
  (update-in kn [:asserted] conj fact))

(defn retract [kn {:keys [name] :as fact}]
  (update-in kn [:retracted] conj fact))

;; TODO can probably just do this on assert/retract by looking at counts
(defn to-be [{:keys [old asserted retracted] :as kn}]
  ;; (old & ¬(retracted & ¬asserted)) | (asserted & ¬retracted)
  (let [actually-asserted (difference asserted retracted)
        actually-retracted (difference retracted asserted)
        to-be (difference (union old actually-asserted) actually-retracted)]
    to-be))

(defn and-now [kn]
  (Knowledge. (to-be kn) #{} #{}))

;; creating queries

(defn vars [clause]
  (condp op? clause
    '+ed (match/vars (second clause))
    '-ed (match/vars (second clause))
    'set (conj (clojure.set/difference (apply clojure.set/union (map vars (nthnext clause 3))) (nth clause 2)) (nth clause 1))
    'in #{(second clause)}
    (if (seq? clause)
      #{}
      (match/vars clause))))

(defn empty-q [kn]
  (with-meta
    #{{}}
    {::shape #{}}))

(defn debug-q [query]
  (with-meta
    (fn [kn]
      (let [facts (query kn)]
        (prn facts)
        facts))
    (meta query)))

(defn project [pattern kn-f]
  (let [return-syms (into [] (match/vars pattern))
        return-keys (map keyword return-syms)
        shape (into #{} return-keys)
        f (match/pattern pattern return-syms)]
    (with-meta
      (fn [kn]
        (into #{}
              (for [fact (kn-f kn)
                    :let [vals (f fact)]
                    :when vals]
                (zipmap return-keys vals))))
      {::shape shape})))

;; TODO hashjoin instead
(defn join [query1 query2]
  (let [shape (union (::shape (meta query1)) (::shape (meta query2)))
        join-shape (intersection (::shape (meta query1)) (::shape (meta query2)))]
    (with-meta
      (fn [kn]
        (into #{}
              (for [vals1 (query1 kn)
                    vals2 (query2 kn)
                    :when (= (select-keys vals1 join-shape) (select-keys vals2 join-shape))]
                (merge vals1 vals2))))
      {::shape shape})))

(defn filter-q [query fnk]
  (check (subset? (:aurora/selects (meta fnk)) (::shape (meta query))))
  (with-meta
    (fn [kn]
      (into #{} (filter fnk (query kn))))
    {::shape (::shape (meta query))}))

(defn map-q [fnk]
  (let [selects (:aurora/selects (meta fnk))]
    (fn [facts]
      (into #{} (map fnk (into #{} (map #(select-keys % selects) facts)))))))

(declare gen*)

(defn set-q [name-sym select-syms clauses]
  (let [vars (apply clojure.set/union (map vars clauses))
        select-keys (into [] (map keyword select-syms))
        project-syms (into [] (difference vars select-syms))
        project-keys (into [] (map keyword project-syms))
        group-f (apply juxt project-keys)
        name-key (keyword name-sym)
        shape (conj (set project-keys) name-key)
        gen (gen* clauses)]
    (with-meta
      (fn [kn]
        (into #{}
              (for [[projects selects] (group-by group-f (gen kn))]
                (assoc (zipmap project-keys projects) name-key (set (map #(clojure.core/select-keys % select-keys) selects))))))
      {::shape shape})))

(defn in-q [query name-sym set-sym]
  (let [name-key (keyword name-sym)
        set-key (keyword set-sym)]
    (fn [kn]
      (for [fact (query kn)
            elem (get fact set-key :inq-not-found)]
        (assoc fact name-key elem)))))

(defn op? [op clause]
  (and (seq? clause) (= op (first clause))))

(defn assert? [clause]
  (op? '+ clause))

(defn retract? [clause]
  (op? '- clause))

(defn gen* [clauses]
  (reduce
   (fn [query clause]
     (debug-q
      (condp op? clause
        '+ed (join query (project (second clause) :asserted))
        '-ed (join query (project (second clause) :retracted))
        '? (filter-q query (second clause))
        'set (join query (set-q (nth clause 1) (nth clause 2) (nthnext clause 3)))
        'in (in-q query (nth clause 1) (nth clause 2))
        '+ query ;; handled later
        '- query ;; handled later
        (join query (project clause to-be)))))
   empty-q
   clauses))

(defn asserts+retracts* [clauses]
  (let [assert-fs (map #(map-q (second %)) (filter assert? clauses))
        retract-fs (map #(map-q (second %)) (filter retract? clauses))
        gen (gen* clauses)]
    (fn [kn]
      (let [facts (gen kn)
            asserts #js []
            retracts #js []]
        (doseq [assert-f assert-fs
                result (assert-f facts)]
          (.push asserts result))
        (doseq [retract-f retract-fs
                result (retract-f facts)]
          (.push retracts result))
        [asserts retracts]))))

(defn query* [clauses]
  (let [asserts+retracts (asserts+retracts* clauses)]
    (fn [kn]
      (let [[asserts retracts] (asserts+retracts kn)]
        (difference (set asserts) retracts)))))

(defn rule* [clauses]
  (let [asserts+retracts (asserts+retracts* clauses)]
    (fn [kn]
      (let [[asserts retracts] (asserts+retracts kn)]
        (reduce retract (reduce assert kn asserts) retracts)))))

(defn chain [rules]
  (fn [kn]
    (reduce #(%2 %1) kn rules)))

;; TODO this doesn't propagate deltas efficiently, needs some fast way to read changes before and after
(defn fixpoint [rule]
  (fn [kn]
    (let [new-kn (rule kn)]
      (if (= new-kn kn)
        new-kn
        (recur kn)))))

;; tests

(comment

  ((project '[a b]) (Knowledge. #{[1 2] [3 4 5] [6 7]} #{} #{}))

  ((join (project '[a b _]) (project '[_ a b])) (Knowledge. #{[1 2 3] [2 3 4] [2 4 6] [4 6 8]} #{} #{}))

  ((filter-q (project '[a b] to-be) (fnk [a b] (= a b))) (Knowledge. #{[1 2] [3 4] [6 6]} #{} #{}))

  (query* ['[a b _] '[_ a b] (list '? (fnk [a] (integer? a))) (list '+ (fnk [a b] (+ a b)))])

  ((query* ['[a b _] '[_ a b] (list '? (fnk [a] (integer? a))) (list '+ (fnk [a b] (+ a b)))]) (Knowledge. #{[1 2 3] [2 3 4] [:a :b :c] [:b :c :d]} #{} #{}))

  ((rule* ['[a b _] '[_ a b] (list '? (fnk [a] (integer? a))) (list '+ (fnk [a b] (+ a b))) (list '- (fnk [a b] (- a b)))]) (Knowledge. #{[1 2 3] [2 3 4] [:a :b :c] [:b :c :d]} #{} #{}))

  ((query [a b _]
          [_ a b]
          (? (integer? a))
          (+ (+ a b)))
   (Knowledge. #{[1 2 3] [2 3 4] [:a :b :c] [:b :c :d]} #{} #{}))

  ((rule [a b _]
         [_ a b]
         (? (integer? a))
         (+ [a a a])
         (- [b b b]))
   (Knowledge. #{[1 2 3] [2 3 4] [:a :b :c] [:b :c :d]} #{} #{}))

  ((rule [a b _]
         (+ed [_ a b])
         (? (integer? a))
         (+ [a a a])
         (- [b b b]))
   (Knowledge. #{[2 3 4] [:a :b :c] [:b :c :d]} #{[1 2 3]} #{}))

  ((rule [a b _]
         [_ a b]
         (? (integer? a))
         (+ [a a a])
         (- [b b b]))
   (Knowledge. #{[2 3 4] [:a :b :c] [:b :c :d]} #{[1 2 3]} #{[1 2 3]}))

  ((query (+ed [a b])
          (+ [a b]))
   (Knowledge. #{} #{[1 2]} #{}))

  ((set-q 'x '[b c] '[[a b c] [b c d]]) (Knowledge. #{[1 2 3] [2 3 4] [3 4 5] [2 8 9] [8 9 5]} #{} #{}))

  ((query (set x [b c]
               [a b c]
               [b c d])
          (+ [a d x]))
   (Knowledge. #{[1 2 3] [2 3 4] [3 4 5] [2 8 9] [8 9 5]} #{} #{}))

  ((query [a b c]
          [b c d]
          (set x [b c]
               [a b c]
               [b c d])
          (+ [a b c d x]))
   (Knowledge. #{[1 2 3] [2 3 4] [3 4 5] [2 8 9] [8 9 5]} #{} #{}))

  ((query [a b c]
          [b c d]
          (set x [b c]
               [a b c]
               [b c d])
          (in y x)
          (+ [a b c d y]))
   (Knowledge. #{[1 2 3] [2 3 4] [3 4 5] [2 8 9] [8 9 5]} #{} #{}))
  )

fix datalog :p

fix datalog :p

Signed-off-by: Chris Granger <5654cde260ae99bc4d30054171b8bcd902efd19a@gmail.com>


(ns comic-reader.main
  (:require
    [comic-reader.api :as api]
    [comic-reader.ui.base :as base]
    [comic-reader.ui.site-list :as site-list]
    [comic-reader.ui.comic-list :as comic-list]
    [reagent.core :as reagent]
    [reagent.ratom :refer-macros [reaction]]
    [re-frame.core :as re-frame]))

(defn page-key [db]
  (:page-key db))

(defn set-page-key [db page-key]
  (assoc db :page-key page-key))

(defn maybe-load-sites [db]
  (if (:site-list db)
    db
    (do
      (api/get-sites {:on-success site-list/set})
      (assoc db :site-list :loading))))

(defn setup! []
  (re-frame/register-sub
   :page-key
   (fn [app-db v]
     (reaction (page-key @app-db))))

  (re-frame/register-handler
   :set-page-key
   (fn [db [_ page-key]]
     (set-page-key db page-key)))

  (re-frame/register-handler
   :view-sites
   (fn [db _]
     (-> db
         (set-page-key :site-list)
         (maybe-load-sites))))

  (re-frame/register-handler
   :view-comics
   (fn [db [_ site-id]]
     (api/get-comics site-id {:on-success comic-list/set})
     (-> db
         (set-page-key :comic-list)
         (assoc :site-id site-id
                :comic-list :loading))))

  (re-frame/register-handler
   :view-comic
   (fn [db [_ comic-id]]
     (-> db
         (set-page-key :comic-viewer)))))

(defn main-panel
  [page-key]
  (case page-key
    :site-list [site-list/site-list-container]
    :comic-list [comic-list/comic-page-container]
    :comic-viewer [:div [:h1 "Read a Comic!"]]
    nil [:span ""]
    [base/four-oh-four]))

(defn main-panel-container []
  (let [page-key (re-frame/subscribe [:page-key])]
    (fn []
      [main-panel (deref page-key)])))

(defn ^:export main
  []
  (enable-console-print!)
  (setup!)
  (site-list/setup!)
  (comic-list/setup!)
  (re-frame/dispatch [:view-sites])
  (reagent/render-component [main-panel-container]
                            (.getElementById js/document "app")))

(main)

(ns comic-reader.main
  (:require
    [comic-reader.api :as api]
    [comic-reader.ui.base :as base]
    [comic-reader.ui.site-list :as site-list]
    [comic-reader.ui.comic-list :as comic-list]
    [reagent.core :as reagent]
    [reagent.ratom :refer-macros [reaction]]
    [re-frame.core :as re-frame]))

(defn page-key [db]
  (:page-key db))

(defn set-page-key [db page-key]
  (assoc db :page-key page-key))

(defn maybe-load-sites [db]
  (if (:site-list db)
    db
    (do
      (api/get-sites {:on-success site-list/set})
      (assoc db :site-list :loading))))

(defn setup! []
  (re-frame/register-sub
   :page-key
   (fn [app-db v]
     (reaction (page-key @app-db))))

  (re-frame/register-handler
   :set-page-key
   (fn [db [_ page-key]]
     (set-page-key db page-key)))

  (re-frame/register-handler
   :view-sites
   (fn [db _]
     (-> db
         (set-page-key :site-list)
         (maybe-load-sites))))

  (re-frame/register-handler
   :view-comics
   (fn [db [_ site-id]]
     (api/get-comics site-id {:on-success comic-list/set})
     (-> db
         (set-page-key :comic-list)
         (assoc :site-id site-id
                :comic-list :loading))))

  (re-frame/register-handler
   :read-comic
   (fn [db [_ comic-id]]
     (-> db
         (set-page-key :reader)))))

(defn main-panel
  [page-key]
  (case page-key
    :site-list [site-list/site-list-container]
    :comic-list [comic-list/comic-page-container]
    :reader [:div [:h1 "Read a Comic!"]]
    nil [:span ""]
    [base/four-oh-four]))

(defn main-panel-container []
  (let [page-key (re-frame/subscribe [:page-key])]
    (fn []
      [main-panel (deref page-key)])))

(defn ^:export main
  []
  (enable-console-print!)
  (setup!)
  (site-list/setup!)
  (comic-list/setup!)
  (re-frame/dispatch [:view-sites])
  (reagent/render-component [main-panel-container]
                            (.getElementById js/document "app")))

(main)

Rename page-key for comic reading view

Rename page-key for comic reading view


;; Functions for helping with start of game
(ns robinson.startgame
  (:require [robinson.common :as rc]
            [taoensso.timbre :as log]
            [robinson.random :as rr]
            [robinson.monstergen :as mg]
            [robinson.itemgen :as ig]
            #?@(:cljs (
                [goog.string :as gstring]
                [goog.string.format]))))

(defn format [s & args]
  #?(:clj
     (apply clojure.core/format s args)
     :cljs
     (apply gstring/format s args)))

(defn start-inventory []
  (let [inventory              [(ig/gen-item :rope)
                                (assoc (ig/gen-item :match) :count 10)
                                (ig/gen-item :knife)
                                (ig/gen-item :plant-guide)
                                (assoc (ig/gen-item :bandage) :count 4)
                                (assoc (ig/gen-item :fishing-line-and-hook) :count 2)
                                (assoc (ig/gen-item :ration) :count 2)
                                (ig/gen-item :flashlight)
                                (ig/gen-item :bedroll)
                                (ig/gen-item :tarp)
                                (ig/gen-item :saw)]
        hotkeys                (vec (seq "abcdefghijklmnopqrstuvwxyzABCdEFGHIJKLMNOPQRSTUVWQYZ"))
        inventory-with-hotkeys (mapv #(assoc %1 :hotkey %2) inventory hotkeys)]
    #_(log/info "start-inventory" inventory-with-hotkeys)
    inventory-with-hotkeys))

(defn start-text [state]
  (let [[n1 n2]            (get-in state [:world :random-numbers])
        modes-of-transport ["boat" "airplane" "train" "blimp" "jetpack" "hovercraft" "bicycle"
                           "sailboat" "steamboat" "barge" "oceanliner" "ferry" "helicopter"
                           "biplane"]
        mode-of-transport (nth modes-of-transport (mod n1 (count modes-of-transport)))
        natural-disasters ["hurricane" "tornado" "dark storm" "cyclone" "squall"]
        natural-disaster  (nth natural-disasters (mod n2 (count natural-disasters)))
        text              (format "While traveling by %s, a %s engulfs you.\n\n             You awake on an island.\n\n     One thing is certain - you'll have to escape."
             mode-of-transport
             natural-disaster)]
    text))

;; Functions for helping with start of game
(ns robinson.startgame
  (:require [robinson.common :as rc]
            [taoensso.timbre :as log]
            [robinson.random :as rr]
            [robinson.monstergen :as mg]
            [robinson.itemgen :as ig]
            #?@(:cljs (
                [goog.string :as gstring]
                [goog.string.format]))))

(defn format [s & args]
  #?(:clj
     (apply clojure.core/format s args)
     :cljs
     (apply gstring/format s args)))

(defn start-inventory []
  (let [inventory              [(ig/gen-item :rope)
                                (assoc (ig/gen-item :match) :count 10)
                                (ig/gen-item :knife)
                                (ig/gen-item :plant-guide)
                                (assoc (ig/gen-item :bandage) :count 4)
                                (assoc (ig/gen-item :fishing-line-and-hook) :count 2)
                                (assoc (ig/gen-item :ration) :count 2)
                                (ig/gen-item :flashlight)
                                (ig/gen-item :bedroll)
                                (ig/gen-item :tarp)
                                (ig/gen-item :saw)]
        hotkeys                (vec (seq "abcdefghijklmnopqrstuvwxyzABCdEFGHIJKLMNOPQRSTUVWQYZ"))
        inventory-with-hotkeys (mapv #(assoc %1 :hotkey %2) inventory hotkeys)]
    #_(log/info "start-inventory" inventory-with-hotkeys)
    inventory-with-hotkeys))

(defn start-text [state]
  (let [[n1 n2]            (get-in state [:world :random-numbers])
        modes-of-transport ["boat" "carriage" "horseback" "wagon" "stagewagon"
                           "sailboat" "barge" "ship" "ferry" "foot"]
        mode-of-transport (nth modes-of-transport (mod n1 (count modes-of-transport)))
        natural-disasters ["hurricane" "tornado" "dark storm" "cyclone" "squall"]
        natural-disaster  (nth natural-disasters (mod n2 (count natural-disasters)))
        text              (format "While traveling by %s, a %s engulfs you.\n\n             You awake on an island.\n\n     One thing is certain - you'll have to escape."
             mode-of-transport
             natural-disaster)]
    text))

Make start game madlib more archaic

Make start game madlib more archaic


(ns hacker-agent.debug
  (:require-macros [cljs.core.async.macros :refer [go go-loop]])
  (:require [reagent.core :as r :refer [atom]]
            [clojure.set :as set]
            [clojure.data :as data]
            [secretary.core :as secretary :include-macros true]
            [goog.dom :as dom]
            [goog.events :as events]
            [goog.history.EventType :as EventType]
            [weasel.repl :as ws-repl]
            [cljs.core.async :as async :refer [put! chan <! >! close!]]
            [hacker-agent.utils :as utils]))

(defonce show? (atom false))

(defonce debug-chan (chan))

(declare field field-list)

(defn console [state]
  (when @show?
    [:div.console
     [:h4 "Debug Console"]
     [field-list state]]))

;; Proxy into console for live reload
(defn view [state]
  [console state])

(defn edit-value [value]
  (if (< 50 (count (str @value)))
    [:textarea {:rows 3
                :value @value
                :on-change #(reset! value (-> % .-target .-value))}]
    [:input {:type "text"
             :value @value
             :on-change #(reset! value (-> % .-target .-value))}]))

(defn field [k v]
  (let [collapse? (atom true)]
    (fn [k v]
      [:div
       [:p [:b (when-not @collapse?
                 {:on-click #(reset! collapse? true)
                  :style {:cursor :pointer
                          :text-decoration :underline}})
            (clj->js k)]
        ": "
        (if @collapse?
          (if (map? @v)
            [:span {:on-click #(reset! collapse? false)
                    :style {:cursor :pointer}}
             "Object"]
            [edit-value v])
          (if (map? @v)
            [field-list v]
            (clj->js v)))]])))

(defn field-list [fields]
  [:ul
   (for [f (into (sorted-map) @fields)]
     (let [[k v] f]
       ^{:key k} [:li
                  [field k (r/wrap v swap! fields assoc k)]]))])

(defn init! [state]
  (r/render-component [view state] (.getElementById js/document "debug")))

(defonce key-chan (utils/listen (dom/getDocument) (.-KEYPRESS events/EventType)))

(defonce key-loop
  (go-loop []
    (when-let [event (<! key-chan)]
      (when (= (.. event -keyCode) 4)   ; CTRL-D
        (swap! show? not))
      (recur))))

(ns hacker-agent.debug
  (:require-macros [cljs.core.async.macros :refer [go go-loop]])
  (:require [reagent.core :as r :refer [atom]]
            [clojure.set :as set]
            [clojure.data :as data]
            [secretary.core :as secretary :include-macros true]
            [goog.dom :as dom]
            [goog.events :as events]
            [goog.history.EventType :as EventType]
            [weasel.repl :as ws-repl]
            [cljs.core.async :as async :refer [put! chan <! >! close!]]
            [hacker-agent.utils :as utils]))

(defonce show? (atom false))

(defonce debug-chan (chan))

(declare field field-list)

(defn console [state]
  (when @show?
    [:div.console
     [:h4 "Debug Console"]
     [field-list state]]))

;; Proxy into console for live reload
(defn view [state]
  [console state])

(defn slider [value min max]
  [:input {:type "range" :value @value :min min :max max
           :style {:width "100%"}
           :on-change #(let [new-val (-> % .-target .-value)]
                         (reset! value new-val))}])

(defn edit-value [value]
  (if (< 50 (count (str @value)))
    [:textarea {:rows 3
                :value @value
                :on-change #(reset! value (-> % .-target .-value))}]
    [:input {:type "text"
             :value @value
             :on-change #(reset! value (-> % .-target .-value))}]))

(defn field [k v]
  (let [collapse? (atom true)]
    (fn [k v]
      [:div
       [:p [:b (when-not @collapse?
                 {:on-click #(reset! collapse? true)
                  :style {:cursor :pointer
                          :text-decoration :underline}})
            (clj->js k)]
        ": "
        (if @collapse?
          (if (map? @v)
            [:span {:on-click #(reset! collapse? false)
                    :style {:cursor :pointer}}
             "Object"]
            [edit-value v])
          (if (map? @v)
            [field-list v]
            (clj->js v)))]])))

(defn field-list [fields]
  [:ul
   (for [f (into (sorted-map) @fields)]
     (let [[k v] f]
       ^{:key k} [:li
                  [field k (r/wrap v swap! fields assoc k)]]))])

(defn init! [state]
  (r/render-component [view state] (.getElementById js/document "debug")))

(defonce key-chan (utils/listen (dom/getDocument) (.-KEYPRESS events/EventType)))

(defonce key-loop
  (go-loop []
    (when-let [event (<! key-chan)]
      (when (= (.. event -keyCode) 4)   ; CTRL-D
        (swap! show? not))
      (recur))))

Add a slider component in debug namespace


(ns proto.goods-search
  (:require [reagent.core :as reagent :refer [atom]]
            [cljs-http.client :as http]
            [cljs.core.async :as async
             :refer [>! <! put! chan]]
            [proto.barcode-picture :as barcode-reader]
            [proto.state :as state])
  (:require-macros [cljs.core.async.macros :refer [go]]))

(defn by-id
  [id]
  (.getElementById js/document id))

(defn good-details-panel
  [good barcode]
  (if (empty? good)
    [:div
     [:h1 "No Item found with this barcode. (" barcode ")"]]
    [:div
     [:h1 (:name good)]
     [:h2 (:description good)]
     [:h3 "Barcode: " barcode]]))

(defn show-good-details
  [goods-chan barcode]
  (go
    (when-let [good (<! goods-chan)]
      (reagent/render [good-details-panel good barcode] (by-id "good-details")))))

(defn shops-list
  [shops]
  (when (vector? shops)
    [:ul {:class "list-group"}
     (for [shop shops]
       [:li {:class "list-group-item"} (:name shop)])]))

(defn show-shops
  [barcode coords]
  (go
    (let [shops-chan (chan 1)
          prices-url (str "/api/goods/prices/nearby?barcode=" barcode "&lon=" (:lon coords) "&lat=" (:lat coords))
          shops-resp (<! (http/get prices-url {"accept" "application/json"}))
          shops (:body shops-resp)]
      (reagent/render [shops-list shops] (by-id "nearby-shops")))))

(defn get-prices
  "Fetches prices in the nearby shops."
  [barcodec coords]
  (go
    (let [barcode (<! barcodec)
          good-url (str "/api/goods/barcode/" barcode)
          good-resp (<! (http/get good-url {"accept" "application/json"}))
          good (:body good-resp)
          goods-chan (chan 1)]
      (show-good-details goods-chan barcode)
      (if (map? good)
        (do
          (put! goods-chan good)
          (show-shops barcode coords))
        (do
          (put! goods-chan {})
          (reagent/render [:div] (by-id "nearby-shops")))))))

(defn write-barcode!
  [barcode]
  (let [barcode-chan (chan 1)]
    (put! barcode-chan barcode)
    (get-prices barcode-chan (state/get-current-location))))

(defn barcode-writer
  "Writes the scanned barcode into an atom."
  [result]
  (if (seq result)
    (write-barcode! (.-Value (nth result 0)))
    (write-barcode! "Error trying to read barcode!")))

(defn scan-barcode
  [dom-event]
  (barcode-reader/picture-cb dom-event barcode-writer))

(defn search-panel
  "View for searching for  goods."
  []
  [:div
   [:canvas {:id "picture-region" :width 640 :height 480 :hidden true}]
   [:img {:id "img" :hidden true}]
   [:form {:class "form-horizontal"}
    [:div {:class "form-group"}
     [:label {:class "col-xs-4 control-label"} "Read barcode from picture"]
     [:div {:class "col-xs-4"}
      [:input {:id "take-picture"
               :class "form-control btn btn-lg"
               :type "file"
               :accept "image/*;capture-camera"
               :on-change scan-barcode}]]]]])

(defn search-view
  []
  [:div {:id "good-search-panel"}
   (search-panel)
   [:div {:id "good-details"}]
   [:div {:id "nearby-shops"}]])

(ns proto.goods-search
  (:require [reagent.core :as reagent :refer [atom]]
            [cljs-http.client :as http]
            [cljs.core.async :as async
             :refer [>! <! put! chan]]
            [proto.barcode-picture :as barcode-reader]
            [proto.state :as state])
  (:require-macros [cljs.core.async.macros :refer [go]]))

(defn by-id
  [id]
  (.getElementById js/document id))

(defn good-details-panel
  [good barcode]
  (if (empty? good)
    [:div
     [:h1 "No Item found with this barcode. (" barcode ")"]]
    [:div
     [:h1 (:name good)]
     [:h2 (:description good)]
     [:h3 "Barcode: " barcode]]))

(defn show-good-details
  [goods-chan barcode]
  (go
    (when-let [good (<! goods-chan)]
      (reagent/render [good-details-panel good barcode] (by-id "good-details")))))

(defn shops-list
  [shops]
  (when (vector? shops)
    [:ul {:class "list-group"}
     (for [shop shops]
       [:li {:class "list-group-item"} (:name shop)])]))

(defn show-shops
  [barcode coords]
  (go
    (let [shops-chan (chan 1)
          prices-url (str "/api/goods/prices/nearby?barcode=" barcode "&lon=" (:lon coords) "&lat=" (:lat coords))
          shops-resp (<! (http/get prices-url {"accept" "application/json"}))
          shops (:body shops-resp)]
      (reagent/render [shops-list shops] (by-id "nearby-shops")))))

(defn get-prices
  "Fetches prices in the nearby shops."
  [barcodec coords]
  (go
    (let [barcode (<! barcodec)
          good-url (str "/api/goods/barcode/" barcode)
          good-resp (<! (http/get good-url {"accept" "application/json"}))
          good (:body good-resp)
          goods-chan (chan 1)]
      (show-good-details goods-chan barcode)
      (if (map? good)
        (do
          (put! goods-chan good)
          (show-shops barcode coords))
        (do
          (put! goods-chan {})
          (reagent/render [:div] (by-id "nearby-shops")))))))

(defn write-barcode!
  [barcode]
  (let [barcode-chan (chan 1)]
    (put! barcode-chan barcode)
    (get-prices barcode-chan (state/get-current-location))))

(defn barcode-writer
  "Writes the scanned barcode into an atom."
  [result]
  (if (empty? result)
    (write-barcode! "Error trying to read barcode!")
    (write-barcode! (.-Value (nth result 0)))))

(defn scan-barcode
  [dom-event]
  (barcode-reader/picture-cb dom-event barcode-writer))

(defn search-panel
  "View for searching for  goods."
  []
  [:div
   [:canvas {:id "picture-region" :width 640 :height 480 :hidden true}]
   [:img {:id "img" :hidden true}]
   [:form {:class "form-horizontal"}
    [:div {:class "form-group"}
     [:label {:class "col-xs-4 control-label"} "Read barcode from picture"]
     [:div {:class "col-xs-4"}
      [:input {:id "take-picture"
               :class "form-control btn btn-lg"
               :type "file"
               :accept "image/*;capture-camera"
               :on-change scan-barcode}]]]]])

(defn search-view
  []
  [:div {:id "good-search-panel"}
   (search-panel)
   [:div {:id "good-details"}]
   [:div {:id "nearby-shops"}]])

Print a message if barcode can not be read


(ns bake.test
  (:use [cake.contrib.find-namespaces :only [find-namespaces-in-dir]])
  (:require clojure.test
            [clojure.stacktrace :as stack]))

(defn map-tags [nses]
  (reduce (partial merge-with concat)
          (for [ns nses
                [name f] (ns-publics ns)
                tag (:tags (meta f))]
            {tag [f]})))

(defn all-test-namespaces []
  (find-namespaces-in-dir (java.io.File. "test")))

(defn prep-opt [str]
  (if (.startsWith str ":")
    (read-string str)
    (symbol str)))

(defn test-type [test]
  (cond (namespace test) :fn
        (keyword?  test) :tag
        :else            :ns))

(defn group-opts [coll]
  ;; don't use group-by so we are compatible with 1.1
  (reduce
   (fn [ret x]
     (let [k (test-type x)]
       (assoc ret k (conj (get ret k []) x))))
   {}
   coll))

(defn get-grouped-tests [namespaces opts]
  (let [tests (:test opts)]
    (group-opts
     (if (nil? tests)
       namespaces
       (map prep-opt tests)))))

(defn timer [begin]
  (println "----")
  (println "Finished in" (/ (- (System/nanoTime) begin) (Math/pow 10 9)) "seconds.\n"))

(defn print-results [m]
  (println "\nRan" (:test m) "tests containing"
           (+ (:pass m) (:fail m) (:error m)) "assertions.")
  (println (:fail m) "failures," (:error m) "errors.")
  (when (:start-time m) (timer (:start-time m))))

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

(defmethod clojure.test/report :summary [m]
  (clojure.test/with-test-out
    (print-results m)))

(defmethod clojure.test/report :fn-summary [m]
  (clojure.test/with-test-out
    (print-results m)))

(defmethod clojure.test/report :begin-auto [m])

(defmethod clojure.test/report :summary-auto [m]
  (clojure.test/with-test-out
    (if (and (= 0 (:fail m))
             (= 0 (:error m))
             (not (:full-report? m)))
      (println ".")
      (print-results m))))

(comment defn diff-actual [[f [_ expected actual]]]
  (diff/clean-difform expected actual))

(defmethod clojure.test/report :fail [m]
  (clojure.test/with-test-out
    (clojure.test/inc-report-counter :fail)
    (println "\nFAIL in" (clojure.test/testing-vars-str m))
    (when (seq clojure.test/*testing-contexts*) (println (clojure.test/testing-contexts-str)))
    (when-let [message (:message m)] (println message))
    (let [expected (:expected m)
          actual   (:actual m)]
      (println "expected:" (pr-str expected))
      (println "  actual:" (pr-str actual))
      (comment when (seq? actual)
        (diff-actual actual)))))

(declare start-time)

(defn run-tests-for-fns [grouped-tests]
  (when-let [input-fs (:fn grouped-tests)]
    (println "testing functions:" (apply str (interpose ", " input-fs)))
    (binding [clojure.test/*report-counters* (ref clojure.test/*initial-report-counters*)
              start-time (System/nanoTime)]
      (doseq [f input-fs]
        (clojure.test/test-var (ns-resolve (symbol (namespace f))
                                           (symbol (name f)))))
      (clojure.test/report (assoc @clojure.test/*report-counters* :type :fn-summary :start-time start-time)))))

(defn run-tests-for-nses [grouped-tests]
  (for [ns (:ns grouped-tests)]
    (binding [clojure.test/*report-counters* (ref clojure.test/*initial-report-counters*)
              start-time (System/nanoTime)]
      (clojure.test/report {:type :begin-test-ns :ns ns})
      (clojure.test/test-all-vars (find-ns ns))
      (clojure.test/report (assoc @clojure.test/*report-counters* :type :summary :start-time start-time))
      @clojure.test/*report-counters*)))

(defn run-tests-for-tags [grouped-tests test-namespaces]
  (when-let [input-tags (:tag grouped-tests)]
    (let [tags-to-fs (map-tags test-namespaces)]
      (doall (for [tag input-tags]
               (binding [clojure.test/*report-counters* (ref clojure.test/*initial-report-counters*)
                         start-time (System/nanoTime)]
                 (println "Testing" tag)
                 (doseq [test (tag tags-to-fs)]
                   (clojure.test/test-var test))
                 (clojure.test/report (assoc @clojure.test/*report-counters* :type :summary :start-time start-time))
                 @clojure.test/*report-counters*))))))

(defn run-tests-for-auto [grouped-tests & full-report]
  (for [ns (:ns grouped-tests)]
    (binding [clojure.test/*report-counters* (ref clojure.test/*initial-report-counters*)
              start-time (System/nanoTime)]
      (clojure.test/report {:type :begin-auto :ns ns})
      (clojure.test/test-all-vars ns)
      (clojure.test/report
       (let [report (assoc @clojure.test/*report-counters* :type :summary-auto :start-time start-time)]
         (if (first full-report)
           (assoc report :full-report? true)
           report)))
      @clojure.test/*report-counters*)))

(ns bake.test
  (:use [cake.contrib.find-namespaces :only [find-namespaces-in-dir]]
        useful)
  (:require [clojure.test :as test]
            [clojure.stacktrace :as stack]))

(defn all-test-namespaces []
  (find-namespaces-in-dir (java.io.File. "test")))

(defn prep-opt [str]
  (if (.startsWith str ":")
    (read-string str)
    (symbol str)))

(defn test-type [test]
  (cond (namespace test) :fn
        (keyword?  test) :tag
        :else            :ns))

(defn get-grouped-tests [namespaces opts]
  (let [tests (:test opts)]
    (group-by
     test-type
     (if (nil? tests)
       namespaces
       (map prep-opt tests)))))

(defn timer [begin]
  (println "----")
  (println "Finished in" (/ (- (System/nanoTime) begin) (Math/pow 10 9)) "seconds.\n"))

(defn print-results [m]
  (println "\nRan" (:test m) "tests containing"
           (+ (:pass m) (:fail m) (:error m)) "assertions.")
  (println (:fail m) "failures," (:error m) "errors.")
  (when (:start-time m) (timer (:start-time m))))

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

(defmethod test/report :summary [m]
  (test/with-test-out
    (print-results m)))

<<<<<<< HEAD
(defmethod clojure.test/report :fn-summary [m]
  (clojure.test/with-test-out
    (print-results m)))

(defmethod clojure.test/report :begin-auto [m])
=======
(defmethod test/report :begin-auto [m])
>>>>>>> fix bugs in test

(defmethod test/report :summary-auto [m]
  (test/with-test-out
    (if (and (= 0 (:fail m))
             (= 0 (:error m))
             (not (:full-report? m)))
      (println ".")
      (print-results m))))

(comment defn diff-actual [[f [_ expected actual]]]
  (diff/clean-difform expected actual))

(defmethod test/report :fail [m]
  (test/with-test-out
    (test/inc-report-counter :fail)
    (println "\nFAIL in" (test/testing-vars-str m))
    (when (seq test/*testing-contexts*) (println (test/testing-contexts-str)))
    (when-let [message (:message m)] (println message))
    (let [expected (:expected m)
          actual   (:actual m)]
      (comment when (seq? actual)
        (diff-actual actual)))))

(declare start-time)

(defn test-fn-seq [pairs]
  (binding [test/*report-counters* (ref test/*initial-report-counters*)
            start-time (System/nanoTime)]
    (doseq [[ns fs] pairs]
      (let [ns (find-ns (symbol ns))
            once-fixture-fn (test/join-fixtures (::test/once-fixtures (meta ns)))
            each-fixture-fn (test/join-fixtures (::test/each-fixtures (meta ns)))]
        (once-fixture-fn
         (fn [] (doseq [f fs]
                  (each-fixture-fn (fn [] (test/test-var f))))))))
    (test/report (assoc @test/*report-counters* :type :summary :start-time start-time))))

(defn run-tests-for-fns [grouped-tests]
  (when-let [input-fs (seq (for [[ns fs] (group-by namespace (:fn grouped-tests))
                                 f fs]
                             [ns (ns-resolve (symbol (namespace f))
                                             (symbol (name f)))]))]
    (test-fn-seq (reduce (fn [m [k v]] (update m k conj v)) {} input-fs))))

(defn run-tests-for-nses [grouped-tests]
  (for [ns (:ns grouped-tests)]
    (binding [test/*report-counters* (ref test/*initial-report-counters*)
              start-time (System/nanoTime)]
      (test/report {:type :begin-test-ns :ns ns})
      (test/test-all-vars (find-ns ns))
      (test/report (assoc @test/*report-counters* :type :summary :start-time start-time))
      @test/*report-counters*)))

(defn map-tags [nses tags]
  (reduce (partial merge-with concat)
          (for [ns nses
                [name f] (ns-publics ns)
                tag (:tags (meta f))]
            (when (contains? (set tags) tag)
              {ns [f]}))))

(defn run-tests-for-tags [grouped-tests test-namespaces]
  (when-let [input-tags (:tag grouped-tests)]
    (let [input-fs (-> test-namespaces (map-tags input-tags) )]
      (test-fn-seq input-fs))))

(defn run-tests-for-auto [grouped-tests & full-report]
  (for [ns (:ns grouped-tests)]
    (binding [test/*report-counters* (ref test/*initial-report-counters*)
              start-time (System/nanoTime)]
      (test/report {:type :begin-auto :ns ns})
      (test/test-all-vars ns)
      (test/report
       (let [report (assoc @test/*report-counters* :type :summary-auto :start-time start-time)]
         (if (first full-report)
           (assoc report :full-report? true)
           report)))
      @test/*report-counters*)))

fix bugs in test

fix bugs in test

- reports for tags and functions
- fixtures for tags and function
- some slight refactoring


(ns circleci.web.views.index
  (use noir.core
       hiccup.core
       hiccup.page-helpers)
  (use circleci.web.views.common)
  (:require [circleci.model.beta-notify :as beta]))

(defpage [:post "/"] {:as request}
  (with-conn
               (beta/insert {:email (:email request)
                             :environment ""
                             :features ""})
               (redirect "/beta-thanks")))

(defpage "/" []
  (layout
   [:div#pitch_wrap
    [:div#pitch

     [:div#cileft
      [:h1#cititle "Continuous Integration" [:br] "made easy"]]

     [:div#ciright
      [:div#cirightinner
      [:div#cirightinnerest

      [:h2.takepart "Take part in the beta"]
      [:p.whenready "We'll email you when we're ready."]
      [:form {:action "/" :method "POST"}
       [:fieldset#actualform
        (unordered-list
         [(list (text-field {:id "email"
                             :type "text"
                             :onfocus "if (this.value == 'Email address') { this.value=''};"
                             :onblur "if (this.value == '') { this.value = 'Email address'};"}
                             "email" "Email address"))
          (list (check-box {:id "contact"
                             :name "contact"
                             :checked true} "contact")
                [:div [:div
                (label {:id "contact-label"} "contact" "May we contact you to ask about your platform, stack, test suite, etc?")]])])]
       [:fieldset
        [:input.call_to_action {:type "submit"
                                :value "Get Notified"}]]]]]]
     [:div.clear]]]

   [:div#content_wrap
    [:div#content
     [:div#main_content_wide.left
      [:div.box_medium.feature.separator_r
       [:img {:src "img/icon_feature_03.png"
              :width 60
              :height 55}]
       [:h3 "No more build breaks"]
       [:p "Circle runs automated tests, builds artifacts, manages integration branches and deploys to production, with ease" ]]
      [:div.box_medium.feature
       [:img {:src "img/icon_feature_02.png"
              :width 60
              :height 55}]
       [:h3 "Staged Deployments"]
       [:p "Control when and how to deploy to automatically production, after the tests pass"]]
      [:div.box_medium.feature.separator_r
       [:img {:src "img/icon_feature_01.png"
              :width 60
              :height 55}]
       [:h3 "Easy Github Integration"]
       [:p "Automatically run the tests after every commit"]]
      [:div.box_medium.feature
       [:img {:src "img/icon_feature_04.png"
              :width 60
              :height 55}]
       [:h3 "Parallel testing"]
       [:p "Reduce test time by running the tests in parallel on multiple boxes"]]]]]))

(ns circleci.web.views.index
  (:use noir.core
       hiccup.core
       hiccup.page-helpers
       hiccup.form-helpers
       circleci.web.views.common
       ring.util.response)
  (:use [circleci.db :only (with-conn)])
  (:use [ring.util.response :only (redirect)])
  (:require [circleci.model.beta-notify :as beta])
  (:require [noir.cookies :as cookies]))

(defpage [:post "/"] {:as request}
  (with-conn
               (beta/insert {:email (:email request)
                             :environment ""
                             :features ""})
               (cookies/put! :signed-up "1")
               (redirect "/")))

(declare signupform youre-done)

(defpage "/" []
  (layout
   [:div#pitch_wrap
    [:div#pitch

     [:div#cileft [:h1#cititle "Continuous Integration" [:br] "made easy"]]
     [:div#ciright (if (cookies/get :signed-up) (youre-done) (signupform))]
     [:div.clear]]]

   [:div#content_wrap
    [:div#content
     [:div#main_content_wide.left
      [:div.box_medium.feature.separator_r
       [:img {:src "img/icon_feature_03.png"
              :width 60
              :height 55}]
       [:h3 "No more build breaks"]
       [:p "Circle runs automated tests, builds artifacts, manages integration branches and deploys to production, with ease" ]]
      [:div.box_medium.feature
       [:img {:src "img/icon_feature_02.png"
              :width 60
              :height 55}]
       [:h3 "Staged Deployments"]
       [:p "Control when and how to deploy to automatically production, after the tests pass"]]
      [:div.box_medium.feature.separator_r
       [:img {:src "img/icon_feature_01.png"
              :width 60
              :height 55}]
       [:h3 "Easy Github Integration"]
       [:p "Automatically run the tests after every commit"]]
      [:div.box_medium.feature
       [:img {:src "img/icon_feature_04.png"
              :width 60
              :height 55}]
       [:h3 "Parallel testing"]
       [:p "Reduce test time by running the tests in parallel on multiple boxes"]]]]]))

(defpartial signupform [& content]
  [:div#cirightinner
  [:div#cirightinnerest

  [:h2.takepart "Take part in the beta"]
  [:p.whenready "We'll email you when we're ready."]
  [:form {:action "/" :method "POST"}
   [:fieldset#actualform
    (unordered-list
     [(list (text-field {:id "email"
                         :type "text"
                         :onfocus "if (this.value == 'Email address') { this.value=''};"
                         :onblur "if (this.value == '') { this.value = 'Email address'};"}
                         "email" "Email address"))
      (list (check-box {:id "contact"
                         :name "contact"
                         :checked true} "contact")
            [:div [:div
            (label {:id "contact-label"} "contact" "May we contact you to ask about your platform, stack, test suite, etc?")]])])]
   [:fieldset
    [:input.call_to_action {:type "submit"
                            :value "Get Notified"}]]]]]
)

(defpartial youre-done [& content]
  [:div#cirightinner
  [:div#cirightinnerest

  [:h2 "Thanks, we'll be in touch soon!"]
                            ]]
)

Fix submission form.

Fix submission form.


(ns clojuredocs.site.nss
  (:require [somnium.congomongo :as mon]
            [clojuredocs.util :as util]
            [clojuredocs.site.common :as common]
            [clojure.string :as str]))

(defn library-for [ns]
  (mon/fetch-one :libraries :where {:namespaces ns}))

(defn namespace-for [ns]
  (mon/fetch-one :namespaces :where {:name ns}))

(defn vars-for [ns]
  (mon/fetch :vars :where {:ns ns} :sort {:name 1}))

(defn group-vars [vars]
  (->> vars
       (group-by
         (fn [v]
           (let [char (-> v :name first str/lower-case)]
             (if (< (int (first char)) 97)
               "*^%"
               char))))
       (sort-by #(-> % first))
       (map (fn [[c vs]]
              {:heading c
               :vars vs}))))

(defn $var-group [{:keys [heading vars]}]
  (concat
    [[:tr
       [:td {:colspan 2}
        [:div.heading heading]]]]
    (for [{:keys [ns name doc]} vars]
      [:tr
       [:td.name [:span (util/$var-link ns name name)]]
       [:td [:div.doc doc]]])))

(defn index [ns-str]
  (fn [r]
    (let [lib (library-for ns-str)
          ns (namespace-for ns-str)
          vars (sort-by #(-> % :name str/lower-case) (vars-for ns-str))]
      (when ns
        (common/$main
          {:body-class "ns-page"
           :content [:div
                     [:div.row
                      [:div.col-sm-2
                       (common/$recent (-> r :session :recent))
                       (common/$library-nav lib)]
                      [:div.col-sm-10
                       [:h1 ns-str]
                       (when (:doc ns)
                         [:pre.doc (:doc ns)])
                       [:table {:class "ns-table"}
                        (->> vars
                             group-vars
                             (mapcat $var-group))]]]]})))))

(ns clojuredocs.site.nss
  (:require [somnium.congomongo :as mon]
            [clojuredocs.util :as util]
            [clojuredocs.site.common :as common]
            [clojure.string :as str]))

(defn library-for [ns]
  (mon/fetch-one :libraries :where {:namespaces ns}))

(defn namespace-for [ns]
  (mon/fetch-one :namespaces :where {:name ns}))

(defn vars-for [ns]
  (mon/fetch :vars :where {:ns ns} :sort {:name 1}))

(defn group-vars [vars]
  (->> vars
       (group-by
         (fn [v]
           (let [char (-> v :name first str/lower-case)]
             (if (< (int (first char)) 97)
               "*^%"
               char))))
       (sort-by #(-> % first))
       (map (fn [[c vs]]
              {:heading c
               :vars vs}))))

(defn $var-group [{:keys [heading vars]}]
  (concat
    [[:tr
       [:td {:colspan 2}
        [:div.heading heading]]]]
    (for [{:keys [ns name doc]} vars]
      [:tr
       [:td.name [:span (util/$var-link ns name name)]]
       [:td [:div.doc doc]]])))

(defn index [ns-str]
  (fn [{:keys [user] :as r}]
    (let [lib (library-for ns-str)
          ns (namespace-for ns-str)
          vars (sort-by #(-> % :name str/lower-case) (vars-for ns-str))]
      (when ns
        (common/$main
          {:body-class "ns-page"
           :user user
           :content [:div
                     [:div.row
                      [:div.col-sm-2
                       (common/$recent (-> r :session :recent))
                       (common/$library-nav lib)]
                      [:div.col-sm-10
                       [:h1 ns-str]
                       (when (:doc ns)
                         [:pre.doc (:doc ns)])
                       [:table {:class "ns-table"}
                        (->> vars
                             group-vars
                             (mapcat $var-group))]]]]})))))

Fix user not showing up on ns page

Fix user not showing up on ns page


(ns dokkaa-builder.route
  (:require [compojure.core :refer [defroutes GET POST PUT DELETE ANY context]]
            [compojure.handler :refer [site]]
            [compojure.route :refer [resources files not-found]]
            [dokkaa-builder.apps :as apps]
            [dokkaa-builder.auth :as auth]
            [dokkaa-builder.pages :as pages]
            [clj-http.client :as http]
            [cheshire.core :as j]
            [cemerick.friend :as friend]
            [dokkaa-builder.oauth.github :as github]))

(declare render-status-page)
(declare render-repos-page)
(declare get-github-repos)

(defn render-status-page [request]
  (let [count (:count (:session request) 0)
        session (assoc (:session request) :count (inc count))]
    (-> (ring.util.response/response
           (str "
We've hit the session page " (:count session)
                " times.

The current session: " session "
"))
         (assoc :session session))))

(defn render-repos-page
  "Shows a list of the current users github repositories by calling the github api
   with the OAuth2 access token that the friend authentication has retrieved."
  [request]
  (prn request)
  (let [access-token (get-in request [:session :cemerick.friend/identity :current :access-token])
        repos-response (get-github-repos access-token)]
    (str (vec (map :name repos-response)))))

(defn get-github-repos
  "Github API call for the current authenticated users repository list."
  [access-token]
  (let [url (str "https://api.github.com/user/repos?access_token=" access-token)
        response (http/get url {:accept :json})
        repos (j/parse-string (:body response) true)]
    repos))

(defn get-apps [req]
  {:status 200
   :body (j/encode {"apps1" {:id "123"}
                    "apps2" {:id "234"}})})

(defn create-app [req]
  (let [app-name (get-in req [:route-params :app])
        token (get-in req [:params :token])
        user  (auth/token->user token)
        image (get-in req [:params :image])
        tag   (or (get-in req [:params :tag]) "latest")
        command (get-in req [:params :command])
        port  (get-in req [:params :port])
        port-bind-to (+ (rand-int 1000) 10000)]
    (if user
      (apps/create app-name user image
                   :tag tag
                   :command command
                   :port port)
      {:status 401, :body "token is invalid"})))

(defn update-app [req]
  )

(defn delete-app [req]
  (let [app-name (get-in req [:route-params :app])
        token (get-in req [:params :token])
        user (auth/token->user token)]
    (if user
      (apps/delete app-name user)
      {:status 401, :body "token is invalid"})))

(defn logs [req]
  (let [app-name (get-in req [:route-params :app])
        token (get-in req [:params :token])
        user (auth/token->user token)]
    (if user
      (apps/logs app-name user)
      {:status 401, :body "token is invalid"})))

(defn ping [req]
  {:status 200})

(defn index [req]
  (if (friend/authorized? [:user] req)
    (pages/index)
    "Login By GitHub"))

(defroutes apps-routes
  (GET    "/" req (get-apps req))
  (GET    "/:app/logs" req (logs req))
  (POST   "/:app" req (create-app req))
  (PUT    "/:app" req (update-app req))
  (DELETE "/:app" req (delete-app req)))

(defroutes users-routes
  (GET "/" request "My Github Repositories
Status")
  (GET "/status" request (render-status-page request))
  (GET "/repos"  request (friend/authorize #{:user} (render-repos-page request)))
  (friend/logout (ANY "/logout" request (ring.util.response/redirect "/"))))

(defroutes routes
  (GET "/" req (index req))
  (GET "/_ping"  [] ping)
  (context "/users" req users-routes)
  (context "/apps/" req apps-routes)
  (resources "/")
  (not-found "404 Not Found"))

(def app (-> routes
             (github/authenticate
              :credential-fn (fn [token]))
             site))

(ns dokkaa-builder.route
  (:require [compojure.core :refer [defroutes GET POST PUT DELETE ANY context]]
            [compojure.handler :refer [site]]
            [compojure.route :refer [resources files not-found]]
            [dokkaa-builder.apps :as apps]
            [dokkaa-builder.auth :as auth]
            [dokkaa-builder.pages :as pages]
            [clj-http.client :as http]
            [cheshire.core :as j]
            [cemerick.friend :as friend]
            [dokkaa-builder.oauth.github :as github]))

(defn get-apps [req]
  {:status 200
   :body (j/encode {"apps1" {:id "123"}
                    "apps2" {:id "234"}})})

(defn create-app [req]
  (let [app-name (get-in req [:route-params :app])
        token (get-in req [:params :token])
        user  (auth/token->user token)
        image (get-in req [:params :image])
        tag   (or (get-in req [:params :tag]) "latest")
        command (get-in req [:params :command])
        port  (get-in req [:params :port])
        port-bind-to (+ (rand-int 1000) 10000)]
    (if user
      (apps/create app-name user image
                   :tag tag
                   :command command
                   :port port)
      {:status 401, :body "token is invalid"})))

(defn update-app [req]
  )

(defn delete-app [req]
  (let [app-name (get-in req [:route-params :app])
        token (get-in req [:params :token])
        user (auth/token->user token)]
    (if user
      (apps/delete app-name user)
      {:status 401, :body "token is invalid"})))

(defn logs [req]
  (let [app-name (get-in req [:route-params :app])
        token (get-in req [:params :token])
        user (auth/token->user token)]
    (if user
      (apps/logs app-name user)
      {:status 401, :body "token is invalid"})))

(defn ping [req]
  {:status 200})

(defn index [req]
  (if (friend/authorized? [:user] req)
    (pages/index)
    "Login By GitHub"))

(defroutes apps-routes
  (GET    "/" req (get-apps req))
  (GET    "/:app/logs" req (logs req))
  (POST   "/:app" req (create-app req))
  (PUT    "/:app" req (update-app req))
  (DELETE "/:app" req (delete-app req)))

(defroutes routes
  (GET "/" req (index req))
  (GET "/_ping"  [] ping)
  (context "/apps/" req apps-routes)
  (resources "/")
  (friend/logout (ANY "/logout" request (ring.util.response/redirect "/")))
  (not-found "404 Not Found"))

(def app (-> routes
             (github/authenticate
              :credential-fn (fn [token]))
             site))

remove dummy routes

remove dummy routes


(ns clojuredocs.sticky
  (:require [dommy.utils :as utils]
            [dommy.core :as dom]
            [clojure.string :as str])
  (:use-macros [dommy.macros :only [node sel sel1]]))

(defn clog [& args]
  (.log js/console (pr-str args)))

(defn parse-int [s & [default]]
  (try
    (js/parseInt s)
    (catch js/Error e
      (if default
        default
        (throw e)))))

(defn offset-top [$el]
  (loop [y 0
         $el $el]
    (let [parent (.-offsetParent $el)]
      (if-not parent
        y
        (recur
          (+ y (.-offsetTop $el))
          parent)))))

(defn computed-style [$el style-attr]
  (let [attr (name style-attr)
        v (.getPropertyValue
            (.getComputedStyle js/window $el nil)
            attr)]
    (when (and v (string? v))
      (js/parseInt (str/replace v #"px" "")))))

(defn init [$el]
  (let [px-offset (-> $el
                      (dom/attr :data-sticky-offset)
                      (parse-int 100))
        $parent (-> $el dom/ancestor-nodes second)
        initial-offset (offset-top $el)
        f (fn [_]
            (if (> (.-pageYOffset js/window) (- initial-offset px-offset))
              (let [{:keys [width]} (-> $el
                                        dom/ancestor-nodes
                                        second
                                        dom/bounding-client-rect)
                    left-padding (computed-style $parent :padding-left)
                    right-padding (computed-style $parent :padding-right)
                    left-margin (computed-style $parent :margin-left)
                    right-margin (computed-style $parent :margin-right)
                    width (- width left-padding right-padding left-margin right-margin)]
                (dom/add-class! $el :sticky)
                (dom/set-style! $el
                  :width (str width "px")
                  :max-height (str js/window.innerHeight "px")
                  :top (str px-offset "px")))
              (dom/remove-class! $el :sticky)))]
    (dom/listen! js/window :scroll f)
    (dom/listen! js/window :resize f)))

(ns clojuredocs.sticky
  (:require [dommy.utils :as utils]
            [dommy.core :as dom]
            [clojure.string :as str])
  (:use-macros [dommy.macros :only [node sel sel1]]))

(defn clog [& args]
  (.log js/console (pr-str args)))

(defn parse-int [s & [default]]
  (try
    (js/parseInt s)
    (catch js/Error e
      (if default
        default
        (throw e)))))

(defn offset-top [$el]
  (loop [y 0
         $el $el]
    (let [parent (.-offsetParent $el)]
      (if-not parent
        y
        (recur
          (+ y (.-offsetTop $el))
          parent)))))

(defn computed-style [$el style-attr]
  (let [attr (name style-attr)
        v (.getPropertyValue
            (.getComputedStyle js/window $el nil)
            attr)]
    (when (and v (string? v))
      (js/parseInt (str/replace v #"px" "")))))

(defn init [$el]
  (let [px-offset (-> $el
                      (dom/attr :data-sticky-offset)
                      (parse-int 100))
        $parent (-> $el dom/ancestor-nodes second)
        initial-offset (offset-top $el)
        f (fn [_]
            (if (> (.-pageYOffset js/window) (- initial-offset px-offset))
              (let [{:keys [width]} (-> $el
                                        dom/ancestor-nodes
                                        second
                                        dom/bounding-client-rect)
                    left-padding (computed-style $parent :padding-left)
                    right-padding (computed-style $parent :padding-right)
                    left-margin (computed-style $parent :margin-left)
                    right-margin (computed-style $parent :margin-right)
                    width (- width left-padding right-padding left-margin right-margin)]
                (dom/add-class! $el :sticky)
                (dom/set-style! $el
                  :width (str width "px")
                  :max-height (str js/window.innerHeight "px")
                  :top (str px-offset "px")))
              (dom/remove-class! $el :sticky)))]
    (dom/listen! js/window :scroll f)
    (dom/listen! js/window :resize f)
    (f nil)))

Fix sticky not positioning correctly on page load


(ns nightmod.manager
  (:require [clojure.java.io :as io]
            [nightmod.utils :as u]
            [play-clj.core :refer :all])
  (:import [com.badlogic.gdx.assets.loaders FileHandleResolver]
           [com.badlogic.gdx.files FileHandle]))

; make all assets load relative to the current project's directory
(def manager (asset-manager*
               (reify FileHandleResolver
                 (resolve [this file-name]
                   (FileHandle. (io/file @u/project-dir file-name))))))
(set-asset-manager! manager)

(defn clear-ns!
  [nspace]
  (doall (map #(ns-unmap nspace %) (keys (ns-interns nspace)))))

(defn clean!
  []
  (clear-ns! u/game-ns)
  (on-gl (asset-manager! manager :clear)))

(ns nightmod.manager
  (:require [clojure.java.io :as io]
            [nightmod.utils :as u]
            [play-clj.core :refer :all])
  (:import [com.badlogic.gdx.assets.loaders FileHandleResolver]
           [com.badlogic.gdx.files FileHandle]))

; make all assets load relative to the current project's directory
(def manager (asset-manager*
               (reify FileHandleResolver
                 (resolve [this file-name]
                   (FileHandle. (io/file @u/project-dir file-name))))))
(set-asset-manager! manager)

; keep a reference to all timers to we can stop them later
(def timers (atom []))
(let [create-and-add-timer! (deref #'play-clj.core/create-and-add-timer!)]
  (intern 'play-clj.core
          'create-and-add-timer!
          (fn [screen id]
            (let [t (create-and-add-timer! screen id)]
              (swap! timers conj t)
              t))))

(defn stop-timers!
  []
  (doseq [t @timers]
    (.stop t))
  (reset! timers []))

(defn clear-ns!
  [nspace]
  (doall (map #(ns-unmap nspace %) (keys (ns-interns nspace)))))

(defn clean!
  []
  (clear-ns! u/game-ns)
  (stop-timers!)
  (on-gl (asset-manager! manager :clear)))

Bring back timer stopping code

Bring back timer stopping code


(ns clojure-fabric.grpc-core)

;; Note that under the cover there are two different kinds of communications with the fabric backend
;; that trigger different events to be emitted back to the application’s handlers:
;; - the grpc client with the orderer service uses a “regular” stateless HTTP connection in
;;      a request/response fashion with the “broadcast” call. The method implementation should emit
;;      “transaction submitted” when a successful acknowledgement is received in the response, or
;;      “error” when an error is received
;; - The method implementation should also maintain a persistent connection with the Chain’s
;;      event source Peer as part of the internal event hub mechanism in order to support
;;      the fabric events “BLOCK”, “CHAINCODE” and “TRANSACTION”. These events should cause
;;      the method to emit “complete” or “error” events to the application

;; Note that under the cover there are two different kinds of communications with the fabric backend
;; that trigger different events to be emitted back to the application’s handlers:
;; - the grpc client with the orderer service uses a “regular” stateless HTTP connection in
;;      a request/response fashion with the “broadcast” call. The method implementation should emit
;;      “transaction submitted” when a successful acknowledgement is received in the response, or
;;      “error” when an error is received
;; - The method implementation should also maintain a persistent connection with the Chain’s
;;      event source Peer as part of the internal event hub mechanism in order to support
;;      the fabric events “BLOCK”, “CHAINCODE” and “TRANSACTION”. These events should cause
;;      the method to emit “complete” or “error” events to the application
(ns clojure-fabric.grpc-core
  (:import [org.hyperledger.fabric.protos.peer Chaincode$ChaincodeID
            Chaincode$ChaincodeSpec Chaincode$ChaincodeInput Chaincode$ChaincodeSpec$Type
            Chaincode$ChaincodeInvocationSpec
            ProposalPackage$ChaincodeHeaderExtension]
           [org.hyperledger.fabric.protos.common Common$ChannelHeader Common$HeaderType]
           [com.google.protobuf ByteString Timestamp]))

(defn make-chaincode-id
  ([name]
   (make-chaincode-id name {}))
  ([name {:keys [version path] :or {version "" path ""}}]
   (-> (Chaincode$ChaincodeID/newBuilder)
       (.setName name)
       (.setVersion version)
       (.setPath path)
       (.build))))

(defn make-chaincode-input
  ([args]
   (-> (Chaincode$ChaincodeInput/newBuilder)
       (.addAllArgs args)
       (.build)))
  ;; FIXME: can't find deatails on decorations
  #_
  ([args decorations]
   (-> (Chaincode$ChaincodeInput/newBuilder)
       (.addAllArgs args))))

(defn make-chaincode-spec
  ([chaincode-id input]
   (-> (Chaincode$ChaincodeSpec/newBuilder)
       (.setType Chaincode$ChaincodeSpec$Type/GOLANG)
       (.setChaincodeId ^Chaincode$ChaincodeID chaincode-id)
       (.setInput ^Chaincode$ChaincodeInput input)
       (.build)))
  ;; FIXME: use of timeout
  #_
  ([type chaincode-id input timeout]
   (-> (Chaincode$ChaincodeSpec/newBuilder)
       (.setType)
       (.setChaincodeId)
       (.setInput)
       (.setTimeout)
       (.build))))

(defn make-chaincode-invocation-spec
  ([^Chaincode$ChaincodeSpec chaincode-spec]
   (-> (Chaincode$ChaincodeInvocationSpec/newBuilder)
       (.setChaincodeSpec chaincode-spec)))
  ;; FIXME: setIdGenerationAlg
  #_
  ([^Chaincode$ChaincodeSpec chaincode-spec id-generation-alg]
   (-> (Chaincode$ChaincodeInvocationSpec/newBuilder)
       (.setChaincodeSpec chaincode-spec)
       (.setIdGenerationAlg id-generation-alg))))

(defn make-chaincode-header-extention
  ([chaincode-id]
   (make-chaincode-header-extention chaincode-id ByteString/EMPTY))
  ([^Chaincode$ChaincodeID chaincode-id payload-visibility]
   (-> (ProposalPackage$ChaincodeHeaderExtension/newBuilder)
       (.setChaincodeId chaincode-id)
       ;; FIXME: payload-visibility is ByteString
       ;; Use above arity 1 function - currently all other SDKs do this
       (.setPayloadVisibility payload-visibility)
       (.build))))

(defn make-current-grpc-timestamp
  []
  (let [now (System/currentTimeMillis)]
    (-> (Timestamp/newBuilder)
        (.setSeconds (quot now 1000))
        (.setNanos (-> now (rem 1000) (* 10000000)))
        (.build))))

(defn make-channel-header
  ([type version channel-id tx-id epoch]
   (make-channel-header type version channel-id tx-id epoch ByteString/EMPTY))
  ([type version channel-id tx-id epoch extension]
   (let [now (System/currentTimeMillis)]
    (-> (Common$ChannelHeader/newBuilder)
        (.setType type)
        (.setVersion version)
        (.setTimestamp ^Timestamp (make-current-grpc-timestamp))
        (.setChannelId ^Chaincode$ChaincodeID channel-id)
        (.setTxId tx-id)
        (.setEpoch epoch)
        (.setExtension extension)
        (.build)))))

(defn make-chaincode-header
  [^Chaincode$ChaincodeID chaincode-id channel-id tx-id epoch]
  (make-channel-header Common$HeaderType/ENDORSER_TRANSACTION ; type
                       1                ; version
                       channel-id
                       tx-id
                       epoch
                       (make-chaincode-header-extention chaincode-id)))

Add some grpc functions

Add some grpc functions


(ns uxbox.ui.users
  (:require [sablono.core :as html :refer-macros [html]]
            [lentes.core :as l]
            [rum.core :as rum]
            [uxbox.router :as r]
            [uxbox.rstore :as rs]
            [uxbox.state :as s]
            [uxbox.data.auth :as da]
            [uxbox.ui.icons :as i]
            [uxbox.ui.navigation :as nav]
            [uxbox.ui.lightbox :as lightbox]
            [uxbox.ui.mixins :as mx]))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Menu
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(defn menu-render
  [own open?]
  (let [open-settings-dialog #(lightbox/open! :settings)]
    (html
     [:ul.dropdown {:class (when-not open?
                             "hide")}
      [:li
       i/page
       [:span "Page settings"]]
      [:li {:on-click open-settings-dialog}
       i/grid
       [:span "Grid settings"]]
      [:li
       i/eye
       [:span "Preview"]]
      [:li {:on-click #(r/go :settings/profile)}
       i/user
       [:span "Your account"]]
      [:li {:on-click #(rs/emit! (da/logout))}
       i/exit
       [:span "Exit"]]])))

(def user-menu
  (mx/component
   {:render menu-render
    :name "user-menu"
    :mixins []}))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; User Widget
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(def ^:static profile-l
  (as-> (l/key :profile) $
    (l/focus-atom $ s/state)))

(defn user-render
  [own]
  (let [profile (rum/react profile-l)
        local (:rum/local own)]
    (html
     [:div.user-zone {:on-mouse-enter #(swap! local assoc :open true)
                      :on-mouse-leave #(swap! local assoc :open false)}
      [:span (:fullname profile)]
      [:img {:border "0"
             :src (:photo profile "/images/favicon.png")}]
      (user-menu (:open @local))])))

(def user
  (mx/component
   {:render user-render
    :name "user"
    :mixins [rum/reactive (rum/local {:open false})]}))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Register
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

;; (rum/defc register-form < rum/static
;;   []
;;   [:div.login-content
;;    [:input.input-text
;;      {:name "name"
;;       :placeholder "Name"
;;       :type "text"}]
;;    [:input.input-text
;;      {:name "email"
;;       :placeholder "Email"
;;       :type "email"}]
;;    [:input.input-text
;;     {:name "password"
;;      :placeholder "Password"
;;      :type "password"}]
;;    [:input.btn-primary
;;     {:name "login"
;;      :value "Continue"
;;      :type "submit"
;;      :on-click #(r/go :dashboard/projects)}]
;;    [:div.login-links
;;     [:a
;;      {:on-click #(r/go :auth/login)}
;;      "You already have an account?"]]])

;; (rum/defc register < rum/static
;;   []
;;   [:div.login
;;    [:div.login-body
;;     [:a i/logo]
;;     (register-form)]])

;; (rum/defc recover-password-form < rum/static
;;   []
;;   [:div.login-content
;;    [:input.input-text
;;      {:name "email"
;;       :placeholder "Email"
;;       :type "email"}]
;;    [:input.btn-primary
;;     {:name "login"
;;      :value "Continue"
;;      :type "submit"
;;      :on-click #(r/go :dashboard/projects)}]
;;    [:div.login-links
;;     [:a
;;      {:on-click #(r/go :auth/login)}
;;      "You have remembered your password?"]
;;     [:a
;;      {:on-click #(r/go :auth/register)}
;;      "Don't have an account?"]]])

;; (rum/defc recover-password < rum/static
;;   []
;;   [:div.login
;;     [:div.login-body
;;      [:a i/logo]
;;      (recover-password-form)]])

(ns uxbox.ui.users
  (:require [sablono.core :as html :refer-macros [html]]
            [lentes.core :as l]
            [rum.core :as rum]
            [uxbox.router :as r]
            [uxbox.rstore :as rs]
            [uxbox.state :as s]
            [uxbox.data.auth :as da]
            [uxbox.ui.icons :as i]
            [uxbox.ui.navigation :as nav]
            [uxbox.ui.lightbox :as lightbox]
            [uxbox.ui.mixins :as mx]))

;; --- User Menu

(defn menu-render
  [own open?]
  (let [open-settings-dialog #(lightbox/open! :settings)]
    (html
     [:ul.dropdown {:class (when-not open?
                             "hide")}
      [:li
       i/page
       [:span "Page settings"]]
      [:li {:on-click open-settings-dialog}
       i/grid
       [:span "Grid settings"]]
      [:li
       i/eye
       [:span "Preview"]]
      [:li {:on-click #(r/go :settings/profile)}
       i/user
       [:span "Your account"]]
      [:li {:on-click #(rs/emit! (da/logout))}
       i/exit
       [:span "Exit"]]])))

(def user-menu
  (mx/component
   {:render menu-render
    :name "user-menu"
    :mixins []}))

;; --- User Widget

(def ^:static profile-l
  (as-> (l/key :profile) $
    (l/focus-atom $ s/state)))

(defn user-render
  [own]
  (let [profile (rum/react profile-l)
        local (:rum/local own)]
    (html
     [:div.user-zone {:on-mouse-enter #(swap! local assoc :open true)
                      :on-mouse-leave #(swap! local assoc :open false)}
      [:span (:fullname profile)]
      [:img {:border "0"
             :src (:photo profile "/images/favicon.png")}]
      (user-menu (:open @local))])))

(def user
  (mx/component
   {:render user-render
    :name "user"
    :mixins [rum/reactive (rum/local {:open false})]}))

Remove commented code on ui.users ns.

Remove commented code on ui.users ns.