Skip to content

Commit e909d46

Browse files
remyrdremyrd
authored
Merge pull request #1 from remyrd/pto
2 parents ffc65bb + 486636a commit e909d46

File tree

7 files changed

+304
-175
lines changed

7 files changed

+304
-175
lines changed

‎src/rock_n_call/common/pagerduty.clj

+8-8
Original file line numberDiff line numberDiff line change
@@ -58,20 +58,20 @@
5858
Eg. Monday from 3am-8pm becomes 3am-9am, 6pm-8pm.
5959
Groups such time intervals by `:user` (who was on call).
6060
Returns a map of user->oncalls"
61-
[{:keys [token timezone schedules]}]
61+
[{:keys [token timezone schedules ptos]}]
6262
(let [since (rnct/date->str (rnct/first-day-of-month))
6363
until (rnct/date->str (rnct/first-day-of-next-month))]
64-
(->> (pd-get! {:resource :oncalls
65-
:token token
66-
:query-params {"schedule_ids[]" (map :id schedules)
67-
:time_zone timezone
68-
:since since
69-
:until until}})
64+
(->> (pd-get! {:resource :oncalls
65+
:token token
66+
:query-params {"schedule_ids[]" (map :id schedules)
67+
:time_zone timezone
68+
:since since
69+
:until until}})
7070
(filter #(= 1 (:escalation_level %)))
7171
(map #(select-keys % [:start :end :user :escalation_policy]))
7272
(map rnct/parse-dates)
7373
(map rnct/trim-dates)
74-
(mapcat rnct/interval->dates)
74+
(mapcat #(rnct/interval->dates % ptos))
7575
(group-by #(get-in % [:user :summary]))
7676
(into {}))))
7777

‎src/rock_n_call/common/pto.cljc

+51
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,51 @@
1+
(ns rock-n-call.common.pto
2+
(:require [dk.ative.docjure.spreadsheet :as xls]
3+
[clojure.string :as str]))
4+
5+
(defn format-row
6+
"Formats row data into the context of a timesheet"
7+
[row]
8+
(-> row
9+
(update :employeeid #(re-find #"7.*" %))
10+
(update :lastname #(-> % (str/split #" ") first)) ;; hispanic surnames...
11+
(assoc :employee (->> ((juxt :firstname :lastname) row)
12+
(str/join " " )))
13+
(dissoc :firstname :lastname)))
14+
15+
(defn file->maps
16+
"Reads a the first sheet of an .xls(x) file containing PTO information.
17+
Extracts the rows into maps."
18+
[file]
19+
(let [column-mapping {:A :employeeid
20+
:B :lastname
21+
:C :firstname
22+
:E :status
23+
:G :comment
24+
:H :date
25+
:I :days}]
26+
(->> (xls/load-workbook file)
27+
xls/sheet-seq
28+
first ;; first sheet - always
29+
(xls/select-columns column-mapping)
30+
rest ;; omit first row - contains titles
31+
(filter #(#{"Approved"} (:status %)))
32+
(map format-row))))
33+
34+
(comment
35+
(require '[cljc.java-time.zoned-date-time :as t])
36+
(-> "abc" (str/split #" ") first)
37+
(filter #(seq (:comment %)) (file->maps "example.xlsx"))
38+
(let [{abc 1.0
39+
bcd 0.5} (->>
40+
(filter #(re-find #"Rem.*" (:employee %)) (file->maps "example.xlsx"))
41+
(map #(select-keys % [:days :date]))
42+
(map #(assoc % :date (.toInstant (:date %))))
43+
(map #(assoc % :date (t/of-instant (:date %) (t/get-zone (t/now)))))
44+
(map #(assoc % :date (t/to-local-date (:date %))))
45+
(group-by :days)
46+
(map (fn [[k v]] [k (set (map :date v))]))
47+
(into {}))]
48+
(bcd (t/to-local-date (t/now))))
49+
(#{(t/to-local-date (t/now))} (t/to-local-date (t/now)))
50+
(group-by :employee (file->maps "example.xlsx")))
51+

‎src/rock_n_call/common/time.clj

+72-47
Original file line numberDiff line numberDiff line change
@@ -61,51 +61,73 @@
6161
"Splits an daily interval into off-hours.
6262
Necessary for weekdays where oncall is not charged
6363
during working hours (9am - 6pm)"
64-
[start end]
65-
(let [nine-am (t/plus-hours (t/truncated-to start unit/days) 9)
66-
six-pm (t/plus-hours (t/truncated-to start unit/days) 18)]
64+
[start end half-day-ptos]
65+
(let [is-pto? (and half-day-ptos
66+
(half-day-ptos (t/to-local-date start))
67+
(t/plus-hours (t/truncated-to start unit/days) 14))
68+
start-work (or is-pto?
69+
(t/plus-hours (t/truncated-to start unit/days) 9))
70+
end-work (t/plus-hours (t/truncated-to start unit/days) 18)]
6771
(filter some? [;; period between 0-9
68-
(when (t/is-after nine-am start)
72+
(when (t/is-after start-work start)
6973
{:start start
70-
:end (if (t/is-after end nine-am)
71-
nine-am
72-
end)})
74+
:pto is-pto?
75+
:end (if (t/is-after end start-work)
76+
start-work
77+
end)})
7378
;; period between 18-24
74-
(when (t/is-after end six-pm)
75-
{:start (if (t/is-after start six-pm)
79+
(when (t/is-after end end-work)
80+
{:start (if (t/is-after start end-work)
7681
start
77-
six-pm)
78-
:end end})])))
82+
end-work)
83+
:pto is-pto?
84+
:end end})])))
7985

8086
(defn interval->dates
8187
"Splits a several-days interval into consecutive intervals
8288
of several hours during each day.
8389
Differenciates workdays and weekends/holidays"
84-
[{:keys [start end] :as schedule}]
85-
(loop [current-dt start
86-
time-rows []]
87-
(let [next-dt (beginning-of-next-day current-dt)]
88-
(if (t/is-after end current-dt)
89-
;; loop into next day
90-
(if (or (dow/equals dow/saturday (dow/from current-dt))
91-
(dow/equals dow/sunday (dow/from current-dt))
92-
(h/holiday? current-dt))
93-
(recur next-dt
94-
(concat time-rows
95-
(list (merge schedule
96-
{:start current-dt
97-
:end (if (t/is-after end next-dt)
98-
next-dt
99-
end)} ))))
100-
(recur next-dt
101-
(concat time-rows
102-
(map (partial merge schedule)
103-
(weekday-times current-dt
104-
(if (t/is-after end next-dt)
105-
next-dt
106-
end))))))
107-
;; exit loop
108-
time-rows))))
90+
[{:keys [start end user] :as schedule} ptos]
91+
(let [{full-day-ptos 1.0
92+
half-day-ptos 0.5} (->> ptos
93+
;; TODO transducer
94+
(filter #(= (:summary user) (:employee %)))
95+
(map #(select-keys % [:days :date]))
96+
(map #(assoc % :date (.toInstant (:date %))))
97+
(map #(assoc % :date (t/of-instant (:date %) (t/get-zone (t/now)))))
98+
(map #(assoc % :date (t/to-local-date (:date %))))
99+
(group-by :days)
100+
(map (fn [[k v]] [k (set (map :date v))]))
101+
(into {}))]
102+
(loop [current-dt start
103+
time-rows []]
104+
(let [next-dt (beginning-of-next-day current-dt)
105+
full-day-pto? (and full-day-ptos
106+
(full-day-ptos (t/to-local-date current-dt)))]
107+
(if (t/is-after end current-dt)
108+
;; loop into next day
109+
(if (or (dow/equals dow/saturday (dow/from current-dt))
110+
(dow/equals dow/sunday (dow/from current-dt))
111+
(h/holiday? current-dt)
112+
full-day-pto?)
113+
(recur next-dt
114+
(concat time-rows
115+
(list (merge schedule
116+
{:start current-dt
117+
:pto full-day-pto?
118+
:end (if (t/is-after end next-dt)
119+
next-dt
120+
end)} ))))
121+
(recur next-dt
122+
(concat time-rows
123+
(map (partial merge schedule)
124+
(weekday-times current-dt
125+
(if (t/is-after end next-dt)
126+
next-dt
127+
end)
128+
half-day-ptos)))))
129+
;; exit loop
130+
time-rows)))))
109131

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

116138
(defn date->row
117139
"Given an interval, generates the corresponding row for the oncall sheet"
118-
[{:keys [start end] :as interval}]
140+
[{:keys [start end pto] :as interval}]
119141
(let [time-format (dtf/of-pattern "HH:mm")
120142
date-format (dtf/of-pattern "dd/MM/YYYY")
121-
start-str (dtf/format time-format start)
122-
end-str (dtf/format time-format end)]
143+
start-str (dtf/format time-format start)
144+
end-str (dtf/format time-format end)]
123145
(list (dtf/format date-format start)
124146
start-str
125147
(if (= end-str "00:00")
126148
"24:00"
127149
end-str)
128-
(interval->hours interval))))
150+
(interval->hours interval)
151+
(when pto "PTO"))))
129152

130153

131154
(comment
132-
(->> {:start "2021-02-05T00:34:00-04:00"
133-
:user {:id "123"}
134-
:end "2021-02-07T12:00:00-04:00"}
135-
parse-dates
136-
trim-dates
137-
interval->dates
138-
(map date->row))
155+
(require '[rock-n-call.common.pto :refer [file->maps]])
156+
(def ptos (file->maps "example2.xlsx"))
157+
(->> {:start "2021-07-01T00:34:00-02:00"
158+
:user {:id "123" :summary "Remy Rojas"}
159+
:end "2021-07-14T12:00:00-02:00"}
160+
parse-dates
161+
trim-dates
162+
(#(interval->dates % ptos))
163+
(map date->row))
139164
)

‎src/rock_n_call/ui/core.clj

+17-16
Original file line numberDiff line numberDiff line change
@@ -20,23 +20,24 @@
2020
Immediately dispatches `e/handler-fn` with `::e/initialize-pd-data`"
2121
[]
2222
(let [config-path (str (System/getProperty "user.home") "/.rock-n-call")
23-
base-config {:path config-path
23+
base-config {:path config-path
2424
:output-dir (str (System/getProperty "user.home") "/Documents")
25-
:token ""
26-
:timezone "CET"}
27-
*state (atom (fx/create-context {:config (or (when (.exists (io/file config-path))
28-
(read-string (slurp config-path)))
29-
base-config)
30-
:show-token false
31-
:status "Enter a valid Pagerduty token and press START"}
32-
cache/lru-cache-factory))
33-
handler (:handler (fx/create-app *state
34-
:event-handler e/handler-fn
35-
:desc-fn (fn [_]
36-
{:fx/type v/root})
37-
:effects {:generate-sheet e/generate-sheet
38-
:pagerduty e/pagerduty-handler
39-
:change-dir e/change-dir}))]
25+
:token ""
26+
:timezone "CET"}
27+
*state (atom (fx/create-context {:config (or (when (.exists (io/file config-path))
28+
(read-string (slurp config-path)))
29+
base-config)
30+
:show-token false
31+
:status "Enter a valid Pagerduty token and press START"}
32+
cache/lru-cache-factory))
33+
handler (:handler (fx/create-app *state
34+
:event-handler e/handler-fn
35+
:desc-fn (fn [_]
36+
{:fx/type v/root})
37+
:effects {:generate-sheet e/generate-sheet
38+
:choose-pto-file e/choose-pto-file
39+
:pagerduty e/pagerduty-handler
40+
:change-dir e/change-dir}))]
4041
(handler {:event-type ::e/initialize-pd-data})
4142
))
4243

‎src/rock_n_call/ui/events.clj

+39-18
Original file line numberDiff line numberDiff line change
@@ -3,9 +3,10 @@
33
[rock-n-call.common.pagerduty :as pd]
44
[rock-n-call.common.time :as rnct]
55
[rock-n-call.common.printer :as printer]
6+
[rock-n-call.common.pto :as pto]
67
[rock-n-call.ui.utils :as utils]
78
[cljfx.api :as fx])
8-
(:import [javafx.stage DirectoryChooser]
9+
(:import [javafx.stage DirectoryChooser FileChooser]
910
[javafx.event ActionEvent]
1011
[javafx.scene Node]
1112
[java.awt Desktop]
@@ -67,6 +68,14 @@
6768
(defmethod handler-fn ::change-dir [{:keys [^ActionEvent fx/event]}]
6869
{:change-dir {:event event}})
6970

71+
(defmethod handler-fn ::choose-pto-file [{:keys [^ActionEvent fx/event]}]
72+
{:choose-pto-file {:event event}})
73+
74+
(defmethod handler-fn ::load-pto [{:keys [fx/event fx/context]}]
75+
{:context (fx/swap-context context assoc :ptos (pto/file->maps event))
76+
:dispatch {:event-type ::update-status
77+
:message (format "Loaded PTO file from %s" event)}})
78+
7079
(defmethod handler-fn ::toggle-show-token [{:keys [fx/context]}]
7180
{:context (fx/swap-context context update :show-token not)})
7281

@@ -93,16 +102,18 @@
93102
{:context context})
94103

95104
(defmethod handler-fn ::choose-team [{:keys [fx/event fx/context]}]
96-
(let [schedules (fx/sub-val context :schedules)
105+
(let [schedules (fx/sub-val context :schedules)
106+
ptos (fx/sub-val context :ptos)
97107
team-schedules (filter (partial pd/contains-team? event) schedules)
98-
timezone (fx/sub-val context #(get-in % [:config :timezone]))]
99-
{:context (fx/swap-context context #(assoc %
100-
:chosen-team event
101-
:status (format "Status: Loading %s" (:summary event))))
108+
timezone (fx/sub-val context #(get-in % [:config :timezone]))]
109+
{:context (fx/swap-context context #(assoc %
110+
:chosen-team event
111+
:status (format "Status: Loading %s" (:summary event))))
102112
:pagerduty {:event-type ::load-team
103-
:token (fx/sub-val context #(get-in % [:config :token]))
104-
:timezone timezone
105-
:schedules team-schedules}} ))
113+
:token (fx/sub-val context #(get-in % [:config :token]))
114+
:timezone timezone
115+
:schedules team-schedules
116+
:ptos ptos}} ))
106117

107118
(defmethod handler-fn ::put-team-to-state [{:keys [fx/context team]}]
108119
{:context (fx/swap-context context merge {:team team
@@ -178,13 +189,23 @@
178189
Dispatches the `::edit-config-field` event when complete, editing `:output-dir`"
179190
[{:keys [^ActionEvent event]} d!]
180191
(fx/on-fx-thread
181-
(let [window (.getWindow (.getScene ^Node (.getTarget event)))
182-
chooser (doto (DirectoryChooser.)
183-
(.setTitle "Open Directory"))]
184-
(when-let [directory (.showDialog chooser window)]
185-
(d! {:event-type ::edit-config-field
186-
:fx/event (.getAbsolutePath directory)
187-
:text-key :output-dir})))))
192+
(let [window (.getWindow (.getScene ^Node (.getTarget event)))
193+
chooser (doto (DirectoryChooser.)
194+
(.setTitle "Open Directory"))]
195+
(when-let [directory (.showDialog chooser window)]
196+
(d! {:event-type ::edit-config-field
197+
:fx/event (.getAbsolutePath directory)
198+
:text-key :output-dir})))))
199+
200+
(defn choose-pto-file
201+
[{:keys [^ActionEvent event]} d!]
202+
(fx/on-fx-thread
203+
(let [window (.getWindow (.getScene ^Node (.getTarget event)))
204+
chooser (doto (FileChooser.)
205+
(.setTitle "Choose XLS sheet contianing PTO information"))]
206+
(when-let [file (.showOpenDialog chooser window)]
207+
(d! {:event-type ::load-pto
208+
:fx/event (.getAbsolutePath file)})))))
188209

189210
(defn generate-sheet
190211
"Effect to handle sheet generation.
@@ -197,11 +218,11 @@
197218
(try
198219
(printer/export-xls args)
199220
(d! {:event-type ::add-recent-file
200-
:f (:output-path args)})
221+
:f (:output-path args)})
201222
(catch Exception e
202223
(println e)
203224
(d! {:event-type ::update-status
204-
:message "Error generating the Sheet..."})))))
225+
:message "Error generating the Sheet..."})))))
205226

206227
(defmulti pagerduty-handler
207228
"Multimethod used to handle the `:pagerduty` effect with calls to the pagerduty API.

0 commit comments

Comments
 (0)