schedule/core.clj
2025-04-19 17:37:31 -04:00

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)))