git.fiddlerwoaroof.com
jsonview.lisp
9a444f03
 #!/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)))