Rotating log file with retention

README.md

@@ -2,8 +2,8 @@
 
 `simple-log` is a small convenience layer on top of Racket's logging system.
 It provides generated procedures for the standard log levels and supports
-logging to the display, a file, custom callbacks, and a filterable in-memory
+logging to the display, regular or daily rotating files, custom callbacks, and
-store.
+a filterable in-memory store.
 
 ```racket
 #lang racket
@@ -31,3 +31,22 @@ Topic filters can select multiple topics or invert a match:
 
 The Scribble manual documents logger definitions, destinations, log levels,
 synchronization, and all in-memory store operations.
+## Rotating log files
+
+Daily rotation keeps the current log as plain text and gzip-compresses older
+days. The retention value counts the current day as well.
+
+```racket
+(sl-log-to-rotating-file "application.log")      ; 7 days
+(sl-log-to-rotating-file "application.log" 14)   ; 14 days
+```
+
+With a retention of 7 days the files look like this:
+
+```text
+application.log
+application.log.2026-08-28.gz
+application.log.2026-08-27.gz
+...
+```
+

info.rkt

@@ -1,7 +1,7 @@
 #lang info
 
 (define pkg-authors '(hnmdijkema))
-(define version "0.2.2")
+(define version "0.2.3")
 (define license 'MIT)   
 (define collection "simple-log")
 (define pkg-desc "simple-log - A simple wrapper around the racket logging system")

main.rkt

@@ -7,11 +7,13 @@
          data/queue
          "private/loghash.rkt"
          "private/store.rkt"
+         "private/rotating-file.rkt"
          )
 
 (provide sl-def-log
          sl-log-to
          sl-log-to-file
+         sl-log-to-rotating-file
          sl-log-to-display
          sl-log-to-store
          sl-log-to-file&display
@@ -211,6 +213,24 @@
   (dbg-simple-log "log-to-file enabled with file ~a" filename)
   )
 
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+; goal       : Enable daily rotating file logging.
+; pre        : filename is a path string and retention-days is a positive integer.
+; post       : The current day is logged as plain text. Older retained days are
+;              stored as <filename>.YYYY-MM-DD.gz.
+; result     : void
+; internals  : retention-days includes the current, uncompressed day.
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+(define (sl-log-to-rotating-file filename [retention-days 7])
+  (unless (exact-positive-integer? retention-days)
+    (raise-argument-error 'sl-log-to-rotating-file
+                          "exact-positive-integer?"
+                          retention-days))
+  (sl-log-to file (make-rotating-log-callback filename retention-days))
+  (dbg-simple-log "rotating log-to-file enabled with file ~a and retention ~a days"
+                  filename retention-days)
+  )
+
 (define-syntax def-log2
   (syntax-rules ()
     ((_ id parent receiver log-callbacks dbgn infon warnn errn fataln syncn)

private/rotating-file.rkt

@@ -0,0 +1,132 @@
+#lang racket
+
+(require file/gzip
+         racket/date
+         racket-sprintf)
+
+(provide make-rotating-log-callback)
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; Supporting functions
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(define (iso-date seconds [local-time? #t])
+  (let ((d (seconds->date seconds local-time?)))
+    (sprintf "%04d-%02d-%02d"
+             (date-year d)
+             (date-month d)
+             (date-day d))))
+
+(define (rotate-log-file! filename log-date)
+  (when (file-exists? filename)
+    (if (> (file-size filename) 0)
+        (let* ((filename-path (if (path? filename) filename (string->path filename)))
+               (archive
+                (string->path
+                 (string-append (path->string filename-path) "." log-date ".gz"))))
+          (gzip filename archive)
+          (delete-file filename))
+        (delete-file filename))))
+
+(define (remove-expired-log-files! filename log-date retention-days)
+  (let* ((filename-path (if (path? filename) filename (string->path filename)))
+         (directory (or (path-only filename-path) (current-directory)))
+         (base-name (path->string (file-name-from-path filename-path)))
+         (archive-regexp
+          (regexp
+           (format "^~a\\.([0-9][0-9][0-9][0-9]-[0-9][0-9]-[0-9][0-9])\\.gz$"
+                   (regexp-quote base-name))))
+         (date-match
+          (regexp-match #rx"^([0-9][0-9][0-9][0-9])-([0-9][0-9])-([0-9][0-9])$"
+                        log-date))
+         (year (string->number (cadr date-match)))
+         (month (string->number (caddr date-match)))
+         (day (string->number (cadddr date-match)))
+         (date-seconds (find-seconds 0 0 12 day month year #f))
+         (cutoff-seconds (- date-seconds (* 86400 (sub1 retention-days))))
+         (cutoff-date (iso-date cutoff-seconds #f)))
+    (for-each
+     (λ (entry)
+       (let* ((entry-name (path->string entry))
+              (archive-match (regexp-match archive-regexp entry-name))
+              (archive-path (build-path directory entry)))
+         (when (and archive-match
+                    (string<? (cadr archive-match) cutoff-date)
+                    (file-exists? archive-path))
+           (delete-file archive-path))))
+     (directory-list directory))))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; Provided functions
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+; goal       : Create a callback that writes to a daily rotating log file.
+; pre        : filename is a path string and retention-days is a positive integer.
+; post       : The current day is kept as plain text. Older retained days are
+;              stored as <filename>.YYYY-MM-DD.gz.
+; result     : A simple-log callback procedure.
+; internals  : Rotation is checked for every log entry using the entry timestamp.
+;              retention-days includes the current, uncompressed day.
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+(define (make-rotating-log-callback filename retention-days)
+  (let ((active-date (iso-date (current-seconds)))
+        (out #f))
+
+    ;; A file left by an earlier process belongs to the day on which it was
+    ;; last written. Keep today's file plain, and archive an older one first.
+    (when (file-exists? filename)
+      (let ((file-date
+             (iso-date (file-or-directory-modify-seconds filename))))
+        (when (not (string=? file-date active-date))
+          (rotate-log-file! filename file-date))))
+
+    (remove-expired-log-files! filename active-date retention-days)
+    (set! out (open-output-file filename #:exists 'append))
+
+    (λ (topic level dt msg)
+      (let ((entry-date (substring dt 0 10)))
+        (when (not (string=? entry-date active-date))
+          (close-output-port out)
+          (rotate-log-file! filename active-date)
+          (set! active-date entry-date)
+          (remove-expired-log-files! filename active-date retention-days)
+          (set! out (open-output-file filename #:exists 'append)))
+
+        (displayln (format "~a:~a:~a:~a" topic level dt msg) out)
+        (flush-output out)))))
+
+(module+ test
+  (require rackunit
+           racket/file
+           file/gunzip)
+
+  (let ((test-directory (make-temporary-file "simple-log-rotation~a" 'directory)))
+    (dynamic-wind
+      void
+      (λ ()
+        (let* ((logfile (build-path test-directory "application.log"))
+               (archive (build-path test-directory "application.log.2026-08-28.gz"))
+               (expired (build-path test-directory "application.log.2026-08-26.gz")))
+
+          (call-with-output-file logfile
+            (λ (out) (displayln "previous day" out))
+            #:exists 'replace)
+          (call-with-output-file expired
+            (λ (out) (displayln "expired" out))
+            #:exists 'replace)
+
+          (rotate-log-file! logfile "2026-08-28")
+          (check-false (file-exists? logfile))
+          (check-true (file-exists? archive))
+
+          (let ((out (open-output-bytes)))
+            (call-with-input-file archive
+              (λ (in) (gunzip-through-ports in out)))
+            (check-equal? (get-output-bytes out) #"previous day\n"))
+
+          (remove-expired-log-files! logfile "2026-08-29" 2)
+          (check-true (file-exists? archive))
+          (check-false (file-exists? expired))))
+      (λ ()
+        (delete-directory/files test-directory)))))

scrbl/simple-log.scrbl

@@ -101,6 +101,34 @@ opened with @racket['replace], and the output is flushed after every line.
 Calling the procedure again replaces the existing file destination.
 }
 
+@defproc[(sl-log-to-rotating-file
+          [filename path-string?]
+          [retention-days exact-positive-integer? 7])
+         void?]{
+
+Registers a daily rotating file destination. The current day's log is kept as
+plain text in @racket[filename]. When the date changes, the previous file is
+compressed with gzip and stored as
+@tt{filename.YYYY-MM-DD.gz}.
+
+@racket[retention-days] is the total number of calendar days retained, including
+the current uncompressed day. With the default value of @racket[7], the current
+day and at most the previous six calendar days are retained. Compressed files
+older than that period are removed.
+
+If @racket[filename] already exists when rotating logging is enabled, a file
+modified today is appended to. An older file is first archived under its last
+modification date. This makes restarting an application on the same day preserve
+the current day's log.
+
+For example:
+
+@racketblock[
+(sl-log-to-rotating-file "application.log")
+(sl-log-to-rotating-file "application.log" 14)
+]
+}
+
 @defproc[(sl-log-to-file&display [filename path-string?]) void?]{
 
 Enables both the display and file destinations.