Clojure Unix Cal

cal.clj

(require '[clojure.string :as str])
(import [java.time Month LocalDateTime YearMonth])

(defn left-pad [desired-width s]
  (let [padding (apply str (repeat (- desired-width
                                      (count (str s)))
                                   " "))]
    (str padding s)))

(defn right-pad [desired-width s]
  (let [padding (apply str (repeat (- desired-width
                                      (count (str s)))
                                   " "))]
    (str s padding)))

(defn center [desired-width s]
  (let [after (quot (- desired-width (count s)) 2)
        before (- desired-width (count s) after)]
    (apply str (concat (repeat before " ")
                       s
                       (repeat after " ")))))

(defn divisible-by? [y d] (zero? (mod y d)))

(defn leap-year? [y]
  (and (divisible-by? y 4)
       (or (not (divisible-by? y 100))
           (divisible-by? y 400))))

(defn week-index-of-first
  "Figure out what day of the week the 1st of this month falls on.
   Answer will be given in offset from Sunday (Sunday=0)"
  [year month-index]
  ;; In the java.time DayOfWeek class Monday=1 and Sunday=7, so we mod it to get
  ;; it to be 0-based on Sunday
  (mod (.getValue
        (.getDayOfWeek
         (.atDay
          (YearMonth/of year month-index)
          1)))
       7))

(defn month-lines [year month-index]
  (let [month (Month/of month-index)
        month-name-header (center 20
                                  (str/capitalize (.name month)))
        days-header "Su Mo Tu We Th Fr Sa"
        days (range 1 (inc (.length month (leap-year? year))))
        days-as-strings (map (partial left-pad 2)
                             (concat (repeat (week-index-of-first
                                              year
                                              (.getValue month)) nil)
                                     days))]
    (concat [month-name-header
             days-header]
            (map (partial right-pad 20)
                 (map (partial str/join " ")
                      (partition-all 7 days-as-strings))))))

;; Run from the repl
(defn cal
  ([year month-index]
   (println (str/join "\n" (month-lines year month-index))))
  ([year]
   (println
    (let [blank-week (apply str (repeat 20 " "))
          slice-weeks (fn [colls]
                        ;; add blank lines for months that are
                        ;; shorter than the longest month in their
                        ;; group of 3 months
                        (let [max-len (apply max (map count colls))
                              normed (map (fn [c] (if (< (count c) max-len)
                                                    (concat c (repeat blank-week))
                                                    c))
                                          colls)]
                          (apply map vector normed)))
          all-months (map (partial month-lines year)
                          (range 1 13))]
      (str/join "\n"
                (map (partial str/join "  ")
                     (mapcat slice-weeks
                             (partition-all 3 all-months))))))))