更新日時ごとのグループ分け

30分プログラム、その188。ファイルを更新日時ごとにグループ分けするプログラム。

もうちょっと練れる気がするけど、時間が来たのでここまで。もしかしたら、またそのうち続きをやるかもしれない。

使い方

$ gosh mtime.scm *.scm | sort +0
2007/06/19: 1
2007/06/19: 2
2007/06/19: 5
2007/06/31: 2
2007/08/08: 1
2007/08/29: 1
..

あれ?2007/6/19がまとめられていない。
また、ちゃんと直そう。

ソースコード

#! /opt/local/bin/gosh
;; -*- mode:scheme; coding:utf-8 -*-
;;
;; mtime.scm -
;;
;; Copyright(C) 2007 by mzp
;; Author: MIZUNO Hiroki
;; http://mzp.sakura.ne.jp/
;;
;; Timestamp: 2007/11/21 21:37:04
;;
;; This program is free software; you can redistribute it and/or
;; modify it under the same terms as Scheme itself.
;;
(use file.util)
(use srfi-1)
(use srfi-19)

;; http://d.hatena.ne.jp/mzp/20071031/dirgroup
(define (group lst fn)
  (if (or (eq? lst '()) (eq? (cdr lst) '()))
      (list lst)
      (receive 
	  (same other) 
	  (span (lambda(y) (fn (car lst) y)) (cdr lst))
	(cons (cons (car lst) same)
	      (group other fn)))))

(define mtime (compose sys-localtime file-mtime expand-path))
(define (time->date time)
  (list (+ (slot-ref time 'year) 1900)
	(slot-ref time 'mon)
	(slot-ref time 'mday)))

(define (mtime-group filenames)
  (group (zip (map (compose time->date mtime) filenames) filenames)
	 (lambda (x y) (equal? (car x) (car y)))))

;; arg example: (((2007 8 9) "~/.emacs"))
(define (fgroup->string group)
  (let ((date      (caar group))
	(file-list (map cadr group)))
    (string-append
     (apply format "~2,'0d/~2,'0d/~2,'0d" date)
     ": "
     (number->string (length file-list)))))

(define (main args)
  (for-each
   (compose print fgroup->string)
   (mtime-group (cdr args))))

参考

• 過去の30分プログラム