89 lines
3.1 KiB
Clojure
89 lines
3.1 KiB
Clojure
(ns meh.schedule
|
|
(:refer-clojure :exclude [==])
|
|
(:require [clojure.core.logic :as logic :refer [run* run == fresh conde membero]]
|
|
[clojure.core.logic.fd :as fd]
|
|
[clj-http.client :as client]
|
|
[clojure.string :as str]
|
|
[hickory.core :as html]
|
|
[hickory.select :as sel]))
|
|
|
|
(defn time->num [timestamp]
|
|
(let [[h m] (str/split timestamp #":")
|
|
pm? (str/ends-with? m "PM")
|
|
h (parse-long h)
|
|
h (if (= h 12) 0 h)
|
|
h (if pm? (+ h 12) h)
|
|
m (parse-long (str/replace m #"(A|P)M" ""))]
|
|
(+ (* h 100) m)))
|
|
|
|
(def base-url (System/getenv "TIMETABLE_URL"))
|
|
|
|
(def get-timetable
|
|
(memoize
|
|
(fn [& {:keys [campus-code term subject number] :or {term "202501" campus-code 0}}]
|
|
(let [params {:CAMPUS campus-code
|
|
:TERMYEAR term
|
|
:SUBJ_CODE subject
|
|
:CRSE_NUMBER number
|
|
:open_only ""
|
|
:CORE_CODE "AR%"
|
|
:PRINT_FRIEND "Y"
|
|
:history "N"
|
|
:disp_comments_in "Y"}
|
|
resp (client/post base-url
|
|
{:form-params params})
|
|
page (-> resp :body html/parse html/as-hickory)
|
|
rows (drop 1 (sel/select (sel/tag :tr) page))]
|
|
(->> rows
|
|
(map :content)
|
|
(map (partial map
|
|
#(or (get-in % [:content 2 :content 0])
|
|
(get-in % [:content 1 :content 0])
|
|
(get-in % [:content 0 :content 0])
|
|
(get-in % [:content 0]))))
|
|
(map (partial filter string?))
|
|
(filter (fn [[crn & _]] (parse-long crn)))
|
|
(map (fn [[crn _ _ modality capacity _ days start end room _]]
|
|
{:crn (parse-long crn)
|
|
:subject subject
|
|
:number number
|
|
:modality (if (= modality "Face-to-Face Instruction") :in-person :online)
|
|
:days (mapv (comp keyword str/lower-case) (str/split days #"\s+"))
|
|
:start (time->num start)
|
|
:end (time->num end)
|
|
:room room})))))))
|
|
|
|
(defn classo [class days start end]
|
|
(logic/all
|
|
; the clojure way: extra keys are *not* an error
|
|
(logic/featurec class {:days days :start start :end end})
|
|
(fd/< start end)))
|
|
|
|
(defn non-overlappingo [a b]
|
|
(fresh [daysa starta enda daysb startb endb]
|
|
(classo a daysa starta enda)
|
|
(classo b daysb startb endb)
|
|
|
|
(conde
|
|
[(fresh [days]
|
|
(logic/appendo daysa daysb days)
|
|
(logic/distincto days))]
|
|
[(fd/< enda startb)]
|
|
[(fd/< endb starta)])))
|
|
|
|
(defn all-non-overlappingo [classes]
|
|
(logic/and*
|
|
(for [a classes
|
|
b classes]
|
|
(conde [(== a b)]
|
|
[(non-overlappingo a b)]))))
|
|
|
|
(defn scheduleo [sch classes]
|
|
(if (first classes)
|
|
(let [[[subject number] & classes] classes]
|
|
(fresh [class sch']
|
|
(membero class (get-timetable :subject subject :number number))
|
|
(logic/conjo sch' class sch)
|
|
(scheduleo sch' classes)))
|
|
(all-non-overlappingo sch)))
|