;;; guile-gpio --- Guile interface to the Linux GPIO Sysfs API
;;; Copyright © 2016 David Thompson <davet@gnu.org>
;;;
;;; This file is part of guile-gpio.
;;;
;;; Guile-gpio is free software; you can redistribute it and/or modify
;;; it under the terms of the GNU Lesser General Public License as
;;; published by the Free Software Foundation; either version 3 of the
;;; License, or (at your option) any later version.
;;;
;;; Guile-gpio is distributed in the hope that it will be useful, but
;;; WITHOUT ANY WARRANTY; without even the implied warranty of
;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
;;; General Public License for more details.
;;;
;;; You should have received a copy of the GNU Lesser General Public
;;; License along with guile-gpio.  If not, see
;;; <http://www.gnu.org/licenses/>.

;;; Commentary:
;;
;; Wrapper over the Linux GPIO Sysfs API.
;;
;;; Code:

(define-module (gpio)
  #:use-module (ice-9 match)
  #:use-module (srfi srfi-9)
  #:export (make-pin
            pin?
            interrupt-generating-pin?
            pin-number
            pin-exported?
            pin-export!
            pin-unexport!
            pin-high?
            pin-low?
            pin-set!
            pin-edge
            set-pin-edge!
            pin-direction
            set-pin-direction!
            call-with-pin
            with-pins))

(define-record-type <pin>
  (make-pin number)
  pin?
  (number pin-number))

(define %gpio-sysfs "/sys/class/gpio")

(define (read-boolean port)
  "Read boolean value, as specified by the GPIO Sysfs API, from PORT.
The value is represented as a single character: \"1\" for true and
\"0\" for false, naturally."
  (eqv? (read-char port) #\1))

(define (pin-directory pin)
  "Return the directory name associated with PIN in the GPIO Sysfs
interface."
  (string-append %gpio-sysfs "/gpio" (number->string (pin-number pin))))

(define (pin-value-file pin)
  "Return the file name where the value of PIN is stored."
  (string-append (pin-directory pin) "/value"))

(define (pin-edge-file pin)
  "Return the file name where the edge of PIN is stored."
  (string-append (pin-directory pin) "/edge"))

(define (pin-direction-file pin)
  "Return the file name where the direction of PIN is stored."
  (string-append (pin-directory pin) "/direction"))

(define (pin-exported? pin)
  "Return #t if PIN has been exported, meaning that it can be
manipulated in userspace."
  (file-exists? (pin-directory pin)))

(define pin-export!
  (let ((export-file (string-append %gpio-sysfs "/export")))
    (lambda (pin)
      "Export PIN so that it may be manipulated in userspace."
      (call-with-output-file export-file
        (lambda (port)
          (display (number->string (pin-number pin)) port))))))

(define pin-unexport!
  (let ((unexport-file (string-append %gpio-sysfs "/unexport")))
    (lambda (pin)
      "Relinquish userspace control of PIN."
      (call-with-output-file unexport-file
        (lambda (port)
          (display (number->string (pin-number pin)) port))))))

(define (pin-high? pin)
  "Return if PIN is set to a high value."
  (call-with-input-file (pin-value-file pin) read-boolean))

(define (pin-low? pin)
  "Return #t if PIN is set to a low value."
  (not (pin-high? pin)))

(define (pin-set! pin high?)
  "Set PIN to a high value if HIGH?, otherwise set PIN to a low
value."
  (call-with-output-file (pin-value-file pin)
    (lambda (port)
      (display (if high? "1" "0") port))))

(define (interrupt-generating-pin? pin)
  "Return #t if PIN is capable of generating interrupts."
  (file-exists? (pin-edge-file pin)))

(define (pin-edge pin)
  "Return the signal edges of PIN that trigger interrupts.  The edge
type may be one of four possible values: none, rising, falling, or
both."
  (call-with-input-file (pin-edge-file pin) read))

(define (set-pin-edge! pin edge)
  "Set the signal EDGE type for PIN that will trigger an interrupt.
The edge type may be one of four possible values: none, rising,
falling, or both.  PIN must be an input pin."
  (match edge
    ((or 'none 'rising 'falling 'both)
     (call-with-output-file (pin-edge-file pin)
       (lambda (port)
         (write edge port))))))

(define (pin-direction pin)
  "Return the direction of PIN, either 'in' or 'out'."
  (call-with-input-file (pin-direction-file pin) read))

(define (set-pin-direction! pin direction)
  "Set the direction of PIN to DIRECTION, either 'in' or 'out'."
  (match direction
    ((or 'in 'out)
     (call-with-output-file (pin-direction-file pin)
       (lambda (port)
         (write direction port))))))

(define* (call-with-pin number proc #:key direction edge)
  "Import GPIO pin NUMBER and apply PROC with an object representing
that pin.  When PROC exits, the pin is unexported.  If DIRECTION is
specified, set the pin to that direction, otherwise use the system
default.  If EDGE is specified, set the pin to that edge, otherwise
use the system default.  Only interrupt generating input pins may
specify a value for EDGE."
  (let ((pin (make-pin number)))
    ;; Try to export before entering the dynamic-wind.  This way, if
    ;; the pin was already exported it won't be automatically
    ;; unexported, potentially screwing up some other process that was
    ;; using it.
    (pin-export! pin)
    (dynamic-wind
      (const #t)
      (lambda ()
        ;; It's important to set the direction first, because only
        ;; input pins may set their edge.
        (when direction (set-pin-direction! pin direction))
        (when edge (set-pin-edge! pin edge))
        (proc pin))
      (lambda ()
        (pin-unexport! pin)))))

(define-syntax with-pins
  (syntax-rules ()
    ((_ () body ...)
     (begin body ...))
    ((_ ((name number kwargs ...) . rest) body ...)
     (call-with-pin number
       (lambda (name)
         (with-pins rest body ...))
       kwargs ...))))