PageRenderTime 51ms CodeModel.GetById 27ms RepoModel.GetById 1ms app.codeStats 0ms

/src/main/clojure/clojure/tools/reader/default_data_readers.clj

https://github.com/coventry/tools.reader
Clojure | 303 lines | 217 code | 55 blank | 31 comment | 22 complexity | 7da52381fb61318814a086be403bc2fe MD5 | raw file
  1. ; Copyright (c) Rich Hickey. All rights reserved.
  2. ; The use and distribution terms for this software are covered by the
  3. ; Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php)
  4. ; which can be found in the file epl-v10.html at the root of this distribution.
  5. ; By using this software in any fashion, you are agreeing to be bound by
  6. ; the terms of this license.
  7. ; You must not remove this notice, or any other, from this software.
  8. ;;; copied from clojure.instant and clojure.uuid ;;;
  9. (ns ^:skip-wiki clojure.tools.reader.default-data-readers
  10. (:import [java.util Calendar Date GregorianCalendar TimeZone]
  11. [java.sql Timestamp]))
  12. ;;; clojure.instant ;;;
  13. ;;; ------------------------------------------------------------------------
  14. ;;; convenience macros
  15. (defmacro ^:private fail
  16. [msg]
  17. `(throw (RuntimeException. ~msg)))
  18. (defmacro ^:private verify
  19. ([test msg] `(when-not ~test (fail ~msg)))
  20. ([test] `(verify ~test ~(str "failed: " (pr-str test)))))
  21. (defn- divisible?
  22. [num div]
  23. (zero? (mod num div)))
  24. (defn- indivisible?
  25. [num div]
  26. (not (divisible? num div)))
  27. ;;; ------------------------------------------------------------------------
  28. ;;; parser implementation
  29. (defn- parse-int [^String s]
  30. (Long/parseLong s))
  31. (defn- zero-fill-right [^String s width]
  32. (cond (= width (count s)) s
  33. (< width (count s)) (.substring s 0 width)
  34. :else (loop [b (StringBuilder. s)]
  35. (if (< (.length b) width)
  36. (recur (.append b \0))
  37. (.toString b)))))
  38. (def parse-timestamp
  39. "Parse a string containing an RFC3339-like like timestamp.
  40. The function new-instant is called with the following arguments.
  41. min max default
  42. --- ------------ -------
  43. years 0 9999 N/A (s must provide years)
  44. months 1 12 1
  45. days 1 31 1 (actual max days depends
  46. hours 0 23 0 on month and year)
  47. minutes 0 59 0
  48. seconds 0 60 0 (though 60 is only valid
  49. nanoseconds 0 999999999 0 when minutes is 59)
  50. offset-sign -1 1 0
  51. offset-hours 0 23 0
  52. offset-minutes 0 59 0
  53. These are all integers and will be non-nil. (The listed defaults
  54. will be passed if the corresponding field is not present in s.)
  55. Grammar (of s):
  56. date-fullyear = 4DIGIT
  57. date-month = 2DIGIT ; 01-12
  58. date-mday = 2DIGIT ; 01-28, 01-29, 01-30, 01-31 based on
  59. ; month/year
  60. time-hour = 2DIGIT ; 00-23
  61. time-minute = 2DIGIT ; 00-59
  62. time-second = 2DIGIT ; 00-58, 00-59, 00-60 based on leap second
  63. ; rules
  64. time-secfrac = '.' 1*DIGIT
  65. time-numoffset = ('+' / '-') time-hour ':' time-minute
  66. time-offset = 'Z' / time-numoffset
  67. time-part = time-hour [ ':' time-minute [ ':' time-second
  68. [time-secfrac] [time-offset] ] ]
  69. timestamp = date-year [ '-' date-month [ '-' date-mday
  70. [ 'T' time-part ] ] ]
  71. Unlike RFC3339:
  72. - we only parse the timestamp format
  73. - timestamp can elide trailing components
  74. - time-offset is optional (defaults to +00:00)
  75. Though time-offset is syntactically optional, a missing time-offset
  76. will be treated as if the time-offset zero (+00:00) had been
  77. specified.
  78. "
  79. (let [timestamp #"(\d\d\d\d)(?:-(\d\d)(?:-(\d\d)(?:[T](\d\d)(?::(\d\d)(?::(\d\d)(?:[.](\d+))?)?)?)?)?)?(?:[Z]|([-+])(\d\d):(\d\d))?"]
  80. (fn [new-instant ^CharSequence cs]
  81. (if-let [[_ years months days hours minutes seconds fraction
  82. offset-sign offset-hours offset-minutes]
  83. (re-matches timestamp cs)]
  84. (new-instant
  85. (parse-int years)
  86. (if-not months 1 (parse-int months))
  87. (if-not days 1 (parse-int days))
  88. (if-not hours 0 (parse-int hours))
  89. (if-not minutes 0 (parse-int minutes))
  90. (if-not seconds 0 (parse-int seconds))
  91. (if-not fraction 0 (parse-int (zero-fill-right fraction 9)))
  92. (cond (= "-" offset-sign) -1
  93. (= "+" offset-sign) 1
  94. :else 0)
  95. (if-not offset-hours 0 (parse-int offset-hours))
  96. (if-not offset-minutes 0 (parse-int offset-minutes)))
  97. (fail (str "Unrecognized date/time syntax: " cs))))))
  98. ;;; ------------------------------------------------------------------------
  99. ;;; Verification of Extra-Grammatical Restrictions from RFC3339
  100. (defn- leap-year?
  101. [year]
  102. (and (divisible? year 4)
  103. (or (indivisible? year 100)
  104. (divisible? year 400))))
  105. (def ^:private days-in-month
  106. (let [dim-norm [nil 31 28 31 30 31 30 31 31 30 31 30 31]
  107. dim-leap [nil 31 29 31 30 31 30 31 31 30 31 30 31]]
  108. (fn [month leap-year?]
  109. ((if leap-year? dim-leap dim-norm) month))))
  110. (defn validated
  111. "Return a function which constructs and instant by calling constructor
  112. after first validating that those arguments are in range and otherwise
  113. plausible. The resulting function will throw an exception if called
  114. with invalid arguments."
  115. [new-instance]
  116. (fn [years months days hours minutes seconds nanoseconds
  117. offset-sign offset-hours offset-minutes]
  118. (verify (<= 1 months 12))
  119. (verify (<= 1 days (days-in-month months (leap-year? years))))
  120. (verify (<= 0 hours 23))
  121. (verify (<= 0 minutes 59))
  122. (verify (<= 0 seconds (if (= minutes 59) 60 59)))
  123. (verify (<= 0 nanoseconds 999999999))
  124. (verify (<= -1 offset-sign 1))
  125. (verify (<= 0 offset-hours 23))
  126. (verify (<= 0 offset-minutes 59))
  127. (new-instance years months days hours minutes seconds nanoseconds
  128. offset-sign offset-hours offset-minutes)))
  129. ;;; ------------------------------------------------------------------------
  130. ;;; print integration
  131. (def ^:private ^ThreadLocal thread-local-utc-date-format
  132. ;; SimpleDateFormat is not thread-safe, so we use a ThreadLocal proxy for access.
  133. ;; http://bugs.sun.com/bugdatabase/view_bug.do?bug_id=4228335
  134. (proxy [ThreadLocal] []
  135. (initialValue []
  136. (doto (java.text.SimpleDateFormat. "yyyy-MM-dd'T'HH:mm:ss.SSS-00:00")
  137. ;; RFC3339 says to use -00:00 when the timezone is unknown (+00:00 implies a known GMT)
  138. (.setTimeZone (java.util.TimeZone/getTimeZone "GMT"))))))
  139. (defn- print-date
  140. "Print a java.util.Date as RFC3339 timestamp, always in UTC."
  141. [^java.util.Date d, ^java.io.Writer w]
  142. (let [utc-format (.get thread-local-utc-date-format)]
  143. (.write w "#inst \"")
  144. (.write w ^String (.format ^java.text.SimpleDateFormat utc-format d))
  145. (.write w "\"")))
  146. (defmethod print-method java.util.Date
  147. [^java.util.Date d, ^java.io.Writer w]
  148. (print-date d w))
  149. (defmethod print-dup java.util.Date
  150. [^java.util.Date d, ^java.io.Writer w]
  151. (print-date d w))
  152. (defn- print-calendar
  153. "Print a java.util.Calendar as RFC3339 timestamp, preserving timezone."
  154. [^java.util.Calendar c, ^java.io.Writer w]
  155. (let [calstr (format "%1$tFT%1$tT.%1$tL%1$tz" c)
  156. offset-minutes (- (.length calstr) 2)]
  157. ;; calstr is almost right, but is missing the colon in the offset
  158. (.write w "#inst \"")
  159. (.write w calstr 0 offset-minutes)
  160. (.write w ":")
  161. (.write w calstr offset-minutes 2)
  162. (.write w "\"")))
  163. (defmethod print-method java.util.Calendar
  164. [^java.util.Calendar c, ^java.io.Writer w]
  165. (print-calendar c w))
  166. (defmethod print-dup java.util.Calendar
  167. [^java.util.Calendar c, ^java.io.Writer w]
  168. (print-calendar c w))
  169. (def ^:private ^ThreadLocal thread-local-utc-timestamp-format
  170. ;; SimpleDateFormat is not thread-safe, so we use a ThreadLocal proxy for access.
  171. ;; http://bugs.sun.com/bugdatabase/view_bug.do?bug_id=4228335
  172. (proxy [ThreadLocal] []
  173. (initialValue []
  174. (doto (java.text.SimpleDateFormat. "yyyy-MM-dd'T'HH:mm:ss")
  175. (.setTimeZone (java.util.TimeZone/getTimeZone "GMT"))))))
  176. (defn- print-timestamp
  177. "Print a java.sql.Timestamp as RFC3339 timestamp, always in UTC."
  178. [^java.sql.Timestamp ts, ^java.io.Writer w]
  179. (let [utc-format (.get thread-local-utc-timestamp-format)]
  180. (.write w "#inst \"")
  181. (.write w ^String (.format ^java.text.SimpleDateFormat utc-format ts))
  182. ;; add on nanos and offset
  183. ;; RFC3339 says to use -00:00 when the timezone is unknown (+00:00 implies a known GMT)
  184. (.write w (format ".%09d-00:00" (.getNanos ts)))
  185. (.write w "\"")))
  186. (defmethod print-method java.sql.Timestamp
  187. [^java.sql.Timestamp ts, ^java.io.Writer w]
  188. (print-timestamp ts w))
  189. (defmethod print-dup java.sql.Timestamp
  190. [^java.sql.Timestamp ts, ^java.io.Writer w]
  191. (print-timestamp ts w))
  192. ;;; ------------------------------------------------------------------------
  193. ;;; reader integration
  194. (defn- construct-calendar
  195. "Construct a java.util.Calendar, preserving the timezone
  196. offset, but truncating the subsecond fraction to milliseconds."
  197. ^GregorianCalendar
  198. [years months days hours minutes seconds nanoseconds
  199. offset-sign offset-hours offset-minutes]
  200. (doto (GregorianCalendar. years (dec months) days hours minutes seconds)
  201. (.set Calendar/MILLISECOND (quot nanoseconds 1000000))
  202. (.setTimeZone (TimeZone/getTimeZone
  203. (format "GMT%s%02d:%02d"
  204. (if (neg? offset-sign) "-" "+")
  205. offset-hours offset-minutes)))))
  206. (defn- construct-date
  207. "Construct a java.util.Date, which expresses the original instant as
  208. milliseconds since the epoch, UTC."
  209. [years months days hours minutes seconds nanoseconds
  210. offset-sign offset-hours offset-minutes]
  211. (.getTime (construct-calendar years months days
  212. hours minutes seconds nanoseconds
  213. offset-sign offset-hours offset-minutes)))
  214. (defn- construct-timestamp
  215. "Construct a java.sql.Timestamp, which has nanosecond precision."
  216. [years months days hours minutes seconds nanoseconds
  217. offset-sign offset-hours offset-minutes]
  218. (doto (Timestamp.
  219. (.getTimeInMillis
  220. (construct-calendar years months days
  221. hours minutes seconds 0
  222. offset-sign offset-hours offset-minutes)))
  223. ;; nanos must be set separately, pass 0 above for the base calendar
  224. (.setNanos nanoseconds)))
  225. (def read-instant-date
  226. "To read an instant as a java.util.Date, bind *data-readers* to a map with
  227. this var as the value for the 'inst key. The timezone offset will be used
  228. to convert into UTC."
  229. (partial parse-timestamp (validated construct-date)))
  230. (def read-instant-calendar
  231. "To read an instant as a java.util.Calendar, bind *data-readers* to a map with
  232. this var as the value for the 'inst key. Calendar preserves the timezone
  233. offset."
  234. (partial parse-timestamp (validated construct-calendar)))
  235. (def read-instant-timestamp
  236. "To read an instant as a java.sql.Timestamp, bind *data-readers* to a
  237. map with this var as the value for the 'inst key. Timestamp preserves
  238. fractional seconds with nanosecond precision. The timezone offset will
  239. be used to convert into UTC."
  240. (partial parse-timestamp (validated construct-timestamp)))
  241. ;;; clojure.uuid ;;;
  242. (defn default-uuid-reader [form]
  243. {:pre [(string? form)]}
  244. (java.util.UUID/fromString form))
  245. (defmethod print-method java.util.UUID [uuid ^java.io.Writer w]
  246. (.write w (str "#uuid \"" (str uuid) "\"")))
  247. (defmethod print-dup java.util.UUID [o w]
  248. (print-method o w))