Rewrite deadlines code.
Add zsh autocompletion. Add symlink to worktimer.scm
This commit is contained in:
Nikolay Puzanov
parent
be26b63924
commit
3fc94fdf6b
827
worktimer.scm
827
worktimer.scm
@ -37,11 +37,12 @@
|
||||
;;; PROJECT/TASK/SUBTASK/ETC: [START_TIME] - [STOP_TIME] - DURATION
|
||||
|
||||
;;; Hardcoded timesheet filename
|
||||
(define ts-file (string-append (getenv "HOME") "/.timesheet"))
|
||||
(define dl-file (string-append (getenv "HOME") "/.deadlines"))
|
||||
(define ts-file (string-append (getenv "HOME") "/.timesheet-new"))
|
||||
(define date-time-format "~Y-~m-~d ~H:~M:~S")
|
||||
(define date-format "~Y-~m-~d")
|
||||
|
||||
;;; ========================= COMMON HELPER FUNCTIONS ==========================
|
||||
|
||||
;;; Find substring separated by ch-start and ch-end.
|
||||
;;; (substring/find str ch-start ch-end [begin end])
|
||||
;;; If ch-start is #f, select substring from beginning of string.
|
||||
@ -57,7 +58,16 @@
|
||||
(if (not cs) (reverse strings)
|
||||
(loop (cons (substring str (1+ cs) ce) strings) (1+ ce)))))))))
|
||||
|
||||
;;; Convert time-difference to string "hh:mm:ss"
|
||||
;;; Remove duplicates in list
|
||||
(define (remove-dup list)
|
||||
(reverse
|
||||
(fold (lambda (x l)
|
||||
(if (or (null? l)
|
||||
(not (equal? (car l) x)))
|
||||
(cons x l) l))
|
||||
'() list)))
|
||||
|
||||
;;; Convert time to string "hh:mm:ss"
|
||||
(define (time->string td)
|
||||
(let ((sec (time-second td)))
|
||||
(let* ((h (quotient sec 3600))
|
||||
@ -68,6 +78,32 @@
|
||||
(format #f "~2,'0d" m) ":"
|
||||
(format #f "~2,'0d" s)))))
|
||||
|
||||
;;; Convert string "hh:mm:ss" to time
|
||||
(define (string->time str)
|
||||
(let ((splitted (string-split str #\:)))
|
||||
(if (not (= (length splitted) 3))
|
||||
(throw 'bad-time-string "Bad time format (expected hh:mm:ss)" str)
|
||||
(let ((h (string->number (car splitted)))
|
||||
(m (string->number (cadr splitted)))
|
||||
(s (string->number (caddr splitted))))
|
||||
(if (and (and h m s) (< m 60) (< s 60))
|
||||
(make-time 'time-duration 0
|
||||
(+ (* h 3600) (* m 60) s))
|
||||
(throw 'bad-time-string "Bad time string" str))))))
|
||||
|
||||
;;; Convert string to date or time
|
||||
;;; Time is "hh:mm:ss", date is date-format
|
||||
(define (string->date/time str)
|
||||
(if (string-any #\: str)
|
||||
(string->time str)
|
||||
(string->date str date-format)))
|
||||
|
||||
;;; Convert date or time to string
|
||||
(define (date/time->string time)
|
||||
(if (date? time)
|
||||
(date->string time date-format)
|
||||
(time->string time)))
|
||||
|
||||
;;; Convert path to string
|
||||
(define (path->string path)
|
||||
(let loop ((path path)
|
||||
@ -91,49 +127,6 @@
|
||||
(loop
|
||||
(cons (substring str path-start item-end) path) (1+ item-end)))))))
|
||||
|
||||
;;; Parse task string and return list:
|
||||
;;; '((list of path elements) start-date stop-date duration)
|
||||
(define (parse-task-string str)
|
||||
(let ((str (string-trim-both str)))
|
||||
(if (or (zero? (string-length str))
|
||||
(equal? (string-ref str 0) #\#))
|
||||
#f
|
||||
(let ((path
|
||||
(let ((path-end (string-index str #\:)))
|
||||
(if (not path-end) #f
|
||||
(path-split str 0 path-end))))
|
||||
(dates (substring/find str #\[ #\])))
|
||||
(if (or (not path) (not dates) (null? dates))
|
||||
#f
|
||||
(let ((date-start (string->date (car dates) date-time-format)))
|
||||
(let-values (((date-end duration)
|
||||
(if (null? (cdr dates))
|
||||
(values #f #f)
|
||||
(let* ((date-end (string->date (cadr dates) date-time-format))
|
||||
(duration (time-difference
|
||||
(date->time-utc date-end)
|
||||
(date->time-utc date-start))))
|
||||
(values date-end duration)))))
|
||||
(list path date-start date-end duration))))))))
|
||||
|
||||
;;; Read file and parse it line by line.
|
||||
;;; Returns list of parsed lines.
|
||||
(define (read-and-parse-file filename lineparser)
|
||||
(if (file-exists? filename)
|
||||
(call-with-input-file filename
|
||||
(lambda (port)
|
||||
(let loop ((recs '()))
|
||||
(let ((line (get-line port)))
|
||||
(if (eof-object? line)
|
||||
(reverse recs)
|
||||
(loop (let ((item (lineparser line)))
|
||||
(if item (cons item recs) recs))))))))
|
||||
'()))
|
||||
|
||||
;;; Parse timesheet file and return list of tasks
|
||||
(define (read-timesheet filename)
|
||||
(read-and-parse-file filename parse-task-string))
|
||||
|
||||
;;; Compare paths
|
||||
(define (path<? a b)
|
||||
(let loop ((a a) (b b))
|
||||
@ -144,52 +137,11 @@
|
||||
(loop (cdr a) (cdr b))
|
||||
(string< (car a) (car b))))))))
|
||||
|
||||
;;; Compare deadlines by path
|
||||
(define (deadline<? a b)
|
||||
(path<? (car a) (car b)))
|
||||
|
||||
;;; Read timesheet and deadlines
|
||||
(define (read-timesheet1 filename)
|
||||
(if (file-exists? filename)
|
||||
(call-with-input-file filename
|
||||
(lambda (port)
|
||||
(let loop ((record-type 'unknown)
|
||||
(timerecords '())
|
||||
(deadlines '()))
|
||||
(let ((line (get-line port)))
|
||||
(if (eof-object? line)
|
||||
(values (reverse timerecords)
|
||||
(sort deadlines deadline<?))
|
||||
(let ((line (string-trim-both line)))
|
||||
(cond
|
||||
((or (string-null? line)
|
||||
(eq? (string-ref line 0) #\#))
|
||||
(loop record-type timerecords deadlines))
|
||||
((string-ci=? line "--- DEADLINES")
|
||||
(loop 'deadline timerecords deadlines))
|
||||
((string-ci=? line "--- TIMESHEET")
|
||||
(loop 'timerecord timerecords deadlines))
|
||||
(else
|
||||
(cond
|
||||
((eq? record-type 'timerecord)
|
||||
(loop record-type
|
||||
(let ((item (parse-task-string line)))
|
||||
(if item
|
||||
(cons item timerecords)
|
||||
(begin
|
||||
(format #t "Warning: Line '~a' is not a timerecord. Skip.\n" line)
|
||||
timerecords)))
|
||||
deadlines))
|
||||
((eq? record-type 'deadline)
|
||||
(loop record-type
|
||||
timerecords
|
||||
(let ((item (parse-deadline-string line)))
|
||||
(if item
|
||||
(cons item deadlines)
|
||||
(begin
|
||||
(format #t "Warning: Line '~a' is not a deadline. Skip.\n" line)
|
||||
deadlines))))))))))))))
|
||||
'()))
|
||||
;;; Compare dates
|
||||
(define (date<? a b)
|
||||
(let ((ta (date->time-utc a))
|
||||
(tb (date->time-utc b)))
|
||||
(time<? ta tb)))
|
||||
|
||||
;;; Return difference of two dates
|
||||
(define (date-difference d1 d2)
|
||||
@ -197,86 +149,6 @@
|
||||
(date->time-utc d1)
|
||||
(date->time-utc d2)))
|
||||
|
||||
;;; Print timesheet item
|
||||
(define (print-task task . now)
|
||||
(let ((path (car task))
|
||||
(sdate (cadr task))
|
||||
(edate (caddr task))
|
||||
(duration (cadddr task))
|
||||
(now (if (null? now) #f (car now))))
|
||||
(let-values (((edate duration)
|
||||
(if edate
|
||||
(values edate duration)
|
||||
(if now
|
||||
(values now (date-difference now sdate))
|
||||
(values #f #f)))))
|
||||
(format #t "~a: [~a]"
|
||||
(path->string path)
|
||||
(date->string sdate date-time-format))
|
||||
(if edate
|
||||
(format #t " - [~a] - ~a\n"
|
||||
(date->string edate date-time-format)
|
||||
(time->string duration))
|
||||
(newline)))))
|
||||
|
||||
;;; Print timesheet
|
||||
(define (print-timesheet timesheet)
|
||||
(for-each print-task timesheet))
|
||||
|
||||
;;; Report is a tree of projects items.
|
||||
;;; Root of the tree is super-project with name "ROOT":
|
||||
;;; ("ROOT" d
|
||||
;;; ("PROJ1" d
|
||||
;;; ("P1-TASK1" d
|
||||
;;; ("P1-T1-SUBTASK1" d)
|
||||
;;; ("P1-T1-SUBTASK2" d))
|
||||
;;; ("P1-TASK2" d)))
|
||||
(define (make-report timesheet)
|
||||
;; Add task duration to project branch
|
||||
(define (tree-add-duration project-tree path duration)
|
||||
(let tree-walk ((tree project-tree)
|
||||
(path path))
|
||||
;; Add task duration
|
||||
(set-car! (cdr tree) (add-duration (cadr tree) duration))
|
||||
|
||||
;; Search next leaf corresponding to path item
|
||||
(if (null? path)
|
||||
project-tree
|
||||
(let ((item (find
|
||||
(lambda (i) (string= (car i) (car path)))
|
||||
(cddr tree))))
|
||||
(if item
|
||||
(tree-walk item (cdr path))
|
||||
|
||||
;; Add new branch (or leaf) to tree
|
||||
(let ((add-items
|
||||
(let add-item-loop ((add-items '())
|
||||
(path (reverse path)))
|
||||
(if (null? path)
|
||||
add-items
|
||||
(add-item-loop
|
||||
(if (null? add-items)
|
||||
(list (car path) duration)
|
||||
(list (car path) duration add-items))
|
||||
(cdr path))))))
|
||||
(set-cdr! (cdr tree) (cons add-items (cddr tree)))
|
||||
project-tree))))))
|
||||
;; END tree-add-duration
|
||||
|
||||
(let loop ((projects (list "Overall" (make-time 'time-duration 0 0)))
|
||||
(timesheet timesheet))
|
||||
(if (null? timesheet)
|
||||
projects ; TODO Sort projects by path
|
||||
(let* ((task (car timesheet))
|
||||
(path (car task))
|
||||
(start (cadr task))
|
||||
(duration (cadddr task)))
|
||||
(loop (tree-add-duration projects path
|
||||
(if duration duration
|
||||
(date-difference (current-date) start)))
|
||||
(cdr timesheet))))))
|
||||
|
||||
|
||||
;;; Dates is in same day?
|
||||
(define (same-month? d1 d2)
|
||||
(and
|
||||
@ -325,37 +197,27 @@
|
||||
(let ((jd (date->julian-day date)))
|
||||
(+ jd (- 7 (remainder-and-rest jd 7)))))))
|
||||
|
||||
;;; Print report
|
||||
(define (print-report report)
|
||||
(let ((deadlines (read-deadlines dl-file)))
|
||||
(let walk ((tree report)
|
||||
(level 0)
|
||||
(path '()))
|
||||
(when (not (null? tree))
|
||||
(format #t "~v_~a: ~a" level (car tree)
|
||||
(time->string (cadr tree)))
|
||||
;;; ========================= PROJECT SPECIFIC HELPERS =========================
|
||||
|
||||
(let ((dl (find-by-path deadlines path)))
|
||||
(when dl
|
||||
(let ((time (cadr dl)))
|
||||
(if (date? time)
|
||||
(begin
|
||||
(format #t " -- DEADLINE AT ~a" (date/time->string time))
|
||||
(when (time<? (date->time-utc time)
|
||||
(date->time-utc (current-date)))
|
||||
(format #t " (expired)")))
|
||||
(begin
|
||||
(format #t " -- DEADLINE TIME ~a" (date/time->string time))
|
||||
(if (time<? time (cadr tree))
|
||||
(format #t " (expired)")
|
||||
(format #t " (expiration at ~a)"
|
||||
(time->string (time-difference time (cadr tree))))))))))
|
||||
(newline)
|
||||
|
||||
(for-each
|
||||
(lambda (l)
|
||||
(walk l (+ level 2) (append path (list (car l)))))
|
||||
(cddr tree))))))
|
||||
;;; Find task or deadline by path
|
||||
(define (find-by-path sheet path)
|
||||
(find (lambda (x) (equal? (car x) path)) sheet))
|
||||
|
||||
;;; Compare deadlines by path
|
||||
(define (deadline<? a b)
|
||||
(path<? (car a) (car b)))
|
||||
|
||||
;;; Compare timerecords
|
||||
(define (timerecord<? a b)
|
||||
(let ((a-start-time (cadr a))
|
||||
(a-stop-time (caddr a))
|
||||
(b-start-time (cadr b))
|
||||
(b-stop-time (caddr b)))
|
||||
(if (and (not a-stop-time)
|
||||
(not b-stop-time))
|
||||
#f
|
||||
(if (not a-stop-time) #t
|
||||
(date<? a-start-time b-start-time)))))
|
||||
|
||||
;;; Returns last record of the sheet or #f if sheet is empty.
|
||||
(define (last-task sheet)
|
||||
@ -377,34 +239,64 @@
|
||||
(let ((task (list path (current-date) #f #f)))
|
||||
(values (append sheet (list task)) task)))
|
||||
|
||||
;;; Convert string HH:MM:SS to time
|
||||
(define (string->time str)
|
||||
(let ((splitted (string-split str #\:)))
|
||||
(if (not (= (length splitted) 3))
|
||||
(throw 'bad-time-string "Bad time format (expected hh:mm:ss)" str)
|
||||
(let ((h (string->number (car splitted)))
|
||||
(m (string->number (cadr splitted)))
|
||||
(s (string->number (caddr splitted))))
|
||||
(if (and (and h m s) (< m 60) (< s 60))
|
||||
(make-time 'time-duration 0
|
||||
(+ (* h 3600) (* m 60) s))
|
||||
(throw 'bad-time-string "Bad time string" str))))))
|
||||
;;; Returns unique path names of record lists
|
||||
(define (record-path-list records . more)
|
||||
(remove-dup
|
||||
(sort
|
||||
(let loop ((recs (apply append (cons records more)))
|
||||
(tasklist '()))
|
||||
(if (null? recs) tasklist
|
||||
(loop (cdr recs)
|
||||
(let fold-path ((path (caar recs))
|
||||
(spath "")
|
||||
(tasklist tasklist))
|
||||
(if (null? path) tasklist
|
||||
(let ((spath (string-append
|
||||
spath
|
||||
(if (zero? (string-length spath)) "" "/")
|
||||
(car path))))
|
||||
(fold-path (cdr path) spath
|
||||
(cons spath tasklist))))))))
|
||||
string<?)))
|
||||
|
||||
;;; Convert string to date or time
|
||||
;;; Time is HH:MM:SS, date is date-format
|
||||
(define (string->date/time str)
|
||||
(if (string-any #\: str)
|
||||
(string->time str)
|
||||
(string->date str date-format)))
|
||||
;;; Returns unique task names
|
||||
(define (record-name-list records . more)
|
||||
(remove-dup
|
||||
(sort
|
||||
(map (lambda (x) (path->string (car x)))
|
||||
(apply append (cons records more)))
|
||||
string<?)))
|
||||
|
||||
;;; Convert date or time to string
|
||||
(define (date/time->string time)
|
||||
(if (date? time)
|
||||
(date->string time date-format)
|
||||
(time->string time)))
|
||||
;;; ========================= PROJECT MAIN FUNCTIONS ==========================
|
||||
|
||||
;;; Parse task string and return list:
|
||||
;;; '((list of path elements) start-date stop-date|#f duration|#f)
|
||||
(define (parse-task-string str)
|
||||
(let ((str (string-trim-both str)))
|
||||
(if (or (zero? (string-length str))
|
||||
(equal? (string-ref str 0) #\#))
|
||||
#f
|
||||
(let ((path
|
||||
(let ((path-end (string-index str #\:)))
|
||||
(if (not path-end) #f
|
||||
(path-split str 0 path-end))))
|
||||
(dates (substring/find str #\[ #\])))
|
||||
(if (or (not path) (not dates) (null? dates))
|
||||
#f
|
||||
(let ((date-start (string->date (car dates) date-time-format)))
|
||||
(let-values (((date-end duration)
|
||||
(if (null? (cdr dates))
|
||||
(values #f #f)
|
||||
(let* ((date-end (string->date (cadr dates) date-time-format))
|
||||
(duration (time-difference
|
||||
(date->time-utc date-end)
|
||||
(date->time-utc date-start))))
|
||||
(values date-end duration)))))
|
||||
(list path date-start date-end duration))))))))
|
||||
|
||||
;;; Deadline file format
|
||||
;;; PROJECT/TASK/ETC: DATE|TIME
|
||||
;;; Returns list '((list of path elements) date|time)
|
||||
(define (parse-deadline-string str)
|
||||
(let ((colon (string-index str #\:)))
|
||||
(if (not colon) #f
|
||||
@ -419,38 +311,207 @@
|
||||
(let ((time (string->date/time time)))
|
||||
(list path time)))))))
|
||||
|
||||
|
||||
;;; Read timesheet and deadlines
|
||||
(define (read-timesheet filename)
|
||||
(if (file-exists? filename)
|
||||
(call-with-input-file filename
|
||||
(lambda (port)
|
||||
(let loop ((record-type 'unknown)
|
||||
(timerecords '())
|
||||
(deadlines '()))
|
||||
(let ((line (get-line port)))
|
||||
(if (eof-object? line)
|
||||
(values (remove-dup
|
||||
(sort timerecords timerecord<?))
|
||||
(remove-dup
|
||||
(sort deadlines deadline<?)))
|
||||
(let ((line (string-trim-both line)))
|
||||
(cond
|
||||
((or (string-null? line)
|
||||
(eq? (string-ref line 0) #\#))
|
||||
(loop record-type timerecords deadlines))
|
||||
((string-ci=? line "--- DEADLINES")
|
||||
(loop 'deadline timerecords deadlines))
|
||||
((string-ci=? line "--- TIMESHEET")
|
||||
(loop 'timerecord timerecords deadlines))
|
||||
(else
|
||||
(cond
|
||||
((eq? record-type 'timerecord)
|
||||
(loop record-type
|
||||
(let ((item (parse-task-string line)))
|
||||
(if item
|
||||
(cons item timerecords)
|
||||
(begin
|
||||
(format #t "Warning: Line '~a' is not a timerecord. Skip.\n" line)
|
||||
timerecords)))
|
||||
deadlines))
|
||||
((eq? record-type 'deadline)
|
||||
(loop record-type
|
||||
timerecords
|
||||
(let ((item (parse-deadline-string line)))
|
||||
(if item
|
||||
(cons item deadlines)
|
||||
(begin
|
||||
(format #t "Warning: Line '~a' is not a deadline. Skip.\n" line)
|
||||
deadlines))))))))))))))
|
||||
'()))
|
||||
|
||||
;;; Print deadline record
|
||||
(define (print-deadline dline)
|
||||
(format #t "~a: ~a\n"
|
||||
(path->string (car dline))
|
||||
(date/time->string (cadr dline))))
|
||||
|
||||
;;; Read deadline records from file
|
||||
(define (read-deadlines filename)
|
||||
(sort
|
||||
(read-and-parse-file filename parse-deadline-string)
|
||||
(lambda (a b)
|
||||
(let loop ((pa (car a))
|
||||
(pb (car b)))
|
||||
(if (and (null? pa) (null? pb)) #f
|
||||
(if (null? pa) #t
|
||||
(if (null? pb) #f
|
||||
(if (string=? (car pa) (car pb))
|
||||
(loop (cdr pa) (cdr pb))
|
||||
(string< (car pa) (car pb))))))))))
|
||||
;;; Print timesheet record
|
||||
(define (print-timerecord task . now)
|
||||
(let ((path (car task))
|
||||
(sdate (cadr task))
|
||||
(edate (caddr task))
|
||||
(duration (cadddr task))
|
||||
(now (if (null? now) #f (car now))))
|
||||
(let-values (((edate duration)
|
||||
(if edate
|
||||
(values edate duration)
|
||||
(if now
|
||||
(values now (date-difference now sdate))
|
||||
(values #f #f)))))
|
||||
(format #t "~a: [~a]"
|
||||
(path->string path)
|
||||
(date->string sdate date-time-format))
|
||||
(if edate
|
||||
(format #t " - [~a] - ~a\n"
|
||||
(date->string edate date-time-format)
|
||||
(time->string duration))
|
||||
(newline)))))
|
||||
|
||||
;;; Print deadline records
|
||||
(define (print-deadlines dlines)
|
||||
(for-each (lambda (x) (print-deadline x)) dlines))
|
||||
;;; Print timerecords
|
||||
(define (print-timerecords timesheet)
|
||||
(for-each print-timerecord (sort timesheet timerecord<?)))
|
||||
|
||||
;;; Find task or deadline by path
|
||||
(define (find-by-path sheet path)
|
||||
(find (lambda (x) (equal? (car x) path)) sheet))
|
||||
;;; Print deadlines
|
||||
(define (print-deadlines deadlines)
|
||||
(for-each print-deadline (sort deadlines deadline<?)))
|
||||
|
||||
;;; Print timesheet
|
||||
(define (print-timesheet timesheet deadlines)
|
||||
(when (not (null? deadlines))
|
||||
(format #t "--- DEADLINES\n")
|
||||
(print-deadlines deadlines))
|
||||
(when (not (null? timesheet))
|
||||
(format #t "--- TIMESHEET\n")
|
||||
(print-timerecords timesheet)))
|
||||
|
||||
;;; Make report
|
||||
;;; Report is a tree of projects items.
|
||||
;;; Root of the tree is super-project with name "ROOT":
|
||||
;;; ("ROOT" d dl
|
||||
;;; ("PROJ1" d dl
|
||||
;;; ("P1-TASK1" d dl
|
||||
;;; ("P1-T1-SUBTASK1" d dl)
|
||||
;;; ("P1-T1-SUBTASK2" d dl))
|
||||
;;; ("P1-TASK2" d dl)))
|
||||
(define (make-report timesheet)
|
||||
;; Add task duration to project branch
|
||||
(define (tree-add-duration! project-tree path duration)
|
||||
(let tree-walk ((tree project-tree)
|
||||
(path path))
|
||||
;; Add task duration
|
||||
(set-car! (cdr tree) (add-duration (cadr tree) duration))
|
||||
|
||||
;; Search next leaf corresponding to path item
|
||||
(if (null? path)
|
||||
project-tree
|
||||
(let ((item (find
|
||||
(lambda (i) (string= (car i) (car path)))
|
||||
(cdddr tree))))
|
||||
(if item
|
||||
(tree-walk item (cdr path))
|
||||
|
||||
;; Add new branch (or leaf) to tree
|
||||
(let ((add-items
|
||||
(let add-item-loop ((add-items '())
|
||||
(path (reverse path)))
|
||||
(if (null? path)
|
||||
add-items
|
||||
(add-item-loop
|
||||
(if (null? add-items)
|
||||
(list (car path) duration #f)
|
||||
(list (car path) duration #f add-items))
|
||||
(cdr path))))))
|
||||
(set-cdr! (cddr tree) (cons add-items (cdddr tree)))
|
||||
project-tree))))))
|
||||
;; END tree-add-duration!
|
||||
|
||||
(let loop ((projects (list "Overall" (make-time 'time-duration 0 0) #f))
|
||||
(timesheet timesheet))
|
||||
(if (null? timesheet)
|
||||
projects
|
||||
(let* ((task (car timesheet))
|
||||
(path (car task))
|
||||
(start (cadr task))
|
||||
(duration (cadddr task)))
|
||||
(loop (tree-add-duration! projects path
|
||||
(if duration duration
|
||||
(date-difference (current-date) start)))
|
||||
(cdr timesheet))))))
|
||||
|
||||
;;; Add deadlines to report tree
|
||||
(define (add-deadlines-to-report! report deadlines)
|
||||
(let walk ((tree report)
|
||||
(path '()))
|
||||
(when (not (null? tree))
|
||||
(let ((deadline (find-by-path deadlines path)))
|
||||
(when deadline
|
||||
(set-car! (cddr tree) (cadr deadline))))
|
||||
(for-each
|
||||
(lambda (l)
|
||||
(walk l (append path (list (car l)))))
|
||||
(cdddr tree))))
|
||||
report)
|
||||
|
||||
;;; Print report
|
||||
(define (print-report report)
|
||||
(let walk ((tree report)
|
||||
(level 0))
|
||||
(when (not (null? tree))
|
||||
(format #t "~v_~a: ~a~a\n"
|
||||
level (car tree)
|
||||
(time->string (cadr tree))
|
||||
(let ((deadline (caddr tree)))
|
||||
(cond
|
||||
;; deadline is date
|
||||
((date? deadline)
|
||||
(string-append
|
||||
" -- deadline at "
|
||||
(date/time->string deadline)
|
||||
(if (date<? (date-round-day deadline)
|
||||
(date-round-day (current-date)))
|
||||
" (expired)" "")))
|
||||
|
||||
;; deadline is time
|
||||
((time? deadline)
|
||||
(string-append
|
||||
" -- deadline time "
|
||||
(date/time->string deadline)
|
||||
(if (time<? deadline (cadr tree))
|
||||
" (expired)"
|
||||
(string-append " (expires in "
|
||||
(time->string
|
||||
(time-difference deadline (cadr tree))) ")"))))
|
||||
|
||||
;; no deadline
|
||||
(else ""))))
|
||||
|
||||
(for-each
|
||||
(lambda (l)
|
||||
(walk l (+ level 2)))
|
||||
(cdddr tree)))))
|
||||
|
||||
;;; ================================ COMMANDS ==================================
|
||||
|
||||
;;; Start new task. Returns new sheet with started task or #f if nothing started.
|
||||
(define (cmd-start-task sheet . params)
|
||||
(define (cmd-start-task sheet deadlines . params)
|
||||
(let* ((last (last-task sheet))
|
||||
(path (if (null? params)
|
||||
(if last (car last) #f)
|
||||
@ -460,28 +521,28 @@
|
||||
(begin (format
|
||||
(current-error-port)
|
||||
"Not specified task path. No tasks in the sheet.\n")
|
||||
#f)
|
||||
(values #f #f))
|
||||
(begin
|
||||
(stop-task last)
|
||||
(let-values (((sheet task) (new-task sheet path)))
|
||||
(format #t "--- NEW TASK RUN\n")
|
||||
(print-task task)
|
||||
sheet)))))
|
||||
(print-timerecord task)
|
||||
(values sheet deadlines))))))
|
||||
|
||||
;;; Stop a running task. Returns new sheet or #f if nothing to stop.
|
||||
(define (cmd-stop-task sheet . params)
|
||||
(define (cmd-stop-task sheet deadlines . params)
|
||||
(let ((last (last-task sheet)))
|
||||
(if (stop-task last)
|
||||
(begin
|
||||
(format #t "--- STOP TASK\n")
|
||||
(print-task last)
|
||||
sheet)
|
||||
(print-timerecord last)
|
||||
(values sheet deadlines))
|
||||
(begin
|
||||
(format (current-error-port) "Nothing to stop\n")
|
||||
#f))))
|
||||
(values #f #f)))))
|
||||
|
||||
;;; Print report
|
||||
(define (cmd-report sheet . params)
|
||||
(define (cmd-report sheet deadlines . params)
|
||||
(format #t "--- REPORT")
|
||||
(let ((sheet
|
||||
(if (null? params) sheet
|
||||
@ -525,118 +586,104 @@
|
||||
sheet)))))
|
||||
(newline)
|
||||
(print-report
|
||||
(make-report sheet)))
|
||||
(add-deadlines-to-report!
|
||||
(make-report sheet) deadlines)))
|
||||
(let ((last (last-task sheet)))
|
||||
(when last
|
||||
(format #t "\n--- ~a TASK\n"
|
||||
(if (caddr last) "LAST STOPPED" "RUNNING"))
|
||||
(print-task last (current-date))))
|
||||
#f)
|
||||
(print-timerecord last (current-date))))
|
||||
(values #f #f))
|
||||
|
||||
;;; Print all tasks
|
||||
(define (cmd-tasklist sheet . unused)
|
||||
(format
|
||||
#t "~{~a ~}\n"
|
||||
(let loop ((sheet sheet)
|
||||
(tasklist '()))
|
||||
(if (null? sheet) tasklist
|
||||
(loop (cdr sheet)
|
||||
(let fold-path ((path (caar sheet))
|
||||
(spath "")
|
||||
(tasklist tasklist))
|
||||
(if (null? path) tasklist
|
||||
(let ((spath (string-append
|
||||
spath
|
||||
(if (zero? (string-length spath)) "" "/")
|
||||
(car path))))
|
||||
(fold-path (cdr path) spath
|
||||
(if (find (lambda (x) (string=? x spath)) tasklist)
|
||||
tasklist
|
||||
(cons spath tasklist))))))))))
|
||||
|
||||
#f)
|
||||
(define (cmd-tasklist sheet deadlines . unused)
|
||||
(format #t "~{~a ~}\n" (record-path-list sheet deadlines))
|
||||
(values #f #f))
|
||||
|
||||
;;; Print deadlines
|
||||
(define (cmd-deadlist sheet deadlines . unused)
|
||||
(format #t "~{~a ~}\n" (record-name-list deadlines))
|
||||
(values #f #f))
|
||||
|
||||
;;; Deadlines
|
||||
(define (cmd-deadline sheet . args)
|
||||
(let ((dlines (read-deadlines dl-file)))
|
||||
(let ((new-dlines
|
||||
(let* ((arg0 (if (null? args) #f (car args)))
|
||||
(arg1 (if (and arg0 (not (null? (cdr args)))) (cadr args) #f))
|
||||
(arg2 (if (and arg1 (not (null? (cddr args)))) (caddr args) #f))
|
||||
(last (last-task sheet)))
|
||||
(cond
|
||||
;; Add deadline
|
||||
((equal? arg0 "set")
|
||||
(if (not arg1)
|
||||
(begin (format #t "Not specified date/time of deadline\n") #f)
|
||||
(let-values (((task time)
|
||||
(if arg2
|
||||
(values (path-split arg1)
|
||||
(string->date/time arg2))
|
||||
(values (if last (car last) #f)
|
||||
(string->date/time arg1)))))
|
||||
(if (not task)
|
||||
(define (cmd-deadline sheet deadlines . args)
|
||||
(let ((deadlines
|
||||
(let* ((arg0 (if (null? args) #f (car args)))
|
||||
(arg1 (if (and arg0 (not (null? (cdr args)))) (cadr args) #f))
|
||||
(arg2 (if (and arg1 (not (null? (cddr args)))) (caddr args) #f))
|
||||
(last (last-task sheet)))
|
||||
(cond
|
||||
;; Add deadline
|
||||
((equal? arg0 "set")
|
||||
(if (not arg1)
|
||||
(begin (format #t "Not specified date/time of deadline\n") #f)
|
||||
(let-values (((task time)
|
||||
(if arg2
|
||||
(values (path-split arg1)
|
||||
(string->date/time arg2))
|
||||
(values (if last (car last) #f)
|
||||
(string->date/time arg1)))))
|
||||
(if (not task)
|
||||
(begin
|
||||
(format #t "Not specified task path.\n")
|
||||
#f)
|
||||
(let ((dl (find-by-path deadlines task)))
|
||||
(if dl
|
||||
(begin (set-car! (cdr dl) time) deadlines)
|
||||
(append deadlines (list (list task time)))))))))
|
||||
|
||||
;; Delete deadline
|
||||
((equal? arg0 "clear")
|
||||
(call/cc
|
||||
(lambda (break-del)
|
||||
(let ((task (if arg1
|
||||
(path-split arg1)
|
||||
(if (null? last)
|
||||
(begin (format #t "Not specified task path.\n") (break-del #f))
|
||||
(car last)))))
|
||||
(fold-right
|
||||
(lambda (x l)
|
||||
(if (equal? (car x) task)
|
||||
(begin
|
||||
(format #t "Not specified task path.\n")
|
||||
#f)
|
||||
(let ((dl (find-by-path dlines task)))
|
||||
(if dl
|
||||
(begin (set-car! (cdr dl) time) dlines)
|
||||
(append dlines (list (list task time)))))))))
|
||||
(format #t "Deleted ~a: ~a\n"
|
||||
(path->string (car x))
|
||||
(date/time->string (cadr x)))
|
||||
l)
|
||||
(cons x l)))
|
||||
'() deadlines)))))
|
||||
|
||||
;; Delete deadline
|
||||
((equal? arg0 "clear")
|
||||
(call/cc
|
||||
(lambda (break-del)
|
||||
(let ((task (if arg1
|
||||
(path-split arg1)
|
||||
(if (null? last)
|
||||
(begin (format #t "Not specified task path.\n") (break-del #f))
|
||||
(car last)))))
|
||||
(fold-right
|
||||
(lambda (x l)
|
||||
(if (equal? (car x) task)
|
||||
(begin
|
||||
(format #t "Deleted ~a: ~a\n"
|
||||
(path->string (car x))
|
||||
(date/time->string (cadr x)))
|
||||
l)
|
||||
(cons x l)))
|
||||
'() dlines)))))
|
||||
|
||||
;; Show all deadlines
|
||||
((equal? arg0 "all")
|
||||
(print-deadlines dlines)
|
||||
#f)
|
||||
|
||||
;; Show deadline for task
|
||||
(else
|
||||
(let ((task (if arg0
|
||||
(path-split arg0)
|
||||
(if (null? last)
|
||||
(begin (format #t "--- SHOW ALL DEADLINES\n") `())
|
||||
(car last)))))
|
||||
(for-each
|
||||
(lambda (dl)
|
||||
(when (let loop ((p1 task)
|
||||
(p2 (car dl)))
|
||||
(if (null? p1) #t
|
||||
(if (null? p2) #f
|
||||
(if (not (string=? (car p1) (car p2))) #f
|
||||
(loop (cdr p1) (cdr p2))))))
|
||||
(print-deadline dl)))
|
||||
dlines))
|
||||
#f)))))
|
||||
|
||||
(when new-dlines
|
||||
(with-output-to-file dl-file
|
||||
(lambda () (print-deadlines new-dlines))))))
|
||||
#f)
|
||||
;; Show all deadlines
|
||||
((equal? arg0 "all")
|
||||
(print-deadlines deadlines)
|
||||
#f)
|
||||
|
||||
;; Show deadline for task
|
||||
(else
|
||||
(let ((task (if arg0
|
||||
(path-split arg0)
|
||||
(if (null? last)
|
||||
(begin (format #t "--- ALL DEADLINES\n") `())
|
||||
(car last)))))
|
||||
(for-each
|
||||
(lambda (dl)
|
||||
(when (let loop ((p1 task)
|
||||
(p2 (car dl)))
|
||||
(if (null? p1) #t
|
||||
(if (null? p2) #f
|
||||
(if (not (string=? (car p1) (car p2))) #f
|
||||
(loop (cdr p1) (cdr p2))))))
|
||||
(print-deadline dl)))
|
||||
deadlines))
|
||||
#f)))))
|
||||
(if deadlines
|
||||
(values sheet deadlines)
|
||||
(values #f #f))))
|
||||
|
||||
;;; ================================ MAIN FUNCTION ==================================
|
||||
|
||||
(define (main cmdl)
|
||||
(let ((command (cdr cmdl)))
|
||||
(let-values (((sheet deadlines) (read-timesheet1 ts-file)))
|
||||
(let-values (((sheet deadlines) (read-timesheet ts-file)))
|
||||
(if (null? command)
|
||||
|
||||
;; Show running task
|
||||
@ -651,48 +698,50 @@
|
||||
;; Else run command
|
||||
(let ((param (cdr command))
|
||||
(command (car command)))
|
||||
(let ((new-sheet
|
||||
(apply (cond
|
||||
((string= command "start") cmd-start-task)
|
||||
((string= command "stop") cmd-stop-task)
|
||||
((string= command "report") cmd-report)
|
||||
((string= command "refresh") (lambda (s . p) s))
|
||||
((string= command "tasklist") cmd-tasklist)
|
||||
((string= command "deadline") cmd-deadline)
|
||||
|
||||
;; ----------------------- Show usage ------------------------- ;;
|
||||
(else
|
||||
(with-output-to-port (current-error-port)
|
||||
(lambda ()
|
||||
(format #t "Usage: ~a [command]\n" (car cmdl))
|
||||
(format #t "Commands:\n")
|
||||
(format #t " start [TASK] Start new task. If no task, use last runned task\n")
|
||||
(format #t " stop Stop task\n")
|
||||
(format #t " report Show report\n")
|
||||
(format #t " report day [DATE] Show report for today or DATE\n")
|
||||
(format #t " report week [DATE] Show report for current week or week of DATE\n")
|
||||
(format #t " report month [DATE] Show report for current month or month of DATE\n")
|
||||
(format #t " report TASK Show report for project\n")
|
||||
(format #t " deadline set [TASK] DATE|+TIME Add deadline for project (or for last task)\n")
|
||||
(format #t " deadline clear [TASK] Remove deadline for project (or for last task)\n")
|
||||
(format #t " deadline [TASK] Show deadline for project\n")
|
||||
(format #t " deadline all Show all deadlines\n")
|
||||
(format #t " refresh Refresh worksheet file after manual edit\n")
|
||||
(format #t " (no command) Show running task and timer\n\n")
|
||||
(format #t "DATE format: YYYY-mm-dd\n")
|
||||
(format #t "TIME format: HH-MM-SS\n")
|
||||
(newline)))
|
||||
(lambda (s . p) #f)))
|
||||
(cons sheet param))))
|
||||
(let-values
|
||||
(((sheet' deadlines')
|
||||
(apply
|
||||
(cond
|
||||
((string= command "start") cmd-start-task)
|
||||
((string= command "stop") cmd-stop-task)
|
||||
((string= command "report") cmd-report)
|
||||
((string= command "refresh") (lambda (s d . p) (values s d)))
|
||||
((string= command "deadline") cmd-deadline)
|
||||
((string= command "tasklist") cmd-tasklist)
|
||||
((string= command "deadlist") cmd-deadlist)
|
||||
|
||||
;; ----------------------- Show usage ------------------------- ;;
|
||||
(else
|
||||
(with-output-to-port (current-error-port)
|
||||
(lambda ()
|
||||
(format #t "Usage: ~a [command]\n" (car cmdl))
|
||||
(format #t "Commands:\n")
|
||||
(format #t " start [TASK] Start new task. If no task, use last runned task\n")
|
||||
(format #t " stop Stop task\n")
|
||||
(format #t " report Show report\n")
|
||||
(format #t " report day [DATE] Show report for today or DATE\n")
|
||||
(format #t " report week [DATE] Show report for current week or week of DATE\n")
|
||||
(format #t " report month [DATE] Show report for current month or month of DATE\n")
|
||||
(format #t " report TASK Show report for project\n")
|
||||
(format #t " deadline set [TASK] DATE|TIME Add deadline for project (or for last task)\n")
|
||||
(format #t " deadline clear [TASK] Remove deadline for project (or for last task)\n")
|
||||
(format #t " deadline [TASK] Show deadline for project\n")
|
||||
(format #t " deadline all Show all deadlines\n")
|
||||
(format #t " refresh Refresh worksheet file after manual edit\n")
|
||||
(format #t " (no command) Show running task and timer\n\n")
|
||||
(format #t "DATE format: YYYY-mm-dd\n")
|
||||
(format #t "TIME format: HH:MM:SS\n")
|
||||
(newline)))
|
||||
(lambda (s d . p) (values #f #f))))
|
||||
(cons* sheet deadlines param))))
|
||||
|
||||
;; ----------------------- Save new sheet ------------------------- ;;
|
||||
(when (and
|
||||
(list? new-sheet)
|
||||
(not (null? new-sheet)))
|
||||
(list? sheet')
|
||||
(not (null? sheet')))
|
||||
(with-output-to-file ts-file
|
||||
(lambda ()
|
||||
(print-timesheet new-sheet))))))))))
|
||||
(print-timesheet sheet' deadlines'))))))))))
|
||||
|
||||
;;; JUST DO IT!
|
||||
;(main (command-line))
|
||||
|
||||
(main (command-line))
|
||||
|
||||
69
zsh-completion/_timer
Normal file
69
zsh-completion/_timer
Normal file
@ -0,0 +1,69 @@
|
||||
#compdef timer
|
||||
|
||||
_timer() {
|
||||
|
||||
typeset -A opt_args
|
||||
|
||||
_arguments \
|
||||
'1: :->command' \
|
||||
'2: :->arg1' \
|
||||
'3: :->arg2' \
|
||||
'4: :->arg3'
|
||||
|
||||
case "$state" in
|
||||
(command)
|
||||
_arguments '1:commands:(start stop report deadline refresh help)'
|
||||
;;
|
||||
|
||||
(arg1)
|
||||
case $words[2] in
|
||||
(start)
|
||||
compadd $(timer tasklist)
|
||||
;;
|
||||
(report)
|
||||
compadd day week month $(timer tasklist)
|
||||
;;
|
||||
(deadline)
|
||||
compadd set clear all $(timer deadlist)
|
||||
;;
|
||||
esac
|
||||
;;
|
||||
|
||||
(arg2)
|
||||
case $words[2] in
|
||||
(report)
|
||||
case $words[3] in
|
||||
(day)
|
||||
compadd $(date +"%Y-%m-%d")
|
||||
;;
|
||||
(week)
|
||||
compadd $(date +"%Y-%m-%d")
|
||||
;;
|
||||
(month)
|
||||
compadd $(date +"%Y-%m-%d")
|
||||
;;
|
||||
esac
|
||||
;;
|
||||
(deadline)
|
||||
case $words[3] in
|
||||
(set)
|
||||
compadd $(timer tasklist) $(date +"%Y-%m-%d")
|
||||
;;
|
||||
(clear)
|
||||
compadd $(timer deadlist)
|
||||
;;
|
||||
esac
|
||||
;;
|
||||
esac
|
||||
;;
|
||||
|
||||
(arg3)
|
||||
if [ "$words[2]" = "deadline" ]
|
||||
then
|
||||
compadd $(date +"%Y-%m-%d")
|
||||
fi
|
||||
;;
|
||||
esac
|
||||
}
|
||||
|
||||
_timer "$@"
|
||||
Loading…
x
Reference in New Issue
Block a user