regular strips works now

regular strips works now

git-svn-id: 90c135e2b654d5d39218b235c725b90ec5779e48@410 cd74b5cd-e609-0410-a199-9e5d10d28226

--- src/edu/berkeley/ai/util/propositions.clj
+++ src/edu/berkeley/ai/util/propositions.clj
@@ -11,9 +11,9 @@
   (let [type-map (map-map seq->vector-pair types)]
 ;    (prn type-map)
     (assert-is (= (count types) (count type-map)) "Duplicate type")
-    (doseq [type (keys types)]
-      (let [distinct? (distinct-elts? (get-subtypes types type))]
-	(assert-is (identity distinct?) "Recursive type or duplicate inclusion %s" (take 100 (get-subtypes types type)))))
+    (doseq [type (keys type-map)]
+      (let [distinct? (distinct-elts? (get-subtypes type-map type))]
+	(assert-is (identity distinct?) "Recursive type or duplicate inclusion %s" (take 100 (get-subtypes type-map type)))))
     type-map))


Delete mars_rover.clj

Delete mars_rover.clj


Solved 5.7

Solved 5.7

--- src/fpinscala/strictness_and_laziness.clj
+++ src/fpinscala/strictness_and_laziness.clj
@@ -92,12 +92,12 @@
 (defn exists
   "Function exists via fold-right from fpins"
   [p s]
-  (fold-right false #(or (p %) %2) s))
+  (fold-right false #(or %2 (p %)) s))

 ;5.4
 ;mine
 (defn for-all
-  "forAll for 5.4 in FPINS, it is lazy but much more verbose than fpins solution and I shoul have noticed f-r should be used!"
+  "forAll for 5.4 in FPINS, it is lazy but much more verbose than fpins solution and I should have noticed f-r should be used!"
   [p s]
   (let [[h & t] s]
     (if t
@@ -107,7 +107,7 @@
 (defn for-all-fpins
   "forAll as in fpins, I should have observed that f-r should be used! But mine works as well and it is lazy also"
   [p s]
-  (fold-right true #(and (p %) %2) s))
+  (fold-right true #(and %2 (p %)) s))
 ;-----------------------------------------------------------------------

 ;5.5


Fix not-equal bug in core

Fix not-equal bug in core

--- src/dataframe/core.clj
+++ src/dataframe/core.clj
@@ -21,7 +21,7 @@
 (def mul dataframe.series/mul)
 (def div dataframe.series/div)
 (def eq dataframe.series/eq)
-(def new dataframe.series/neq)
+(def neq dataframe.series/neq)

 ; Imported frame methods


Proof of concept for redoing scraper using agents

--- src/hackerati_interval_web_app/schema.clj
+++ src/hackerati_interval_web_app/schema.clj
@@ -133,6 +133,29 @@
       #_(println entry)
       (add-price! entry))))

+;; test ;;
+
+;; working proof of concept--retrieves one item's price
+(time (let [agents (list (agent 1))
+       products (select products)
+       urls (map :url products)
+       url (first urls)]
+   (doseq [a agents]
+     (send-off a (fn [_] (scrape/get-price-from-url url))))
+   (doseq [a agents]
+     (await-for 4000 a))
+   (doseq [a agents]
+     (print @a))))
+
+;; demo code from JoC p. 252
+(time (let [agents (map #(agent %) (range 10))]
+   (doseq [a agents]
+     (send-off a (fn [_] (Thread/sleep 1000))))
+   (doseq [a agents]
+     (await-for 1000 a))))
+
+;; test ;;
+
 (defn user-exists? [username]
   (seq (select users (where {:username username}))))


Remove mock vitals data

Remove mock vitals data

--- src_patient/patient/events.cljs
+++ src_patient/patient/events.cljs
@@ -104,335 +104,4 @@
 (reg-event-db
  :success-load-vitals-sign-screen
  (fn [db _]
-   (assoc db :observations
-          [{
-            :resourceType "Observation",
-            :id "blood-pressure",
-            :meta {
-                   :profile [
-                             "http//hl7.org/fhir/StructureDefinition/vitalsigns"
-                             ]
-                   },
-            :text {
-                   :status "generated",
-                   :div "

Generated Narrative with Details

id blood-pressure

meta

identifier urnuuid187e0c12-8dd2-67e2-99b2-bf273c878281

basedOn

status final

category Vital Signs (Details  {http//hl7.org/fhir/observation-category code 'vital-signs' = 'Vital Signs', given as 'Vital Signs'})

code Blood pressure systolic & diastolic (Details  {LOINC code '85354-9' = 'lood pressure panel with all children optional', given as 'Bood pressure panel with all children optional'})

subject Patient/example

effective 17/09/2012

performer Practitioner/example

interpretation Below low normal (Details  {http//hl7.org/fhir/v2/0078 code 'L' = 'Low', given as 'low'})

bodySite Right arm (Details  {SNOMED CT code '368209003' = 'Right upper arm', given as 'Right arm'})

component

code Systolic blood pressure (Details  {LOINC code '8480-6' = 'Systolic blood pressure', given as 'Systolic blood pressure'}; {SNOMED CT code '271649006' = 'Systolic blood pressure', given as 'Systolic blood pressure'}; {http//acme.org/devices/clinical-codes code 'bp-s' = 'bp-s', given as 'Systolic Blood pressure'})

value 107 mmHg (Details UCUM code mm[Hg] = 'mmHg')

interpretation Normal (Details  {http//hl7.org/fhir/v2/0078 code 'N' = 'Normal', given as 'normal'})

component

code Diastolic blood pressure (Details  {LOINC code '8462-4' = 'Diastolic blood pressure', given as 'Diastolic blood pressure'})

value 60 mmHg (Details UCUM code mm[Hg] = 'mmHg')

interpretation Below low normal (Details  {http//hl7.org/fhir/v2/0078 code 'L' = 'Low', given as 'low'})

"
-                   },
-            :identifier [
-                         {
-                          :system "urnietfrfc3986",
-                          :value "urnuuid187e0c12-8dd2-67e2-99b2-bf273c878281"
-                          }
-                         ],
-            :basedOn [
-                      {
-                       :identifier {
-                                    :system "https//acme.org/identifiers",
-                                    :value "1234"
-                                    }
-                       }
-                      ],
-            :status "final",
-            :category [
-                       {
-                        :coding [
-                                 {
-                                  :system "http//hl7.org/fhir/observation-category",
-                                  :code "vital-signs",
-                                  :display "Vital Signs"
-                                  }
-                                 ]
-                        }
-                       ],
-            :code {
-                   :coding [
-                            {
-                             :system "http//loinc.org",
-                             :code "85354-9",
-                             :display "Bood pressure panel with all children optional"
-                             }
-                            ],
-                   :text "Blood pressure systolic & diastolic"
-                   },
-            :subject {
-                      :reference "Patient/example"
-                      },
-            :effectiveDateTime "2012-09-17",
-            :performer [
-                        {
-                         :reference "Practitioner/example"
-                         }
-                        ],
-            :interpretation {
-                             :coding [
-                                      {
-                                       :system "http//hl7.org/fhir/v2/0078",
-                                       :code "L",
-                                       :display "low"
-                                       }
-                                      ],
-                             :text "Below low normal"
-                             },
-            :bodySite {
-                       :coding [
-                                {
-                                 :system "http//snomed.info/sct",
-                                 :code "368209003",
-                                 :display "Right arm"
-                                 }
-                                ]
-                       },
-            :component [
-                        {
-                         :code {
-                                :coding [
-                                         {
-                                          :system "http//loinc.org",
-                                          :code "8480-6",
-                                          :display "Systolic blood pressure"
-                                          },
-                                         {
-                                          :system "http//snomed.info/sct",
-                                          :code "271649006",
-                                          :display "Systolic blood pressure"
-                                          },
-                                         {
-                                          :system "http//acme.org/devices/clinical-codes",
-                                          :code "bp-s",
-                                          :display "Systolic Blood pressure"
-                                          }
-                                         ]
-                                },
-                         :valueQuantity {
-                                         :value 107,
-                                         :unit "mmHg",
-                                         :system "http//unitsofmeasure.org",
-                                         :code "mm[Hg]"
-                                         },
-                         :interpretation {
-                                          :coding [
-                                                   {
-                                                    :system "http//hl7.org/fhir/v2/0078",
-                                                    :code "N",
-                                                    :display "normal"
-                                                    }
-                                                   ],
-                                          :text "Normal"
-                                          }
-                         },
-                        {
-                         :code {
-                                :coding [
-                                         {
-                                          :system "http//loinc.org",
-                                          :code "8462-4",
-                                          :display "Diastolic blood pressure"
-                                          }
-                                         ]
-                                },
-                         :valueQuantity {
-                                         :value 60,
-                                         :unit "mmHg",
-                                         :system "http//unitsofmeasure.org",
-                                         :code "mm[Hg]"
-                                         },
-                         :interpretation {
-                                          :coding [
-                                                   {
-                                                    :system "http//hl7.org/fhir/v2/0078",
-                                                    :code "L",
-                                                    :display "low"
-                                                    }
-                                                   ],
-                                          :text "Below low normal"
-                                          }
-                         }
-                        ]
-            },
-           {
-            :resourceType "Observation"
-            :id "f202"
-            :text {
-                     :status "generated"
-                     :div "

Generated Narrative with Details

id f202

status entered-in-error

category Vital Signs (Details  {http//hl7.org/fhir/observation-category code 'vital-signs' = 'Vital Signs' given as 'Vital Signs'})

code Temperature (Details  {http//acme.lab code 'BT' = 'BT' given as 'Body temperature'}; {LOINC code '8310-5' = 'Body temperature' given as 'Body temperature'}; {LOINC code '8331-1' = 'Oral temperature' given as 'Oral temperature'}; {SNOMED CT code '56342008' = 'Temperature taking' given as 'Temperature taking'})

subject Roel

issued 04/04/2013 12700 PM

performer Practitioner/f201

value 39 degrees C (Details UCUM code Cel = 'Cel')

interpretation High (Details  {http//hl7.org/fhir/v2/0078 code 'H' = 'High)

bodySite Oral cavity (Details  {SNOMED CT code '74262004' = 'Oral cavity' given as 'Oral cavity'})

method Oral temperature taking (Details  {SNOMED CT code '89003005' = 'Oral temperature taking' given as 'Oral temperature taking'})

ReferenceRanges

-	High

*	38.2 degrees C

"
-                     }
-            :status "entered-in-error"
-            :category [
-                         {
-                          :coding [
-                                     {
-                                      :system "http//hl7.org/fhir/observation-category"
-                                      :code "vital-signs"
-                                      :display "Vital Signs"
-                                      }
-                                     ]
-                          }
-                         ]
-            :code {
-                     :coding [
-                                {
-                                 :system "http//acme.lab"
-                                 :code "BT"
-                                 :display "Body temperature"
-                                 }
-                                {
-                                 :system "http//loinc.org"
-                                 :code "8310-5"
-                                 :display "Body temperature"
-                                 }
-                                {
-                                 :system "http//loinc.org"
-                                 :code "8331-1"
-                                 :display "Oral temperature"
-                                 }
-                                {
-                                 :system "http//snomed.info/sct"
-                                 :code "56342008"
-                                 :display "Temperature taking"
-                                 }
-                                ]
-                     :text "Temperature"
-                     }
-            :subject {
-                        :reference "Patient/f201"
-                        :display "Roel"
-                        }
-            :issued "2013-04-04T132700+0100"
-            :performer [
-                          {
-                           :reference "Practitioner/f201"
-                           }
-                          ]
-            :valueQuantity {
-                              :value 39
-                              :unit "degrees C"
-                              :system "http//unitsofmeasure.org"
-                              :code "Cel"
-                              }
-            :interpretation {
-                               :coding [
-                                          {
-                                           :system "http//hl7.org/fhir/v2/0078"
-                                           :code "H"
-                                           }
-                                          ]
-                               }
-            :bodySite {
-                         :coding [
-                                    {
-                                     :system "http//snomed.info/sct"
-                                     :code "74262004"
-                                     :display "Oral cavity"
-                                     }
-                                    ]
-                         }
-            :method {
-                       :coding [
-                                  {
-                                   :system "http//snomed.info/sct"
-                                   :code "89003005"
-                                   :display "Oral temperature taking"
-                                   }
-                                  ]
-                       }
-            :referenceRange [
-                               {
-                                :high {
-                                         :value 38.2
-                                         :unit "degrees C"
-                                         }
-                                }
-                               ]
-            },
-           {
-            :resourceType "Observation",
-            :id "heart-rate",
-            :meta {
-                   :profile [
-                             "http//hl7.org/fhir/StructureDefinition/vitalsigns"
-                             ]
-                   },
-            :text {
-                   :status "generated",
-                   :div "

Generated Narrative with Details

id heart-rate

meta

status final

category Vital Signs (Details  {http//hl7.org/fhir/observation-category code 'vital-signs' = 'Vital Signs', given as 'Vital Signs'})

code Heart rate (Details  {LOINC code '8867-4' = 'Heart rate', given as 'Heart rate'})

subject Patient/example

effective 02/07/1999

value 44 beats/minute (Details UCUM code /min = '/min')

"
-                   },
-            :status "final",
-            :category [
-                       {
-                        :coding [
-                                 {
-                                  :system "http//hl7.org/fhir/observation-category",
-                                  :code "vital-signs",
-                                  :display "Vital Signs"
-                                  }
-                                 ],
-                        :text "Vital Signs"
-                        }
-                       ],
-            :code {
-                   :coding [
-                            {
-                             :system "http//loinc.org",
-                             :code "8867-4",
-                             :display "Heart rate"
-                             }
-                            ],
-                   :text "Heart rate"
-                   },
-            :subject {
-                      :reference "Patient/example"
-                      },
-            :effectiveDateTime "1999-07-02",
-            :valueQuantity {
-                            :value 44,
-                            :unit "beats/minute",
-                            :system "http//unitsofmeasure.org",
-                            :code "/min"
-                            }
-            },
-           {
-            :resourceType "Observation",
-            :id "respiratory-rate",
-            :meta {
-                   :profile [
-                             "http//hl7.org/fhir/StructureDefinition/vitalsigns"
-                             ]
-                   },
-            :text {
-                   :status "generated",
-                   :div "

Generated Narrative with Details

id respiratory-rate

meta

status final

category Vital Signs (Details  {http//hl7.org/fhir/observation-category code 'vital-signs' = 'Vital Signs', given as 'Vital Signs'})

code Respiratory rate (Details  {LOINC code '9279-1' = 'Respiratory rate', given as 'Respiratory rate'})

subject Patient/example

effective 02/07/1999

value 26 breaths/minute (Details UCUM code /min = '/min')

"
-                   },
-            :status "final",
-            :category [
-                       {
-                        :coding [
-                                 {
-                                  :system "http//hl7.org/fhir/observation-category",
-                                  :code "vital-signs",
-                                  :display "Vital Signs"
-                                  }
-                                 ],
-                        :text "Vital Signs"
-                        }
-                       ],
-            :code {
-                   :coding [
-                            {
-                             :system "http//loinc.org",
-                             :code "9279-1",
-                             :display "Respiratory rate"
-                             }
-                            ],
-                   :text "Respiratory rate"
-                   },
-            :subject {
-                      :reference "Patient/example"
-                      },
-            :effectiveDateTime "1999-07-02",
-            :valueQuantity {
-                            :value 26,
-                            :unit "breaths/minute",
-                            :system "http//unitsofmeasure.org",
-                            :code "/min"
-                            }
-            }])))
-
+   (assoc db :observations [])))


Use resolve to fetch the rest of the app's data

The org-level workflow runs API no longer exists, so skip it.

--- src-cljs/frontend/send.cljs
+++ src-cljs/frontend/send.cljs
@@ -140,37 +140,6 @@
 (defn- cancel-run-expression?
   [expression]
   (= 'run/cancel (first expression)))
-
-(defn- org-runs-ast?
-  "returns true if the ast is for an expression rendering the org workflows page"
-  [expr-ast]
-  (boolean (and (= :circleci/organization (:key expr-ast))
-                (expr-ast/has-children? expr-ast
-                                        #{:routed-page
-                                          :organization/name
-                                          :organization/vcs-type}))))
-
-(defn- get-org-runs
-  "Retrieves workflow runs for and org and merges them into the
-  app. Takes an expression ast, send callback, and query."
-  [expr-ast send-cb query]
-  (let [vcs-type (-> expr-ast :params :organization/vcs-type)
-        org-name (-> expr-ast :params :organization/name)
-        {:keys [connection/offset connection/limit]}
-        (:params (expr-ast/get-in expr-ast [:routed-page]))]
-    (api/get-org-workflows
-     (callback-api-chan
-      (fn [response]
-        (let [novelty {:circleci/organization
-                       {:routed-page
-                        {:connection/total-count (:total-count response)
-                         :connection/edges (->> (:results response)
-                                                (map adapt-to-run)
-                                                (mapv #(hash-map :edge/node %)))}}}]
-          (send-cb novelty query))))
-     vcs-type
-     org-name
-     {:offset offset :limit limit})))

 (defn- branch-crumb-ast?
   "returns true if the ast is for an expression rendering the branch
@@ -511,74 +480,6 @@
             (let [adapted (:run/project (adapt-to-run response))]
               (parser {:state (atom adapted)} (mapv om-next/ast->query (:children ast))))))))})

-(defn- resolvers-can-handle?
-  "Tool for migrating to resolvers. True if the expression can be handled by the
-  resolvers above."
-  [expr]
-  (let [ast (om-parser/expr->ast (first (de-alias-expression expr #())))]
-    (or (branch-crumb-ast? ast)
-        (branch-runs-ast? ast)
-        (= {:app/current-user [{:user/organizations [:organization/name :organization/vcs-type :organization/avatar-url]}]}
-           expr)
-        (and (= :circleci/organization (:key ast))
-             (= '[:organization/vcs-type
-                  :organization/name
-                  :organization/avatar-url
-                  :organization/current-user-is-admin?]
-                (:query ast)))
-        (and (= :circleci/organization (:key ast))
-             (= '[:organization/vcs-type
-                  :organization/name
-                  {:organization/projects [:project/follower-count
-                                           :project/vcs-url
-                                           :project/name
-                                           :project/parallelism
-                                           :project/oss?]}
-                  {:organization/plan [*]}]
-                (:query ast)))
-        (project-runs-ast? ast)
-        (let [{:keys [key children]} ast]
-          (and (= :circleci/run key)
-               (= 1 (count children))
-               (= :run/job (:key (first children)))
-               (= [:job/build :job/name]
-                  (:query (first children)))))
-        (and (= :circleci/organization (:key ast))
-             (= '[:organization/vcs-type :organization/name] (:query ast)))
-        (project-crumb-ast? ast)
-        (run-page-crumbs-ast? ast)
-        (let [{:keys [key query]} ast]
-          (and (= :circleci/run key)
-               (= [:run/id
-                   :run/name
-                   :run/status
-                   :run/started-at
-                   :run/stopped-at
-                   {:run/jobs [:job/id]}
-                   {:run/trigger-info [:trigger-info/vcs-revision
-                                       :trigger-info/subject
-                                       :trigger-info/body
-                                       :trigger-info/branch
-                                       {:trigger-info/pull-requests [:pull-request/url]}]}
-                   {:run/project [:project/name
-                                  {:project/organization [:organization/name
-                                                          :organization/vcs-type]}]}]
-                  query)))
-        (let [{:keys [key query]} ast]
-          (and (= :circleci/run key)
-               (= '[({:jobs-for-jobs [:job/id
-                                      :job/status
-                                      :job/started-at
-                                      :job/stopped-at
-                                      :job/name
-                                      :job/build]}
-                     {:< :run/jobs})
-                    ({:jobs-for-first [:job/id
-                                       :job/build
-                                       :job/name]}
-                     {:< :run/jobs})]
-                  query))))))
-
 (defmulti send* key)

 ;; This implementation is merely a prototype, which does some rudimentary
@@ -596,18 +497,11 @@
       (js/setTimeout #(send* [:remote (rest query)] cb)
                      ms-until-retried-run-retrieved))
     (doseq [expr query]
-      (if (resolvers-can-handle? expr)
-        (let [ch (resolve {:resolvers resolvers} [expr] (chan))]
-          (go-loop []
-            (when-let [novelty (<! ch)]
-              (cb novelty query)
-              (recur))))
-
-        (let [[expr cb] (de-alias-expression expr cb)
-              ast (om-parser/expr->ast expr)]
-          (cond
-            ;; :route/org-workflows
-            (org-runs-ast? ast) (get-org-runs ast cb query)))))))
+      (let [ch (resolve {:resolvers resolvers} [expr] (chan))]
+        (go-loop []
+          (when-let [novelty (<! ch)]
+            (cb novelty query)
+            (recur)))))))

 (defn send [remotes cb]
   (doseq [remote-entry remotes]


Allow tooling to explicitly clear the session cache, which is useful for certain reload workflows.

--- src/main/clojure/clara/rules/compiler.clj
+++ src/main/clojure/clara/rules/compiler.clj
@@ -942,6 +942,14 @@
 ;; Cache of sessions for fast reloading.
 (def ^:private session-cache (atom {}))

+(defn clear-session-cache!
+  "Clears the cache of reusable Clara sessions, so any subsequent sessions
+   will be re-compiled from the rule definitions. This is intended for use
+   by tooling or specialized needs; most users can simply specify the :cache false
+   option when creating sessions."
+  []
+  (reset! session-cache {}))
+
 (sm/defn mk-session*
   "Compile the rules into a rete network and return the given session."
   [productions :- [schema/Production]


Renames function and local vars

Renames function and local vars

--- src/expound/alpha.cljc
+++ src/expound/alpha.cljc
@@ -342,8 +342,7 @@
         {:keys [type spec-name val in]} (problem-parts problem opts)]
     (expected-str type spec-name val in problems opts)))

-;; TODO - rename to :problem/value-group
-(defmethod problem-group-str :value-group [_type spec-name val path problems opts]
+(defmethod problem-group-str :problem/value-group [_type spec-name val path problems opts]
   (let [problem (first problems)
         subproblems (:problems problem)
         {:keys [form in]} (problem-parts (first subproblems) opts)
@@ -498,24 +497,24 @@
   (walk/postwalk
    (fn [form]
      (if (and (map? form)
-              (= :value-group (:expound.spec.problem/type form))
+              (= :problem/value-group (:expound.spec.problem/type form))
               (= 1 (count (:problems form))))
        (first (:problems form))
        form))
    groups))

-(defn ^:private grouped-problems1 [problems]
+(defn ^:private groups [problems]
   (let [grouped-by-in-path (->> problems
                                 (group-by :expound/in)
                                 vals
                                 (map (fn [grp]
                                        (if (= 1 (count grp))
-                                         {:expound.spec.problem/type :value-group
-                                          :path-prefix (:expound/path (first grp))
-                                          :problems grp}
-                                         {:expound.spec.problem/type :value-group
-                                          :path-prefix (apply lcs1 (map :expound/path grp))
-                                          :problems grp}))))]
+                                         {:expound.spec.problem/type :problem/value-group
+                                          :path-prefix               (:expound/path (first grp))
+                                          :problems                  grp}
+                                         {:expound.spec.problem/type :problem/value-group
+                                          :path-prefix               (apply lcs1 (map :expound/path grp))
+                                          :problems                  grp}))))]

     (->> grouped-by-in-path
          (reduce
@@ -541,13 +540,13 @@
        "")
      (let [failure nil
            non-matching-value [:expound/value-that-should-never-match]
-           problems1 (grouped-problems1 (annotate-1*
-                                         failure
-                                         (map #(dissoc % :reason)
-                                              (map
-                                               #(dissoc % :expound.spec.problem/type)
-                                               problems))))]
-       (apply str (for [prob problems1]
+           problems (groups (annotate-1*
+                             failure
+                             (map #(dissoc % :reason)
+                                  (map
+                                   #(dissoc % :expound.spec.problem/type)
+                                   problems))))]
+       (apply str (for [prob problems]
                     (let [in (-> prob :expound/in)]
                       (expected-str (-> prob :expound.spec.problem/type) :expound/no-spec-name non-matching-value in [prob] opts))))))))

@@ -763,10 +762,10 @@
           ;; TODO - grab everything with let binding
           caller (:expound/caller explain-data')
           form (:expound/form explain-data')
-          problems1 (->> explain-data'
-                         :expound/problems
-                         grouped-problems1
-                         (safe-sort-by :expound/in paths/compare-paths))]
+          problems (->> explain-data'
+                        :expound/problems
+                        groups
+                        (safe-sort-by :expound/in paths/compare-paths))]

       (printer/no-trailing-whitespace
        (str
@@ -774,7 +773,7 @@
         (printer/format
          "%s%s\n%s %s %s\n"
          (apply str
-                (for [prob problems1]
+                (for [prob problems]
                   (str
                    (problem-group-str (-> prob :expound.spec.problem/type)
                                       (spec-name explain-data')
@@ -792,8 +791,8 @@
                        (str s "\n\n"))))))
          (ansi/color (section-label) :footer)
          (ansi/color "Detected" :footer)
-         (ansi/color (count problems1) :footer)
-         (ansi/color (if (= 1 (count problems1)) "error" "errors") :footer)))))))
+         (ansi/color (count problems) :footer)
+         (ansi/color (if (= 1 (count problems)) "error" "errors") :footer)))))))

 (defn ^:private minimal-fspec [form]
   (let [fspec-sp (s/cat


Refactored main to avoid double-parsing

Refactored main to avoid double-parsing

This was a necessary change after adding auditing, but now the main
function is getting a bit smelly. In the meantime, at least the facts
are only processed one time.

--- src/extracter/core.clj
+++ src/extracter/core.clj
@@ -67,10 +67,8 @@
     (md/facts->file facts fout-path)))

 (def cli-options
-  [["-o" "--out FILE" "The path to the output file"
-    :default "docs.{md,json}"]
-   ["-i" "--in PATH" "A path containing facts"
-    :default "facter/lib/facter"]
+  [["-o" "--out FILE" "The path to the output file"]
+   ["-i" "--in PATH" "A path containing facts"]
    ["-m" "--markdown" "Output markdown"
     :default true
     :flag true]
@@ -80,29 +78,28 @@
    ["-u" "--usage" "Print this help message"]]) ;; lein run -h shadows "help"

 (defn run-markdown
-  [path output]
-  (if (= output "docs.{md,json}")
-    (run-markdown path "docs.md")
-    (do (println "Scanning" path "for facts. Will output markdown to" output)
-        (path->md path output))))
+  [results output]
+  (do (println "Outputting markdown to:" output)
+      (md/facts->file results output)))

 (defn run-json
-  [path output]
-  (if (= output "docs.{md,json}")
-    (run-json path "docs.json")
-    (do (println "Scanning" path "for facts. Will output JSON to" output)
-        (->> path
-             transform-facts-in-dir
-             json/pretty-encode
-             (spit output)))))
+  [results output]
+  (println "Outputting JSON to:" output)
+  (->> results
+       json/pretty-encode
+       (spit output)))

 (defn -main
   [& args]
   (let [opts (cli/parse-opts args cli-options)
         {:keys [usage in out markdown json]} (:options opts)]
-    (cond
-     usage (print (:summary opts))
-     json (run-json in out)
-     markdown (run-markdown in out))
-    (println "Completed run. Beginning audit.")
-    (audit/find-missing in (transform-facts-in-dir in)))) ;; this is not optimal!
+    (if (and in out (or markdown json)) ;; if the input is sufficient
+      (do
+        (println "Processing files in:" in)
+        (let [results (transform-facts-in-dir in)]
+          (cond
+           json (run-json results out)
+           markdown (run-markdown results out))
+          (println "Completed run. Auditing...")
+          (audit/find-missing in results)))
+      (print (:summary opts))))) ;; if there's no clear directive, print usage info


Fix num-bins. Finally.

Fix num-bins. Finally.

--- src/forecast/parse.clj
+++ src/forecast/parse.clj
@@ -139,7 +139,7 @@
     (when (contains? args "--hist")
       (let [num-bins (if (= \- (-> params num-bins-location first))
                        5
-                       (read-string (second params)))]
+                       (read-string (num-bins-location params)))]
         (print-histogram num-bins)))
     ))


implemented upload slots

implemented upload slots

--- src/frontend/core.cljs
+++ src/frontend/core.cljs
@@ -3,6 +3,8 @@
 (defonce room-id (.getAttribute (. js/document (getElementById "roomid")) "data"))
 (defonce socket (js/io))
 (defonce current-sound-id "current-song")
+(defonce default-upload-slots 1)
+(defonce default-download-slots 1)
 (defonce app-state (atom {:signed-in? false
                           :messages []
                           :message-received? false
@@ -16,7 +18,11 @@
                           :current-track-id nil
                           :current-sound nil
                           :ball-being-dragged? false
-                          :upload-queue []}))
+                          :upload-queue []
+                          :upload-slots default-upload-slots
+                          :download-slots default-download-slots
+                          :num-of-uploads 0
+                          :num-of-downloads 0}))

 (enable-console-print!)

@@ -36,6 +42,8 @@
     false))

 (defn upload-file [file]
+  (swap! app-state assoc :num-of-uploads (+ 1 (:num-of-uploads @app-state)))
+
   (let [stream (.createStream js/ss)
         blob-stream (.createBlobReadStream js/ss file)]
     (println "File uploading!")
@@ -47,18 +55,23 @@

     (.on blob-stream "end"
       (fn []
+        (swap! app-state assoc :num-of-uploads (- (:num-of-uploads @app-state) 1))
+        (println "NUM OF UPLOADS NOW!" (:num-of-uploads @app-state))
         (if-not (empty? (:upload-queue @app-state))
           (let [next-file (first (:upload-queue @app-state))]
             (swap! app-state assoc :upload-queue (pop (:upload-queue @app-state)))
             (if-not (= next-file file)
-              (upload-file next-file))))))))
+              (if (> (:upload-slots @app-state) (:num-of-uploads @app-state))
+                (upload-file next-file)))))))))

 (.change (js/$ "#file-upload")
   (fn [e]
     (let [file (aget (.-files (.-target e)) 0)]
-      (swap! app-state assoc :upload-queue (conj (:upload-queue @app-state) file))
+      (swap! app-state assoc :upload-queue (vec (cons file (:upload-queue @app-state))))
+      (println "SHIT " (:num-of-uploads @app-state))
       (if (= 1 (count (:upload-queue @app-state)))
-        (upload-file file)))))
+        (if (> (:upload-slots @app-state) (:num-of-uploads @app-state))
+          (upload-file file))))))

 ; end stuff that should probably be cleaned up with react....


fixed hotjoin rendering

fixed hotjoin rendering

--- src/frontend/core.cljs
+++ src/frontend/core.cljs
@@ -266,7 +266,7 @@

     (swap! app-state assoc :track-id-hashes (js->clj room-track-id-map))
     (swap! app-state assoc :track-order (js->clj track-order))
-    (swap! app-state assoc :music-info (js->clj room-music-info))
+    (swap! app-state assoc :music-info (vec (map #(clj->js %1) (js->clj room-music-info))))

     (swap! app-state assoc :current-track-id current-track-id)
     (swap! app-state assoc :current-sound-id current-sound-id)


More examples to stress the Swagger support

--- spec/rooms.clj
+++ spec/rooms.clj
@@ -37,13 +37,16 @@
   {:start_at s/Inst
    :end_at   s/Inst
    :rating   (rs/with-description "Client's rating for their stay."
-                                  (s/maybe s/Int))})
+                                  (s/maybe (s/both
+                                             s/Int
+                                             (s/pred pos? 'non-negative))))})

 (rs/defschema ShowRoomResponse "A room within a hotel."
   {:number          s/Int
    :floor           s/Int
    :last_booked_at  (s/maybe s/Inst)
    :size            RoomSize
+   :meta            {s/Keyword s/Str}
    :booking_history [RoomBooking]})

 (def show-responses


mmm is no longer supported

mmm is no longer supported

--- src/overtone/device/midi/nanoKONTROL2.clj
+++ src/overtone/device/midi/nanoKONTROL2.clj
@@ -171,7 +171,8 @@
   determined by recording the sysex messages that the official Korg
   Kontrol Editor sends to perform this task.)

-  On OS X, this requires the mmj library to be installed and enabled."
+  On OS X, this is currently broken due to broken Java support for MIDI
+  sysex messages."
   [nko]
    (doseq [m [sysex-1 sysex-2 sysex-3 sysex-4 sysex-5 sysex-6]]
      (midi-sysex (:out nko) m)))


update figwheel

update figwheel

--- examples/todomvc/project.clj
+++ examples/todomvc/project.clj
@@ -18,7 +18,7 @@
                  #_[com.gfredericks/test.chuck "0.2.5"]]

   :plugins [[lein-cljsbuild "1.1.2"]
-            [lein-figwheel "0.5.0"]
+            [lein-figwheel "0.5.0-6"]
             #_[lein-doo "0.1.6"]]

   :clean-targets ^{:protect false} ["resources/public/js/compiled" "resources/private" "target"]


Tweak settings header style

Tweak settings header style

--- src/braid/core/client/ui/styles/mixins.cljs
+++ src/braid/core/client/ui/styles/mixins.cljs
@@ -152,6 +152,8 @@
     :margin (rem 1)
     :padding (rem 1)
     :border-radius (px 10)}
+   [:>h2
+    {:margin 0}]
    [:button (settings-button)]
    [:&.avatar
     [:>.upload


Removed useless required namespace.

Removed useless required namespace.

--- app/src/clj_web_example/routes.clj
+++ app/src/clj_web_example/routes.clj
@@ -1,6 +1,5 @@
 (ns clj-web-example.routes
   (:require [compojure.api.sweet :refer :all]
-            [schema.core :as s]
             [clj-web-example.ui.index :as index]
             [compojure.route :as route]
             [ring.util.response :as response]


(PE-3002) Use `doto`, change fn name to `run!`

Cleanup based on PR feedback.  Renamed `run` to `run!` to make it
more clear that it is only intended to be called for side
effects.

--- src/clj/puppetlabs/puppetserver/cli/gem.clj
+++ src/clj/puppetlabs/puppetserver/cli/gem.clj
@@ -8,19 +8,18 @@
   "Parses the command-line arguments using `puppetlabs.kitchensink.core/cli!`.
       --config <config file or directory>"
   [cli-args]
-  ;; TODO: schema
   (let [specs       [["-c" "--config CONFIG-PATH"
                       (str "Path to a configuration file or directory of configuration files. "
                            "See the documentation for a list of supported file types.")]]
         required    [:config]]
     (ks/cli! cli-args specs required)))

-(defn run
+(defn run!
   [config args]
-  (let [sc      (ScriptingContainer.)]
-    (.setArgv sc (into-array String args))
-    (.setEnvironment sc (hash-map "GEM_HOME" (get-in config [:jruby-puppet :gem-home])))
-    (.runScriptlet sc "load 'META-INF/jruby.home/bin/gem'")))
+  (doto (ScriptingContainer.)
+    (.setArgv (into-array String args))
+    (.setEnvironment (hash-map "GEM_HOME" (get-in config [:jruby-puppet :gem-home])))
+    (.runScriptlet "load 'META-INF/jruby.home/bin/gem'")))

 (defn load-tk-config
   [cli-data]
@@ -36,7 +35,7 @@
   (try+
     (let [[config extra-args help] (-> (or args '())
                                        (parse-cli-args!))]
-      (run (load-tk-config config) extra-args))
+      (run! (load-tk-config config) extra-args))
     (catch map? m
       (println (:message m))
       (case (ks/without-ns (:type m))


Use idents instead of raw color data in user faces

--- src/cljs/koeeoadi/components/userfaces.cljs
+++ src/cljs/koeeoadi/components/userfaces.cljs
@@ -34,10 +34,25 @@
 (defn face-remove [comp]
   (om/transact! comp `[(user-face/remove) :user-faces]))

+(defn color-change [comp color-type e]
+  (let [{face-name    :face/name}    (om/props comp)
+        {colors-by-id :colors/by-id} (om/get-computed comp)
+
+        value (util/target-value e)
+        color (if (= value "None")
+                nil
+                [:colors/by-id (.parseInt js/window
+                                 (util/target-value e))])]
+    (face-update comp {:face/name face-name
+                       color-type color})))
+
 (defn color-option [{:keys [color/rgb color/id] :as color} current-color]
   (let [selected? (= current-color color)]
-    (dom/option #js {:style #js {:backgroundColor rgb}
-                     :value id} rgb)))
+    (dom/option
+      #js {:style     #js {:backgroundColor rgb}
+           :selected  selected?
+           :value     id}
+      rgb)))

 (defui UserFace
   static om/Ident
@@ -93,27 +108,15 @@
         (dom/td nil
           (apply dom/select
             #js {:style    #js {:backgroundColor (or bg-rgb nil)}
-                 :onChange #(face-update this
-                              {:face/name     name
-                               :face/color-bg (get colors-by-id
-                                                     (.parseInt js/window
-                                                       (util/target-value %)))})}
-            (when-not bg-rgb
-              (dom/option #js {:selected true
-                               :disabled true} "Select a color"))
+                 :onChange #(color-change this :face/color-bg %)}
+            (dom/option #js {:value "None"} "None")
             (map #(color-option % color-bg) colors-list)))

         (dom/td nil
-          ;; TODO refactor with above
           (apply dom/select
             #js {:style    #js {:backgroundColor (or fg-rgb nil)}
-                 :onChange #(face-update this
-                              {:face/name     name
-                               :face/color-fg (get colors-by-id
-                                                     (.parseInt js/window
-                                                       (util/target-value %)))})}
-            (when-not fg-rgb
-              (dom/option #js {:selected true :disabled true} "Select a color"))
+                 :onChange #(color-change this :face/color-fg %)}
+            (dom/option #js {:value "None"} "None")
             (map #(color-option % color-fg) colors-list)))

         ;; BOLD


metabadge icon

metabadge icon

--- src/cljs/salava/metabadge/ui/metabadge.cljs
+++ src/cljs/salava/metabadge/ui/metabadge.cljs
@@ -14,27 +14,21 @@
        :handler (fn [data]
                   (reset! state data))})))

-  (defn init-metabadge-icon [id data-atom]
-    (ajax/GET
-      (path-for (str "/obpv1/metabadge/badge/info"))
-      {:params {:user_badge_id id}
-       :handler (fn [data] (reset! data-atom data))}))
-
-  #_(defn meta_icon [data-atom]
-    (let [{:keys [meta_badge meta_badge_req]} @data-atom
-          m (str meta_badge meta_badge_req)]
-      (case m
-        "truefalse" [:div {:title (t :metabadge/Amilestonebadge)}[:span [:i.link-icon {:class "fa fa-sitemap"}]]]
-        "truetrue" [:div {:title (t :metabadge/Partofamilestonebadge)} [:span [:i.link-icon {:class "fa fa-puzzle-piece"}]]]
-        "falsetrue" [:div {:title (t :metabadge/Partofamilestonebadge)} [:span [:i.link-icon {:class "fa fa-puzzle-piece"}]]]
-        nil)))
+(defn init-metabadge-icon [id data-atom]
+  (ajax/GET
+    (path-for (str "/obpv1/metabadge/badge/info"))
+    {:params {:user_badge_id id}
+     :handler (fn [data] (reset! data-atom data))}))

 (defn meta_icon [meta_badge meta_badge_req]
-    (cond
-      (and (blank? meta_badge) (blank? meta_badge_req)) nil
-      (and (= "NULL" meta_badge) (not (blank? meta_badge_req))) [:div {:title (t :metabadge/Partofamilestonebadge)} [:span [:i.link-icon {:class "fa fa-puzzle-piece"}]]]
-      (and (and (not= "NULL" meta_badge) (not (blank? meta_badge))) (blank? meta_badge_req)) [:div {:title (t :metabadge/Amilestonebadge)}[:span [:i.link-icon {:class "fa fa-sitemap"}]]]
-      (and (or (not= "NULL" meta_badge) (not (blank? meta_badge))) (not (blank? meta_badge_req))) [:div {:title (t :metabadge/Partofamilestonebadge)} [:span [:i.link-icon {:class "fa fa-puzzle-piece"}]]]))
+  (let [is_milestone? (and (not= "NULL" meta_badge) (not (blank? meta_badge)))
+        is_required? (not (blank? meta_badge_req))
+        string (str is_milestone? is_required?)]
+    (case string
+      "truefalse" [:div {:title (t :metabadge/Amilestonebadge)}[:span [:i.link-icon {:class "fa fa-sitemap"}]]]
+      "truetrue" [:div {:title (t :metabadge/Partofamilestonebadge)} [:span [:i.link-icon {:class "fa fa-puzzle-piece"}]]]
+      "falsetrue" [:div {:title (t :metabadge/Partofamilestonebadge)} [:span [:i.link-icon {:class "fa fa-puzzle-piece"}]]]
+      nil)))

   (defn current-badge [required_badges current-badge-id]


more on macro

more on macro

--- src/language/macro.clj
+++ src/language/macro.clj
@@ -162,21 +162,155 @@

 ;quote, unquote, unquote-splicing are all functions.

-;we can see what these 'functions' actually do by quote them to stop the return forms evaluated
+;we can see what these 'functions' actually do by quoting them to stop the return forms evaluated
 '`(map println ~[foo])

-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+;you cannot let a qualified x
+
+(defmacro incorrect-let
+  [& body]
+  `(let [x 3]
+     ~@body))
+
+;(incorrect-let (println ":x" x));cannot be evaluated for you cannot let qualified name.
+
+;we would take some clever roundabout ways to solve this problem
+
+(defmacro unhygiene-let
+  [& body]
+  `(let [~'x 3]
+     ~@body))
+
+;however, this has a macro hygiene problem
+
+(let [x 4]
+  (unhygiene-let (println ":x" x)))
+
+;here is the problem, the code calls macro does not know the macro returns form bingding x to another value
+
+
+(macroexpand-1 '(unhygiene-let (println ":x" x)))
+
+
+(defmacro hello
+  [a]
+  `(let [~'x 3]
+     (concat [x] [~a])))
+
+(unhygiene-let (println "x:" x))
+
+(eval `(let [~'x 3] ~'(println "x:" x)))
+
+(defmacro abc
+  [x]
+  (println (name x)))
+
+(symbol? (gensym))
+
+(gensym "hahaha")
+
+
+(defmacro hygienic
+  [& body]
+  (let [sym (gensym)]
+    `(let [~sym :macro-value]
+       ~@body
+       ~sym)))
+
+(let [x :important]
+  (hygienic (println "x:" x)))
+
+;this makes macro safe, we can use auto-gensym to make it more simple
+
+(defmacro hygeienic
+  [& body]
+  `(let [x# :macro-value]
+     ~@body
+     x#))
+
+(let [x :important]
+ (hygeienic (println "x:" x)))
+
+;auto-gensym under same syntax quote expand to same actual symbol
+
+(defmacro auto-gensyms
+  [& numbers]
+  `(let [x# (rand-int 10)]
+     (+ x# ~@numbers)))
+
+(auto-gensyms 1 2 3 4)
+
+(macroexpand-1 `(auto-gensyms 1 2 3 4))
+
+;however, to unify gensyms in multiple syntax quote, we go back to use (gensym)
+
+(defmacro our-doto
+  [expr & forms]
+  (let [obj (gensym "obj")]
+    `(let [~obj ~expr]
+     ~@(map (fn [[f & args]]
+              (list* f obj args))
+            forms)
+     ~obj)))
+
+(our-doto "It works"
+   (println "hahahah")
+   (println "wagagaga"))
+
+;user picked names
+
+(defmacro with
+  [name & body]
+  `(let [~name 5]
+     ~@body))
+
+(with kala (+ kala 10))
+(with yukun (+ yukun 250))
+
+;double evaluation problem
+
+(defmacro spy
+  [x]
+  `(do
+     (println "spied" '~x ~x)
+     ~x))
+
+
+
+(spy 3);this is ok
+(spy (rand-int 10));this is terrible
+
+(macroexpand-1 '(spy (rand-int 10)))
+
+; to solve this, include a gensym all the time when argument appears more than once
+
+(defmacro spy
+  [x]
+  `(let [x# ~x]
+     (println "spied" '~x x#)
+     x#))
+
+(macroexpand-1 '(spy (rand-int 10)))
+
+(spy (rand-int 10))
+
+;double evaluation may hint that your macro done jobs that can be extracted into a function
+
+
+(defn spy-helper
+  [expr value]
+  (println "spied" expr value))
+
+(defmacro spy
+  [x]
+  `(spy-helper '~x ~x))
+
+(spy (rand-int 10))
+
+
+;;;;;;;;;;;tips;;;;;;;;;;;;
+
+(list* 1 2 [4 5])
+(list 1 2 [4 5])
+
+


Just stop using goblocks in the worker for now

--- src/lazubot/worker.clj
+++ src/lazubot/worker.clj
@@ -1,6 +1,6 @@
 (ns lazubot.worker
   (:require [clojail.core :refer [sandbox]]
-            [clojure.core.async :refer [>! <! go go-loop chan sliding-buffer]]
+            [clojure.core.async :refer [>!! <!! chan sliding-buffer]]
             [com.keminglabs.zmq-async.core :refer [register-socket!]]))

 (def sb (sandbox [])) ;; sandbox without any testers, only using timeout capability
@@ -10,12 +10,7 @@
         [reply-in reply-out] (repeatedly 2 #(chan (sliding-buffer 64)))]
     (register-socket! {:in reply-in :out reply-out :socket-type :rep
                        :configurator (fn [socket] (.bind socket addr))})
-    (go-loop []
-             (let [message (<! reply-out)]
-               (println (str "got " message))
-               (>! reply-in message)
-               (recur)))
     (println "Worker initialized")
-    (loop []
-      (Thread/sleep 5)
+    (when-let [message (<!! reply-out)]
+      (>!! reply-in message)
       (recur))))


Fixed error displaying if no :min-lein-version is specified.

--- src/leiningen/core.clj
+++ src/leiningen/core.clj
@@ -206,7 +206,8 @@
      (let [task-name (or (@aliases task-name) task-name "help")
            project (if (.exists (File. "project.clj")) (read-project))
            compile-path (:compile-path project)]
-       (verify-min-version project)
+       (if-not (nil? (:min-lein-version project))
+                     (verify-min-version project))
        (user-init project)
        (when compile-path (.mkdirs (File. compile-path)))
        (binding [*compile-path* compile-path]


Add code on 'build-deps path to 'ensure-repo.

--- src/leiningen/voom.clj
+++ src/leiningen/voom.clj
@@ -279,10 +279,14 @@
   "Build and install given artifact using git. Return value is
   undefined. Throws an exception with detailed message if artifact
   cannot be resolved."
-  [old-exception {:keys [artifactId version] :as art}]
+  [old-exception proj {:keys [groupId artifactId version] :as art}]

   (if-let [vmap (ver-parse version)]
-    (let [prjs (find-matching-projects voom-repos (merge vmap art))]
+    (let [dep-entry [(symbol groupId artifactId) version]
+          dep (first (filter #(= dep-entry %) (:dependencies proj)))
+          dep-meta-repo (-> dep meta :voom :repo)
+          _ (when dep-meta-repo (ensure-repo dep-meta-repo))
+          prjs (find-matching-projects voom-repos (merge vmap art))]
       (when (empty? prjs)
         (throw (ex-info (str "No project found for " artifactId " " version
                              " (Hint: might need to clone a new repo into "
@@ -316,7 +320,7 @@
         ;; the real cause of failure we have to dig for it:
         (if-let [arts (seq (missing-artifacts-from-exception e))]
           (doseq [art arts]
-            (resolve-artifact e art))
+            (resolve-artifact e non-dev-proj art))
           (throw e))))))

 (defn build-deps


eliminated the have-to pred from the verb have

--- src/babel/english/lexicon-verbcoach.clj
+++ src/babel/english/lexicon-verbcoach.clj
@@ -904,7 +904,6 @@
            ;; modal: "have to + VP"
            ;; TODO: if used without infinitive VP, conjugates as "have" but should be "have to".
            {:synsem {:cat :verb
-                     :sem {:pred :have-to}}
             :english {:present {:3sing "has"}
                       :past "had"}
             :modal-with :infinitive}]


wash-oneself: {:subj {:living true}}

wash-oneself: {:subj {:living true}}

--- src/babel/encyclopedia.cljc
+++ src/babel/encyclopedia.cljc
@@ -548,6 +548,9 @@

         {:pred :wash
          :subj {:human true}}
+
+        {:pred :wash-oneself
+         :subj {:living true}}

         {:pred :win
          :subj {:human true}


Add possibility to create new context in GUI directly

Signed-off-by: Daniel Borchmann <25857343a15bf1edafebc2912e82ecf775c585c1@mailbox.tu-dresden.de>

--- src/conexp/contrib/gui/editors/contexts.clj
+++ src/conexp/contrib/gui/editors/contexts.clj
@@ -40,10 +40,10 @@

 (defn- load-context-and-go
   "Loads context with given loader and adds a new tab with a context-editor."
-  [frame loader]
+  [frame]
   (when-let [^File file (choose-open-file frame)]
     (let [path (.getPath file),
-          thing (loader path)]
+          thing (read-context path)]
       (add-tab frame
                (make-context-editor thing)
                (str "Context " path)))))
@@ -55,13 +55,12 @@
     (clone-context-view-from-panel (current-tab frame))
     (str (current-tab-title frame) "*")))

-(defn- random-context-and-go
-  "Creates a random context and adds a new tab with a context-editor."
-  [frame]
-  (let [thing (rand-context #{"a" "b" "c" "d" "e" "f"} #{1 2 3 4 5 6} 0.4)]
-    (add-tab frame
-             (make-context-editor thing)
-             "Context")))
+(defn- context-and-go
+  "Opens given context in a new context editor tab."
+  [frame context]
+  (add-tab frame
+           (make-context-editor context)
+           "Context"))

 (defn- second-op-context-and-go
   "Show the current second operand context in a new tab."
@@ -92,10 +91,14 @@

 (defvar- context-menu
   {:name "Context",
-   :content [{:name "Load Context",
-              :handler #(load-context-and-go % read-context)},
+   :content [{:name "New Context",
+              :handler #(context-and-go % (make-context (set-of-range 10)
+                                                        (set-of-range 10)
+                                                        #{}))},
+             {:name "Load Context",
+              :handler load-context-and-go},
              {:name "Random Context",
-              :handler random-context-and-go},
+              :handler #(context-and-go % (rand-context 5 5 0.4))},
              {:name "Second Operand Context",
               :handler second-op-context-and-go},
              {}


Optimize spec lookup

Optimize spec lookup

--- src/bluebell/utils/ebmd.clj
+++ src/bluebell/utils/ebmd.clj
@@ -175,15 +175,11 @@
       ::reg-counter))

 (defn unwrap-reg-value [x]
-  (let [v (spec/conform ::reg-value x)
-        _ (when (= ::spec/invalid v)
-            (throw (ex-info "Invalid reg-value"
-                            {:reg-value x})))
-        [type parsed] v]
-    (case type
-      :indirect (:ref x)
-      :arg-spec x
-      :empty (throw (ex-info "Empty arg-spec encountered" {})))))
+  {:pre [(v? ::reg-value x)]}
+  (cond
+    (contains? x :pred) x
+    (contains? x :ref) (:ref x)
+    :default (throw (ex-info "Empty arg-spec encountered" {}))))

 (defn look-up-reg [k]
   (get (deref arg-spec-registry) k))


When opening app get a list of allowable interfaces

For example if an app can have its database schema edited then it
returns the "edit.my.database" interface and the default application
which implements this interface

--- src/webapp/framework/server/systemfns.clj
+++ src/webapp/framework/server/systemfns.clj
@@ -2264,19 +2264,30 @@

-
 (defn !getfilecontents [{:keys [id  app-session-id]}]
   (if id
-    (let [content-records   (cond
-                              (= *database-type* "postgres" )
-                              (sql-1 "select  application_code as ac from appshare_applications where id = ?" [id])
-
-                              (= *database-type* "oracle" )
-                              (sql-1 "select  dbms_lob.substr( application_code, 3000, 1 ) as ac, dbms_lob.substr( application_code, 3000, 3001 ) as ac2 from appshare_applications where id = ?" [id]))
-
-          content           (str (get content-records :ac) (get content-records :ac2))
-
-          schema-id         (:fk_appshare_schema_id (sql-1 "select  fk_appshare_schema_id  from  appshare_application_schemas  where  application_environment = 'DEV' and fk_appshare_application_id = ?"  [id]))
+    (let [content-records      (cond
+                                 (= *database-type* "postgres" )
+                                 (sql-1 "select  application_code as ac from appshare_applications where id = ?" [id])
+
+                                 (= *database-type* "oracle" )
+                                 (sql-1 "select  dbms_lob.substr( application_code, 3000, 1 ) as ac, dbms_lob.substr( application_code, 3000, 3001 ) as ac2 from appshare_applications where id = ?" [id]))
+
+          content              (str (get content-records :ac) (get content-records :ac2))
+
+          schema-id            (:fk_appshare_schema_id (sql-1 "select  fk_appshare_schema_id  from  appshare_application_schemas  where  application_environment = 'DEV' and fk_appshare_application_id = ?"  [id]))
+
+          int-sql              (sql "select interface_name from appshare_application_can_call_interface where  fk_application_id = ?" [id])
+          interfaces-list      (map  :interface_name  int-sql)
+
+          get-default-app-fn   (fn [interface-name]
+                                 {interface-name
+                                  (:fk_default_interface_application_id
+                                    (sql-1 "select   fk_default_interface_application_id   from   appshare_interfaces   where   interface_name  =   ?" [interface-name]))})
+
+          enriched-interfaces  (reduce merge (map get-default-app-fn  interfaces-list))
+
+          can-use-interfaces   enriched-interfaces
           ]

       (do
@@ -2294,7 +2305,7 @@
           (do
             (sql "update  appshare_web_sessions  set fk_appshare_schema_id = NULL  where  session_id = ?"  [app-session-id])))

-        {:value content}))
+        {:value content :can-use-interfaces can-use-interfaces }))

     {:value "" :error "No content"}
     ))


(TK-23) Get rid of unnecessary calls to `true?`

--- test/clj/puppetlabs/trapperkeeper/services/webserver/jetty9_service_test.clj
+++ test/clj/puppetlabs/trapperkeeper/services/webserver/jetty9_service_test.clj
@@ -203,11 +203,11 @@
     ; should default to 'need' to validate the client certificate.  In this
     ; case, the validation should fail because the client is providing a
     ; certificate which the CA cannot validate.
-    (is (true? (ssl-exception-thrown?
-                 (validate-ring-handler
-                   "https://localhost:8081"
-                   jetty-ssl-pem-config
-                   unauthorized-pem-options-for-https)))))
+    (is (ssl-exception-thrown?
+          (validate-ring-handler
+            "https://localhost:8081"
+            jetty-ssl-pem-config
+            unauthorized-pem-options-for-https))))

   (testing "ring request over SSL fails with the server's client-auth setting
             not set and the client configured to not provide a certificate"
@@ -215,37 +215,37 @@
     ; should default to 'need' to validate the client certificate.  In this
     ; case, the validation should fail because the client is not providing a
     ; certificate
-    (is (true? (ssl-exception-thrown?
-                 (validate-ring-handler
-                   "https://localhost:8081"
-                   jetty-ssl-pem-config
-                   (dissoc default-options-for-https-client :ssl-cert :ssl-key))))))
+    (is (ssl-exception-thrown?
+          (validate-ring-handler
+            "https://localhost:8081"
+            jetty-ssl-pem-config
+            (dissoc default-options-for-https-client :ssl-cert :ssl-key)))))

   (testing "ring request over SSL fails with a server client-auth setting
             of 'need' and the client configured to provide a certificate which
             the CA cannot validate"
-    (is (true? (ssl-exception-thrown?
-                 (validate-ring-handler
-                   "https://localhost:8081"
-                   jetty-ssl-client-need-config
-                   unauthorized-pem-options-for-https)))))
+    (is (ssl-exception-thrown?
+          (validate-ring-handler
+            "https://localhost:8081"
+            jetty-ssl-client-need-config
+            unauthorized-pem-options-for-https))))

   (testing "ring request over SSL fails with a server client-auth setting
             of 'need' and the client configured to not provide a certificate"
-    (is (true? (ssl-exception-thrown?
-                 (validate-ring-handler
-                   "https://localhost:8081"
-                   jetty-ssl-client-need-config
-                   (dissoc default-options-for-https-client :ssl-cert :ssl-key))))))
+    (is (ssl-exception-thrown?
+          (validate-ring-handler
+            "https://localhost:8081"
+            jetty-ssl-client-need-config
+            (dissoc default-options-for-https-client :ssl-cert :ssl-key)))))

   (testing "ring request over SSL fails with a server client-auth setting
             of 'want' and the client configured to provide a certificate which
             the CA cannot validate"
-    (is (true? (ssl-exception-thrown?
-                 (validate-ring-handler
-                   "https://localhost:8081"
-                   jetty-ssl-client-want-config
-                   unauthorized-pem-options-for-https))))))
+    (is (ssl-exception-thrown?
+          (validate-ring-handler
+            "https://localhost:8081"
+            jetty-ssl-client-want-config
+            unauthorized-pem-options-for-https)))))

 (deftest crl-success-test
   (testing (str "ring request over SSL succeeds when no client certificates "
@@ -270,14 +270,14 @@
 (deftest crl-failure-test
   (testing (str "ring request over SSL fails when the client certificate has "
                 "been revoked")
-    (is (true? (ssl-exception-thrown?
-                 (validate-ring-handler
-                   "https://localhost:8081"
-                   (assoc-in
-                     jetty-ssl-client-need-config
-                     [:webserver :ssl-crl-path]
-                     "./dev-resources/config/jetty/ssl/crls/crls_localhost_revoked.pem")
-                   default-options-for-https-client)))))
+    (is (ssl-exception-thrown?
+          (validate-ring-handler
+            "https://localhost:8081"
+            (assoc-in
+              jetty-ssl-client-need-config
+              [:webserver :ssl-crl-path]
+              "./dev-resources/config/jetty/ssl/crls/crls_localhost_revoked.pem")
+            default-options-for-https-client))))

   (testing (str "jetty throws startup exception if non-CRL PEM is specified "
                 "as ssl-crl-path")


Extract query prefixes

Extract query prefixes

--- src/clj/sparqlab/sparql.clj
+++ src/clj/sparqlab/sparql.clj
@@ -232,6 +232,11 @@
      :query-string (serialize-query parsed-query)
      :query-type (get-query-type parsed-query)}))

+(defn query-prefixes
+  "Get namespace prefixes from `query` as a map."
+  [^Query query]
+  (into {} (.. query getPrefixMapping getNsPrefixMap)))
+
 (defn select-query
   "Execute SPARQL SELECT `query` on the `model`."
   [^Model model


Add repeating-lineage-meta-error

Add repeating-lineage-meta-error

--- src/clojush/meta_errors.clj
+++ src/clojush/meta_errors.clj
@@ -148,6 +148,19 @@
         (if (> (/ (count (distinct hist))
                   (count hist))
                1/2)
+          0
+          1)))))
+
+(defn repeating-lineage-meta-error
+  [ind evaluated-population argmap]
+  (if (not (:print-history argmap))
+    (throw
+     (Exception.
+      ":print-history must be true for :repeating-lineage"))
+    (let [hist (:history ind)]
+      (if (< (count hist) 2)
+        0
+        (if (apply distinct? hist)
           0
           1)))))


Fixed mistyped config name.

Fixed mistyped config name.

--- src/cmr/transmit/config.clj
+++ src/cmr/transmit/config.clj
@@ -9,7 +9,7 @@
   [s]
   (Long. s))

-(def metadata-db-port (cfg/config-value-fn :metadata-db-host 3001 parse-port))
+(def metadata-db-port (cfg/config-value-fn :metadata-db-port 3001 parse-port))

 (def ingest-port (cfg/config-value-fn :ingest-port 3002 parse-port))