commit 6882ef9185ce3a57fa06b2db600816198576af90 Author: mehbark Date: Sat Apr 19 17:37:31 2025 -0400 initial diff --git a/core.clj b/core.clj new file mode 100644 index 0000000..c27d0f7 --- /dev/null +++ b/core.clj @@ -0,0 +1,88 @@ +(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))) diff --git a/deps.edn b/deps.edn new file mode 100644 index 0000000..1520bab --- /dev/null +++ b/deps.edn @@ -0,0 +1,5 @@ +{:deps + {org.clojure/clojure {:mvn/version "1.12.0"} + org.clojure/core.logic {:mvn/version "1.1.0"} + clj-http/clj-http {:mvn/version "3.13.0"} + org.clj-commons/hickory {:mvn/version "0.7.7"}}}