indent-json.lisp

   1 ;;; PHOROS -- Photogrammetric Road Survey
   2 ;;; Copyright (C) 2012 Bert Burgemeister
   3 ;;;
   4 ;;; This program is free software; you can redistribute it and/or modify
   5 ;;; it under the terms of the GNU General Public License as published by
   6 ;;; the Free Software Foundation; either version 2 of the License, or
   7 ;;; (at your option) any later version.
   8 ;;;
   9 ;;; This program is distributed in the hope that it will be useful,
  10 ;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  11 ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  12 ;;; GNU General Public License for more details.
  13 ;;;
  14 ;;; You should have received a copy of the GNU General Public License along
  15 ;;; with this program; if not, write to the Free Software Foundation, Inc.,
  16 ;;; 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
  17
  18 (in-package :phoros)
  19
  20 (defun indent-json (text &key (indentation 0) suppress-indentation)
  21   "Improve readability of JSON text.  String delimiter is `\"'."
  22   (flet ((leftmost-position (string char-bag)
  23            (let ((positions (mapcar #'(lambda (x) (position x string))
  24                                     char-bag)))
  25              (when (some #'identity positions)
  26                (loop for p in positions when p minimize it))))
  27          (newline-and-spaces (n)
  28            (concatenate 'string
  29                         (string #\Newline)
  30                         (make-string n :initial-element #\Space))))
  31     (setf text (string-left-trim "      " text)) ;Tab and Space
  32     (let* ((quoted-start (leftmost-position text '(#\")))
  33            (quoted-end (when quoted-start
  34                          (+ quoted-start
  35                             2
  36                             (leftmost-position (subseq text (1+ quoted-start))
  37                                                '(#\")))))
  38            (open-position (leftmost-position text '(#\{ #\[)))
  39            (close-position (leftmost-position text '(#\} #\])))
  40            (delimiter-position (leftmost-position text '(#\, #\:))))
  41       (cond
  42         ((and delimiter-position        ;delimiter at position 0
  43               (zerop delimiter-position))
  44          (concatenate 'string
  45                       (subseq text 0 (1+ delimiter-position))
  46                       (unless suppress-indentation
  47                         (newline-and-spaces indentation))
  48                       (indent-json (subseq text (1+ delimiter-position))
  49                                    :indentation indentation
  50                                    :suppress-indentation t)))
  51         ((and close-position            ;closer at position 0
  52               (zerop close-position))
  53          (concatenate 'string
  54                       (subseq text 0 (1+ close-position))
  55                       (indent-json (subseq text (1+ close-position))
  56                                    :indentation (1- indentation))))
  57
  58         ((and open-position             ;opener at position 0
  59               (zerop open-position))
  60          (concatenate 'string
  61                       (newline-and-spaces indentation)
  62                       (subseq text open-position (1+ open-position))
  63                       (indent-json (subseq text (1+ open-position))
  64                                    :indentation (1+ indentation)
  65                                    :suppress-indentation t)))
  66         ((and quoted-start              ;quote comes first
  67               (or (not open-position)
  68                   (< quoted-start open-position))
  69               (or (not close-position)
  70                   (< quoted-start close-position))
  71               (or (not delimiter-position)
  72                   (< quoted-start delimiter-position)))
  73          (concatenate 'string
  74                       (unless suppress-indentation
  75                         (newline-and-spaces indentation))
  76                       (subseq text 0 quoted-end)
  77                       (indent-json (subseq text quoted-end)
  78                                    :indentation indentation
  79                                    :suppress-indentation t)))
  80         ((and close-position            ;closer > 0 and comes first
  81               (or (not open-position)
  82                   (< close-position open-position)))
  83          (concatenate 'string
  84                       (unless suppress-indentation
  85                         (newline-and-spaces indentation))
  86                       (subseq text 0 (1+ close-position))
  87                       (indent-json (subseq text (1+ close-position))
  88                                    :indentation (1- indentation))))
  89         ((and delimiter-position
  90               (or (not open-position)
  91                   (< delimiter-position open-position)))
  92          (concatenate 'string
  93                       (subseq text 0 (1+ delimiter-position))
  94                       (indent-json (subseq text (1+ delimiter-position))
  95                                    :indentation indentation
  96                                    :suppress-indentation t)))
  97         (open-position                  ;opener > 0 and comes first
  98          (concatenate 'string
  99                       (unless suppress-indentation
 100                         (newline-and-spaces indentation))
 101                       (subseq text 0 open-position)
 102                       (newline-and-spaces indentation)
 103                       (subseq text open-position (1+ open-position))
 104                       (indent-json (subseq text (1+ open-position))
 105                                    :indentation (1+ indentation)
 106                                    :suppress-indentation t)))
 107         (t
 108          (concatenate 'string
 109                       (newline-and-spaces indentation)
 110                       text))))))