module Ketchup.Routing
( route
) where
import qualified Data.ByteString.Char8 as C
import qualified Data.Map as M
import Ketchup.Httpd
import Network
route :: [(C.ByteString, (Socket -> HTTPRequest -> (M.Map C.ByteString C.ByteString) -> IO ()))]
-> (Socket -> HTTPRequest -> IO ())
route [] handle request = sendNotFound handle
route (r:routes) handle request
| match (uri request) (fst r) = (snd r) handle request $ params (uri request) (fst r)
| otherwise = route routes handle request
match :: C.ByteString -> C.ByteString -> Bool
match url template =
and $ zipWith compare urlparts tmpparts
where
compare x y
| x == y = True
| or [C.null y, C.null x] = False
| C.head y == ':' = True
| otherwise = False
urlparts = C.split '/' url
tmpparts = C.split '/' template
params :: C.ByteString -> C.ByteString -> M.Map C.ByteString C.ByteString
params url template =
M.fromList $ filter (not . C.null . fst) $ zipWith retrieve urlparts tmpparts
where
retrieve x y
| or [C.null y, C.null x] = ("","")
| C.head y == ':' = (C.tail y, x)
| otherwise = ("","")
urlparts = C.split '/' url
tmpparts = C.split '/' template