Merge branch 'master' of https://github.com/active-group/active-clojure

Author: dfrese

.gitignore

@@ -7,4 +7,5 @@ pom.xml.asc
 *.class
 /.lein-*
 /.nrepl-port
+/.cljs_rhino_repl
 *~

README.md

@@ -12,7 +12,7 @@ The `active.clojure.record` namespace implements a
 
 ### Records (Spec)
 
-The `active.clojure.record` namespace implements a
+The `active.clojure.record-spec` namespace implements a
 `define-record-type` form similar to Scheme's [SRFI
 9](http://srfi.schemers.org/srfi-9/) (similar to `active.clojure.record`).
 
@@ -38,11 +38,13 @@ Example:
 ```
 
 This defines the following Specs (aside from what the regular 
-`active.cloujre.record`s already define):
+`active.clojure.record`s already define):
 
-* `::card` a Spec which conforms values that are instances of a card (see 
+* `::card`, a Spec which conforms values that are instances of a card (see 
   example below).
-* Specs for accessors.
+* Specs `::card-number` and `::card-color` for accessors. Note that these names
+  are **not** based on the given accessor names but rather a concatenation of
+  the record type and field names.
 * Spec for the constructor function.
 
 ```clojure
@@ -118,7 +120,7 @@ tools such as a macro `pret` that prints and returns its argument.
 
 ### Pattern Matching
 
-The `active.clojure.match` namespaces provides some syntactic sugar
+The `active.clojure.match` namespace provides some syntactic sugar
 for map matching around `core.match`.
 
 ## License

project.clj

@@ -1,15 +1,15 @@
-(defproject active-clojure "0.23.0-SNAPSHOT"
+(defproject active-clojure "0.27.0-SNAPSHOT"
   :description "Active Clojure: Various Clojure utilities in use at Active Group"
   :url "http://github.com/active-group/active-clojure"
   :license {:name "Eclipse Public License"
             :url "http://www.eclipse.org/legal/epl-v10.html"}
-  :dependencies [[org.clojure/clojure "1.9.0-RC1"]
-                 [io.aviso/pretty "0.1.24"]
-                 [org.clojure/core.match "0.3.0-alpha4"]
+  :dependencies [[org.clojure/clojure "1.9.0"]
+                 [io.aviso/pretty "0.1.34"]
+                 [org.clojure/core.match "0.3.0-alpha5"]
                  [org.clojure/test.check "0.10.0-alpha2"]]
 
   :generated-paths ["target"]
-    
+
   :clean-targets ^{:protect false} [:generated-paths]
 
   :cljsbuild {:builds
@@ -22,17 +22,24 @@
                       :compiler {:output-to "target/test.js"
                                  ;; this fixes an error from doo
                                  :output-dir "target"
-                                 :source-map "target/test.map"
                                  :main active.clojure.test-runner
-                                 :optimizations :whitespace
+                                 :optimizations :whitespace  ;; This is required for testing with nashorn.
                                  :pretty-print true}}}}
 
-  :profiles {:dev {:dependencies [[lein-doo "0.1.6"]]}
-             :cljs {:dependencies [[org.clojure/clojurescript "1.9.293"]]}}
+  :profiles {:cljs {:dependencies [[org.clojure/clojurescript "1.10.238"]
+                                   [com.cemerick/piggieback "0.2.2"]
+                                   [org.clojure/tools.nrepl "0.2.10"]
+                                   [doo "0.1.10"]]
+                    ;; run CLJS repl with
+                    ;; lein with-profile cljs repl
+                    ;; (cemerick.piggieback/cljs-repl (cljs.repl.rhino/repl-env))
+                    :repl-options {:nrepl-middleware [cemerick.piggieback/wrap-cljs-repl]}}}
 
-  :aliases {"test-nashorn" ["with-profile" "cljs" "doo" "nashorn" "test"]}
+  :aliases {"test-nashorn" ["with-profile" "cljs" "doo" "nashorn" "test"]
+            "test-phantom" ["with-profile" "cljs" "doo" "phantom" "test"]
+            }
 
-  :plugins [[lein-cljsbuild "1.1.3"]
-            [lein-doo "0.1.6"]]
+  :plugins [[lein-cljsbuild "1.1.7"]
+            [lein-doo "0.1.10"]]
 
   :global-vars {*warn-on-reflection* true})

src/active/clojure/condition.cljc

@@ -1,4 +1,5 @@
-(ns ^{:doc "Conditions, protocol for communicating the causes of exceptions.
+(ns active.clojure.condition
+  "Conditions, protocol for communicating the causes of exceptions.
 
   This provides infrastructure for building *condition* objects.
   A condition object provides information about the cause of an exception.
@@ -12,9 +13,8 @@
 
   Condition objects are represented as specially marked `ex-info` objects.
 
-  One notable difference to the R6RS design is that there is no user-facing type for 
-  'simple conditions', nor are they regular records."}
-  active.clojure.condition
+  One notable difference to the R6RS design is that there is no user-facing type for
+  'simple conditions', nor are they regular records."
   (:refer-clojure :exclude (assert))
   #?(:clj (:require [clojure.core :as core] ; get assert back
                     [clojure.stacktrace :as stack]
@@ -66,7 +66,7 @@
     (print-condition exc w)
     (.write w (str "clojure.lang.ExceptionInfo: " (.getMessage exc) " " (str (ex-data exc)))))))
 
-(defn ^:private ex-info-msg 
+(defn ^:private ex-info-msg
   [namespace]
   (str "This is a " namespace " active.clojure.condition."))
 
@@ -376,7 +376,7 @@
 
   For internal use."
   [?base ?who ?message ?irritants]
-  `(let [g# (group-by (fn [thing#] (or (condition? thing#) (instance? Throwable thing#))) ~?irritants)
+  `(let [g# (group-by (fn [thing#] (or (condition? thing#) (if-cljs (instance? js/Error thing#) (instance? Throwable thing#)))) ~?irritants)
          irritants# (get g# false)
          conditions# (get g# true)
          who# ~?who]
@@ -387,7 +387,7 @@
                    (and (not-empty irritants#) (make-irritants-condition irritants#))
                    conditions#)))))
 
-(defn error 
+(defn error
   "Throw an exception that signals that an error has occurred.
 
   This function should be called when an error has occurred,
@@ -502,7 +502,7 @@
   "Return a keyword describing the type,
   a symbol or string describing the source of the problem, an error
   message or nil, and a sequence of other objects describing the
-  problem.  
+  problem.
 
   Valid type symbols include: `:error`, `:assertion-violation`,
   `:violation`, `:serious`."
@@ -625,4 +625,3 @@
         (print spaces)
         (pr irritant))
       (print "\n")))))
-

src/active/clojure/config.cljc

@@ -24,17 +24,25 @@ settings that can be mixed in, like so:
 
 Each profile has the same format as the top-level configuration itself
   (sans the `:profiles` key)."
-  #?(:cljs (:require-macros [active.clojure.record :refer (define-record-type)]))
-  (:require [clojure.set :as set]
-            [active.clojure.condition :as c]
-            #?(:cljs [active.clojure.record])
-            #?(:clj [active.clojure.record :refer :all]))
-  #?(:clj (:import [java.net URL])))
+  (:refer-clojure :exclude [boolean?])
+  #?@
+   (:clj
+    [(:require
+      [active.clojure.condition :as c]
+      [active.clojure.record :refer :all]
+      [clojure.set :as set])
+     (:import java.net.URL)]
+    :cljs
+    [(:require [active.clojure.condition :as c]
+               [clojure.set :as set]
+               active.clojure.record)
+     (:require-macros
+      [active.clojure.record :refer [define-record-type]])]))
 
 ;; TODO
 ;; - provide better support for reaching inside of collection ranges
 
-(define-record-type 
+(define-record-type
   ^{:doc "Description of a range of values."}
   ValueRange ; used to be called Range, but conflicts with cljs.core/->Range
   (^{:doc "Make a [[Range]] range object.
@@ -185,7 +193,7 @@ Each profile has the same format as the top-level configuration itself
 (defn nonempty-string-range
   "Range for a non-empty string with optional max length."
   [& [max-length]]
-  (make-scalar-range (str "non-empty string" (if (some? max-length) 
+  (make-scalar-range (str "non-empty string" (if (some? max-length)
                                                (str " with maximum length of " max-length)
                                                ""))
                      (fn [range path val]
@@ -351,7 +359,7 @@ Each profile has the same format as the top-level configuration itself
                 (fn [this-range ky vl] ; we need the key & val functions
                   (cond
                    (nil? vl) {}
-                   
+
                    (map? vl)
                    (loop [kvs (seq vl)
                           ret {}]
@@ -366,7 +374,7 @@ Each profile has the same format as the top-level configuration itself
                           :else (recur (next kvs)
                                        (assoc ret k v))))
                        ret))
-                   
+
                    :else (make-range-error this-range ky vl))))
               (fn [this-range path f res val]
                 (let [v ((range-completer this-range) this-range path val)]
@@ -388,7 +396,6 @@ Each profile has the same format as the top-level configuration itself
                                  (string? val) val
                                  ;; FIXME: more cases?
                                  :else (make-range-error range path val))))))
-                 
 
 ;; Schemas
 
@@ -497,7 +504,7 @@ Each profile has the same format as the top-level configuration itself
           settings (map-schema-settings-map schema)
           sections (map-schema-sections-map schema)]
       (c/assert (not (range-error? cmap)) (pr-str cmap))
-      (reduce (fn [res [k v]]                            
+      (reduce (fn [res [k v]]
                 (if-let [setting (get settings k)]
                   ((range-reduce (setting-range setting))
                    (setting-range setting)
@@ -590,15 +597,15 @@ Each profile has the same format as the top-level configuration itself
                   val1 (get c1 key)
                   val2 (get c2 key)]
               (if (contains? settings-map key)
-                (recur (assoc c 
+                (recur (assoc c
                               ;; that `nil` is a valid value
-                              key 
+                              key
                               (if (contains? c2 key)
                                 val2
                                 val1))
                        (next all-keys))
                 (if-let [section (get sections-map key)]
-                  (recur (assoc c key 
+                  (recur (assoc c key
                                 (merge-config-objects-sans-profiles (section-schema section) (conj (vec path) key) (or val1 {}) (or val2 {})))
                          (next all-keys))
                   (c/error `merge-config-objects-sans-profiles
@@ -616,7 +623,7 @@ Each profile has the same format as the top-level configuration itself
         (c/error `merge-config-objects-sans-profiles
                  (str "configuration at " path " is not a sequence: " (pr-str c2))
                  path c2))
-      
+
       (concat c1 c2))))
 
 (defn merge-config-objects
@@ -639,7 +646,7 @@ Each profile has the same format as the top-level configuration itself
     (let [config-object (dissoc config-object :profiles)
           profiles (map (fn [n]
                           (or (profile-map n)
-                              (c/error `apply-profiles "profile does not exist" n)))                              
+                              (c/error `apply-profiles "profile does not exist" n)))
                         profile-names)]
       (reduce (partial merge-config-objects-sans-profiles schema []) config-object profiles))
     config-object))
@@ -666,7 +673,7 @@ Each profile has the same format as the top-level configuration itself
                (vals settings-map))))
 
 (defn check-section
-  [section val inherited-map path] 
+  [section val inherited-map path]
   (normalize&check-config-object-internal (section-schema section)
                                           val
                                           inherited-map
@@ -747,7 +754,7 @@ Each profile has the same format as the top-level configuration itself
                 (recur (+ 1 idx)
                        (rest els)
                        (conj! res r))))))))))
-  
+
 (defn normalize&check-config-object
   "Normalize and check the validity of a configuration object.
 
@@ -833,7 +840,7 @@ Each profile has the same format as the top-level configuration itself
                       [])]
       (concat triples-common triples-1 triples-2))))
 
-    
+
 (defn diff-configurations
   "Returns sequence of triples [path-vectors version-1 version-2] of settings that differ."
   [schema config-1 config-2]
@@ -861,7 +868,7 @@ Each profile has the same format as the top-level configuration itself
                             (cond
                               (map-schema? schema)
                               (recurse (rest sections) cf)
-                              
+
                               (sequence-schema? schema)
                               (map (fn [subcf]
                                      (schemarec (sequence-schema-element-schema schema)
@@ -906,4 +913,3 @@ Each profile has the same format as the top-level configuration itself
 the remainder of the lines the field holds \".\"."
   [r]
   (any-range (one-of-range #{"."} nil) r))
-

src/active/clojure/debug.clj

@@ -1,7 +1,7 @@
 (ns active.clojure.debug)
 
-(defmacro pret [x] 
+(defmacro pret [x]
   "Print and return the argument."
-  `(let [x# ~x] 
-     (println x#) 
+  `(let [x# ~x]
+     (println x#)
      x#))

src/active/clojure/lens.cljc

@@ -1,51 +1,37 @@
 (ns active.clojure.lens)
 
-(defprotocol Lens
-  "Protocol for types that can be used as a lens, defined by a
-   function to yank some value out of a given data value, and a function
-   to shove an updated value back in."
-  (-yank [lens data])
-  (-shove [lens data v]))
-
 ;; TODO document lens laws
 
 (defn yank
   "Yank a value from the given data value, as defined by the given
    lens."
   [data lens]
-  (-yank lens data))
+  (lens data))
 
 (defn shove
   "Shove a new value v into the given data value, as defined by the
    given lens, and return the updated data structure."
   [data lens v]
-  (-shove lens data v))
-
-;; Keywords are lenses over a map (or object), focusing on the value associated with that keyword.
-(extend-type #?(:clj clojure.lang.Keyword) #?(:cljs cljs.core.Keyword)
-  Lens
-  (-yank [kw data] (kw data))
-  (-shove [kw data v] (assoc data kw v)))
+  (if (keyword? lens)
+    (assoc data lens v)
+    (lens data v)))
 
 (defrecord ExplicitLens
     ^{:private true}
   [yanker shover args]
-  Lens
-  (-yank [lens data] (apply yanker data args))
-  (-shove [lens data v] (apply shover data v args))
   #?@(:clj [clojure.lang.IFn
-            (invoke [this data] (-yank this data))
-            (invoke [this data v] (-shove this data v))
+            (invoke [this data] (apply yanker data args))
+            (invoke [this data v] (apply shover data v args))
             (applyTo [this args]
                      (let [args (object-array args)]
                        (case (count args)
-                         1 (-yank this (aget args 0))
-                         2 (-shove this (aget args 0) (aget args 1))
+                         1 (yanker (aget args 0))
+                         2 (shover (aget args 0) (aget args 1))
                          (throw #?(:clj (java.lang.IllegalArgumentException. (str "invalid number of arguments (" (count args) ") to lens")))
                                 #?(:cljs (str "invalid number of arguments (" (count args) ") to lens"))))))]
       :cljs [IFn
-             (-invoke [this data] (-yank this data))
-             (-invoke [this data v] (-shove this data v))]))
+             (-invoke [this data] (apply yanker data args))
+             (-invoke [this data v] (apply shover data v args))]))
 
 (defn lens
   "Returns a new lens defined by the given yanker function, which
@@ -95,7 +81,6 @@
    value of the last one, in a data structure that the first one is put
    over."
   [l1 & lmore]
-  (assert (not-any? #(not (satisfies? Lens %)) (cons l1 lmore)))
   (loop [res l1
          lmore lmore]
     (if (empty? lmore)
@@ -231,7 +216,7 @@
         mult-shove
         lenses))
 
-;; not very general: 
+;; not very general:
 ;; (defn repeated
 ;;   [n]
 ;;   (lens #(take n (repeat %))