git.fiddlerwoaroof.com
textmessage-proc.lisp
1511fa78
 (defpackage :fwoar.hub.client-sms
   (:use :cl :alexandria :fw.lu :fwoar.string-utils)
   (:export #:main #:queue-processor))
 (in-package :fwoar.hub.client-sms)
 
 (defparameter *obj-style* :hash-table)
 (defparameter *event-table* (make-array 100 :adjustable t :fill-pointer 0))
 (defparameter *event-queue* (lparallel.queue:make-queue))
 
 (defun parse-fa-body (ht)
   (prog1 ht
379bf21d
     (ecase *obj-style*
       (:hash-table (setf (gethash "body" ht)
                          (yason:parse (gethash "body" ht)
                                       :object-as *obj-style*)))
c71f6c36
       #+(or)
379bf21d
       (:alist (setf (assoc "body" ht)
                     (yason:parse (gethash "body" ht)
                                  :object-as *obj-style*))))))
1511fa78
 
 (defun parse (string)
1abfbd92
   (destructuring-bind (path result)
       (coerce (split #\space string
                      :count 1)
               'list)
     (format t "~&(PATH ~a) (RESULT ~a)~%"
             path result)
     (list path
           (parse-fa-body
            (yason:parse result
                         :object-as *obj-style*)))))
1511fa78
 
379bf21d
 (defun get-and-process-one-message (socket)
   (let* ((raw-reply (pzmq:recv-string socket :encoding :utf-8)))
     (format t "~&~a~%" raw-reply)
     (destructuring-bind (path payload . r) (parse raw-reply)
       (when r
         (format t "~&extra stuff? PATH: ~a~%~4t~a~%~4t~a~2%"
                 path
                 payload
                 r)) 
       payload)))
 
 (defmacro with-hub ((symbol port subscription) &body body)
   (alexandria:once-only (port subscription)
     `(pzmq:with-socket ,symbol (:sub :subscribe ,subscription)
        (pzmq:connect ,symbol ,port)
        ,@body)))
 
1511fa78
 (defun main-thread (&optional (subscription "/flowroutesms") (port "tcp://127.0.0.1:5557"))
   (format t "~&Starting main thread...~%")
   (pzmq:with-socket socket (:sub :subscribe subscription)
     (pzmq:connect socket port)
     (loop for i from 1
1abfbd92
           for raw-reply = (pzmq:recv-string socket
                                             :encoding :utf-8)
379bf21d
           for (path payload . r) = (progn (format t "~&~a~%" raw-reply)
                                           (parse raw-reply))
           when r do (format t "~&extra stuff? PATH: ~a~%~4t~a~%~4t~a~2%"
                             path
                             payload
                             r)
             do (lparallel.queue:push-queue payload *event-queue*))))
1511fa78
 
 (defun make-taskpaper (sms)
   (format nil "~{- ~a~%~}"
           (funcall (compose (op (remove-if (lambda (s) (equal s "")) _))
                             (op (map 'list #'serapeum:trim-whitespace _))
                             (op (fwoar.string-utils:split #\. _)))
                    (pick '("body" "body") sms))))
 
 (defun get-filename (&optional (time (local-time:now)))
   (make-pathname :host "notes"
                  :directory "Listacular"
                  :name (local-time:format-timestring nil time
1abfbd92
                                                      :format '("shopping-"
                                                                (:year 4) #\-
                                                                (:month 2) #\-
                                                                (:day 2)))
1511fa78
                  :type "taskpaper"))
 
 (defun write-to-list (event)
   (with-output-to-file (f (get-filename) :if-exists :append :if-does-not-exist :create)
     (write-sequence (make-taskpaper event)
                     f)
     (finish-output f)))
 
379bf21d
 (defun make-text-message (message)
   (lambda (stream)
     (yason:encode-alist (acons "body" message
                                '(("to" . "18325852660")
                                  ("from" . "18052103310")))
                         stream)))
 
 (defun send-text-message (message)
   (let ((drakma:*text-content-types* (acons "application" "vnd.api+json"
                                             drakma:*text-content-types*)))
     (yason:parse
      (drakma:http-request "https://api.flowroute.com/v2/messages"
1abfbd92
                           :basic-authorization (car
                                                 (uiop:read-file-form
                                                  (translate-logical-pathname "CONFIG:flowroute.sexp")))
379bf21d
                           :method :post
                           :content-type "application/json"
                           :content (make-text-message message)))))
 
1511fa78
 (defun finish-tasklist ()
   (let* ((taskfile (get-filename))
          (filename (pathname-name taskfile)))
     (if (probe-file taskfile)
         (loop for x from 1
379bf21d
               for version = (make-pathname :name (format nil "~a-v~d" filename x)
                                            :defaults taskfile)
               while (probe-file version)
               finally
                  (format *standard-output* "~&Renaming old taskfile ~a -> ~a~%"
                          taskfile
                          version)
                  (send-text-message
                   (format nil "~&Renaming old taskfile ~a -> ~a~%"
                           taskfile
                           version))
                  (rename-file taskfile version)
                  (return version))
1511fa78
         (format *standard-output* "~&No tasklist~%"))))
 
 (defun test-get-filename ()
   (format *standard-output* "~&Test simple output: ~:[Fail~;Pass~]~%"
           (equal #p"notes:listacular;shopping-2017-02-02.taskpaper"
                  (get-filename (local-time:encode-timestamp 0 0 0 0 2 2 2017))))
   (format *standard-output* "~&Test that we ignore the time part of the timestamp: ~:[Fail~;Pass~]~%"
           (equal #p"notes:listacular;shopping-2017-02-02.taskpaper"
                  (get-filename (local-time:encode-timestamp 1 2 3 4 2 2 2017)))))
 
 (defun queue-processor ()
   (format t "~&Starting queue processor...~%")
   (loop
1abfbd92
     for ev = (lparallel.queue:pop-queue *event-queue*)
     for message-body = (pick '("body" "body")
                              ev)
     do
1511fa78
        (format t "~&New Message:~%~4tFrom: ~a~%~4tBody: ~a~2%"
                (pick '("body" "from") ev)
                message-body)
7d846e70
        (string-case:string-case ((string-trim " " (string-downcase message-body)))
1511fa78
          ("finish" (finish-tasklist))
          (t (write-to-list ev)))
        (sleep 0.01)))
 
1abfbd92
 (defun config-file-name (id)
   (merge-pathnames (make-pathname :host "CONFIG"
                                   :name (string-upcase id)
                                   :type "SEXP"
                                   :directory "")))
 
 (defun config-for (id)
   (uiop:read-file-form (config-file-name id)))
 
1511fa78
 (defun main ()
1abfbd92
   "Note this depends on having setup
 load-logical-pathname-translations appropriately for your
 implementation"
1511fa78
   (load-logical-pathname-translations "NOTES")
1abfbd92
   (load-logical-pathname-translations "CONFIG")
   (let ((main-thread (bt:make-thread #'main-thread
                                      :name "message-handler"
                                      :initial-bindings `((*event-queue* . ,*event-queue*)))))
1511fa78
     (queue-processor)))