Lattay · October 9, 2020 14:44
diff --git a/sort_dune.scm b/sort_dune.scm
 #!/usr/bin/env -S csi -s
 ; This is a quick and dirty Chicken 5 script
 ; to help auto format dune config files
 ; It is incomplete since I did not want to take
 ; time to handle all stanza cases but it should be a decent
 ; base for a more complete script.
 ;
 ; Distributed under CC-0/Public domain with no guaranty.


 (import scheme
        chicken.base
        chicken.sort
        chicken.pretty-print)

 (define (read-all)
  (let loop ((acc '()))
    (let ((sexp (read)))
      (if (eof-object? sexp)
          (reverse acc)
          (loop (cons sexp acc))))))

 (define (get-name sexp)
  (case (car sexp)
    ((executable library alias)
     (cadr (assoc 'name (cdr sexp))))
    (else
      (error "don't know how to order" (car sexp)))))

 (define ordered-stanza
  '(alias
     install
     package
     library
     foreign_library
     executables
     executable
     documentation))

 (define (index-of a lst)
  (let loop ((i 0) (rest lst))
    (if (null? rest)
        #f
        (if (eq? a (car rest))
            i
            (loop (+ 1 i) (cdr rest))))))

 (define (symbol-comp s1 s2)
  (let ((n1 (symbol->string s1))
        (n2 (symbol->string s2)))
    (cond ((< n1 n2) 'less)
          ((> n1 n2) 'more)
          (#t 'equal))))

 (define (stanza-order s1 s2)
  (let ((i1 (index-of s1 ordered-stanza))
        (i2 (index-of s2 ordered-stanza)))
    (cond ((and i1 (not i2) 'less)) ; i2 not in ordered-stanza
          ((and i2 (not i1) 'more)) ; i1 not in ordered-stanza
          ((and (not i1) (not i2)) ; both not in ordered-stanza
           (symbol-comp s1 s2))
          ; both in ordered-stanza
          ((= i1 i2) 'equal)
          ((< i1 i2) 'less)
          (#t 'more))))

 (define (sexp-less? s1 s2)
  (case (stanza-order (car s1) (car s2))
    ((less) #t)
    ((more) #f)
    ((equal)
     (let ((n1 (symbol->string (get-name s1)))
           (n2 (symbol->string (get-name s2))))
       (string-ci<? n1 n2)))))

 (define (for-each* f seq)
  (let loop ((rest seq))
    (cond
      ((null? rest) '())
      ((null? (cdr rest)) (f (car rest) #t) (loop (cdr rest)))
      (#t (f (car rest) #f) (loop (cdr rest))))))

 (define (format-input)
  (for-each* (lambda (sexp last-one)
               (pp sexp)
               (unless last-one (newline)))
             (sort (read-all) sexp-less?)))

 (format-input)
	#!/usr/bin/env -S csi -s
	; This is a quick and dirty Chicken 5 script
	; to help auto format dune config files
	; It is incomplete since I did not want to take
	; time to handle all stanza cases but it should be a decent
	; base for a more complete script.
	;
	; Distributed under CC-0/Public domain with no guaranty.


	(import scheme
	chicken.base
	chicken.sort
	chicken.pretty-print)

	(define (read-all)
	(let loop ((acc '()))
	(let ((sexp (read)))
	(if (eof-object? sexp)
	(reverse acc)
	(loop (cons sexp acc))))))

	(define (get-name sexp)
	(case (car sexp)
	((executable library alias)
	(cadr (assoc 'name (cdr sexp))))
	(else
	(error "don't know how to order" (car sexp)))))

	(define ordered-stanza
	'(alias
	install
	package
	library
	foreign_library
	executables
	executable
	documentation))

	(define (index-of a lst)
	(let loop ((i 0) (rest lst))
	(if (null? rest)
	#f
	(if (eq? a (car rest))
	i
	(loop (+ 1 i) (cdr rest))))))

	(define (symbol-comp s1 s2)
	(let ((n1 (symbol->string s1))
	(n2 (symbol->string s2)))
	(cond ((< n1 n2) 'less)
	((> n1 n2) 'more)
	(#t 'equal))))

	(define (stanza-order s1 s2)
	(let ((i1 (index-of s1 ordered-stanza))
	(i2 (index-of s2 ordered-stanza)))
	(cond ((and i1 (not i2) 'less)) ; i2 not in ordered-stanza
	((and i2 (not i1) 'more)) ; i1 not in ordered-stanza
	((and (not i1) (not i2)) ; both not in ordered-stanza
	(symbol-comp s1 s2))
	; both in ordered-stanza
	((= i1 i2) 'equal)
	((< i1 i2) 'less)
	(#t 'more))))

	(define (sexp-less? s1 s2)
	(case (stanza-order (car s1) (car s2))
	((less) #t)
	((more) #f)
	((equal)
	(let ((n1 (symbol->string (get-name s1)))
	(n2 (symbol->string (get-name s2))))
	(string-ci<? n1 n2)))))

	(define (for-each* f seq)
	(let loop ((rest seq))
	(cond
	((null? rest) '())
	((null? (cdr rest)) (f (car rest) #t) (loop (cdr rest)))
	(#t (f (car rest) #f) (loop (cdr rest))))))

	(define (format-input)
	(for-each* (lambda (sexp last-one)
	(pp sexp)
	(unless last-one (newline)))
	(sort (read-all) sexp-less?)))

	(format-input)