np/worktimer
1
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

Add date selection for a report.

Browse Source
This commit is contained in:
Nikolay Puzanov 2014-05-16 13:31:20 +04:00
parent 4ed944b9c7
commit 095ace7632
2 changed files with 71 additions and 54 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

23
README.org
View File

@ -61,9 +61,26 @@ uberproject/website/programming: [2014-04-18 09:47:04] - [2014-04-18 09:49:38] -
которых на дизайн сайта ушло 1 минута 11 секунд, а на программирование 2 минуты которых на дизайн сайта ушло 1 минута 11 секунд, а на программирование 2 минуты
34 секунды. 34 секунды.
У команды =report= могут быть агрументы =today=, =week=, =month= или название Команда =report= может иметь параметры:
задачи, с помощью которых можно сформировать отчет за сегодня, за тукущую
неделю, текущий месяц или по выбранной задаче. - =day [DATE]= - отчет по текущему дню или по дате DATE;
- =week [DATE]= - отчет по текущей неделе или по неделе, в которую входит день
DATE;
- =month [DATE]= - отчет по текущему месяцу или по месяцу, в который входит день
DATE;
Кроме того, параметром команды =report= может быть название проекта, например:
#+begin_src sh
$ worktimer.scm report uberproject/website
--- REPORT
Overall: 00:03:45
uberproject: 00:03:45
website: 00:03:45
--- LAST STOPPED TASK
uberproject/website/programming: [2014-04-18 09:47:04] - [2014-04-18 09:49:38] - 00:02:34
#+end_src
При запуске программы без аргументов выводится имя текущей задачи и текущий При запуске программы без аргументов выводится имя текущей задачи и текущий
таймер: таймер:

88
worktimer.scm
View File

@ -38,7 +38,8 @@
;;; Hardcoded timesheet filename ;;; Hardcoded timesheet filename
(define ts-file (string-append (getenv "HOME") "/.timesheet")) (define ts-file (string-append (getenv "HOME") "/.timesheet"))
(define date-format "~Y-~m-~d ~H:~M:~S") (define date-format-time "~Y-~m-~d ~H:~M:~S")
(define date-format "~Y-~m-~d")
;;; Find substring separated by ch-start and ch-end. ;;; Find substring separated by ch-start and ch-end.
;;; (substring/find str ch-start ch-end [begin end]) ;;; (substring/find str ch-start ch-end [begin end])
@ -103,11 +104,11 @@
(dates (substring/find str #\[ #\]))) (dates (substring/find str #\[ #\])))
(if (or (not path) (not dates)) (if (or (not path) (not dates))
#f #f
(let ((date-start (string->date (car dates) date-format))) (let ((date-start (string->date (car dates) date-format-time)))
(let-values (((date-end duration) (let-values (((date-end duration)
(if (null? (cdr dates)) (if (null? (cdr dates))
(values #f #f) (values #f #f)
(let* ((date-end (string->date (cadr dates) date-format)) (let* ((date-end (string->date (cadr dates) date-format-time))
(duration (time-difference (duration (time-difference
(date->time-utc date-end) (date->time-utc date-end)
(date->time-utc date-start)))) (date->time-utc date-start))))
@ -148,10 +149,10 @@
(values #f #f))))) (values #f #f)))))
(format #t "~a: [~a]" (format #t "~a: [~a]"
(path->string path) (path->string path)
(date->string sdate date-format)) (date->string sdate date-format-time))
(if edate (if edate
(format #t " - [~a] - ~a\n" (format #t " - [~a] - ~a\n"
(date->string edate date-format) (date->string edate date-format-time)
(time-difference->h:m:s duration)) (time-difference->h:m:s duration))
(newline))))) (newline)))))
@ -212,20 +213,17 @@
(cdr timesheet)))))) (cdr timesheet))))))
;;; Date is today? ;;; Dates is in same day?
(define (today? date) (define (same-month? d1 d2)
(let ((now (current-date)))
(and (and
(= (date-day date) (date-day now)) (= (date-month d1) (date-month d2))
(= (date-month date) (date-month now)) (= (date-year d1) (date-year d2))))
(= (date-year date) (date-year now)))))
;;; Date is in current month? ;;; Dates is in same month?
(define (current-month? date) (define (same-day? d1 d2)
(let ((now (current-date)))
(and (and
(= (date-month date) (date-month now)) (same-month? d1 d2)
(= (date-year date) (date-year now))))) (= (date-day d1) (date-day d2))))
;;; Check date for occurence between d-past and d-future ;;; Check date for occurence between d-past and d-future
(define (date-in-range? d d-past d-future) (define (date-in-range? d d-past d-future)
@ -243,16 +241,6 @@
(zf (date-zone-offset date))) (zf (date-zone-offset date)))
(make-date 0 0 0 0 day month year zf))) (make-date 0 0 0 0 day month year zf)))
;;; Returns today date with time 00:00
;; (define (today)
;; (date-round-day (current-date)))
;;; Returns tomorrow date with time 00:00
;; (define (tomorrow)
;; (date-round-day
;; (julian-day->date
;; (+ (date->julian-day (current-date)) 1))))
;;; Returns remainder plus fractional part of ;;; Returns remainder plus fractional part of
;;; truncating x. ;;; truncating x.
;;; For example: (remainder-and-rest 5.1 3) -> 2.1 ;;; For example: (remainder-and-rest 5.1 3) -> 2.1
@ -262,17 +250,17 @@
(remainder xi y)))) (remainder xi y))))
;;; Returns monday of current week ;;; Returns monday of current week
(define (monday) (define (monday-of-week date)
(date-round-day (date-round-day
(julian-day->date (julian-day->date
(let ((jd (date->julian-day (current-date)))) (let ((jd (date->julian-day date)))
(- jd (remainder-and-rest jd 7)))))) (- jd (remainder-and-rest jd 7))))))
;;; Returns monday of next week ;;; Returns monday of next week
(define (next-monday) (define (monday-of-next-week date)
(date-round-day (date-round-day
(julian-day->date (julian-day->date
(let ((jd (date->julian-day (current-date)))) (let ((jd (date->julian-day date)))
(+ jd (- 7 (remainder-and-rest jd 7))))))) (+ jd (- 7 (remainder-and-rest jd 7)))))))
;;; Print report ;;; Print report
@ -343,21 +331,33 @@
(format #t "--- REPORT") (format #t "--- REPORT")
(let ((sheet (let ((sheet
(if (null? param) sheet (if (null? param) sheet
(let ((interval (car param))) (let* ((interval (car param))
(report-date (catch #t
(lambda () (string->date (cadr param) date-format))
(lambda (key . args) (current-date)))))
(filter (cond (filter (cond
((string-ci= interval "today") ;; Filter records by day
(format #t " FOR TODAY") ((string-ci= interval "day")
(lambda (x) (today? (cadr x)))) (format #t ". DAY ~a" (date->string report-date "~Y-~m-~d"))
(lambda (x) (same-day? report-date (cadr x))))
;; Filter records by month
((string-ci= interval "month") ((string-ci= interval "month")
(format #t " FOR CURRENT MONTH") (format #t ". MONTH ~a" (date->string report-date "~Y-~m"))
(lambda (x) (current-month? (cadr x)))) (lambda (x) (same-month? report-date (cadr x))))
;; Filter records by week
((string-ci= interval "week") ((string-ci= interval "week")
(format #t " FOR CURRENT WEEK") (let ((beg (monday-of-week report-date))
(lambda (x) (date-in-range? (cadr x) (end (monday-of-next-week report-date)))
(monday) (format #t ". WEEK [~a - ~a)"
(next-monday)))) (date->string beg date-format)
(date->string end date-format))
(lambda (x) (date-in-range? (cadr x) beg end))))
;; Filter records by path
(else (else
(format #t " FOR PROJECT ~a" interval) (format #t ". PROJECT ~a" interval)
(let ((rep-path (path-split interval))) (let ((rep-path (path-split interval)))
(lambda (x) (lambda (x)
(let loop ((path (car x)) (let loop ((path (car x))
@ -388,9 +388,9 @@
(format #t " start [TASK] Start new task. If no task, use last runned task\n") (format #t " start [TASK] Start new task. If no task, use last runned task\n")
(format #t " stop Stop task\n") (format #t " stop Stop task\n")
(format #t " report Show report\n") (format #t " report Show report\n")
(format #t " report today Show report for today\n") (format #t " report day [DATE] Show report for today or DATE\n")
(format #t " report week Show report for current week\n") (format #t " report week [DATE] Show report for current week or week of DATE\n")
(format #t " report month Show report for current month\n") (format #t " report month [DATE] Show report for current month or month of DATE\n")
(format #t " report PATH Show report for project\n") (format #t " report PATH Show report for project\n")
(format #t " Show running task and timer\n") (format #t " Show running task and timer\n")
(newline))) (newline)))