module Web.Scotty.Route
( get, post, put, delete, addroute, matchAny, notFound,
capture, regex, function, literal
) where
import Web.Scotty.Action
import Web.Scotty.Types
import Control.Monad.Error
import qualified Control.Monad.State as MS
import Data.Monoid (mconcat)
import qualified Data.Text.Lazy as T
import Network.HTTP.Types
import Network.Wai
import Web.Scotty.Util
import qualified Text.Regex as Regex
import Control.Arrow ((***))
get :: RoutePattern -> ActionM () -> ScottyM ()
get = addroute GET
post :: RoutePattern -> ActionM () -> ScottyM ()
post = addroute POST
put :: RoutePattern -> ActionM () -> ScottyM ()
put = addroute PUT
delete :: RoutePattern -> ActionM () -> ScottyM ()
delete = addroute DELETE
matchAny :: RoutePattern -> ActionM () -> ScottyM ()
matchAny pattern action = mapM_ (\v -> addroute v pattern action) [minBound..maxBound]
notFound :: ActionM () -> ScottyM ()
notFound action = matchAny (Function (\req -> Just [("path", path req)])) (status status404 >> action)
addroute :: StdMethod -> RoutePattern -> ActionM () -> ScottyM ()
addroute method pat action = MS.modify (addRoute r)
where r = route method pat action
route :: StdMethod -> RoutePattern -> ActionM () -> Middleware
route method pat action app req =
if Right method == parseMethod (requestMethod req)
then case matchRoute pat req of
Just captures -> do
env <- mkEnv method req captures
res <- lift $ runAction env action
maybe tryNext return res
Nothing -> tryNext
else tryNext
where tryNext = app req
matchRoute :: RoutePattern -> Request -> Maybe [Param]
matchRoute (Literal pat) req | pat == path req = Just []
| otherwise = Nothing
matchRoute (Function fun) req = fun req
matchRoute (Capture pat) req = go (T.split (=='/') pat) (T.split (=='/') $ path req) []
where go [] [] prs = Just prs
go [] r prs | T.null (mconcat r) = Just prs
| otherwise = Nothing
go p [] prs | T.null (mconcat p) = Just prs
| otherwise = Nothing
go (p:ps) (r:rs) prs | p == r = go ps rs prs
| T.null p = Nothing
| T.head p == ':' = go ps rs $ (T.tail p, r) : prs
| otherwise = Nothing
path :: Request -> T.Text
path = strictByteStringToLazyText . rawPathInfo
regex :: String -> RoutePattern
regex pattern = Function $ \ req -> fmap (map (T.pack . show *** T.pack) . zip [0 :: Int ..] . strip)
(Regex.matchRegexAll rgx $ T.unpack $ path req)
where rgx = Regex.mkRegex pattern
strip (_, match, _, subs) = match : subs
capture :: String -> RoutePattern
capture = Capture . T.pack
function :: (Request -> Maybe [Param]) -> RoutePattern
function = Function
literal :: String -> RoutePattern
literal = Literal . T.pack