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 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178
(use-modules (srfi srfi-1) ;; map/fold (srfi srfi-19) ;; date/time (srfi srfi-26) ;; partial application (srfi srfi-69) ;; hash-table (sxml simple) (ice-9 match) (data-source-git) (data-source-rss) (generate-data-svg) (svg-template-gregorian) (svg-template-discord) (svg-template-french-revolutionary)) (define (write-svg name css-files data) (with-output-to-file name (lambda () (for-each (lambda (css-file) (display (string-append "<?xml-stylesheet type=\"text/css\" href=\"" css-file "\" ?>"))) css-files) (sxml->xml data)))) (define (parse-arguments args) (define program (car args)) (define rest (cdr args)) (if (null? rest) default-arguments (parse-arguments-itr (car rest) (cdr rest) default-arguments))) (define (parse-arguments-itr arg rest acc) (define (next-arg) (if (null? rest) #f (car rest))) (define (next-rest) (if (null? rest) '() (cdr rest))) (define (next-arg2) (if (null? (next-rest)) #f (car (next-rest)))) (define (next-rest2) (if (null? (next-rest)) '() (cdr (next-rest)))) (define (get-acc key) (define result (assoc key acc)) (if result (cdr result) #f)) (define (continue new-arg new-rest new-acc) (if (not new-arg) new-acc (parse-arguments-itr new-arg new-rest new-acc))) (match arg ("--year" (continue (next-arg2) (next-rest2) (cons (cons 'year (string->number (next-arg))) acc))) ("--output" (continue (next-arg2) (next-rest2) (cons (cons 'output (next-arg)) acc))) ("-o" (continue (next-arg2) (next-rest2) (cons (cons 'output (next-arg)) acc))) ("--rss-file" (continue (next-arg2) (next-rest2) (cons (cons 'rss-files (cons (next-arg) (assoc-ref acc 'rss-files))) acc))) ("--calendar" (continue (next-arg2) (next-rest2) (cons (cons 'calendar (cons (string->symbol (next-arg)) (get-acc 'directories))) acc))) ("--css" (continue (next-arg2) (next-rest2) (cons (cons 'css (cons (next-arg) (get-acc 'directories))) acc))) ("--help" (display "Exports your git/rss activity for a year into a svg. \x1B[1mHOW TO USE:\x1B[0m git-log-calendar [list of git project directories, ...] [--year 1984] # creates calendar for the gregorian year 1984 # By default gregorian, french-revolutionary and discordian svgs are generated to counterbalance the illuminati at redhat who removed ddate from util-linux. Use --calendar gregorian to only create one svg. [--calendar discordian] [--calendar gregorian] [--calendar french] [--output | -o out.svg] # only works for one calendar atm # The svg will include this css [--css svg.css] \x1B[1mEXAMPLE:\x1B[0m ./git-log-calendar ~/some-repo/ ~/some-other-repo/ ./git-log-calendar . ./git-log-calendar ~/some-repo/.git ./git-log-calendar ~/some-repo/ --css ../css/svg.css --year 2015\\ --output /tmp/greg --calendar gregorian \x1B[1mSEE ALSO\x1B[0m ddate(1), \x1B[3mMalaclypse the Younger\x1B[0m, \x1B[4mPrincipia Discordia, Or How I Found Goddess\x1B[0m \x1B[4mAnd What I Did To Her When I Found Her\x1B[0m \x1B[1mRobert Shea\x1B[0m and \x1B[1mRobert Anton Wilson\x1B[0m, The \x1B[2m\x1B[4m\x1B[53mIlluminatus!\x1B[0m Trilogy ") (exit 2)) (else (continue (next-arg) (next-rest) (cons (cons 'directories (cons arg (get-acc 'directories))) acc))))) (define default-arguments `((directories . ()) (rss-files . ()) (css . ()))) (define (main args) (define arguments (parse-arguments args)) (define (get-arg key) (define result (assoc key arguments)) (if result (cdr result) #f)) (define rss-files (get-arg 'rss-files)) (define directories (get-arg 'directories)) (define year-date (if (get-arg 'year) (make-date 0 0 0 0 0 1 (get-arg 'year) 0) (current-date))) (define year (date-year year-date)) (define days (fold (cut generate-days-table year <> <>) (make-hash-table) (append (map (lambda (d) (data-source-git year d)) directories) (map (lambda (f) (data-source-rss year f)) rss-files)))) (define fyear (gdate->fyear year-date)) (define gyear-name (number->string year)) (define dyear-name (number->string (+ year 1166))) (define fyear-name (number->string fyear)) (define goutput (or (get-arg 'output) (string-append "img/git-activity-" gyear-name ".svg"))) (define doutput (or (get-arg 'output) (string-append "img/git-discord-" dyear-name ".svg"))) (define foutput (or (get-arg 'output) (string-append "img/git-revolutionary-" fyear-name ".svg"))) (define create-all-outputs? (not (get-arg 'calendar))) (when (null? directories) (display "Error: Please call with a list of repo directories\n") (display "Call ./git-log-calendar --help for more info") (display "Example:\n") (display "./git-log-calendar . ~/some-repo/ ~/some-other-repo/.git\n") (exit 1)) (when (not (file-exists? "img/")) (mkdir "img")) (when (or create-all-outputs? (member 'gregorian (get-arg 'calendar)) (member 'greg (get-arg 'calendar))) (write-svg goutput (get-arg 'css) (generate-svg svg-template-gregorian year days))) (when (or create-all-outputs? (member 'discordian (get-arg 'calendar)) (member 'disc (get-arg 'calendar))) (write-svg doutput (get-arg 'css) (generate-svg svg-template-discord year days))) (when (or create-all-outputs? (member 'french (get-arg 'calendar)) (member 'fr (get-arg 'calendar))) (write-svg foutput (get-arg 'css) (generate-svg svg-template-french-revolutionary year-date days))))