handlers.rkt

#lang racket

(provide user-handler
         bar-handler
         baz-handler
         use-bar-handler?)

(define (user-handler attrs)
  (printf "user-handler: id is ~a\n" (hash-ref attrs "id")))

(define (bar-handler attrs)
  (printf "bar-handler:\n"))

(define (baz-handler attrs)
  (printf "baz-handler:\n"))

(define (use-bar-handler? args)
  #f)

router-stx.rkt

#lang racket

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

(provide routes
         (struct-out route-struct))

(struct route-struct (path
                      handler
                      methods
                      guard)
  #:transparent)

(begin-for-syntax
  (define-splicing-syntax-class methods-cls
    #:attributes (methods)
    (pattern (~seq #:methods (method:expr ...))
             #:with methods #'(list 'method ...))
    (pattern (~seq #:method method:expr)
             #:with methods #'(list 'method)))

  (define-syntax-class route-cls
    (pattern (route:string
              handler:id
              (~alt (~optional ms:methods-cls
                               #:name "#:method, or #:methods option")
                    (~optional (~seq #:when guard-e:expr)
                               #:name "#:when option")) ...)
             #:with methods #`#,(or (attribute ms.methods) #'(list))
             #:with guard #`#,(attribute guard-e))))

(define-simple-macro (routes :route-cls ...)
  #:with name (format-id this-syntax "axio-routes")
  (begin
    (define name (list (route-struct route handler methods guard) ...))
    (provide name)))

router.rkt

#lang racket

(require "./router-stx.rkt")
(require "./routes.rkt")

(define (find-route path)
  (let loop ([lst axio-routes])
    (if (null? lst)
        (values #f #f)
        (let* ([ route-obj  (car lst)                     ]
               [ url-pat    (route-struct-path route-obj) ]
               [ url-nodes  (string-split url-pat "/")    ]
               [ path-nodes (string-split path "/")       ])
          (let inner-loop ([ url-nodes  url-nodes  ]
                           [ path-nodes path-nodes ]
                           [ hsh        (hash)     ])
            (cond [ (and (null? url-nodes) (null? path-nodes))
                    ;; Both lists empty, return route struct and attributes hash
                    (values route-obj hsh) ]
                  [ (or (null? url-nodes)
                        (null? path-nodes))
                    ;; One list, but not both, are empty - no match, try next route
                    (loop (cdr lst)) ]
                  [ else
                    (let ([ url-node (car url-nodes) ]
                          [ path-node (car path-nodes) ])
                      (cond [ (string-prefix? url-node "~")
                              ;; The route nodes is a placeholder, update the hash and recur
                              (inner-loop (cdr url-nodes)
                                          (cdr path-nodes)
                                          (hash-set hsh (substring url-node 1) path-node)) ]
                            [ (string=? url-node path-node)
                              ;; Literal nodes are equal, recur
                              (inner-loop (cdr url-nodes)
                                          (cdr path-nodes)
                                          hsh) ]
                            [ else
                              ;; Literal nodes are different, no match, try next route
                              (loop (cdr lst)) ])) ]))))))
                                          

(define (route path)
  (let-values ([ (result hsh) (find-route path) ])
    (if result
        ((route-struct-handler result) hsh)
        (displayln "No route found"))))

(begin
  (route "/user/badkins")
  (route "/bar")
  (route "/baz"))

routes.rkt

#lang racket

(require "./router-stx.rkt")
(require "./handlers.rkt")

(routes
 ("/user/~id" user-handler
         #:methods (get post))
 ("/bar" bar-handler
         #:methods (put update)
         #:when use-bar-handler?)
 ("/baz" baz-handler))