(eval-when (:compile-toplevel :load-toplevel :execute)
  (ql:quickload '(:with-user-abort :uiop :adopt) :silent t))


(defpackage :beepy
  (:use :cl)
  (:export :toplevel *ui*))

(in-package :beepy)

;;;; Configuration -----------------------------------------------
(defparameter *sysfs-firmware* "/sys/firmware/beepy/")

;;;; Errors ------------------------------------------------------
(define-condition user-error (error) ())

(define-condition bad-path (user-error)
  ((interface :initarg  :interface
	      :reader    interface)
   (path      :initform *sysfs-firmware*
	      :reader   fw-path))
  (:report (lambda (condition stream)
	     (format stream
		     "sysfs interface '~a' doesn't exist (in ~a)"
		     (interface condition)
		     (fw-path   condition)))))

(define-condition non-numeric-interface (bad-path)
  ((value :initarg :value
          :reader value))
  (:report (lambda (condition stream)
             (format stream
		     "interface ~a~a should be numeric, but is ~a (~a)"
                     (pathname (interface condition))
		     (interface condition)
                     (type-of (value condition))
		     (value condition)))))

(define-condition non-numeric-value (user-error)
  ((value :initarg :value
          :reader value))
  (:report (lambda (condition stream)
             (format stream
		     "a numeric value is expected, but a ~a value was provided (value was ~a)"
                     (type-of (value condition))
		     (value condition)))))

(define-condition non-boolean-value (user-error)
  ((value :initarg :value
          :reader value))
  (:report (lambda (condition stream)
             (format stream
		     "a boolean value is expected, but a ~a value was provided (value was ~a)"
                     (type-of (value condition))
		     (value condition)))))

(define-condition invalid-color (user-error)
  ((color :initarg :color
          :reader color))
  (:report (lambda (condition stream)
	     (if (keywordp (color condition))
	       (format stream
		       "keyword colors must be one of '(:red :green :blue)")
	       (format stream
		       "color should be a list of (r g b) in the range 0-255 (have ~a)"
		       (color condition))))))

(defun list-commands ()
  (format t "Available commands:
    :led [t nil]	--- turn the onboard LED on or off
    :rgb r g b		--- set the onboard LED's color
    :rgb [:red :green :blue]
    :kbl [t nil]	--- turn the keyboard backlight on or off
    :batt		--- read the battery statistics
    :fw-verison		--- read the current firmware version
")
  (uiop:quit))

;;;; Down to business --------------------------------------------

(defun firmware-file (interface)
  (merge-pathnames interface *sysfs-firmware*))

(defun write-value-to-interface (interface val)
  "Write the numeric value VAL to the file for INTERFACE.
   INTERFACE is a string mapped to a path by FIRMWARE-FILE.
   VAL is a number (integer or float).
   Signals BAD-PATH if the file cannot be written or INTERFACE is invalid."
  (unless (stringp interface)
    (error 'bad-path :interface interface))
  (unless (numberp val)
    (error 'non-numeric-value :value val))
  (let* ((path (handler-case (firmware-file interface)
                 (error (e)
		   (declare (ignore e))
                   (error 'bad-path :interface interface))))
         (truename (or (uiop:truename* path)
                       (error 'bad-path :interface interface))))
    (when (uiop:directory-pathname-p truename)
      (error 'bad-path :interface interface))
    (handler-case
        (with-open-file (stream truename
                               :direction :output
                               :if-exists :supersede
                               :if-does-not-exist :create
                               :element-type 'character
                               :external-format :utf-8)
          (format stream "~A" val)
	  val)
      (file-error (e)
	(declare (ignore e))
        (error 'bad-path :interface interface)))))

(defun read-interface-as-string (interface)
  "Read the contents of a sysfs interface file as a trimmed string.
   INTERFACE is a string identifier (e.g., 'sensor') mapped to a file
   path.  Returns a non-empty string with whitespace trimmed.  Signals
   BAD-PATH if the file doesn't exist, is a directory, is empty, or
   cannot be read."
  (unless (stringp interface)
    (error 'bad-path :interface interface))
  (let* ((path (handler-case (firmware-file interface)
                 (error (e)
		   (declare (ignore e))
                   (error 'bad-path :interface interface))))
         (truename (or (uiop:truename* path)
		       (error 'bad-path :interface interface))))
    (when (uiop:directory-pathname-p truename)
      (error 'bad-path :interface interface))
    (handler-case
        (with-open-file (stream truename
				:direction :input
				:element-type 'character
				:external-format :utf-8)
          (let ((content (string-trim
                          '(#\Space #\Tab #\Newline
			    #\Return #\Linefeed #\Page)
                          (read-line stream nil ""))))
            (when (string= content "")
	      (error 'bad-path :interface interface))
            content))
      (file-error (e)
	(declare (ignore e))
        (error 'bad-path :interface interface)))))

(defun read-interface-numeric (path)
  "Read a numeric form from the file at PATH, signaling non-numeric-interface if invalid.
   Assumes read-interface-as-string returns trimmed file contents."
  (let* ((string (read-interface-as-string path))
         (form (handler-case
                   (let ((*read-eval* nil)) ; Disable evaluation
                     (read-from-string string))
                 (reader-error ()
                   (error 'non-numeric-interface
                          :interface path
                          :value string)))))
    (unless (numberp form)
      (error 'non-numeric-interface
             :interface path
             :value form))
    form))

(defun battery ()
  (list
   (cons :percent (read-interface-numeric "battery_percentage"))
   (cons :raw     (read-interface-numeric "battery_raw"))
   (cons :volts   (read-interface-numeric "battery_volts"))))

(defun println (arg)
  (print arg)
  (terpri))

(defvar *rgb-pure*
  '((:red   (255 0 0))
    (:green (0 255 0))
    (:blue  (0 0 255))))

(defun in-range (number low high)
  (and
   (<= number high)
   (>= number low)))

(defun uint8p (n)
  (and (integerp n)
       (in-range n 0 255)))

(defun validate-rgb (rgb)
  (or
   (and (keywordp rgb)
	(assoc rgb *rgb-pure*))
   (and (listp rgb)
	(= (length rgb) 3)
	(every #'uint8p rgb))))

(defun get-color (color)
  (let ((color (if (and (listp color)
			(listp (car color)))
		   (car color)
		   color)))
    (when (validate-rgb color)
      (if (keywordp color)
	  (cadr (assoc color *rgb-pure*))
	  color))))

(defun set-led (state)
  (unless (typep state 'boolean)
    (error 'non-boolean-value :value state))
  (let ((state-number (if state 1 0)))
    (write-value-to-interface "led" state-number)))

(defun set-led-color (color &optional no-write)
  (let ((rgb (get-color color)))
    (unless rgb
      (error 'invalid-color :color rgb))
    (destructuring-bind (r g b) rgb
      (if no-write
	  (format t "r: ~a, g: ~a, b: ~a~%" r g b)
	  (list
	   (write-value-to-interface "led_red"   r)
	   (write-value-to-interface "led_green" g)
	   (write-value-to-interface "led_blue"  b))))))

(defun set-keyboard-backlight (level)
  (unless (uint8p level)
    (error 'non-numeric-value :value level))
  (write-value-to-interface "keyboard_backlight" level))

(defun beepberry (arg)
  (let* ((arg       (read-from-string arg))
	 (subsystem (car arg))
	 (args      (cdr arg))
	 (result
	   (progn
	     (case subsystem
	       ;; turn LED on or off
	       (:led (set-led args))

	       ;; set the color of the LED
	       (:rgb (set-led-color args))

	       ;; keeb is lit
	       (:kbl (set-keyboard-backlight args))

	       ;; battery info
	       (:batt (battery))

	       ;; firmware version
	       (:fw-version (read-interface-as-string "fw_version"))

	       ;; not handled:
	       ;; - fw_update
	       ;; - last_keypress
	       ;; - rewake_timer
	       ;; - startup_reason
	       (otherwise (list-commands))))))
    (when result
      (cons subsystem result))))

#|
Available interfaces:

  battery_percent  fw_version          led_blue      startup_reason
  battery_raw      keyboard_backlight  led_green
  battery_volts    last_keypress       led_red
  fw_update        led                 rewake_timer

|#

(defun run (arguments)
  (println
   (remove-if #'null (map 'list #'beepberry arguments))))

;;;; User Interface ----------------------------------------------
(defmacro exit-on-ctrl-c (&body body)
  `(handler-case (with-user-abort:with-user-abort (progn ,@body))
     (with-user-abort:user-abort () (sb-ext:exit :code 130))))

(defparameter *option-help*
  (adopt:make-option 'help
		     :help "Display help and exit."
		     :long "help"
		     :short #\h
		     :reduce (constantly t)))

(adopt:defparameters (*option-debug* *option-no-debug*)
  (adopt:make-boolean-options 'debug
    :long "debug"
    :short #\d
    :help "Enable the Lisp debugger."
    :help-no "Disable the Lisp debugger (the default)."))

(defun last-option (prev new)
  (declare (ignore prev))
  new)

(defparameter *option-firmware-path*
  (adopt:make-option 'sysfs-path
		     :parameter "STRING"
		     :help "Look for the sysfs interface at path"
		     :manual (format nil "~
      This must be a path to a valid beepy sysfs. The default is ~a."
				     *sysfs-firmware*)
		     :long "path"
		     :short #\p
		     :initial-value *sysfs-firmware*
		     :reduce #'last-option
		     :key #'uiop:ensure-directory-pathname))

(adopt:define-string *help-text*
  "beepy takes commands, each of which is a list. For example,
  '(:led t) (:rgb 127 0 0).")

(adopt:define-string *extra-manual-text* "Available commands:
    :led [t nil]	--- turn the onboard LED on or off
    :rgb r g b		--- set the onboard LED's color
    :rgb [:red :green :blue]
    :kbl [t nil]	--- turn the keyboard backlight on or off
    :batt		--- read the battery statistics
    :fw-verison		--- read the current firmware version

    The battery returns an assoc list of values:
    '((:percent . 67) (:raw . 2312) (:volts . 3.885))

    The firmware version returns an assoc list with a single
    key:
    '((:fw-version \"3.4\"))
")

(defparameter *examples*
  '(("Turn the LED on, showing red:"
     . "'(:led t) '(:rgb 127")
    ("Turn the LED on, showing green (alternate syntax):"
     . "'(:led t) '(:rgb :green)")
    ("Return the firmware version:"
     . "'(:fw-version)")))

(defparameter *ui*
  (adopt:make-interface
   :name "beepy"
   :usage "[OPTIONS] commands..."
   :summary "interface with beepy's sysfs interface"
   :help *help-text*
   :manual (format nil "~A~2%~A" *help-text* *extra-manual-text*)
   :examples *examples*
   :contents (list
              *option-help*
	      *option-debug*
              *option-no-debug*
              *option-firmware-path*)))

(defun configure (options)
  (maphash
   (lambda (key value)
     (case key
       ('sysfs-path
	(progn
	  (setf *sysfs-firmware* value)))))
   options))

(defun toplevel ()
  (sb-ext:disable-debugger)
  (exit-on-ctrl-c
   (multiple-value-bind (arguments options)
       (adopt:parse-options-or-exit *ui*)
     (when (gethash 'debug options)
       (sb-ext:enable-debugger))
     (handler-case
         (cond
           ((gethash 'help options) (adopt:print-help-and-exit *ui*))
           ((null arguments) (list-commands))
           (t (progn
		(configure options)
		(run arguments))))
       (user-error (e) (adopt:print-error-and-exit e))))))