Created
January 21, 2009 17:57
-
-
Save mjm/50074 to your computer and use it in GitHub Desktop.
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
;;; A date library that follows principle of least surprise | |
(ns clojure.contrib.date) | |
(import 'java.util.Calendar) | |
(import 'java.util.TimeZone) | |
(def #^{:doc "Conversion of Calendar weekdays to keywords"} | |
weekday-map | |
{Calendar/SUNDAY :sunday | |
Calendar/MONDAY :monday | |
Calendar/TUESDAY :tuesday | |
Calendar/WEDNESDAY :wednesday | |
Calendar/THURSDAY :thursday | |
Calendar/FRIDAY :friday | |
Calendar/SATURDAY :saturday}) | |
(defn- make-calendar | |
"Given some date values, create a Java Calendar object with only | |
that data." | |
([] (doto (Calendar/getInstance) | |
(.clear) | |
(.setLenient true))) | |
([year month day] | |
(doto (make-calendar) | |
(.set year (dec month) day))) | |
([year month day hours minutes] | |
(doto (make-calendar) | |
(.set year (dec month) day hours minutes))) | |
([year month day hours minutes seconds] | |
(doto (make-calendar) | |
(.set year (dec month) day hours minutes seconds)))) | |
(defn- time-zone-object | |
"Gets a Java TimeZone object from a string ID. | |
If no ID is given, use the default time zone for the current locale." | |
([] (TimeZone/getDefault)) | |
([id] (TimeZone/getTimeZone id))) | |
(defn- time-zone-id | |
"Gets the string ID of a Java TimeZone object" | |
[tz-obj] | |
(.getID tz-obj)) | |
(defn date-dispatcher | |
"Gets a type keyword for a Date object. Uses ::Calendar for Java | |
Calendar objects, and the symbol in the :type slot for Clojure dates." | |
[x] | |
(if (instance? Calendar x) | |
::Calendar | |
(:type x))) | |
(derive ::Date ::Instant) | |
(derive ::Time ::Instant) | |
(defmulti to-date date-dispatcher) | |
(defmethod to-date ::Calendar [cal] | |
(let [d {:year (.get cal Calendar/YEAR) | |
:month (inc (.get cal Calendar/MONTH)) | |
:day (.get cal Calendar/DAY_OF_MONTH) | |
:zone (time-zone-id (.getTimeZone cal))} | |
h (.get cal Calendar/HOUR_OF_DAY) | |
m (.get cal Calendar/MINUTE) | |
s (.get cal Calendar/SECOND)] | |
(if (= 0 h m s) | |
(assoc d :type ::Date) | |
(assoc d | |
:type ::Time | |
:hour h | |
:minute m | |
:second s)))) | |
(defmulti to-calendar date-dispatcher) | |
(defmethod to-calendar ::Date [date] | |
(doto (Calendar/getInstance) | |
(.clear) | |
(.set (:year date) | |
(dec (:month date)) | |
(:day date)) | |
(.setTimeZone (time-zone-object (:zone date))))) | |
(defmethod to-calendar ::Instant [date] | |
(doto (Calendar/getInstance) | |
(.clear) | |
(.set (:year date) | |
(dec (:month date)) | |
(:day date) | |
(:hour date) | |
(:minute date) | |
(:second date)) | |
(.setTimeZone (time-zone-object (:zone date))))) | |
(defn date | |
"Creates a Date or Time object with exactly the given information." | |
[& args] | |
(to-date (apply make-calendar args))) | |
(defn now | |
"Creates a Time object with the current date and time." | |
[] | |
(to-date (Calendar/getInstance))) | |
(defn today | |
"Creates a Date object with the current date." | |
[] | |
(assoc (dissoc (now) :hour :minute :second) | |
:type ::Date)) | |
(defn day-of-week [date] | |
(weekday-map (.get (to-calendar date) Calendar/DAY_OF_WEEK))) |
Sign up for free
to join this conversation on GitHub.
Already have an account?
Sign in to comment