invoice/invoice.in

#!@GUILE@ \
-e main
!#
;; Copyright 2015,2018 Eric Bavier <bavier@member.fsf.org>
;;
;; This program is free software.  It is released under the GNU GPLv3,
;; or any later version, at your option.

(use-modules (ice-9 format)
             (ice-9 match)
             (srfi srfi-1)              ;append-map
             (srfi srfi-37)             ;for args-fold
             (srfi srfi-26))            ;for cut

(define (billable hours rate description)
  (vector hours rate description))
(define (billable-hours billable)
  (vector-ref billable 0))
(define (billable-rate billable)
  (vector-ref billable 1))
(define (billable-description billable)
  (vector-ref billable 2))

(define (subtotal billable)
  (* (billable-hours billable)
     (billable-rate billable)))
(define (total billables)
  (apply + (map subtotal billables)))

(define* (invoice number
                  bill-to
                  bill-for
                  billables
                  #:optional
                  (port (current-output-port))
                  #:key
                  (name (getenv "USERNAME"))
                  (address "ADDRESS")
                  (phone #f)
                  (email #f)
                  (closing "Thank you for your business!")
                  (payment #f))
  "Writes to the current output, or PORT if given, an invoice in LaTeX
markup.  The list of billable items in BILLABLES will be formatted in
a table with subtotals and total."
  (format port "~
\\documentclass[12pt]{article}

\\usepackage{microtype}
\\usepackage{xcolor}
\\usepackage{ctable}
\\usepackage{tabularx}

\\leftskip 0.1in
\\parindent -0.1in
\\setlength{\\textfloatsep}{0cm}

\\begin{document}
\\thispagestyle{empty} %% Do not output page numbers
\\noindent
\\parbox[t]{.5\\linewidth}{\\Large\\scshape\\textbf{~a}}
\\hfill
\\parbox[t]{.5\\linewidth}{\\raggedleft \\Huge\\scshape\\textcolor{gray}{Invoice}}

\\vspace{2\\baselineskip}
\\noindent
\\parbox[t]{.5\\linewidth}{\\raggedright ~a \\\\\\vspace{1ex}~@[Phone: ~a~]~@[\\\\ Email: ~a~]}
\\hfill
\\parbox[t]{.5\\linewidth}{\\raggedleft \\textsc{Date}: \\today \\\\ \\textsc{Invoice}: ~d}

\\vspace{2\\baselineskip}
\\noindent
\\parbox[t]{.5\\linewidth}{\\textsc{Bill To}:\\\\ ~a}
\\hfil
\\parbox[t]{.5\\linewidth}{\\textsc{For}:\\\\ ~a}

\\vspace{3\\baselineskip}
\\noindent
\\begin{tabularx}{1.0\\linewidth}[h]{Xrrr}
  \\toprule
  \\textit{Description} & \\textit{Hours} & \\textit{\\$/hr} & \\textit{Amount} \\\\ \\midrule~a
  & & \\textsc{Total}: & \\$ ~$ \\\\ \\bottomrule
\\end{tabularx}

\\vspace{2\\baselineskip}
\\noindent ~:[Make checks payable to \\textbf{~a}~;~a~]
\\vspace{2\\baselineskip}
\\begin{center}
  \\textsc{~a}
\\end{center}
\\end{document}~%"
          name
          address
          phone
          email
          number
          bill-to
          bill-for
          (format #f "~:{
  ~a & ~f & ~$ & ~$ \\\\~}"
                  (map (lambda (b)
                         (list (billable-description b)
                               (billable-hours b)
                               (billable-rate b)
                               (subtotal b)))
                       billables))
          (total billables)
          payment
          (or payment name)
          closing))

(define %config-file
  (string-append (getenv "HOME") "/.invoicerc"))
(define %last-invoice-file
  (string-append (getenv "HOME") "/.last-invoice-number"))

(define (load-config)
  (primitive-load %config-file))

(define (last-invoice-number)
  (primitive-load %last-invoice-file))

(define (write-invoice-number num)
  (call-with-output-file %last-invoice-file
    (cut format <> "~d" num)))

(define (read-args args config)
  (args-fold args
             (let ((display-and-exit-proc
                    (lambda (msg)
                      (lambda (opt name args load)
                        (display msg) (newline) (quit))))
		   (simple-opt
		    (lambda (short long)
		      (option (list short long) #t #f
			      (lambda (opt name arg load)
				(alist-replace long arg load))))))
               (list (option '(#\v "version") #f #f
                             (display-and-exit-proc "@PACKAGE_NAME@ @PACKAGE_VERSION@"))
                     (option '(#\h "help") #f #f
                             (display-and-exit-proc
                              (format #f
                               "Usage: invoice [options] -D <desc> -R <rate> -H <hours> ...

Options:
  -h, --help     Print this message
  -v, --version  Print this program's version
  -t STR, --bill-to=STR
  -f STR, --bill-for=STR
  -n STR, --name=STR
  -a STR, --address=STR
  -p STR, --phone=STR
  -e STR, --email=STR
  -c STR, --closing=STR
  -y STR, --payment=STR
                 Set template contents.
  -N STR, --invoice-number=NUM
                 Override the invoice number in ~a
  -U, --no-update
                 Do NOT record the latest invoice number in ~a
  -D STR, --description=STR
                 Begin a billable item and provide its description.
                 Expects to be followed by an --hours argument, and
                 may optionally be followed by --rate.
  -H NUM, --hours=NUM
                 Set the number of hours for the current billable item.
  -R STR, --rate=STR
                 If given before the first --description argument is
                 encountered, sets the default hourly rate.  Otherwise
                 sets the hourly rate for the current billable item.

Default configuration will be loaded from ~a

Send bug reports to @PACKAGE_BUGREPORT@~%"
                               %last-invoice-file
			       %last-invoice-file
                               %config-file)))
		     (simple-opt #\t "bill-to")
		     (simple-opt #\f "bill-for")
		     (simple-opt #\n "name")
		     (simple-opt #\a "address")
		     (simple-opt #\p "phone")
		     (simple-opt #\e "email")
		     (simple-opt #\c "closing")
		     (simple-opt #\y "payment")
		     (simple-opt #\N "invoice-number")
		     (option '(#\U "no-update") #f #f
			     (lambda (opt name arg load)
			       (alist-replace "no-update" #t load)))
		     (option '(#\D "description") #t #f
			     (lambda (opt name arg load)
			       (alist-reduce
				"billables"
				`(("description" . ,arg)
				  ("rate" . ,(or (config-lookup "rate" load)
						 0.0))
				  ("hours" . 0.0))
				load cons '())))
		     (option '(#\R "rate") #t #f
			     (lambda (opt name arg load)
			       (let ((rate (string->number arg)))
				 (match (config-lookup "billables" load)
				   ((head . tail)
				    (alist-replace "billables"
						   `(,(alist-replace "rate" rate head)
						     ,@tail)
						   load))
				   (#f
				    (alist-replace "rate" rate load))))))
		     (option '(#\H "hours") #t #f
			     (lambda (opt name arg load)
			       (let ((hours (string->number arg)))
				 (match (config-lookup "billables" load)
				   ((head . tail)
				    (alist-replace "billables"
						   `(,(alist-replace "hours" hours head)
						     ,@tail)
						   load))
				   (else
				    (error (format #f "invoice: cannot give ~a before ~:@
                                                       --description~%"
						   name)))))))))
             (lambda (opt name arg loads)
               (error "Unrecognized option `~A'" name))
             (lambda (op loads) (cons op loads))
             config))

(define (config-lookup key configdb)
  "Lookup the configuration variable KEY in the configuration database
CONFIGDB.  Values are assumed to be strings.  If KEY does not have a
value then #f is returned."
  (match (assoc key configdb)
    ((_ . value) value)
    (#f #f)))

(define (maybe-keyword kw configdb)
  "Lookup the the KW's name in configdb, and return (KW <value>) or an
empty list if there is no value on CONFIGDB."
  (or (and=> (config-lookup (symbol->string (keyword->symbol kw)) configdb)
             (cut list kw <>))
      '()))

(define* (alist-replace key datum alist #:optional (= equal?))
  "Insert an association KEY and DATUM into ALIST.  If an association
for KEY already exists in ALIST, it is overriden.  Equality is
determined with the = predicate, or equal? if not given."
  (alist-cons key datum
              (alist-delete key alist =)))

(define (alist->billables billable-alist)
  "Transform a list of alist-based billable items into the more
compact format."
  (map (lambda (b)
	 (billable (assoc-ref b "hours")
		   (assoc-ref b "rate")
		   (assoc-ref b "description")))
       billable-alist))

(define* (alist-reduce key datum alist proc init #:optional (= equal?))
  "Insert an association into ALIST which is the result of (PROC DATUM
<previous>), where <previous> is either the existing value of the
association or INIT if there is no association with KEY."
  (alist-replace key
		 (proc datum (or (and=> (assoc key alist =) cdr)
				 init))
		 alist =))

(define (main args)
  (let* ((config (read-args (cdr args) (load-config)))
	 (invoice-num (or (and=> (config-lookup "invoice-number" config)
				 string->number)
			  (1+ (last-invoice-number)))))
    (apply invoice `(,invoice-num
                     ,(config-lookup "bill-to" config)
                     ,(config-lookup "bill-for" config)
                     ,(alist->billables (or (and=> (config-lookup "billables" config)
						   reverse)
					    '()))
                     ,@(append-map (cut maybe-keyword <> config)
                                   '(#:name #:address #:phone #:email
					    #:closing #:payment))))
    (unless (config-lookup "no-update" config)
       (write-invoice-number invoice-num))))