Skip to content

Instantly share code, notes, and snippets.

@mjm
Created January 20, 2009 20:43
  • Star 1 You must be signed in to star a gist
  • Fork 0 You must be signed in to fork a gist
Star You must be signed in to star a gist
Save mjm/49656 to your computer and use it in GitHub Desktop.
;;; A date library that follows principle of least surprise
;;;
;;; A few usage examples:
;;;
;;; user> (now)
;;; {:second 24, :minute 10, :hour 0, :type
;;; :clojure.contrib.date/DateTime, :year 2009, :month 1, :day 23
;;; :zone "America/New_York"}
;;;
;;; user> (today)
;;; {:type :clojure.contrib.date/Date, :year 2009, :month 1, :day
;;; 23, :zone "America/New_York"}
;;;
;;; user> (date 2008 12 25)
;;; {:type :clojure.contrib.date/Date, :year 2008, :month 12, :day
;;; 25, :zone "America/New_York"}
;;;
;;; user> (date 2008 12 25 4 25 36)
;;; {:second 36, :minute 25, :hour 4, :type
;;; :clojure.contrib.date/DateTime, :year 2008, :month 12, :day 25
;;; :zone "America/New_York"}
;;;
;;; user> (format-date (now) :short)
;;; "1/23/09 12:18 AM"
;;;
;;; user> (format-date (today) :short)
;;; "1/23/09"
;;;
;;; user> (format-date (date 2008 12 25) :long)
;;; "December 25, 2008"
;;;
;;; user> (parse-date "Jan 1, 2009" :medium-date)
;;; {:type :clojure.contrib.date/Date, :year 2009, :month 1, :day 1
;;; :zone "America/New_York"}
;;;
(ns clojure.contrib.date
(:import (java.util Calendar TimeZone)
(java.text DateFormat SimpleDateFormat)))
;; Use to resolve keywords
(def this-ns (str *ns*))
(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 ::DateTime ::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 ::DateTime
: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 ::DateTime [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
"Returns a keyword representing the day of the week (:sunday
:monday, :tuesday, etc.) of the given date"
[date]
(weekday-map (.get (to-calendar date) Calendar/DAY_OF_WEEK)))
(defmulti
#^{:doc "Take in a date and a format (either a keyword or
a string) and return a string with the formatted date."}
format-date (fn [date form] [(date-dispatcher date) form]))
(defmulti
#^{:doc "Take in a string with a formatted date and a format
(either a keyword or a string) and return a parsed date."}
parse-date (fn [source form] form))
(defn- camelcase
"Takes a string that is lowercase and dash-separated and
converts it to CamelCase."
[string]
(apply str
(map (fn [x]
(str (.toUpperCase (subs x 0 1))
(subs x 1)))
(into [] (.split string "-")))))
(defn- sanitize-options
"Turn the options passed in to def-date-format into a map"
[options]
(apply hash-map
(apply concat
(map (fn [decl]
(if (> (count decl) 2)
(cons (first decl)
(list (rest decl)))
decl))
options))))
(defmacro def-date-format
"Defines a new date format for use with format-date and parse-date.
The formatter and parser can be arbitrary code. Both are optional
although it's not all that useful if neither is specified. If
the :append-type is true, the parser name is formed by joining the
format name and the format type with a dash. Otherwise, the parser
name is just the format name."
[fname ftype & options]
(let [resolved-type (keyword this-ns (camelcase (name ftype)))
option-map (sanitize-options options)
append? (:append-type option-map)
format-name (keyword (if append?
(str (name fname) "-" (name ftype))
(name fname)))]
[resolved-type option-map append? format-name]
`(do
~(if-let [f (:formatter option-map)]
`(defmethod format-date
[~resolved-type ~(keyword (name fname))]
[~(ffirst f) ~'_]
~@(rest f)))
~(if-let [p (:parser option-map)]
`(defmethod parse-date
~format-name
[~(ffirst p) ~'_]
~@(rest p))))))
(comment
(def-date-format short date
(:append-type true)
(:formatter [date]
(blah blah))
(:parser [source]
())))
(defmacro def-java-date-format
"Defines a date format that delegates to a Java DateFormat.
The body is simply an expression that will return a DateFormat."
[fname ftype formatter]
`(def-date-format ~fname ~ftype
(:append-type true)
(:formatter [date#]
(.format ~formatter
(.getTime (to-calendar date#))))
(:parser [source#]
(to-date
(doto (make-calendar)
(.setTime (.parse
~formatter
source#)))))))
(comment
(defmacro def-date-format [dispatch [date] & body]
`(defmethod format-date ~dispatch [~date ~'_]
~@body))
(defmacro def-java-date-format [[date-type form] formatter]
`(def-date-format [~date-type ~form] [date#]
(.format ~formatter
(.getTime (to-calendar date#))))))
(def-java-date-format short date
(DateFormat/getDateInstance DateFormat/SHORT))
(def-java-date-format medium date
(DateFormat/getDateInstance DateFormat/MEDIUM))
(def-java-date-format long date
(DateFormat/getDateInstance DateFormat/LONG))
(def-java-date-format full date
(DateFormat/getDateInstance DateFormat/FULL))
(def-java-date-format short date-time
(DateFormat/getDateTimeInstance
DateFormat/SHORT
DateFormat/SHORT))
(def-java-date-format medium date-time
(DateFormat/getDateTimeInstance
DateFormat/MEDIUM
DateFormat/MEDIUM))
(def-java-date-format long date-time
(DateFormat/getDateTimeInstance
DateFormat/LONG
DateFormat/LONG))
(def-java-date-format full date-time
(DateFormat/getDateTimeInstance
DateFormat/FULL
DateFormat/FULL))
;;; Formats dates with a custom string format
(defmethod format-date :default [date form]
(.format (SimpleDateFormat. form)
(.getTime (to-calendar date))))
;;; Parse a date from a string format
(defmethod parse-date :default [source form]
(to-date
(doto (make-calendar)
(.setTime (.parse (SimpleDateFormat. form) source)))))
(comment
(defmacro def-date-parser [form [source] & body]
`(defmethod parse-date ~(keyword (str form)) [~source ~'_]
~@body))
(defmacro def-java-date-parser [form formatter]
`(def-date-parser ~form [source#]
(to-date
(doto (make-calendar)
(.setTime (.parse
~formatter
source#))))))
(def-java-date-parser short-date
(DateFormat/getDateInstance DateFormat/SHORT))
(def-java-date-parser medium-date
(DateFormat/getDateInstance DateFormat/MEDIUM))
(def-java-date-parser long-date
(DateFormat/getDateInstance DateFormat/LONG))
(def-java-date-parser full-date
(DateFormat/getDateInstance DateFormat/FULL))
(def-java-date-parser short-date-time
(DateFormat/getDateTimeInstance DateFormat/SHORT DateFormat/SHORT))
(def-java-date-parser medium-date-time
(DateFormat/getDateTimeInstance DateFormat/MEDIUM DateFormat/MEDIUM))
(def-java-date-parser long-date-time
(DateFormat/getDateTimeInstance DateFormat/LONG DateFormat/LONG))
(def-java-date-parser full-date-time
(DateFormat/getDateTimeInstance DateFormat/FULL DateFormat/FULL)))
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment