Change group-by to return direct pairs.

Each value in the return of group-by must have exactly two values, so
cons pairs (instead of lists) is much better.

8 files changed, 31 insertions, 15 deletions

diff --git a/module/calp/entry-points/tidsrapport.scm b/module/calp/entry-points/tidsrapport.scm
index b5b9564f..a258cd73 100644
--- a/module/calp/entry-points/tidsrapport.scm
+++ b/module/calp/entry-points/tidsrapport.scm
@@ -93,7 +93,7 @@
                                            (as-time
                                             (datetime-difference (prop e 'DTEND)
                                                                  (prop e 'DTSTART)))))
-                                        (cadr group))))))
+                                        (cdr group))))))
             instances)
 
 
diff --git a/module/datetime/zic.scm b/module/datetime/zic.scm
index ace3d991..470f6c07 100644
--- a/module/datetime/zic.scm
+++ b/module/datetime/zic.scm
@@ -298,16 +298,16 @@
       (for-each (lambda (group)
                   (hashq-set! rules
                               (car group)
-                              (sort* (cadr group)
+                              (sort* (cdr group)
                                      (lambda (a b) (if (eq? 'minimum) #t (< a b)))
                                      rule-from)))
-                (group-by rule-name (car it))))
+                (group-by rule-name it)))
 
     ;; put zones in map
     (awhen (assoc-ref groups 'zone)
       (for-each (lambda (zone)
                   (hash-set! zones (zone-name zone) (zone-entries zone)))
-                (car it)))
+                it))
 
     ;; resolve links to extra entries in the zone map
     (awhen (assoc-ref groups 'link)
@@ -318,7 +318,7 @@
                     (if (not target-item)
                         (warning (G_ "Unresolved link, target missing ~a -> ~a") name target)
                         (hash-set! zones name target-item))))
-                (car it)))
+                it))
 
     (make-zoneinfo rules zones)))
 
diff --git a/module/hnh/util.scm b/module/hnh/util.scm
index 36b56c58..ba2a8a59 100644
--- a/module/hnh/util.scm
+++ b/module/hnh/util.scm
@@ -330,10 +330,7 @@
     (for value in lst
          (let ((key (proc value)))
            (hash-set! h key (cons value (hash-ref h key '())))))
-    ;; TODO change this 'list' to 'cons'.
-    ;; It will give a "proper" alist, and also allows the output to work
-    ;; with assq-merge
-    (hash-map->list list h)))
+    (hash-map->list cons h)))
 
 ;; (split-by '(0 1 2 3 4 2 5 6) 2)
 ;; ⇒ ((0 1) (3 4) (5 6))
diff --git a/module/vcomponent/recurrence/display/en.scm b/module/vcomponent/recurrence/display/en.scm
index c711a75c..18d11dba 100644
--- a/module/vcomponent/recurrence/display/en.scm
+++ b/module/vcomponent/recurrence/display/en.scm
@@ -26,13 +26,13 @@
                (list "every "
                      (add-enumeration-punctuation
                       (map (lambda (d) (list (week-day-name (cdr d))))
-                           (cadr group)
+                           (cdr group)
                            )))]
               [else
                (list (number->string-ordinal (car group)) " "
                      (add-enumeration-punctuation
                       (map (lambda (d) (list (week-day-name (cdr d)) "en"))
-                           (cadr group))))])
+                           (cdr group))))])
             )
           groups))))
 
diff --git a/module/vcomponent/recurrence/display/sv.scm b/module/vcomponent/recurrence/display/sv.scm
index 2bd70657..ee8fc3fd 100644
--- a/module/vcomponent/recurrence/display/sv.scm
+++ b/module/vcomponent/recurrence/display/sv.scm
@@ -31,7 +31,7 @@
                (list "varje "
                      (add-enumeration-punctuation
                       (map (lambda (d) (list (week-day-name (cdr d))))
-                           (cadr group)
+                           (cdr group)
                            )))]
               [else
                (list (number->string-ordinal
@@ -40,7 +40,7 @@
                      " "
                      (add-enumeration-punctuation
                       (map (lambda (d) (list (week-day-name (cdr d)) "en"))
-                           (cadr group))))])
+                           (cdr group))))])
             )
           groups))))
 
diff --git a/module/vcomponent/util/instance/methods.scm b/module/vcomponent/util/instance/methods.scm
index 5651b265..75510009 100644
--- a/module/vcomponent/util/instance/methods.scm
+++ b/module/vcomponent/util/instance/methods.scm
@@ -96,7 +96,7 @@
            type (concatenate
                  (map children (slot-ref this 'calendars)))))
          (events (awhen (assoc-ref groups 'VEVENT)
-                        (car it)))
+                        it))
          (removed remaining (partition (extract 'X-HNH-REMOVED) events)))
 
     ;; TODO figure out what to do with removed events
diff --git a/tests/test/util.scm b/tests/test/util.scm
index 2a171d12..9a203f50 100644
--- a/tests/test/util.scm
+++ b/tests/test/util.scm
@@ -132,6 +132,25 @@
 
 ;; TODO assq-limit ?
 
+(test-group "group by"
+  ;; Extra roundabout tests since groups-by doesn't guarantee order of the keys
+  (test-group "Two simple groups"
+    (let ((groups (group-by even? (iota 10))))
+      (test-assert (lset= eq? '(#f #t) (map car groups)))
+      (test-assert (lset= = '(0 2 4 6 8) (assq-ref groups #t)))
+      (test-assert (lset= = '(1 3 5 7 9) (assq-ref groups #f)))))
+
+  (test-group "Identity groups"
+    (let ((groups (group-by identity (iota 5))))
+      (test-assert "Correct keys"
+        (lset= = (iota 5) (map car groups)))
+      (test-group "Correct amount in each group"
+        (for-each (lambda (g) (test-equal 1 (length (cdr g)))) groups))))
+
+  (test-equal "Null case"
+    '()
+    (group-by (lambda _ (/ 0)) '())))
+
 (test-equal "->" 9 (-> 1 (+ 2) (* 3)))
 (test-equal "-> order dependant" -1 (-> 1 (- 2)))
 (test-equal "->> order dependant" 1 (->> 1 (- 2)))
diff --git a/tests/validate-html/run-validator.scm b/tests/validate-html/run-validator.scm
index bd96c32d..0c4ee0bc 100755
--- a/tests/validate-html/run-validator.scm
+++ b/tests/validate-html/run-validator.scm
@@ -80,6 +80,6 @@ exec $GUILE -e main -s "$0" -- "$@"
         (begin
          (for-each (lambda (group)
                      (format #t "~a~%" (-> group car (assoc-ref 'url) car))
-                     (for-each display-entry (cadr group)))
+                     (for-each display-entry (cdr group)))
                    (group-by-file filtered-data))
          (exit 1)))))