git.fiddlerwoaroof.com
Raw Blame History
#!/usr/bin/sbcl --script
(load "/home/edwlan/.sbclrc")

(ql:quickload :qt)

(defpackage jsonview
  (:use #:cl
        #:cl-user
        #:qt))

(in-package jsonview)

(named-readtables:in-readtable :qt)

(defclass json-view-app () 
  ((json-view :accessor json-view)
   (json-model :accessor json-model)
   (json-data :accessor json-data))
  (:metaclass qt-class)
  (:qt-superclass "QWidget"))

(defmethod initialize-instance :after
  ((instance json-view-app) &key)
  (new instance))

(defun prepare-row (&rest keys)
  (let ((keys (loop for k in keys collect (if (null k) "NULL" k))))
    (loop for k in keys collect (#_new QStandardItem (format nil "~a" k)))))

(defun rows-from-alist (alist)
  (loop for (key . value) in alist
        collect (prepare-row (format nil "~a" key) (format nil "~a" value))))

(defun mktree-helper (key value root n)
 (let
   ((row (if (listp key)
           (prepare-row (car key) (cdr key))
           (prepare-row key)))
    (root (if (listp key)
            (let ((nrow (prepare-row (format nil "List Item ~a" n))))
              (#_appendRow root nrow)
              (car nrow))
            root)))
   (#_appendRow root row)
   (if (listp key)
     (mktree root value)
     (mktree (car row) value))))

(defun mktree (root alist)
  (let ((counter 0))
    (loop
      for item in alist
      collect (if (listp item)
                (destructuring-bind (key . value) item
                  (cond ((listp value) (mktree-helper key value root (incf counter)))
                        (t (#_appendRow root (prepare-row key value)))))
                (#_appendRow root (prepare-row item))))))

(defun add-rows (root rows)
  (loop for row in rows do (#_appendRow root row)))

(defmethod init-ui ((instance json-view-app ))
  (#_setWindowTitle instance "JSON viewer")

  (setf (json-view instance) (#_new QTreeView instance)
        (json-model instance) (#_new QStandardItemModel instance))

  (#_setWordWrap (json-view instance) t)
  (let* ((root (#_invisibleRootItem (json-model instance))))
    (mktree root (json-data instance)))
  
  (#_setColumnCount (json-model instance) 2)
  (#_setModel (json-view instance)  (json-model instance))
  (#_expandAll (json-view instance))
  (#_resizeColumnToContents (json-view instance) 0)

  (let ((grid (#_new QVBoxLayout instance))
        (grid1 (#_new QHBoxLayout instance))
        (quit-button  (#_new QPushButton "&Quit!" instance)))
    (#_addWidget grid (json-view instance))
    (#_addWidget grid1 (#_new QPushButton))
    (#_addWidget grid1 (#_new QPushButton))
    (#_addWidget grid1 quit-button)
    (#_addLayout grid grid1)
    (#_setLayout instance grid)
    
    (connect quit-button "clicked()" *qapplication* "quit()")
    ))

(make-qapplication)

(ql:quickload :cl-json)
(ql:quickload :s-http-client)
(let
  ((app (make-instance 'json-view-app))
   (r_json (json:decode-json *standard-input*)))
  (setf (json-data app) r_json)
  (init-ui app)
  (with-main-window
    (window app)))