#lang racket/base
;; Copyright Neil Van Dyke.  See file "info.rkt".

(require racket/list
         racket/runtime-path
         racket/string
         setup/getinfo
         "planet-neil-cpuinfo.rkt"
         "rackout-system.rkt"
         "rackout-xrandr.rkt")

(define (lspci-value-cleanup str)
  (regexp-replace* #rx"^ATI Technologies " 
                   (regexp-replace* #rx" (?:Corp(?:\\.|oration)?|Inc\\.?) "
                                    str
                                    " ")
                   "ATI "))

(define get-device-info-from-lspci
  (let ((lspci-label-to-category-hash (make-immutable-hash
                                       '((#"VGA compatible controller" . "Video")
                                         (#"Ethernet controller"       . "Network")
                                         (#"Network controller"        . "Network")
                                         (#"Audio device"              . "Audio")))))
    (lambda ()
      (let loop ((lines (with-handlers ((exn:fail? (lambda (e) '())))
                          (system-command/stdout-line-strings #:error-name 'get-device-info-from-lspci
                                                              #:command "/usr/bin/lspci")))
                 (type-to-values-hash (make-immutable-hash)))
        (log-debug ":lines ~S" lines)
        (if (null? lines)
            type-to-values-hash
            (let ((line (car lines)))
              (log-debug ":line ~S" line)
              (cond ((regexp-match #rx"^[0-9a-fA-F]+:[0-9a-fA-F]+\\.[0-9a-fA-F]+ +(.+)$" line)
                     => (lambda (m)
                          (apply (lambda (all part2)
                                   (cond ((regexp-match #rx"^([a-zA-Z ]+): +(.+)$" part2)
                                          => (lambda (m)
                                               
                                               (apply (lambda (all label val)
                                                        (log-debug ":label ~S :val ~S" label val)
                                                        (cond ((hash-ref lspci-label-to-category-hash
                                                                         label
                                                                         #f)
                                                               => (lambda (our-label)
                                                                    (log-debug ":our-label ~S" our-label)
                                                                    (loop (cdr lines)
                                                                          (hash-update type-to-values-hash
                                                                                       our-label
                                                                                       (lambda (old-val)
                                                                                         (cons (lspci-value-cleanup (bytes->string/utf-8 val))
                                                                                               old-val))
                                                                                       '()))))
                                                              (else (loop (cdr lines) 
                                                                          type-to-values-hash))))
                                                      m)))
                                         (else (loop (cdr lines) 
                                                     type-to-values-hash))))
                                 m)))
                    (else (loop (cdr lines) 
                                type-to-values-hash)))))))))

(provide get-devices-about-xexp)
(define (get-devices-about-xexp)
  (let* ((category-to-string-list-hash
          (get-device-info-from-lspci))
         (category-to-string-list-hash
          (cond ((with-handlers ((exn:fail? (lambda (e) #f)))
                   (cpuinfo->english (get-cpuinfo)))
                 => (lambda (val)
                      (hash-update category-to-string-list-hash
                                   "CPU"
                                   (lambda (old-val)
                                     (cons val old-val))
                                   '())))
                (else category-to-string-list-hash)))
         (category-to-string-list-hash
          (cond ((with-handlers ((exn:fail? (lambda (e) #f)))
                   (get-xrandr-displays))
                 => (lambda (xds)
                      (if (null? xds)
                          category-to-string-list-hash
                          (hash-update category-to-string-list-hash
                                       "Display"
                                       (lambda (old-val)
                                         (append (map (lambda (xd)
                                                        (let ((name-string     (xrandr-display-name-string xd))
                                                              (connected?      (xrandr-display-connected? xd))
                                                              (mm-pair         (xrandr-display-mm-pair xd))
                                                              (max-pixels-pair (xrandr-display-max-pixels-pair xd)))
                                                          (apply string-append
                                                                 `(,name-string
                                                                   ,@(if connected?
                                                                         `(" (connected"
                                                                           ,@(if (or max-pixels-pair
                                                                                     mm-pair)
                                                                                 '(", ")
                                                                                 '())
                                                                           ,@(if max-pixels-pair
                                                                                 `(,(number->string (car max-pixels-pair))
                                                                                   "x"
                                                                                   ,(number->string (cdr max-pixels-pair))
                                                                                   " pixels"
                                                                                   ,@(if mm-pair
                                                                                         '(", ")
                                                                                         '()))
                                                                                 '())
                                                                           ,@(if mm-pair
                                                                                 `(,(number->string (car mm-pair))
                                                                                   "x"
                                                                                   ,(number->string (cdr mm-pair))
                                                                                   " mm"
                                                                                   )
                                                                                 '())
                                                                           ")")
                                                                         '(" (unconnected)"))))))
                                                      xds)
                                                 old-val))
                                       '()))))
                (else category-to-string-list-hash))))
    (let loop ((categories '("CPU" "Video" "Audio" "Network" "Display")))
      (if (null? categories)
          '()
          (let* ((category (car categories))
                 (vals     (hash-ref category-to-string-list-hash category '())))
            (if (null? vals)
                (loop (cdr categories))
                `((p (b ,category ":")
                     " "
                     ,@(add-between (sort vals string<?)
                                    '(br)))
                  ,@(loop (cdr categories)))))))))

(provide get-linux-version-string)
(define (get-linux-version-string)
  (with-handlers ((exn:fail? (lambda (e) #f)))
  (if (equal? "Linux" (string-trim (bytes->string/latin-1
                                    (system-command/stdout-bytes
                                     #:command "/bin/uname"
                                     #:args '("-s")))))
      (string-trim (bytes->string/latin-1
                    (system-command/stdout-bytes
                     #:command "/bin/uname"
                     #:args '("-r"))))
      #f)))

;; TODO: Will this "." work on all OSes?
(define-runtime-path %rackout:inforkt-runtime-path "info.rkt")

(provide get-legal-info-from-inforkt)
(define (get-legal-info-from-inforkt)
  (let-values (((base name dir?) (split-path %rackout:inforkt-runtime-path)))
    (cond ((get-info/full base)
           => (lambda (get)
                (get 'mcfly-legal (lambda () #f))))
          (else #f))))