From cfd8274e26cfa5f393305399c62454c50d88099d Mon Sep 17 00:00:00 2001 From: Nikolay Puzanov Date: Tue, 15 Apr 2014 01:05:18 +0400 Subject: [PATCH] Initial commit --- .gitignore | 1 + worktimer.scm | 186 ++++++++++++++++++++++++++++++++++++++++++++++++++ 2 files changed, 187 insertions(+) create mode 100644 .gitignore create mode 100755 worktimer.scm diff --git a/.gitignore b/.gitignore new file mode 100644 index 0000000..b25c15b --- /dev/null +++ b/.gitignore @@ -0,0 +1 @@ +*~ diff --git a/worktimer.scm b/worktimer.scm new file mode 100755 index 0000000..c94eca3 --- /dev/null +++ b/worktimer.scm @@ -0,0 +1,186 @@ +#!/usr/bin/guile +!# + +;; Copyright (c) 2014 Nikolay Puzanov +;; Permission is hereby granted, free of charge, to any person obtaining a copy +;; of this software and associated documentation files (the "Software"), to deal +;; in the Software without restriction, including without limitation the rights +;; to use, copy, modify, merge, publish, distribute, sublicense, and/or sell +;; copies of the Software, and to permit persons to whom the Software is +;; furnished to do so, subject to the following conditions: + +;; The above copyright notice and this permission notice shall be included in +;; all copies or substantial portions of the Software. + +;; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR +;; IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, +;; FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE +;; AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER +;; LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, +;; OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN +;; THE SOFTWARE. + +(import (rnrs io ports (6)) + (srfi srfi-19) + (srfi srfi-11)) + +;;; Use srfi-48 in other scheme implementation +(use-modules (ice-9 format)) + +;;; Record format: +;;; PROJECT/PATH: [START_TIME] - [STOP_TIME] - DURATION + +;;; 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. +;; If ch-end is #f, select substring from ch-start to end string. +(define (substring/find str ch-start ch-end . args) + (let ((start (if (null? args) 0 (car args))) + (end (if (< (length args) 2) (string-length str) (cadr args)))) + (let loop ((strings '()) (start start)) + (let ((ce + (if ch-end (string-index str ch-end start end) end))) + (if (not ce) (reverse strings) + (let ((cs (if ch-start (string-index str ch-start start ce) (- start 1)))) + (if (not cs) (reverse strings) + (loop (cons (substring str (1+ cs) ce) strings) (1+ ce))))))))) + +(define (time-difference->h:m:s td) + (let ((sec (time-second td))) + (let* ((h (quotient sec 3600)) + (m (quotient (- sec (* h 3600)) 60)) + (s (- sec (* h 3600) (* m 60)))) + (string-append + (format #f "~2,'0d" h) ":" + (format #f "~2,'0d" m) ":" + (format #f "~2,'0d" s))))) + +(define (path->string path) + (let loop ((path path) + (str "")) + (if (null? path) str + (loop (cdr path) + (string-append + str + (car path) + (if (null? (cdr path)) "" "/")))))) + +(define (parse-path str . args) + (let ((start (if (null? args) 0 (car args))) + (end (if (or (null? args) (null? (cdr args))) (string-length str) (cadr args)))) + (let loop ((path '()) (path-start start)) + (let ((item-end (string-index str #\/ path-start end))) + (if (not item-end) + (reverse (cons (substring str path-start end) path)) + (loop + (cons (substring str path-start item-end) path) (1+ item-end))))))) + +(define (parse-task-string str) + (let ((path + (let ((path-end (string-index str #\:))) + (if (not path-end) '() + (parse-path str 0 path-end)))) + (dates (substring/find str #\[ #\]))) + (if (null? dates) '() + (let ((date-start (string->date (car dates) "~Y-~m-~d ~H:~M:~S"))) + (let-values (((date-end duration) + (if (null? (cdr dates)) + (values #f #f) + (let* ((date-end (string->date (cadr dates) "~Y-~m-~d ~H:~M:~S")) + (duration (time-difference + (date->time-utc date-end) + (date->time-utc date-start)))) + (values date-end duration))))) + (list path date-start date-end duration)))))) + +(define (parse-timesheet filename) + (call-with-input-file filename + (lambda (port) + (let loop ((recs '())) + (let ((line (get-line port))) + (if (eof-object? line) + recs + (loop (parse-task-string line)))))))) + +(define (timesheet-get-last filename) + (let ((last-line + (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 + (date->time-utc stop-date) + (date->time-utc start-date))))) + +;; MAIN + +(define ts-file "/home/np/timesheet.txt") + +(let* ((cmdl (command-line)) + (params (cdr cmdl))) + (if (null? params) + ;; No command. Show last record and duration if running + (let ((last (timesheet-get-last ts-file))) + (if (null? last) + (format #t "Not any tasks\n") + (let ((path (car last)) + (start-date (cadr last)) + (stop-date (caddr last)) + (duration (cadddr last)) + (now (current-date))) + (format #t "~a: [~a] - [~a] - ~a\n" + (path->string path) + (date->string start-date "~Y-~m-~d ~H:~M:~S") + (if (not stop-date) "NOW" + (date->string stop-date "~Y-~m-~d ~H:~M:~S")) + (time-difference->h:m:s + (if duration duration + (time-difference + (date->time-utc (if stop-date stop-date now)) + (date->time-utc start-date)))))))) + + ;; Commands + (let ((command (car params)) + (date (current-date))) + (cond + + ((equal? command "start") + ;; ----------------------- Start timer ------------------------- ;; + (call-with-append-file + ts-file + (lambda (port) + (let* ((last (timesheet-get-last ts-file)) + (path + (if (null? (cdr params)) + (if (null? last) '() (car last)) + (parse-path (cadr params))))) + (if (null? path) + (format #t "ERROR: Not specified the task path\n") + (begin + (when (and (not (null? last)) (not (caddr last))) + (write-stop-and-duration port (cadr last) date)) + (format port "~a: [~a]" (path->string path) (date->string date "~Y-~m-~d ~H:~M:~S")))))))) + + ((equal? command "stop") + ;; ----------------------- Stop timer ------------------------- ;; + (call-with-append-file + ts-file + (lambda (port) + (let ((last (timesheet-get-last ts-file))) + (if (or (null? last) (caddr last)) + (format #t "WARNING: Not running any tasks\n") + (write-stop-and-duration port (cadr last) date))))))))))