1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55
(define-module (data-source-git) #:use-module (srfi srfi-1) ;; map/reduce #:use-module (srfi srfi-19) ;; date #:use-module (srfi srfi-69) ;; hash-tables #:use-module (system-utils) #:export (data-source-git)) (define (unix->day unix) (time-monotonic->date (make-time 'time-monotonic 0 unix))) (define (git-log-str directory start end) (cdr (with-error-to-string* (lambda () (shell-command-to-string* "git" "--git-dir" directory "log" "--pretty=format:%at" (string-append "--after=" start) (string-append "--before=" end)))))) (define (data-source-git year directory) ;; TODO shift year based on calendar (let* ((start-date (make-date 0 0 0 0 1 1 year 0)) (end-date (make-date 0 0 0 0 31 12 (+ year 1) 0)) (start (date->string start-date "~s")) (end (date->string end-date "~s")) (result-str (git-log-str directory start end))) ;; shitty workaround that allows giving "repo/.git" or "repo" (define activities-unix-dates (if (string-null? result-str) (let ((non-bare-str (git-log-str (string-append directory file-name-separator-string ".git") start end))) (unlines non-bare-str)) (unlines result-str))) (define project (projectname directory)) (map (lambda (d) (define date-str d) (define u (unix->day (string->number date-str))) `((date . ,u) (project . ,project) (git-directory . ,directory))) activities-unix-dates))) (define (unlines str) (if (string-null? str) '() (string-split str #\newline))) (define (projectname dir) (let ((name (basename dir))) (if (string=? name ".git") (basename (dirname dir)) name)))