A quickscript to transform a s-exp into another. The transformation is currently hardcoded.

transform-s-exp.rkt

#lang racket/base

;;; License: [Apache License, Version 2.0](http://www.apache.org/licenses/LICENSE-2.0) or
;;;          [MIT license](http://opensource.org/licenses/MIT) at your option.


;;; Transforms a s-exp into another.
;;; Tries to keep most of the original indentation, parenthesis shapes,
;;; but it will remove all comments within the s-exp.
;;; New lines can be added with #\n.
;;; The resulting code is then tabified.

;;; also check out resyntax, which preserves comments:
;;; https://github.com/jackfirth/resyntax
;;; but currently it doesn't support user-provided parsers.

(require quickscript
         racket/class
         syntax/to-string
         syntax/parse
         racket/string)

(provide transform-string
         formatter)

(script-help-string "A refactoring example")

;====================================;
;=== User defined transformations ===;
;====================================;

;; This is the function to customize, but you can add other functions if
;; you add them to the `rules` list below.
(define (->define-rule/stx stx)
  (syntax-parse stx
    #:datum-literals (define match match-let list)
    
    [(define (name X ...)
       (match (list _X ...)
         [(list X2 ...)
          BODY ...]))
     (list 'define-rule (list #'(name X2 ...))
           #\n
           #'(BODY ...))]

    [(define (name X)
       (match _X
         [X2 BODY ...]))
     (list 'define-rule (list #'(name X2))
           #\n
           #'(BODY ...))]

    [(define (name X ...)
       (match-let ([X2 _X] ...)
         BODY ...))
     (list 'define-rule (list #'(name X2 ...))
           #\n
           #'(BODY ...))]
    
    [_ #f])) ; failed match

;; List of all the rules to try in order
(define rules
  (list ->define-rule/stx))

;============================;
;=== Transformation logic ===;
;============================;

(define (formatter s)
  (cond [(eq? s #\n) "\n"]
        [(list? s) (string-join (map formatter s) #:before-first "(" #:after-last ")")]
        [(syntax? s)
         (syntax->string s)]
        [else (format "~a" s)]))

;; Tries all rules in order, applies the first one that matches
;; and returns the formatted string
(define (transform-string str)
  (define in (open-input-string str))
  (port-count-lines! in)

  (define stx (parameterize ([current-input-port in])
                (read-syntax)))
  (define res (for/or ([rule (in-list rules)]) (rule stx)))
  (and res (formatter res)))

;===================;
;=== Quickscript ===;
;===================;

(define-script transform-s-exp
  #:label "&Transform s-exp"
  #:menu-path ("Re&factor")
  (λ (selection #:editor ed)
    (send ed select-forward-sexp)
    (define str (send ed get-text (send ed get-start-position) (send ed get-end-position)))
    (define new-str (transform-string str))
    (when new-str
      (send ed begin-edit-sequence)
      (send ed insert new-str)
      (send ed select-backward-sexp)
      (send ed tabify-selection)
      (send ed set-position (send ed get-start-position))
      (send ed end-edit-sequence))
    #f))

;; Make this quickscript fetchable/updatable by url2script
(module url2script-info racket/base
  (provide filename url)
  (define filename "transform-s-exp.rkt")
  (define url "https://gist.github.com/Metaxal/cb9ba6d6a8214ef5f092fd82e83c32ff"))

;================;
;=== Examples ===;
;================;

;; In DrRacket, place the cursor right before the first parenthesis, then click on
;; Scripts|Refactor|Transform s-exp
;; Shortcut: Alt-s, f, t
#;
(define (pi-form j1 j2)
  (match (list j1 j2)
    [(list (judgment c (stmt A (u i)))
           (judgment (cons (stmt x A) c) (stmt B (u i))))
     (displayln "Yep")
     (judgment c (stmt (pi x A B) [u i]))]))

#;
(define (pi-intro j)
  (match j
    [(judgment (cons (stmt x A) t) (stmt b B))
     (judgment t (stmt (bind 'lambda x A b) (bind 'pi x A B)))]))

#;
(define (sigma-intro j1 j2 j3)
  (match-let ([(judgment c (stmt a A)) j2]
              [(judgment (cons (stmt x A) c) (stmt B (u i))) j1]
              [(judgment c (stmt b C)) j3])
    (if (equal? (subst B x a) C)
        (judgment c (stmt (p pair a b) (bind 'sigma x A B)))
        #f)))