-
Notifications
You must be signed in to change notification settings - Fork 0
/
schedule.lisp
55 lines (50 loc) · 2.33 KB
/
schedule.lisp
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
(defpackage #:shibuyarakugo-parser/schedule
(:use #:cl
#:shibuyarakugo-parser/utils
#:lquery)
(:import-from #:quri)
(:import-from #:cl-ppcre)
(:export #:parse-index))
(in-package #:shibuyarakugo-parser/schedule)
(defvar *base-uri*
(quri:uri "https://eurolive.jp/shibuya-rakugo/"))
(defparameter *venue* "ユーロライブ")
(defparameter *venue-address* "東京都渋谷区円山町1-5 KINOHAUS2F")
(defun parse-performers (performers)
(mapcar (lambda (performer)
(ppcre:regex-replace "\\*+$" performer ""))
(remove ""
(ppcre:split " " performers)
:test 'equal)))
(defun parse-dl (dl)
(let ((dt ($1 dl "dt")))
(assert dt)
(let ((date ($1 dt (render-text))))
(or (ppcre:register-groups-bind ((#'parse-integer month day))
("^(\\d{1,2})月(\\d{1,2})日" date)
(let* ((year (get-year-of-month month))
(date-string (format nil "~D-~2,'0D-~2,'0D" year month day)))
(coerce
($ dl "dd"
(combine ".time" ".title" ".text")
(map-apply (lambda (time title text)
(let ((time-string ($1 time (render-text))))
(or (ppcre:register-groups-bind (start-time end-time)
("^(\\d{2}:\\d{2})~(\\d{2}:\\d{2})$" time-string)
`(("date" . ,date-string)
("start-time" . ,start-time)
("end-time" . ,end-time)
("title" . ,(ppcre:regex-replace "「(.+)」" ($1 title (render-text)) "\\1"))
("performers" . ,(parse-performers ($1 text (render-text))))))
(error "Invalid shibuya-rakugo time: ~S" time-string))))))
'list)))
(error "Invalid shibuya-rakugo date: ~S" date)))))
(defun parse-index (body)
(let* ((main ($1 (initialize body) "#schedule"))
(schedules ($ main ".calendar dl")))
(assert main)
(assert (< 0 (length schedules)))
`(("schedules" . ,(loop for schedule across schedules
append (parse-dl schedule)))
("place" . ,*venue*)
("address" . ,*venue-address*))))