From 574c33c27e2cc0cb9d18dfddbf772af50023c7a1 Mon Sep 17 00:00:00 2001
From: urlysses <chrisconstandinou@gmail.com>
Date: Fri, 24 Feb 2017 19:35:28 -0500
Subject: [PATCH] Add url pattern matching (url mapping?)

TODO: Make the collected vars available to the handler words.
---
 1991.fs         | 90 +++++++++++++++++++++++++++++++++++++++++++++++--
 examples/app.fs | 19 +++++++++++
 2 files changed, 107 insertions(+), 2 deletions(-)

diff --git a/1991.fs b/1991.fs
index ebc8dae..bbc1c2f 100644
--- a/1991.fs
+++ b/1991.fs
@@ -5,6 +5,12 @@ include unix/socket.fs
 \ Helper words
 : +s ( addr1 u1 addr2 u2 -- addr3 u3 )          \ like s+ but prepend rather than append.
     2swap s+ ;
+: str-count ( addr1 u1 addr2 u2 -- u3 )         \ Counts occurrences of addr2 within addr1.
+    2swap 0 >r
+    begin 2over search
+    while 2over nip /string
+        r> 1+ >r
+    repeat 2drop 2drop r> ;
 : exchange ( a1 a2 -- )
     2dup c@ swap c@ rot c! swap c! ;
 : reverse ( caddr u -- )                        \ reverse a string
@@ -30,13 +36,94 @@ include unix/socket.fs
         then ;
 : file-exists? ( addr u -- addr u bool )
     2dup file-status nip 0= ;
+: pubvar create 0 , 0 , ;
 
 \ User-defined routing
 wordlist constant routes
+pubvar reqroute
+: set-requested-route ( addr u -- )
+    reqroute 2! ;
+: get-requested-route ( -- addr u )
+    reqroute 2@ ;
+: fuzzy-find-route ( xt -- xt' bool )
+    \ Takes an xt that accepts a name token
+    \ and returns a bool.
+    \ Traverse will run as long as xt
+    \ returns true.
+    \ Also takes the addr u of the requested
+    \ route we're trying to validate.
+    >r routes wordlist-id @                     \ Store xt and specify wordlist
+    begin
+    dup
+    while
+        r@ over >r execute while r> @
+    repeat r>
+    then
+    rdrop
+    ?dup if
+        name>int                                \ Get the xt of the nt.
+        -1                                      \ Return true.
+    else
+        0
+    then ;
+: fuzzy-compare ( nt -- bool )
+    \ Takes a route name token and returns
+    \ whether that route name fuzzy matches
+    \ the requested url
+    name>string                                 \ Get the string value of the NT.
+    2dup s" <" search if                        \ See if the route expects fuzzy matching.
+        2drop                                   \ Drop search results.
+        2dup s" /" str-count >r                 \ Check to see if both routes have the same
+        get-requested-route s" /" str-count     \ number of / occurrences.
+        r> = if
+            2dup s" <" str-count 0 do
+                2dup 2>r
+                2r@
+                2dup s" <" search drop          \ Get position of "<",
+                swap drop -
+                swap drop
+                get-requested-route rot /string \ crop until there in the requested route,
+                2dup s" /" search if            \ search for the next / or end of route,
+                    swap drop -
+                else
+                    2drop
+                then
+                2r@
+                2dup s" <" search drop          \ and replace <...> with the requested route word
+                swap drop -
+                +s                              \ by prepending pre-< to route word
+                2r> s" >" search drop 1 /string \ and then by appending post-> to route word.
+                s+
+                2>r
+                2drop
+                2r>
+            loop
+            get-requested-route compare         \ Check to see if the strings match.
+        else
+            2drop                               \ Drop name>string.
+            -1                                  \ Keep looping.
+        then
+    else
+        2drop                                   \ Drop search results.
+        2drop                                   \ Drop name>string.
+        -1                                      \ Keep looping.
+    then ;
+: fuzzy-match ( addr u -- xt bool )
+    set-requested-route
+    ['] fuzzy-compare fuzzy-find-route ;
 : find-route ( addr u -- data )
+    2dup 2>r
     routes search-wordlist if
+        2rdrop                                  \ Exact match found. Drop the dup string.
         >body @
-    else 0 then ;
+    else
+        2r>
+        fuzzy-match if                          \ Fuzzy match found.
+            >body @
+        else
+            0                                   \ No match at all.
+        then
+    then ;
 : register-route ( data addr u -- )
     2dup routes search-wordlist if
         routes drop nip nip
@@ -48,7 +135,6 @@ wordlist constant routes
     then ;
 
 \ Public directory
-: pubvar create 0 , 0 , ;
 pubvar public
 : set-public-path ( addr u -- )
     public 2! ;
diff --git a/examples/app.fs b/examples/app.fs
index 22c7901..72e654d 100644
--- a/examples/app.fs
+++ b/examples/app.fs
@@ -20,4 +20,23 @@ sourcedir s" views/" s+ set-view-path
 /1991 /index handle-/index
 /1991 /import handle-import
 
+: handle-uid
+    s" uid:" ;
+: handle-uid-new
+    s" uid:new" ;
+: handle-uid-delete
+    s" uid:delete" ;
+: handle-pid
+    s" pid:" ;
+: handle-pid-new
+    s" pid:new" ;
+: handle-pid-delete
+    s" pid:delete" ;
+/1991 /api/v1/users/<uid> handle-uid
+/1991 /api/v1/users/<uid>/new handle-uid-new
+/1991 /api/v1/users/<uid>/delete handle-uid-delete
+/1991 /api/v1/users/<uid>/post/<pid> handle-pid
+/1991 /api/v1/users/<uid>/post/<pid>/new handle-pid-new
+/1991 /api/v1/users/<uid>/post/<pid>/delete handle-pid-delete
+
 8080 1991: