c0a398105876b7741e1ee54d10aefc17a45ebca4 — Josef Pospíšil 4 years ago
Initial commit
5 files changed, 122 insertions(+), 0 deletions(-)

A project.janet
A router.janet
A src/router.janet
A test/router.janet
A  => README.md +6 -0
@@ 1,6 @@
# Trolley 

General router for Janet programming language. It is based on idea of path and
action to which it resolves.

@todo add more documentation

A  => project.janet +11 -0
@@ 1,11 @@
  :name "trolley"
  :description "General router"
  :dependencies ["https://github.com/joy-framework/tester"]
	:author "Josef Pospíšil"
  :license "MIT"
  :url "https://github.com/pepe/trolley"
  :repo "git+https://github.com/pepe/trolley")

  :source @["src/router.janet"])

A  => router.janet +0 -0
A  => src/router.janet +68 -0
@@ 1,68 @@
# @todo: make this dyn
(def content 
  "Characters we consider part of the route"
  '(+ (range "AZ") (range "az") (range "09") (set "-_")))

(def sep "Separator character" "/")

(def pref "Param prefix character" ":")

(def grammar 
  "PEG grammar to match routes with"
    {:sep sep :pref pref :path ~(some ,content) 
     :param '(* :pref :path) :capture-path '(<- :path)
     :main '(some (* :sep 
                     (+ (if :param (group (* (constant :param) :pref :capture-path)))
                        (if :path (group (* (constant :path) :capture-path)))
                        (if -1 (group (* (constant :root) (constant -1))) ))))}))

(defn- compile-route
  "Compiles custom grammar for one route"
  (-> (seq [[pt p] :in (peg/match grammar route)]
           (case pt
             :root (tuple '* sep p)
             :path (tuple '* sep p) 
             :param (tuple '* sep 
                           ~(group (* (constant ,(keyword p))
                                      (<- (some ,content)))))))
      (array/insert 0 '*)
      (array/push -1)

(defn- extract-args
  "Extracts arguments from peg match"
  [route-grammar uri]
  (when-let [p (peg/match route-grammar uri)]
    (table ;(flatten p))))

(defn compile-routes
  "Compiles PEG grammar for all routes"
  (let [res @{}]
    (loop [[route action] :pairs routes] 
        (when (string? route) (put res (compile-route route) action)))

(defn lookup 
  "Looks up uri in routes and returns action and params for the matched route"
  [compiled-routes uri]
  (var matched [])
  (loop [[grammar action] :pairs compiled-routes :while (empty? matched)]
    (when-let [args (extract-args grammar uri)] (set matched [action args])))

(defn router
  "Creates a router from routes"
  (def compiled-routes (compile-routes routes))
  (fn [path]
    (let [[action params] (lookup compiled-routes path)]
      (if action 
        (routes :not-found))))) # @todo document

A  => test/router.janet +37 -0
@@ 1,37 @@
(import tester :prefix "")
(import ../src/router :as router)

(deftest "Compile routes"
  (def compiled-routes 
    (router/compile-routes {"/" :root "/home/:id" :home}))

  (test "are compiled" compiled-routes)
  (test "has all actions" 
        (deep= @[:home :root] (values compiled-routes)))
  (test "route is peg"
        (= :core/peg (type (first (keys compiled-routes))))))

(deftest "Lookup uri"
  (def compiled-routes 
    (router/compile-routes {"/" :root "/home/:id" :home}))

  (test "lookup"
        (deep= (router/lookup compiled-routes "/home/3") 
               '(:home @{:id "3"})))
  (test "lookup root"
        (deep= (router/lookup compiled-routes "/") 
               '(:root @{})))
  (test "lookup rooty"
        (empty? (router/lookup compiled-routes "/home/"))))

(deftest "Router"
  (def router (router/router {"/" :root 
                              "/home/:id" :home 
                              :not-found :not-found}))
  (test "root"
        (= (router "/") :root))
  (test "home"
        (= (router "/home/3") :home))
  (test "not found"
        (= (router "home") :not-found)))