Define Paths Pithily

Show & Tell
1

Hi, Racket Discourse.

I thought I'd quickly share this little macro for defining paths originating from a single root (or home), which I've been using for easily referencing paths when writing scripts. Perhaps there is already a form which does exactly this, but I have not chanced upon it, yet.

The paths aren't realized, although it would probably be easy to adjust the macro to take care of this as well, or perhaps even incorporate "runtime-path" et al.

Interestingly, this was one of the very first macros I attempted, although it has evolved over time, as I have gained more experience.

#lang racket/base

(require
  (for-syntax
   racket/base
   racket/syntax
   syntax/parse))

(provide
  define-paths)

(begin-for-syntax  
  (define-syntax-class
    (path-name type)
    #:attributes
    ([labl 0]
     [path 0])
    
    (pattern name:id
      #:attr labl (case type [(file) #'("~a")] [(directory) #'("~a/")])
      #:attr path #'(name)))
  
  (define-syntax-class
    file
    #:attributes
    ([labl 0]
     [path 0])
    #:local-conventions
    ([name (path-name 'file)])
    
    (pattern name
      #:attr labl #'name.labl
      #:attr path #'name.path))
  
  (define-syntax-class
    directory
    #:attributes
    ([labls 1]
     [paths 1])
    #:local-conventions
    ([name (path-name 'directory)])
    
    (pattern [name (~alt file:file sub:directory) ...]
      #:with (labls ...) #'(("~a/" . file.labl) ... name.labl ("~a/" . sub.labls) ... ...)
      #:with (paths ...) #'((name  . file.path) ... name.path (name  . sub.paths) ... ...)))

  (define ((format-path-name stx) labl path)
    (format-id stx labl #:subs? #true . apply . path))
  
  (define (path-join names) (string-append . apply . names))
  
  (define (format-paths-names stx labls-stx paths-stx)
    (define paths* (map path-join (syntax->datum labls-stx)))
    (map (format-path-name stx) paths* (map syntax->list (syntax->list paths-stx)))))

(define (norm-path path-symbol)
  (define path-string (symbol->string path-symbol))
  (case (system-path-convention-type)
    [(unix)    path-string]
    [(windows) (regexp-replace* #rx"/" path-string "\\\\")]))

(define-syntax (define-paths stx)
  (syntax-parse stx
    [(_ #:home home:expr {~alt :file :directory} ...)
     #:with once (generate-temporary #'once)
     #:with (path-names ...)
     (format-paths-names stx #'(labl ... labls ... ...) #'(path ... paths ... ...))
     #'(define-values (path-names ...)
         (let ([once home])
           (values (build-path once (norm-path 'path-names)) ...)))]))

The usage then, looks something like this:

(define-paths
  #:home temp/
  [cmds
   ; command outputs
   recon.txt
   subdomains.txt
   take-overs.txt
   doppelgangers.json
   load-balancing.txt
   waf-signatures.json
   dir-enumeration.txt
   dir-traversal.txt
   url-scan.json
   wordpress.json]
  
  [assm
   ; assessment data
   assm.log
   assm.json
   info.json])

Directories appear at the head of a parens-group, as in [cmds ...] and files are the atoms in such a group, as in [cmds ... recon.txt ...].

image
image286×490 19.6 KB

Happy hacking!

2 Likes
2

Nice!

Tiny suggestion/idea: Maybe also check out the multi-in clause for require.

Although that can be used (AFAIK) only within require to make import module paths, and isn't a general-purpose path-maker like yours -- multi-in's Cartesian product syntax/approach might be interesting to consider for yours; it's a generalization of yours (IIUC)?

1 Like
3

Neat! Great reference.

Oh, man, this takes me back to a similar idea I came across from, I think, Norman Wildberger, which describes an operator, let's call it Π, that works like this:

#lang racket/base

(require
  (only-in
   racket/list append* cartesian-product))

(define (Π index)
  (lambda msets
    (let loop ([inner index]
               [msets msets])
      (if (zero? inner)
          (append* msets)
          (map (lambda (combination)
                 (loop (- inner 1) combination))
               (apply cartesian-product msets))))))

{(Π 0)
 '(0)
 
 '(1)
 
 '(0)}
#| produces
'(0 1 0)
|#

{(Π 1)
 '((0))

 '((1) (0))

 '((0))}
#| produces
'((0 1 0)
  (0 0 0))
|#

{(Π 2)
 '(((0) (1))
   
   ((1) (0)))

 '(((0) (1)))

 '(((1)))}
#| produces
'(((0 0 1)
   (0 1 1)
   (1 0 1)
   (1 1 1))

  ((1 0 1)
   (1 1 1)
   (0 0 1)
   (0 1 1)))
|#

It is an interesting concept to apply to such paths, thanks for the suggestion.