Programming Praxis

The hard part of this exercise is deciding on a feature set that is both useful in practice but reasonably simple to implement. We design a feature set based on the formatting capabilities of the unix date(1) command. Our function takes a julian day number, as produced by the date functions in the Standard Prelude, along with a format string that shows how the date is to be formatted. The format string is copied from the input to the output, except that escape sequences introduced by a percent sign are translated according to the table below:

; %% literal percent (%)
; %a abbreviated dayname (Tue)
; %A full dayname (Tuesday)
; %b abbreviated monthname (Apr)
; %B full monthname (April)
; %d day of month, zero padded (09)
; %D day of month (9)
; %m month number, zero padded (04)
; %M month number (4)
; %y two-digit year (13)
; %Y four-digit year (2013)

For instance, today, which is julian number 2456399, is formatted as “Tuesday, April 16, 2013” if the format string is “%A, %B %D, %Y”, as “04/16/13” if the format string is “%m/%d/%y”, and as “4/16/2013” if the format string is “%M/%D/%Y”. This collection of formatting commands isn’t perfect, but covers enough of the basic set of possibilities to be useful. You may well choose a different set of formatting commands, or even a different syntax.

Our function is based on pattern-matching the list of characters in the format string:

(define (date-format julian fmt-string)
  (define (pad n)
    (if (< 9 n) (number->string n)
      (string-append "0" (number->string n))))
  (let ((ds (vector "Mon" "Tue" "Wed" "Thu" "Fri" "Sat" "Sun"))
        (days (vector "Monday" "Tuesday" "Wednesday" "Thursday" "Friday" "Saturday" "Sunday"))
        (ms (vector "" "Jan" "Feb" "Mar" "Apr" "May" "Jun" "Jul" "Aug" "Sep" "Oct" "Nov" "Dec"))
        (months (vector "" "January" "February" "March" "April" "May" "June" "July" "August"
          "September" "October" "November" "December")))
    (let-values (((year month day) (gregorian julian)) ((weekday) (modulo julian 7)))
      (let loop ((fmt (string->list fmt-string)) (cs (string)))
        (list-match fmt
          (() cs)
          ((#\% #\% . rest) (loop (cddr fmt) (string-append cs "%")))
          ((#\% #\a . rest) (loop (cddr fmt) (string-append cs (vector-ref ds weekday))))
          ((#\% #\A . rest) (loop (cddr fmt) (string-append cs (vector-ref days weekday))))
          ((#\% #\b . rest) (loop (cddr fmt) (string-append cs (vector-ref ms month))))
          ((#\% #\B . rest) (loop (cddr fmt) (string-append cs (vector-ref months month))))
          ((#\% #\d . rest) (loop (cddr fmt) (string-append cs (pad day))))
          ((#\% #\D . rest) (loop (cddr fmt) (string-append cs (number->string day))))
          ((#\% #\m . rest) (loop (cddr fmt) (string-append cs (pad month))))
          ((#\% #\M . rest) (loop (cddr fmt) (string-append cs (number->string month))))
          ((#\% #\y . rest) (loop (cddr fmt) (string-append cs (substring (number->string year) 2 4))))
          ((#\% #\Y . rest) (loop (cddr fmt) (string-append cs (number->string year))))
          ((c . rest) (loop (cdr fmt) (string-append cs (string c)))))))))

Here are some examples:

> (date-format 2456399 "%% %a %A %b %B %d %D %m %M %X %y %Y")
"% Tue Tuesday Apr April 16 16 04 4 %X 13 2013"
> (date-format 2456399 "%A, %B %D, %Y")
"Tuesday, April 16, 2013"
> (date-format 2456399 "%m/%d/%y")
"04/16/13"
> (date-format 2456399 "%M/%D/%Y")
"4/16/2013"

We used pattern-matching and date arithmetic from the Standard Prelude. You can run the program at http://programmingpraxis.codepad.org/FCeMibaU. This function will be added to the Standard Prelude the next time revisions are made to it.

Pages: 1 2