Merge pull request #17 from active-group/accessors-as-lenses

Remove explicit lens definition in favor of regular accessors being lenses

Author: smoes

src/active/clojure/record.cljc

@@ -15,6 +15,13 @@
   [msg]
   (c/assertion-violation `throw-illegal-argument-exception "Illegal argument" msg))
 
+
+(defn report-lens-deprecation [type]
+  (println (str "active.clojure.record WARNING for record-type `" type
+                "`: the explicit definition of lenses is deprecated in favor of regular "
+                "accessors already being lenses")))
+
+
 ;; Only needed in ClojureScript, does nothing in Clojure
 (defn check-type
   [type rec]
@@ -158,28 +165,29 @@
                        ?field-triples))))
        (declare ~@(map (fn [[?field ?accessor ?lens]] ?accessor) ?field-triples))
        ~@(mapcat (fn [[?field ?accessor ?lens]]
-                   (let [?rec (with-meta `rec# {:tag ?type})]
-                     `((def ~(document-with-arglist ?accessor (vector ?type)  (str "Access `" ?field "` field"
-                                                                                   (name-doc ?field)
-                                                                                   " from a [[" ?type "]] record. " ?docref))
-                         (fn [~?rec]
-                           (check-type ~?type ~?rec)
-                           (. ~?rec ~(symbol (str "-" ?field)))))
-                       ~@(if ?lens
-                           (let [?data `data#
-                                 ?v `v#]
-                             `((def ~(document ?lens (str "Lens for the `" ?field "` field"
-                                                          (name-doc ?field)
-                                                          " from a [[" ?type "]] record." ?docref))
-                                 (lens/lens ~?accessor
-                                            (fn [~?data ~?v]
-                                              (~?constructor ~@(map
-                                                                (fn [[?shove-field ?shove-accessor]]
-                                                                  (if (= ?field ?shove-field)
-                                                                    ?v
-                                                                    `(~?shove-accessor ~?data)))
-                                                                ?field-triples)))))))
-                           '()))))
+                   (let [?rec (with-meta `rec# {:tag ?type})
+                         ?data `data#
+                         ?v `v#]
+                     `((def ~(document-with-arglist
+                              ?accessor
+                              (vector ?type)
+                              (str "Lens for the `" ?field "` field"
+                                   (name-doc ?field)
+                                   " from a [[" ?type "]] record. " ?docref))
+                         (lens/lens (fn [~?rec]
+                                      (check-type ~?type ~?rec)
+                                      (. ~?rec ~(symbol (str "-" ?field))))
+                                    (fn [~?data ~?v]
+                                      (~?constructor ~@(map
+                                                        (fn [[?shove-field ?shove-accessor]]
+                                                          (if (= ?field ?shove-field)
+                                                            ?v
+                                                            `(~?shove-accessor ~?data)))
+                                                        ?field-triples)))))
+                       ~(when ?lens
+                          (report-lens-deprecation ?type)
+                          `(def ~?lens ~?accessor))
+                       )))
                  ?field-triples)))))
 
 

test/active/clojure/record_test.cljc

@@ -72,27 +72,27 @@
 (define-record-type ^{:doc "Lens example"} LensPare
   (lens-kons a b)
   lens-pare?
-  [(^{:doc "a field"} a lens-kar lens-kar-lens)
-   (^{:doc "b field"} b lens-kdr lens-kdr-lens)])
+  [^{:doc "a field"} a lens-kar
+   ^{:doc "b field"} b lens-kdr])
 
 (deftest pare-lens
-  (lens-laws-hold lens-kar-lens (lens-kons 1 2) 23 42)
-  (lens-laws-hold lens-kdr-lens (lens-kons 1 2) 23 42)
+  (lens-laws-hold lens-kar (lens-kons 1 2) 23 42)
+  (lens-laws-hold lens-kdr (lens-kons 1 2) 23 42)
   (is (= (lens-kons "a" 42)
-         (lens/shove (lens-kons 23 42) lens-kar-lens "a")))
+         (lens/shove (lens-kons 23 42) lens-kar "a")))
   (is (= (lens-kons 23 "b")
-         (lens/shove (lens-kons 23 42) lens-kdr-lens "b"))))
+         (lens/shove (lens-kons 23 42) lens-kdr "b"))))
 
 (define-record-type Quadruple
   (quadruple a b c d)
   quadruple?
-  [(a quadruple-one quadruple-one-lens)
+  [a quadruple-one
    b quadruple-two
-   (c quadruple-three quadruple-three-lens)
+   c quadruple-three
    d quadruple-four])
 
 (deftest quadruple-lens
-  (lens-laws-hold quadruple-one-lens (quadruple 'a 'b 'c 'd) 12 78)
-  (lens-laws-hold quadruple-three-lens (quadruple 'a 'b 'c 'd) 12 78)
+  (lens-laws-hold quadruple-one (quadruple 'a 'b 'c 'd) 12 78)
+  (lens-laws-hold quadruple-three (quadruple 'a 'b 'c 'd) 12 78)
   (is (= (quadruple 4 8 15 16)
-         (lens/shove (quadruple 108 8 15 16) quadruple-one-lens 4))))
+         (lens/shove (quadruple 108 8 15 16) quadruple-one 4))))