fin-lisp.lisp 7.4 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251
  1. ;;;(ql:quickload "cl-store")
  2. (ql:quickload "yason")
  3. (ql:quickload "cl-ppcre")
  4. (ql:quickload "unix-opts")
  5. (ql:quickload "ironclad")
  6. ;;; Features
  7. ;;; - Import records from old .txt format
  8. ;;; - Interactive prompt to manage expenses
  9. ;;; - Generic expense handling
  10. ;;; TODO
  11. ;;; - Non interactive CLI Interface
  12. ;;; - Upload/download support like perl version
  13. ;;; - Should support encryption/decryption of records
  14. ;;;; Reimplementation of my bills tracker in Lisp
  15. ;;; All records exist in this data structure
  16. ;;; nil on start and loaded in from file
  17. ;;; *records* represents as hash of months,
  18. ;;; where the key is the month stamp, eg 20210701
  19. ;;; and the value is the monthly expenses hash
  20. (defvar *records* (make-hash-table :test 'equalp))
  21. (defun file-test (filename)
  22. (if (probe-file filename) filename (print "Couldn't find filename")))
  23. ;;; Used by "print-month" arg to validate
  24. ;;; the user provided a valid key
  25. (defun check-month (month-key)
  26. (if (stringp month-key) month-key))
  27. (opts:define-opts
  28. (:name :help
  29. :description "Print help text"
  30. :short #\h
  31. :long "help")
  32. (:name :read
  33. :description "Read serialized records file"
  34. :short #\r
  35. :long "read"
  36. :arg-parser #'file-test)
  37. (:name :print-month
  38. :description "Print records for given month"
  39. :short #\p
  40. :long "print-month"
  41. :arg-parser #'check-month)
  42. (:name :interactive-mode
  43. :description "Run in interactive mode"
  44. :short #\i
  45. :long "interactive"))
  46. ;; See: https://github.com/libre-man/unix-opts/blob/master/example/example.lisp
  47. (defmacro when-option ((options opt) &body body)
  48. `(let ((it (getf ,options ,opt)))
  49. (when it
  50. ,@body)))
  51. (defun reload ()
  52. (load "~/Repos/fin-lisp/fin-lisp.lisp"))
  53. (defun wfile (file-content file-path)
  54. (alexandria:write-string-into-file
  55. (concatenate 'string file-content) file-path :if-exists :overwrite
  56. :if-does-not-exist :create))
  57. ;;;;;;;;;;;;;;;;;;;;;;;;
  58. ;;; Encryption stuff ;;;
  59. ;;;;;;;;;;;;;;;;;;;;;;;;
  60. ;;; See: https://www.cliki.net/Ironclad
  61. ;;; Return cipher when provided key
  62. (defun get-cipher (key)
  63. (ironclad:make-cipher
  64. :blowfish
  65. :mode :ecb
  66. :key (ironclad:ascii-string-to-byte-array key)))
  67. ;;; First serialize the file,
  68. ;;; then encrypt it from disk
  69. (defun encrypt-records (key filename)
  70. (let ((cipher (get-cipher key))
  71. (file-content (uiop:read-file-string filename)))
  72. (let ((content (ironclad:ascii-string-to-byte-array file-content)))
  73. (ironclad:encrypt-in-place cipher content)
  74. (wfile
  75. (write-to-string (ironclad:octets-to-integer content))
  76. (concatenate 'string filename ".enc")))))
  77. (defun decrypt-records (key filename)
  78. (let ((cipher (get-cipher key))
  79. (file-content (uiop:read-file-string filename)))
  80. (let ((content (ironclad:integer-to-octets (parse-integer file-content))))
  81. (ironclad:decrypt-in-place cipher content)
  82. (coerce (mapcar #'code-char (coerce content 'list)) 'string))))
  83. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  84. ;;; End Encryption Stuff ;;;
  85. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  86. (defun reset-records ()
  87. (setf *records* (make-hash-table :test 'equal)))
  88. ;; Called like: (add-month '202107)
  89. (defun add-month (month-key)
  90. (setf (gethash month-key *records*) (make-hash-table :test 'equalp))
  91. month-key)
  92. ;;; Taken from practical common lisp
  93. (defun prompt-read (prompt)
  94. (format *query-io* "~a: " prompt)
  95. (force-output *query-io*)
  96. (read-line *query-io*))
  97. (defun prompt-for-expense ()
  98. (list
  99. (prompt-read "Enter expense name")
  100. (parse-integer
  101. (prompt-read "Enter expense value"))))
  102. (defun add-expense-to-month (month)
  103. (if (gethash month *records*)
  104. (let ((innerhash (gethash month *records*))
  105. (exp-l (prompt-for-expense)))
  106. (setf (gethash (first exp-l) innerhash) (second exp-l)))
  107. ;;NIL))
  108. (add-expense-to-month (add-month month))))
  109. ;;; Given key for *records* hash,
  110. ;;; print expenses/values for month
  111. (defun dump-month (month-key)
  112. (format t "~a~C" month-key #\linefeed)
  113. (let ((month-hash)
  114. (exp-keys))
  115. (setf month-hash (gethash month-key *records*))
  116. (setf exp-keys (loop for key being the hash-keys of month-hash collect key))
  117. (dolist (exp-key exp-keys)
  118. (format t "~a : ~a~C" exp-key (gethash exp-key month-hash) #\linefeed))))
  119. ;;; Dump all records.
  120. (defun dump-records ()
  121. (let ((record-key-list (loop for key being the hash-keys of *records* collect key)))
  122. (dolist (month-key record-key-list) (dump-month month-key))))
  123. (defun serialize-records (key filename)
  124. (with-open-file (stream filename
  125. :direction :output
  126. :if-exists :overwrite
  127. :if-does-not-exist :create)
  128. (yason:encode *records* stream))
  129. (encrypt-records key filename))
  130. (defun deserialize-records (key filename)
  131. ;; Import records from old perl version (plaintext file)
  132. (defun import-records (filename)
  133. (let ((old-file-lines
  134. (with-open-file (stream filename)
  135. (loop for line = (read-line stream nil)
  136. while line
  137. collect line)))
  138. (mre (ppcre:create-scanner "^(.*)[0-9]{4}$"))
  139. (ere (ppcre:create-scanner "^([A-Z].*)\ -\ \\\$([0-9]{1,4}) - PAID"))
  140. (cur-mon)
  141. (cur-exp))
  142. (loop for line in old-file-lines
  143. do (progn
  144. (if (ppcre:scan mre line) (setf cur-mon line))
  145. (if (ppcre:scan ere line)
  146. (progn
  147. (setf cur-exp (ppcre:register-groups-bind (first second) (ere line) :sharedp t (list first second)))
  148. (print cur-exp)
  149. (if (gethash cur-mon *records*)
  150. (let ((innerhash (gethash cur-mon *records*)))
  151. (setf (gethash (first cur-exp) innerhash) (second cur-exp))))
  152. (if (not (gethash cur-mon *records*))
  153. (progn
  154. (add-month cur-mon)
  155. (let ((innerhash (gethash cur-mon *records*)))
  156. (setf (gethash (first cur-exp) innerhash) (second cur-exp)))))))))))
  157. (defmacro generic-handler (form error-string)
  158. `(handler-case ,form
  159. (error (e)
  160. (format t "Invalid input: ~a ~%" ,error-string)
  161. (values 0 e))))
  162. ;; Util screen clearer
  163. (defun cls()
  164. (format t "~A[H~@*~A[J" #\escape))
  165. (defun interactive-mode ()
  166. (format t "~%")
  167. (format t "Available options:~%")
  168. (format t "1. Enter expense~%")
  169. (format t "2. Display month~%")
  170. (format t "3. Write records~%")
  171. (format t "4. Read records~%")
  172. (format t "5. Quit~%")
  173. (format t "6. Import Records~%")
  174. (let
  175. ((answer (prompt-read "Select an option")))
  176. (if (string= answer "1")
  177. (generic-handler
  178. (add-expense-to-month (prompt-read "Enter month"))
  179. "Invalid Input"))
  180. (if (string= answer "2")
  181. (generic-handler
  182. (dump-month (prompt-read "Enter month"))
  183. "Invalid month"))
  184. (if (string= answer "3")
  185. (generic-handler
  186. (serialize-records (prompt-read "Enter encryption key")
  187. (prompt-read "Enter filename"))
  188. "Serialization error or invalid filename"))
  189. (if (string= answer "4")
  190. (generic-handler
  191. (deserialize-records (prompt-read "Enter filename"))
  192. "Deserialization error or invalid filename"))
  193. (if (string= answer "5")
  194. (quit))
  195. (if (string= answer "6")
  196. (generic-handler
  197. (import-records (prompt-read "Enter filename"))
  198. "Parsing error or invalid filename")))
  199. (interactive-mode))
  200. (defun display-help ()
  201. (format t "foo ~%")
  202. (opts:describe
  203. :prefix "fin-lisp.lisp - Basic expense tracker in lisp"
  204. :usage-of "fin-lisp.lisp"
  205. :args "[FREE-ARGS]")
  206. (quit))
  207. ;; Entry point
  208. (defun main ()
  209. (if (= 1 (length sb-ext:*posix-argv*)) (interactive-mode))
  210. (let ((matches (opts:get-opts)))
  211. (format t "~a ~%" matches)
  212. (when-option (matches :help)
  213. (display-help))
  214. (when-option (matches :print-month)
  215. (when-option (matches :interactive-mode)
  216. (progn
  217. (interactive-mode)
  218. (quit))))))