Skip to content

Commit

Permalink
Merge pull request #1 from remyrd/pto
Browse files Browse the repository at this point in the history
  • Loading branch information
@remyrd
remyrd authored Jul 11, 2021
2 parents ffc65bb + 486636a commit e909d46
Show file tree
Hide file tree
Showing 7 changed files with 304 additions and 175 deletions.
16 changes: 8 additions & 8 deletions src/rock_n_call/common/pagerduty.clj
View file
Original file line number Diff line number Diff line change
Expand Up @@ -58,20 +58,20 @@
Eg. Monday from 3am-8pm becomes 3am-9am, 6pm-8pm.
Groups such time intervals by `:user` (who was on call).
Returns a map of user->oncalls"
[{:keys [token timezone schedules]}]
[{:keys [token timezone schedules ptos]}]
(let [since (rnct/date->str (rnct/first-day-of-month))
until (rnct/date->str (rnct/first-day-of-next-month))]
(->> (pd-get! {:resource :oncalls
:token token
:query-params {"schedule_ids[]" (map :id schedules)
:time_zone timezone
:since since
:until until}})
(->> (pd-get! {:resource :oncalls
:token token
:query-params {"schedule_ids[]" (map :id schedules)
:time_zone timezone
:since since
:until until}})
(filter #(= 1 (:escalation_level %)))
(map #(select-keys % [:start :end :user :escalation_policy]))
(map rnct/parse-dates)
(map rnct/trim-dates)
(mapcat rnct/interval->dates)
(mapcat #(rnct/interval->dates % ptos))
(group-by #(get-in % [:user :summary]))
(into {}))))

Expand Down
51 changes: 51 additions & 0 deletions src/rock_n_call/common/pto.cljc
View file
Original file line number Diff line number Diff line change
@@ -0,0 +1,51 @@
(ns rock-n-call.common.pto
(:require [dk.ative.docjure.spreadsheet :as xls]
[clojure.string :as str]))

(defn format-row
"Formats row data into the context of a timesheet"
[row]
(-> row
(update :employeeid #(re-find #"7.*" %))
(update :lastname #(-> % (str/split #" ") first)) ;; hispanic surnames...
(assoc :employee (->> ((juxt :firstname :lastname) row)
(str/join " " )))
(dissoc :firstname :lastname)))

(defn file->maps
"Reads a the first sheet of an .xls(x) file containing PTO information.
Extracts the rows into maps."
[file]
(let [column-mapping {:A :employeeid
:B :lastname
:C :firstname
:E :status
:G :comment
:H :date
:I :days}]
(->> (xls/load-workbook file)
xls/sheet-seq
first ;; first sheet - always
(xls/select-columns column-mapping)
rest ;; omit first row - contains titles
(filter #(#{"Approved"} (:status %)))
(map format-row))))

(comment
(require '[cljc.java-time.zoned-date-time :as t])
(-> "abc" (str/split #" ") first)
(filter #(seq (:comment %)) (file->maps "example.xlsx"))
(let [{abc 1.0
bcd 0.5} (->>
(filter #(re-find #"Rem.*" (:employee %)) (file->maps "example.xlsx"))
(map #(select-keys % [:days :date]))
(map #(assoc % :date (.toInstant (:date %))))
(map #(assoc % :date (t/of-instant (:date %) (t/get-zone (t/now)))))
(map #(assoc % :date (t/to-local-date (:date %))))
(group-by :days)
(map (fn [[k v]] [k (set (map :date v))]))
(into {}))]
(bcd (t/to-local-date (t/now))))
(#{(t/to-local-date (t/now))} (t/to-local-date (t/now)))
(group-by :employee (file->maps "example.xlsx")))

119 changes: 72 additions & 47 deletions src/rock_n_call/common/time.clj
View file
Original file line number Diff line number Diff line change
Expand Up @@ -61,51 +61,73 @@
"Splits an daily interval into off-hours.
Necessary for weekdays where oncall is not charged
during working hours (9am - 6pm)"
[start end]
(let [nine-am (t/plus-hours (t/truncated-to start unit/days) 9)
six-pm (t/plus-hours (t/truncated-to start unit/days) 18)]
[start end half-day-ptos]
(let [is-pto? (and half-day-ptos
(half-day-ptos (t/to-local-date start))
(t/plus-hours (t/truncated-to start unit/days) 14))
start-work (or is-pto?
(t/plus-hours (t/truncated-to start unit/days) 9))
end-work (t/plus-hours (t/truncated-to start unit/days) 18)]
(filter some? [;; period between 0-9
(when (t/is-after nine-am start)
(when (t/is-after start-work start)
{:start start
:end (if (t/is-after end nine-am)
nine-am
end)})
:pto is-pto?
:end (if (t/is-after end start-work)
start-work
end)})
;; period between 18-24
(when (t/is-after end six-pm)
{:start (if (t/is-after start six-pm)
(when (t/is-after end end-work)
{:start (if (t/is-after start end-work)
start
six-pm)
:end end})])))
end-work)
:pto is-pto?
:end end})])))

(defn interval->dates
"Splits a several-days interval into consecutive intervals
of several hours during each day.
Differenciates workdays and weekends/holidays"
[{:keys [start end] :as schedule}]
(loop [current-dt start
time-rows []]
(let [next-dt (beginning-of-next-day current-dt)]
(if (t/is-after end current-dt)
;; loop into next day
(if (or (dow/equals dow/saturday (dow/from current-dt))
(dow/equals dow/sunday (dow/from current-dt))
(h/holiday? current-dt))
(recur next-dt
(concat time-rows
(list (merge schedule
{:start current-dt
:end (if (t/is-after end next-dt)
next-dt
end)} ))))
(recur next-dt
(concat time-rows
(map (partial merge schedule)
(weekday-times current-dt
(if (t/is-after end next-dt)
next-dt
end))))))
;; exit loop
time-rows))))
[{:keys [start end user] :as schedule} ptos]
(let [{full-day-ptos 1.0
half-day-ptos 0.5} (->> ptos
;; TODO transducer
(filter #(= (:summary user) (:employee %)))
(map #(select-keys % [:days :date]))
(map #(assoc % :date (.toInstant (:date %))))
(map #(assoc % :date (t/of-instant (:date %) (t/get-zone (t/now)))))
(map #(assoc % :date (t/to-local-date (:date %))))
(group-by :days)
(map (fn [[k v]] [k (set (map :date v))]))
(into {}))]
(loop [current-dt start
time-rows []]
(let [next-dt (beginning-of-next-day current-dt)
full-day-pto? (and full-day-ptos
(full-day-ptos (t/to-local-date current-dt)))]
(if (t/is-after end current-dt)
;; loop into next day
(if (or (dow/equals dow/saturday (dow/from current-dt))
(dow/equals dow/sunday (dow/from current-dt))
(h/holiday? current-dt)
full-day-pto?)
(recur next-dt
(concat time-rows
(list (merge schedule
{:start current-dt
:pto full-day-pto?
:end (if (t/is-after end next-dt)
next-dt
end)} ))))
(recur next-dt
(concat time-rows
(map (partial merge schedule)
(weekday-times current-dt
(if (t/is-after end next-dt)
next-dt
end)
half-day-ptos)))))
;; exit loop
time-rows)))))

(defn interval->hours
[{:keys [start end]}]
Expand All @@ -115,25 +137,28 @@

(defn date->row
"Given an interval, generates the corresponding row for the oncall sheet"
[{:keys [start end] :as interval}]
[{:keys [start end pto] :as interval}]
(let [time-format (dtf/of-pattern "HH:mm")
date-format (dtf/of-pattern "dd/MM/YYYY")
start-str (dtf/format time-format start)
end-str (dtf/format time-format end)]
start-str (dtf/format time-format start)
end-str (dtf/format time-format end)]
(list (dtf/format date-format start)
start-str
(if (= end-str "00:00")
"24:00"
end-str)
(interval->hours interval))))
(interval->hours interval)
(when pto "PTO"))))


(comment
(->> {:start "2021-02-05T00:34:00-04:00"
:user {:id "123"}
:end "2021-02-07T12:00:00-04:00"}
parse-dates
trim-dates
interval->dates
(map date->row))
(require '[rock-n-call.common.pto :refer [file->maps]])
(def ptos (file->maps "example2.xlsx"))
(->> {:start "2021-07-01T00:34:00-02:00"
:user {:id "123" :summary "Remy Rojas"}
:end "2021-07-14T12:00:00-02:00"}
parse-dates
trim-dates
(#(interval->dates % ptos))
(map date->row))
)
33 changes: 17 additions & 16 deletions src/rock_n_call/ui/core.clj
View file
Original file line number Diff line number Diff line change
Expand Up @@ -20,23 +20,24 @@
Immediately dispatches `e/handler-fn` with `::e/initialize-pd-data`"
[]
(let [config-path (str (System/getProperty "user.home") "/.rock-n-call")
base-config {:path config-path
base-config {:path config-path
:output-dir (str (System/getProperty "user.home") "/Documents")
:token ""
:timezone "CET"}
*state (atom (fx/create-context {:config (or (when (.exists (io/file config-path))
(read-string (slurp config-path)))
base-config)
:show-token false
:status "Enter a valid Pagerduty token and press START"}
cache/lru-cache-factory))
handler (:handler (fx/create-app *state
:event-handler e/handler-fn
:desc-fn (fn [_]
{:fx/type v/root})
:effects {:generate-sheet e/generate-sheet
:pagerduty e/pagerduty-handler
:change-dir e/change-dir}))]
:token ""
:timezone "CET"}
*state (atom (fx/create-context {:config (or (when (.exists (io/file config-path))
(read-string (slurp config-path)))
base-config)
:show-token false
:status "Enter a valid Pagerduty token and press START"}
cache/lru-cache-factory))
handler (:handler (fx/create-app *state
:event-handler e/handler-fn
:desc-fn (fn [_]
{:fx/type v/root})
:effects {:generate-sheet e/generate-sheet
:choose-pto-file e/choose-pto-file
:pagerduty e/pagerduty-handler
:change-dir e/change-dir}))]
(handler {:event-type ::e/initialize-pd-data})
))

Expand Down
57 changes: 39 additions & 18 deletions src/rock_n_call/ui/events.clj
View file
Original file line number Diff line number Diff line change
Expand Up @@ -3,9 +3,10 @@
[rock-n-call.common.pagerduty :as pd]
[rock-n-call.common.time :as rnct]
[rock-n-call.common.printer :as printer]
[rock-n-call.common.pto :as pto]
[rock-n-call.ui.utils :as utils]
[cljfx.api :as fx])
(:import [javafx.stage DirectoryChooser]
(:import [javafx.stage DirectoryChooser FileChooser]
[javafx.event ActionEvent]
[javafx.scene Node]
[java.awt Desktop]
Expand Down Expand Up @@ -67,6 +68,14 @@
(defmethod handler-fn ::change-dir [{:keys [^ActionEvent fx/event]}]
{:change-dir {:event event}})

(defmethod handler-fn ::choose-pto-file [{:keys [^ActionEvent fx/event]}]
{:choose-pto-file {:event event}})

(defmethod handler-fn ::load-pto [{:keys [fx/event fx/context]}]
{:context (fx/swap-context context assoc :ptos (pto/file->maps event))
:dispatch {:event-type ::update-status
:message (format "Loaded PTO file from %s" event)}})

(defmethod handler-fn ::toggle-show-token [{:keys [fx/context]}]
{:context (fx/swap-context context update :show-token not)})

Expand All @@ -93,16 +102,18 @@
{:context context})

(defmethod handler-fn ::choose-team [{:keys [fx/event fx/context]}]
(let [schedules (fx/sub-val context :schedules)
(let [schedules (fx/sub-val context :schedules)
ptos (fx/sub-val context :ptos)
team-schedules (filter (partial pd/contains-team? event) schedules)
timezone (fx/sub-val context #(get-in % [:config :timezone]))]
{:context (fx/swap-context context #(assoc %
:chosen-team event
:status (format "Status: Loading %s" (:summary event))))
timezone (fx/sub-val context #(get-in % [:config :timezone]))]
{:context (fx/swap-context context #(assoc %
:chosen-team event
:status (format "Status: Loading %s" (:summary event))))
:pagerduty {:event-type ::load-team
:token (fx/sub-val context #(get-in % [:config :token]))
:timezone timezone
:schedules team-schedules}} ))
:token (fx/sub-val context #(get-in % [:config :token]))
:timezone timezone
:schedules team-schedules
:ptos ptos}} ))

(defmethod handler-fn ::put-team-to-state [{:keys [fx/context team]}]
{:context (fx/swap-context context merge {:team team
Expand Down Expand Up @@ -178,13 +189,23 @@
Dispatches the `::edit-config-field` event when complete, editing `:output-dir`"
[{:keys [^ActionEvent event]} d!]
(fx/on-fx-thread
(let [window (.getWindow (.getScene ^Node (.getTarget event)))
chooser (doto (DirectoryChooser.)
(.setTitle "Open Directory"))]
(when-let [directory (.showDialog chooser window)]
(d! {:event-type ::edit-config-field
:fx/event (.getAbsolutePath directory)
:text-key :output-dir})))))
(let [window (.getWindow (.getScene ^Node (.getTarget event)))
chooser (doto (DirectoryChooser.)
(.setTitle "Open Directory"))]
(when-let [directory (.showDialog chooser window)]
(d! {:event-type ::edit-config-field
:fx/event (.getAbsolutePath directory)
:text-key :output-dir})))))

(defn choose-pto-file
[{:keys [^ActionEvent event]} d!]
(fx/on-fx-thread
(let [window (.getWindow (.getScene ^Node (.getTarget event)))
chooser (doto (FileChooser.)
(.setTitle "Choose XLS sheet contianing PTO information"))]
(when-let [file (.showOpenDialog chooser window)]
(d! {:event-type ::load-pto
:fx/event (.getAbsolutePath file)})))))

(defn generate-sheet
"Effect to handle sheet generation.
Expand All @@ -197,11 +218,11 @@
(try
(printer/export-xls args)
(d! {:event-type ::add-recent-file
:f (:output-path args)})
:f (:output-path args)})
(catch Exception e
(println e)
(d! {:event-type ::update-status
:message "Error generating the Sheet..."})))))
:message "Error generating the Sheet..."})))))

(defmulti pagerduty-handler
"Multimethod used to handle the `:pagerduty` effect with calls to the pagerduty API.
Expand Down
Loading

0 comments on commit e909d46

Please sign in to comment.