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

Add report build function.

Browse Source 
Remove append file functionality.
Fix some bugs.
This commit is contained in:
Nikolay Puzanov 2014-04-17 01:03:19 +04:00
parent cfd8274e26
commit 52ef1c8f87
1 changed files with 154 additions and 80 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

236
worktimer.scm
View File

@ -21,19 +21,24 @@
;; THE SOFTWARE. ;; THE SOFTWARE.
(import (rnrs io ports (6)) (import (rnrs io ports (6))
(srfi srfi-1)
(srfi srfi-19) (srfi srfi-19)
(srfi srfi-11)) (srfi srfi-11))
;;; Use srfi-48 in other scheme implementation ;;; Use srfi-48 in other scheme implementation
(use-modules (ice-9 format)) (use-modules (ice-9 format))
(use-modules (ice-9 pretty-print))
;;; Record format: ;;; Record format:
;;; PROJECT/PATH: [START_TIME] - [STOP_TIME] - DURATION ;;; PROJECT/TASK/SUBTASK/ETC: [START_TIME] - [STOP_TIME] - DURATION
(define date-format "~Y-~m-~d ~H:~M:~S")
;;; 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])
;; If ch-start is #f, select substring from beginning of string. ;;; If ch-start is #f, select substring from beginning of string.
;; If ch-end is #f, select substring from ch-start to end string. ;;; If ch-end is #f, select substring from ch-start to end string.
(define (substring/find str ch-start ch-end . args) (define (substring/find str ch-start ch-end . args)
(let ((start (if (null? args) 0 (car args))) (let ((start (if (null? args) 0 (car args)))
(end (if (< (length args) 2) (string-length str) (cadr args)))) (end (if (< (length args) 2) (string-length str) (cadr args))))
@ -45,6 +50,7 @@
(if (not cs) (reverse strings) (if (not cs) (reverse strings)
(loop (cons (substring str (1+ cs) ce) strings) (1+ ce))))))))) (loop (cons (substring str (1+ cs) ce) strings) (1+ ce)))))))))
;;; Convert time-difference to string "hh:mm:ss"
(define (time-difference->h:m:s td) (define (time-difference->h:m:s td)
(let ((sec (time-second td))) (let ((sec (time-second td)))
(let* ((h (quotient sec 3600)) (let* ((h (quotient sec 3600))
@ -55,6 +61,7 @@
(format #f "~2,'0d" m) ":" (format #f "~2,'0d" m) ":"
(format #f "~2,'0d" s))))) (format #f "~2,'0d" s)))))
;;; Convert path to string
(define (path->string path) (define (path->string path)
(let loop ((path path) (let loop ((path path)
(str "")) (str ""))
@ -65,7 +72,9 @@
(car path) (car path)
(if (null? (cdr path)) "" "/")))))) (if (null? (cdr path)) "" "/"))))))
(define (parse-path str . args) ;;; Split path to separate elements
;;; (path-split str [start end])
(define (path-split str . args)
(let ((start (if (null? args) 0 (car args))) (let ((start (if (null? args) 0 (car args)))
(end (if (or (null? args) (null? (cdr args))) (string-length str) (cadr args)))) (end (if (or (null? args) (null? (cdr args))) (string-length str) (cadr args))))
(let loop ((path '()) (path-start start)) (let loop ((path '()) (path-start start))
@ -75,11 +84,13 @@
(loop (loop
(cons (substring str path-start item-end) path) (1+ item-end))))))) (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) (define (parse-task-string str)
(let ((path (let ((path
(let ((path-end (string-index str #\:))) (let ((path-end (string-index str #\:)))
(if (not path-end) '() (if (not path-end) '()
(parse-path str 0 path-end)))) (path-split str 0 path-end))))
(dates (substring/find str #\[ #\]))) (dates (substring/find str #\[ #\])))
(if (null? dates) '() (if (null? dates) '()
(let ((date-start (string->date (car dates) "~Y-~m-~d ~H:~M:~S"))) (let ((date-start (string->date (car dates) "~Y-~m-~d ~H:~M:~S")))
@ -93,94 +104,157 @@
(values date-end duration))))) (values date-end duration)))))
(list path date-start date-end duration)))))) (list path date-start date-end duration))))))
;;; Parse timesheet file and return list of tasks
(define (parse-timesheet filename) (define (parse-timesheet filename)
(call-with-input-file filename (call-with-input-file filename
(lambda (port) (lambda (port)
(let loop ((recs '())) (let loop ((recs '()))
(let ((line (get-line port))) (let ((line (get-line port)))
(if (eof-object? line) (if (eof-object? line)
recs (reverse recs)
(loop (parse-task-string line)))))))) (loop (cons (parse-task-string line) recs))))))))
(define (timesheet-get-last filename) ;;; Return difference of two dates
(let ((last-line (define (date-difference d1 d2)
(call-with-input-file filename
(lambda (port)
(let loop ((last-line ""))
(let ((line (get-line port)))
(if (eof-object? line) last-line
(loop line))))))))
(parse-task-string last-line)))
(define (call-with-append-file filename thunk)
(let ((port (open-file filename
(if (file-exists? filename) "a" "w"))))
(thunk port)
(close-port port)))
(define (write-stop-and-duration port start-date stop-date)
(format port " - [~a] - ~a\n"
(date->string stop-date "~Y-~m-~d ~H:~M:~S")
(time-difference->h:m:s
(time-difference (time-difference
(date->time-utc stop-date) (date->time-utc d1)
(date->time-utc start-date))))) (date->time-utc d2)))
;;; Print timesheet
(define (print-timesheet timesheet)
(for-each
(lambda (task)
(let ((path (car task))
(sdate (cadr task))
(edate (caddr task))
(duration (cadddr task)))
(format #t "~a: [~a]"
(path->string path)
(date->string sdate date-format))
(if edate
(format #t " - [~a] - ~a\n"
(date->string edate date-format)
(time-difference->h:m:s duration))
(newline))))
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 to tree leaf
(set-car! (cdr tree) (add-duration (cadr tree) duration))
;; Search next leaf corresponding with 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))
(duration (cadddr task)))
(loop (if duration
(tree-add-duration projects path duration)
projects)
(cdr timesheet))))))
(define (print-report report)
(let walk ((tree report)
(level 0))
(when (not (null? tree))
(format #t "~v_~a: ~a\n" level (car tree)
(time-difference->h:m:s (cadr tree)))
(for-each (lambda (l) (walk l (+ level 2))) (cddr tree)))))
;; MAIN ;; MAIN
(define ts-file "/home/np/timesheet.txt") (define ts-file "/home/np/timesheet.txt")
(let* ((cmdl (command-line)) ;; (let* ((cmdl (command-line))
(params (cdr cmdl))) ;; (params (cdr cmdl)))
(if (null? params) ;; (if (null? params)
;; No command. Show last record and duration if running ;; ;; No command. Show last record and duration if running
(let ((last (timesheet-get-last ts-file))) ;; (let ((last (timesheet-get-last ts-file)))
(if (null? last) ;; (if (null? last)
(format #t "Not any tasks\n") ;; (format #t "Not any tasks\n")
(let ((path (car last)) ;; (let ((path (car last))
(start-date (cadr last)) ;; (start-date (cadr last))
(stop-date (caddr last)) ;; (stop-date (caddr last))
(duration (cadddr last)) ;; (duration (cadddr last))
(now (current-date))) ;; (now (current-date)))
(format #t "~a: [~a] - [~a] - ~a\n" ;; (format #t "~a: [~a] - [~a] - ~a\n"
(path->string path) ;; (path->string path)
(date->string start-date "~Y-~m-~d ~H:~M:~S") ;; (date->string start-date "~Y-~m-~d ~H:~M:~S")
(if (not stop-date) "NOW" ;; (if (not stop-date) "NOW"
(date->string stop-date "~Y-~m-~d ~H:~M:~S")) ;; (date->string stop-date "~Y-~m-~d ~H:~M:~S"))
(time-difference->h:m:s ;; (time-difference->h:m:s
(if duration duration ;; (if duration duration
(time-difference ;; (time-difference
(date->time-utc (if stop-date stop-date now)) ;; (date->time-utc (if stop-date stop-date now))
(date->time-utc start-date)))))))) ;; (date->time-utc start-date))))))))
;; Commands ;; ;; Commands
(let ((command (car params)) ;; (let ((command (car params))
(date (current-date))) ;; (date (current-date)))
(cond ;; (cond
((equal? command "start") ;; ((equal? command "start")
;; ----------------------- Start timer ------------------------- ;; ;; ;; ----------------------- Start timer ------------------------- ;;
(call-with-append-file ;; (call-with-append-file
ts-file ;; ts-file
(lambda (port) ;; (lambda (port)
(let* ((last (timesheet-get-last ts-file)) ;; (let* ((last (timesheet-get-last ts-file))
(path ;; (path
(if (null? (cdr params)) ;; (if (null? (cdr params))
(if (null? last) '() (car last)) ;; (if (null? last) '() (car last))
(parse-path (cadr params))))) ;; (path-split (cadr params)))))
(if (null? path) ;; (if (null? path)
(format #t "ERROR: Not specified the task path\n") ;; (format #t "ERROR: Not specified the task path\n")
(begin ;; (begin
(when (and (not (null? last)) (not (caddr last))) ;; (when (and (not (null? last)) (not (caddr last)))
(write-stop-and-duration port (cadr last) date)) ;; (write-stop-and-duration port (cadr last) date))
(format port "~a: [~a]" (path->string path) (date->string date "~Y-~m-~d ~H:~M:~S")))))))) ;; (format port "~a: [~a]" (path->string path) (date->string date "~Y-~m-~d ~H:~M:~S"))))))))
((equal? command "stop") ;; ((equal? command "stop")
;; ----------------------- Stop timer ------------------------- ;; ;; ;; ----------------------- Stop timer ------------------------- ;;
(call-with-append-file ;; (call-with-append-file
ts-file ;; ts-file
(lambda (port) ;; (lambda (port)
(let ((last (timesheet-get-last ts-file))) ;; (let ((last (timesheet-get-last ts-file)))
(if (or (null? last) (caddr last)) ;; (if (or (null? last) (caddr last))
(format #t "WARNING: Not running any tasks\n") ;; (format #t "WARNING: Not running any tasks\n")
(write-stop-and-duration port (cadr last) date)))))))))) ;; (write-stop-and-duration port (cadr last) date))))))))))
(print-report (make-report (parse-timesheet ts-file)))