Difference between revisions of "UrlDisp"
m (grammar fix) |
Ashalkhakov (talk | contribs) (more examples) |
||
Line 10: | Line 10: | ||
UrlDisp provides (Fast)CGI programs a minimalistic domain-specific parser for URLs. | UrlDisp provides (Fast)CGI programs a minimalistic domain-specific parser for URLs. | ||
− | Hierarchical part of the URL is tokenized and matched against rules defined using UrlDisp combinators. Every rule consists of, basically, a predicate and a CGI action. Once a predicate is satisfied, an action is performed; otherwise, alternatives are tried in order. The matching algorithm is backtracking. | + | Hierarchical part of the URL (e.g., /foo/bar/ or /bar/baz/quix) is tokenized (turned into a list of "URL fragments", e.g. ["foo","bar"]) and matched against rules defined using UrlDisp combinators. Every rule consists of, basically, a predicate and a CGI action. Once a predicate is satisfied, an action is performed; otherwise, alternatives are tried in the order given (<|> associates to the left). The matching algorithm is backtracking. |
== Usage examples == | == Usage examples == | ||
Line 20: | Line 20: | ||
<hask>output "hello, world!"</hask> | <hask>output "hello, world!"</hask> | ||
− | + | This one replies to all requests with "hello, world!". | |
+ | |||
+ | One can add a predicate to make things more interesting: | ||
<hask> | <hask> | ||
− | |||
h |/ "hello" *> output "hello, world!"</hask> | h |/ "hello" *> output "hello, world!"</hask> | ||
− | + | This one will greet people only if the URL starts with "/hello". It will give a 404 error page otherwise. | |
+ | |||
+ | Such "if-then" clauses can be combined using "or" -- (<|>), which associates to the left, so | ||
+ | |||
+ | <hask>a <|> b <|> c</hask> | ||
+ | |||
+ | is equivalent to | ||
+ | |||
+ | <hask>((a <|> b) <|> c)</hask> | ||
+ | |||
+ | Anyway, code using UrlDisp shouldn't depend on this property. | ||
+ | |||
+ | To introduce an "and" in your rule, apply (|/) successively, as in | ||
+ | |||
+ | <hask>h |/ "foo" |/ "bar"</hask> | ||
+ | |||
+ | Generally, other combinators will correspond to "and" and bind stronger than "or". For example: | ||
<hask> | <hask> | ||
− | + | h |// "GET" |/ "foo" |/ "bar" |? ("cmd", "foo") *> output "hello" | |
− | + | <|> endPath |? ("cmd, "bar") *> output "goodbye" | |
− | |||
</hask> | </hask> | ||
+ | |||
+ | Will behave as follows: | ||
+ | * all GET requests to /foo/bar (and anything that follows) and parameter "cmd" set to "foo" will output "hello" | ||
+ | * requests with empty path and parameter cmd set to "bar" will output "goodbye" | ||
+ | * other requests will trigger a 404 page | ||
As you can see, the |/ combinator matches current token against its right operand. h is a special predicate that matches anything, it is used to begin a string of combinators. | As you can see, the |/ combinator matches current token against its right operand. h is a special predicate that matches anything, it is used to begin a string of combinators. | ||
Line 45: | Line 66: | ||
=== Extending UrlDisp === | === Extending UrlDisp === | ||
− | The examples given above are not very interesting since one wants to interact with outside world. Let's | + | The examples given above are not very interesting since one wants to interact with the outside world. Let's take a look at how to extend UrlDisp to handle database access. |
Wrapping UrlDisp around a ReaderT will do the trick. | Wrapping UrlDisp around a ReaderT will do the trick. | ||
Line 71: | Line 92: | ||
m :: UrlDisp (ReaderT Connection (CGIT IO)) CGIResult | m :: UrlDisp (ReaderT Connection (CGIT IO)) CGIResult | ||
m = do | m = do | ||
− | v <- lift ask >>= \c -> liftIO (quickQuery' c | + | v <- lift ask >>= \c -> liftIO (quickQuery' c queryText []) |
output $ show v | output $ show v | ||
+ | |||
+ | -- you will have to provide this one | ||
+ | queryText = "select * from ..." | ||
</hask> | </hask> | ||
[[Category:Web]] | [[Category:Web]] | ||
[[Category:Packages]] | [[Category:Packages]] |
Revision as of 07:30, 26 May 2009
Contents
What is UrlDisp
Problem statement
URLs are everywhere on the web. Most of them, however, are hard to remember, because they are meaningless for humans. This is wrong: URLs are a part of user interface, and therefore should be kept simple, meaningful and memorizeable.
Solution
UrlDisp provides (Fast)CGI programs a minimalistic domain-specific parser for URLs.
Hierarchical part of the URL (e.g., /foo/bar/ or /bar/baz/quix) is tokenized (turned into a list of "URL fragments", e.g. ["foo","bar"]) and matched against rules defined using UrlDisp combinators. Every rule consists of, basically, a predicate and a CGI action. Once a predicate is satisfied, an action is performed; otherwise, alternatives are tried in the order given (<|> associates to the left). The matching algorithm is backtracking.
Usage examples
Basics
A regular CGI action looks like this:
output "hello, world!"
This one replies to all requests with "hello, world!".
One can add a predicate to make things more interesting:
h |/ "hello" *> output "hello, world!"
This one will greet people only if the URL starts with "/hello". It will give a 404 error page otherwise.
Such "if-then" clauses can be combined using "or" -- (<|>), which associates to the left, so
a <|> b <|> c
is equivalent to
((a <|> b) <|> c)
Anyway, code using UrlDisp shouldn't depend on this property.
To introduce an "and" in your rule, apply (|/) successively, as in
h |/ "foo" |/ "bar"
Generally, other combinators will correspond to "and" and bind stronger than "or". For example:
h |// "GET" |/ "foo" |/ "bar" |? ("cmd", "foo") *> output "hello" <|> endPath |? ("cmd, "bar") *> output "goodbye"
Will behave as follows:
- all GET requests to /foo/bar (and anything that follows) and parameter "cmd" set to "foo" will output "hello"
- requests with empty path and parameter cmd set to "bar" will output "goodbye"
- other requests will trigger a 404 page
As you can see, the |/ combinator matches current token against its right operand. h is a special predicate that matches anything, it is used to begin a string of combinators.
One can also match against
- URL parameters,
- HTTP methods,
- and also convert token into a variable which is an instance of Read
There's also an API which is believed to be more human-readable.
Extending UrlDisp
The examples given above are not very interesting since one wants to interact with the outside world. Let's take a look at how to extend UrlDisp to handle database access.
Wrapping UrlDisp around a ReaderT will do the trick.
{-# LANGUAGE FlexibleInstances, ScopedTypeVariables #-} import Network.UrlDisp import Database.HDBC import Database.HDBC.ODBC import Control.Exception (bracket) import Network.CGI import Network.CGI.Monad instance MonadCGI (ReaderT Connection (CGIT IO)) where cgiAddHeader n v = lift $ cgiAddHeader n v cgiGet = lift . cgiGet -- once a request to "/db/" is sent, -- execute an SQL query and show its results main :: IO () main = bracket (connectODBC connStr) disconnect (\c -> runCGI $ (flip runReaderT) c $ evalUrlDisp $ ((h |/ "db" *> m) <|> output "not found")) m :: UrlDisp (ReaderT Connection (CGIT IO)) CGIResult m = do v <- lift ask >>= \c -> liftIO (quickQuery' c queryText []) output $ show v -- you will have to provide this one queryText = "select * from ..."