Facebook の日付形式「約1時間前」などを返す手続きを書いてみた
以下のような Facebook 日付形式を返す手続きを書いてみた。
テストの部分を見ると、どういう場合に日付形式が変わるのかが分かって面白いかも。
(import (rnrs) (mosh test) (only (mosh) format) (srfi :19)) (define dw '#("日曜日" "月曜日" "火曜日" "水曜日" "木曜日" "金曜日" "土曜日")) (define (date-diff->string lhs rhs) (let ([seconds (- (time-second (date->time-monotonic rhs)) (time-second (date->time-monotonic lhs)))]) (assert (> seconds 0)) (cond [(not (= (date-year lhs) (date-year rhs))) (format "~d年~d月~d日 ~d:~a" (date-year lhs) (date-month lhs) (date-day lhs) (date-hour lhs) (date->string lhs "~M"))] [(< seconds 60) (format "~a秒前" seconds)] [(< seconds 120) "約1分前"] [(< seconds (* 60 60)) (format "~d分前" (exact (truncate (inexact (/ seconds 60)))))] [(< seconds (* 2 60 60)) "約1時間前"] [(< seconds (* 24 60 60)) (format "~a時間前" (exact (truncate (inexact (/ seconds 60 60)))))] [(< seconds (* 48 60 60)) (format "昨日 ~a" (date->string lhs "~H:~M"))] [(< seconds (* 7 24 60 60)) (format "~a~a" (vector-ref dw (date-week-day lhs )) (date->string lhs "~H:~M"))] [else (format "~d月~d日 ~d:~a" (date-month lhs) (date-day lhs) (date-hour lhs) (date->string lhs "~M"))]))) ;; テスト (define (test expected lhs rhs) (test-equal expected (date-diff->string (string->date lhs "~Y/~m/~d ~H:~M:~S") (string->date rhs "~Y/~m/~d ~H:~M:~S")))) (test "50秒前" "2011/01/01 00:00:00" "2011/01/01 0:00:50") (test "約1分前" "2011/01/01 00:00:00" "2011/01/01 0:01:00") (test "約1分前" "2011/01/01 00:00:00" "2011/01/01 0:01:01") (test "約1分前" "2011/01/01 00:00:00" "2011/01/01 0:01:59") (test "2分前" "2011/01/01 00:00:00" "2011/01/01 0:02:00") (test "2分前" "2011/01/01 00:00:00" "2011/01/01 0:02:15") (test "約1時間前" "2011/01/01 00:00:00" "2011/01/01 1:00:00") (test "約1時間前" "2011/01/01 00:00:00" "2011/01/01 1:59:00") (test "2時間前" "2011/01/01 00:00:00" "2011/01/01 2:00:00") (test "昨日 17:30" "2011/01/01 17:30:22" "2011/01/02 18:15:24") (test "土曜日17:30" "2011/01/01 17:30:22" "2011/01/04 18:15:24") (test "1月1日 17:30" "2011/01/01 17:30:22" "2011/01/10 18:15:24") (test "2011年12月31日 17:30" "2011/12/31 17:30:22" "2012/01/01 0:00:00") (test-results)