date-strings.scm 2.2 KB

12345678910111213141516171819202122232425262728293031323334353637383940414243444546474849505152535455565758596061
  1. ;;
  2. ;; Copyright 2022, Jaidyn Levesque <jadedctrl@posteo.at>
  3. ;;
  4. ;; This program is free software: you can redistribute it and/or
  5. ;; modify it under the terms of the GNU General Public License as
  6. ;; published by the Free Software Foundation, either version 3 of
  7. ;; the License, or (at your option) any later version.
  8. ;;
  9. ;; This program is distributed in the hope that it will be useful,
  10. ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  11. ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
  12. ;; GNU General Public License for more details.
  13. ;;
  14. ;; You should have received a copy of the GNU General Public License
  15. ;; along with this program. If not, see <https://www.gnu.org/licenses/>.
  16. ;;
  17. ;; Simple helper module for feedsnake; converts between datestrings of different
  18. ;; formats and srfi-19 date objects.
  19. ;; Some of these formats have dedicated output codes in srfi-19 (~c, ~x, etc),
  20. ;; but it looks like the chicken doesn't support them.
  21. (module date-strings
  22. (date->rfc339-string rfc339-string->date date->rfc228-string date->mbox-string)
  23. (import scheme
  24. (chicken condition) (chicken format)
  25. srfi-19 srfi-13)
  26. ;; Converts a date into an rfc399 string
  27. (define (date->rfc339-string date)
  28. (date->string date "~Y-~m-~dT~H:~M:~S~z"))
  29. ;; Converts an rfc339 string into a datetime, timezone optional
  30. ;; … copied but not exported by feedsnake? mayyyybe >w>"
  31. (define (rfc339-string->date string)
  32. (handle-exceptions exn
  33. (handle-exceptions exn
  34. (string->date string "~Y-~m-~dT~H:~M:~S~z")
  35. #f)
  36. (string->date string "~Y-~m-~dT~H:~M:~S")))
  37. ;; Date into an RFC228 (e-mail) string
  38. (define (date->rfc228-string date)
  39. (let* ([month (string-titlecase (date->string date "~b"))]
  40. [weekday (string-titlecase (date->string date "~a"))]
  41. [timezone-raw (date->string date "~z")]
  42. [timezone (if (string=? timezone-raw "Z") "+0000" timezone-raw)])
  43. (format (date->string date "~~A, ~d ~~A ~Y ~T ~~A") weekday month timezone)))
  44. ;; Converts a date into an mbox From-compatible string
  45. (define (date->mbox-string date)
  46. (let* ([month (string-titlecase (date->string date "~b"))]
  47. [weekday (string-titlecase (date->string date "~a"))])
  48. (format (date->string date "~~A ~~A ~d ~T ~Y") weekday month)))
  49. ) ;; date-strings module