git.fiddlerwoaroof.com
Raw Blame History
(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
    (ecase *obj-style*
      (:hash-table (setf (gethash "body" ht)
                         (yason:parse (gethash "body" ht)
                                      :object-as *obj-style*)))
      #+(or)
      (:alist (setf (assoc "body" ht)
                    (yason:parse (gethash "body" ht)
                                 :object-as *obj-style*))))))

(defun parse (string)
  (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*)))))

(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)))

(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
          for raw-reply = (pzmq:recv-string socket
                                            :encoding :utf-8)
          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*))))

(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
                                                     :format '("shopping-"
                                                               (:year 4) #\-
                                                               (:month 2) #\-
                                                               (:day 2)))
                 :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)))

(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"
                          :basic-authorization (car
                                                (uiop:read-file-form
                                                 (translate-logical-pathname "CONFIG:flowroute.sexp")))
                          :method :post
                          :content-type "application/json"
                          :content (make-text-message message)))))

(defun finish-tasklist ()
  (let* ((taskfile (get-filename))
         (filename (pathname-name taskfile)))
    (if (probe-file taskfile)
        (loop for x from 1
              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))
        (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
    for ev = (lparallel.queue:pop-queue *event-queue*)
    for message-body = (pick '("body" "body")
                             ev)
    do
       (format t "~&New Message:~%~4tFrom: ~a~%~4tBody: ~a~2%"
               (pick '("body" "from") ev)
               message-body)
       (string-case:string-case ((string-trim " " (string-downcase message-body)))
         ("finish" (finish-tasklist))
         (t (write-to-list ev)))
       (sleep 0.01)))

(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)))

(defun main ()
  "Note this depends on having setup
load-logical-pathname-translations appropriately for your
implementation"
  (load-logical-pathname-translations "NOTES")
  (load-logical-pathname-translations "CONFIG")
  (let ((main-thread (bt:make-thread #'main-thread
                                     :name "message-handler"
                                     :initial-bindings `((*event-queue* . ,*event-queue*)))))
    (queue-processor)))