diff --git a/README.md b/README.md --- a/README.md +++ b/README.md @@ -2,15 +2,21 @@ ## Type safe URLs for Snap -[`Snap web routes`](http://hackage.haskell.org/package/snap-web-routes) provides type safe URLs for Snap using [`web routes`](http://hackage.haskell.org/package/web-routes). +[`Snap web routes`](http://hackage.haskell.org/package/snap-web-routes) +provides type safe URLs for Snap using +[`web routes`](http://hackage.haskell.org/package/web-routes). ## How to use -The tutorial assumes you have a standard Snap app layout with an Application.hs and Site.hs. If your setup differs you'll need to adapt the instructions accordingly. +The tutorial assumes you have a standard Snap app layout with an +Application.hs and Site.hs. If your setup differs you'll need to adapt +things accordingly. ### `Application.hs` -To get going, you'll need to add a few things to `Application.hs`. This includes creating the URL data type and adding the routing function to our `App` data type. +To get going, you'll need to add a few things to `Application.hs`. +This includes creating the URL data type and adding the routing +function to our `App` data type. ```haskell -- Enable a few extensions @@ -27,15 +33,17 @@ -- Snap.Snaplet.Router.Types exports everything you need to -- define your PathInfo and HasRouter instances. -import Snap.Web.Routes.Types +import Snap.Snaplet.Router.Types -- Your URL data type. Deriving a `Generic` allows you to -- get a free `PathInfo` instance. data AppUrl - = Count Int + = Login + | Logout + | Count Int | Echo Text | Paths [Text] - deriving (Generic) + deriving (Eq, Show, Read, Generic) -- Extend your App type to include the router snaplet. data App = App @@ -49,18 +57,17 @@ instance PathInfo AppUrl -- You need to define a HasRouter instance for your app. --- @type URL (Handler App App)@ must be set to the URL --- data type you defined above. --- @with router@ uses the lens for the @RouterState@ snaplet +-- You must set type URL (Handler App App) to the URL +-- data type you defined above. The router in +-- `with router` is the lens for the @RouterState@ snaplet -- you added to App. instance HasRouter (Handler App App) where type URL (Handler App App) = AppUrl getRouterState = with router get -- You also need to define a HasRouter instance for the --- router snaplet. --- @type URL (Handler b RouterState)@ must be set to the URL --- data type you defined above. +-- router snaplet. Once again, set type URL (Handler b +-- RouterState) to the data type you defined above. instance HasRouter (Handler b RouterState) where type URL (Handler b RouterState) = AppUrl getRouterState = get @@ -68,7 +75,8 @@ ### `Site.hs` -Moving on to `Site.hs`, we'll setup handlers for each URL, as well initialise our app with the router snaplet.. +Moving on to `Site.hs`, we'll setup handlers for each URL, as well as initialise +our app with the router snaplet.. ```haskell -- Snap.Snaplet.Router provides routing functions @@ -84,6 +92,8 @@ routeAppUrl :: AppUrl -> Handler App App () routeAppUrl appUrl = case appUrl of + (Login) -> with auth handleLoginSubmit + (Logout) -> with auth handleLogout (Count n) -> writeText $ ("Count = " `T.append` (T.pack $ show n)) (Echo text) -> echo text (Paths ps) -> writeText $ T.intercalate " " ps @@ -103,27 +113,66 @@ return $ App h r ``` -The prefix you pass to the router snaplet must match the prefix you specified in routes, e.g. if it was `("/prefix", routeWith routeAppUrl)`) then: +The prefix you pass to the router snaplet must match the prefix you specified +in routes, e.g. if it was `("/prefix", routeWith routeAppUrl)`) then: ```haskell r <- nestSnaplet "router" router $ initRouter "/prefix" ``` -If you are having trouble figuring out why a particular request isn't routing as expected, try replacing `routeWith` with `routeWithDebug`. It'll display the available routes, as well as any failed route parses. Just remember that it's **not suitable for production** use, and only displays debugging information for local requests. +If you are having trouble figuring out why a particular request isn't routing +as expected, try replacing `routeWith` with `routeWithDebug`. It'll display +the available routes, as well as any failed route parses. Just remember that +it's **not suitable for production** use, and only displays debugging +information for local requests. -### Rendering URLs +### Using URLs -Helper functions are provided for rendering URLs: +Let's look at how you can use your newly defined URL data type in your app. +Firstly, you'll probably want to add links in Heist views. This is easily +accomplished with the `urlSplice` and `urlParamsSplice` functions. ```haskell -echo :: T.Text -> Handler App App () -echo msg = do - if msg == "test" then redirectURL (Echo "test passed") else renderEcho +linksHandler :: Handler App App () +linksHandler = heistLocal (I.bindSplices linksSplices) $ render "links" where - renderEcho = heistLocal (I.bindSplices echoSplices) $ render "echo" - echoSplices = do - "message" ## I.textSplice msg - "countUrl" ## urlSplice (Count 10) + linksSplices = do + "loginUrl" ## urlSplice Login + "echoUrl" ## urlSplice (Echo "ping") + "countUrl" ## urlParamsSplice (Count 10) [("explanation", Just "true")] ``` -In the example above you'll find we use `urlSplice` to turn a URL into a splice, and `redirectURL` to redirect to a URL. There is also `urlPath` to render a URL as Text, as well as params versions of all these functions (`urlParamsSplice`, `redirectURLParams` and `urlPathParams`) that take a params list to append as a query string. +As you can see, splicing URLs into Heist views is easily accomplished. You +will likely also want to redirect to the handler for a certain URL. To do +this we've got `redirectURL` and `redirectURLParams`. Let's look at an +example. + +```haskell +doSomethingHandler :: Handler App App () +doSomethingHandler = doSomething >> redirectURL Logout +``` + +However, you will sometimes wish to redirect within a handler that runs in a +snaplet other than the main app. With the router snaplet though, this is +easily done: + +```haskell +handleLogout :: Handler App (AuthManager App) () +handleLogout = logout >> (withTop router $ redirectURL (Echo "logged out")) +``` + +Lastly, you can render a URL as Text with `urlPath` and `urlPathParams`. + +```haskell +messageHandler :: Handler App App () +messageHandler = do + pathText <- urlPath (Echo "hello") + heistLocal (I.bindSplices $ messageSplices path) $ render "message" + where + messageSplices path = do + "message" ## I.textSplice $ "The path is " `append` pathText +``` + +Remember, for each of `urlSplice`, `redirectURL` and `urlPath` there is a +params version that takes a params list as an extra argument, and renders +the URL with the given params as a query string. diff --git a/changelog b/changelog --- a/changelog +++ b/changelog @@ -1,3 +1,6 @@ +* Add Resource and SingletonResource data types for RESTful routes +* Ignore trailing slashes + 2014-05-07 0.4.0.0 * Make router a snaplet diff --git a/snap-web-routes.cabal b/snap-web-routes.cabal --- a/snap-web-routes.cabal +++ b/snap-web-routes.cabal @@ -1,13 +1,34 @@ name: snap-web-routes -version: 0.4.0.0 +version: 0.5.0.0 synopsis: Type safe URLs for Snap description: - Type safe URL generation and routing for Snap using web-routes. + Type safe URL generation and routing for Snap using , and builds on + done by Jeremy Shaw. . - To get started, there is a ____. + Get started with the comprehensive ____. . - This builds on - done by Jeremy Shaw. Thanks Jeremy! + = Brief overview + . + It allows you to define a data type that represents the routes in your application: + . + > data AppUrl + > = Login -- routes to /login + > | Logout -- routes to /logout + > | User (Resource UserId) -- provides RESTful routes at /user + . + 'Resource' is documented in Snap.Snaplet.Router.REST, and makes defining RESTful routes easier. Also provided are functions to use the URL data type in your app: + . + > someHandler :: Handler App App () + > someHandler :: doSomething >> redirectURL $ User Index + . + and to generate URLs in views: + . + > linksHandler :: Handler App App () + > linksHandler = heistLocal (I.bindSplices linksSplices) $ render "links" + > where + > linksSplices = do + > "loginUrl" ## urlSplice Login + . homepage: https://github.com/lukerandall/snap-web-routes bug-reports: https://github.com/lukerandall/snap-web-routes/issues @@ -30,13 +51,15 @@ exposed-modules: Snap.Snaplet.Router - Snap.Snaplet.Router.Heist + Snap.Snaplet.Router.HeistSplices Snap.Snaplet.Router.Internal.Types + Snap.Snaplet.Router.REST Snap.Snaplet.Router.Types Snap.Snaplet.Router.URL build-depends: base >= 4.4 && < 5, + bytestring >= 0.9.1 && < 0.11, heist >= 0.13 && < 0.14, mtl >= 2 && < 3, snap-core >= 0.9 && < 0.11, diff --git a/src/Snap/Snaplet/Router.hs b/src/Snap/Snaplet/Router.hs --- a/src/Snap/Snaplet/Router.hs +++ b/src/Snap/Snaplet/Router.hs @@ -18,18 +18,19 @@ ) where +import Data.ByteString (ByteString) +import qualified Data.ByteString.Char8 as B import Data.Text import Snap.Core (MonadSnap) import qualified Snap.Core as SC import Snap.Snaplet -import Web.Routes (PathInfo, toPathInfoParams, fromPathInfo) +import Web.Routes (PathInfo, fromPathInfo) ------------------------------------------------------------------------------ -import Snap.Snaplet.Router.Heist +import Snap.Snaplet.Router.HeistSplices import Snap.Snaplet.Router.URL import Snap.Snaplet.Router.Internal.Types - ------------------------------------------------------------------------------ -- | Snaplet initializer. initRouter :: Text -- ^ Prefix to add to paths. @@ -61,8 +62,19 @@ ------------------------------------------------------------------------------ routeWithOr :: (PathInfo url, MonadSnap m) => (url -> m ()) -> (Text -> m ()) -> m () -routeWithOr router leftFn = - do rq <- SC.getRequest - case fromPathInfo $ SC.rqPathInfo rq of - (Left e) -> leftFn . pack $ e +routeWithOr router onLeft = do + rqPath <- rqPathInfoNormalized + case fromPathInfo rqPath of + (Left e) -> onLeft . pack $ e (Right url) -> router url + +rqPathInfoNormalized + :: (MonadSnap m) => m ByteString +rqPathInfoNormalized = do + rq <- SC.getRequest + return . dropTrailingSlashes $ SC.rqPathInfo rq + where + dropTrailingSlashes s = + if B.singleton '/' `B.isSuffixOf` s + then dropTrailingSlashes $ B.init s + else s diff --git a/src/Snap/Snaplet/Router/Heist.hs b/src/Snap/Snaplet/Router/Heist.hs deleted file mode 100644 --- a/src/Snap/Snaplet/Router/Heist.hs +++ /dev/null @@ -1,32 +0,0 @@ -{-# LANGUAGE FlexibleContexts #-} - -module Snap.Snaplet.Router.Heist - ( urlSplice - , urlParamsSplice - ) where - - -import Data.Text -import Snap.Snaplet.Router.Internal.Types -import Snap.Snaplet.Router.URL (urlPathParams) -import Text.XmlHtml hiding (render) -import Web.Routes (PathInfo) - - ------------------------------------------------------------------------------- --- | Returns the given URL as a `Heist` splice -urlSplice - :: (HasRouter m, PathInfo (URL m)) => URL m -- ^ URL data type - -> m [Node] -urlSplice u = urlParamsSplice u [] - - ------------------------------------------------------------------------------- --- | Returns the given URL as a `Heist` splice with query string for params -urlParamsSplice - :: (HasRouter m, PathInfo (URL m)) => URL m -- ^ URL data type - -> [(Text, Maybe Text)] -- ^ Params - -> m [Node] -urlParamsSplice u p = do - t <- urlPathParams u p - return [TextNode t] diff --git a/src/Snap/Snaplet/Router/HeistSplices.hs b/src/Snap/Snaplet/Router/HeistSplices.hs new file mode 100644 --- /dev/null +++ b/src/Snap/Snaplet/Router/HeistSplices.hs @@ -0,0 +1,32 @@ +{-# LANGUAGE FlexibleContexts #-} + +module Snap.Snaplet.Router.HeistSplices + ( urlSplice + , urlParamsSplice + ) where + + +import Data.Text +import Snap.Snaplet.Router.Internal.Types +import Snap.Snaplet.Router.URL (urlPathParams) +import Text.XmlHtml hiding (render) +import Web.Routes (PathInfo) + + +------------------------------------------------------------------------------ +-- | Returns the given URL as a `Heist` splice +urlSplice + :: (HasRouter m, PathInfo (URL m)) => URL m -- ^ URL data type + -> m [Node] +urlSplice u = urlParamsSplice u [] + + +------------------------------------------------------------------------------ +-- | Returns the given URL as a `Heist` splice with query string for params +urlParamsSplice + :: (HasRouter m, PathInfo (URL m)) => URL m -- ^ URL data type + -> [(Text, Maybe Text)] -- ^ Params + -> m [Node] +urlParamsSplice u p = do + t <- urlPathParams u p + return [TextNode t] diff --git a/src/Snap/Snaplet/Router/REST.hs b/src/Snap/Snaplet/Router/REST.hs new file mode 100644 --- /dev/null +++ b/src/Snap/Snaplet/Router/REST.hs @@ -0,0 +1,83 @@ +-- | This module provides data types useful for declaring RESTful routes. +-- 'Resource' is provided for the common case of resource specified +-- by a unique identifier (for e.g. @\/products\/3@). 'SingletonResource' +-- is provided for resources that do not require an identifier. Typical +-- usage would be as follows: +-- +-- @ +-- data AppUrl +-- = User (Resource Int) +-- | Profile SingletonResource +-- | Login +-- | Logout +-- @ +-- +-- This now allows you to define handlers for different end points for +-- your resource. +-- @ +-- routeAppUrl appUrl = +-- case appUrl of +-- Login -> with auth handleLogin -- \/login +-- Logout -> with auth handleLogout -- \/logout +-- User Index -> handleUserIndex -- \/user +-- User New -> handleUserNew -- \/user\/new +-- User (Show n) -> handleUserShow n -- \/user\/:Int +-- User (Edit n) -> handleUserEdit n -- \/user\/:Int\/edit +-- Profile ShowS -> handleProfileShow -- \/profile +-- Profile NewS -> handleProfileNew -- \/profile/new +-- Profile EditS -> handleProfileEdit -- \/profile/edit +-- @ +-- + +{-# LANGUAGE OverloadedStrings #-} + +module Snap.Snaplet.Router.REST + ( Resource (..) + , SingletonResource (..) + ) where + + +import Control.Applicative +import Web.Routes.PathInfo (PathInfo (..), segment, toPathSegments, fromPathSegments) + + +-- | A data type to represent RESTful resources that have a unique identifier. +-- The data type used as the identifier must be an instance of 'PathInfo'. +data (PathInfo id) => Resource id + = Index + | New + | Show id + | Edit id + deriving (Eq, Show, Read) + + +-- | A data type to represent singleton RESTful resources. Generally these +-- are identified in some other way, often the user's session. +data SingletonResource + = ShowS + | NewS + | EditS + deriving (Eq, Show, Read) + + +instance (PathInfo id) => PathInfo (Resource id) where + toPathSegments Index = [] + toPathSegments New = ["new"] + toPathSegments (Show n) = toPathSegments n + toPathSegments (Edit n) = toPathSegments n ++ ["edit"] + + fromPathSegments = + New <$ segment "new" + <|> fromPathSegments <**> ((pure Edit <* segment "edit") <|> pure Show) + <|> pure Index + + +instance PathInfo SingletonResource where + toPathSegments ShowS = [] + toPathSegments NewS = ["new"] + toPathSegments EditS = ["edit"] + + fromPathSegments = + NewS <$ segment "new" + <|> EditS <$ segment "edit" + <|> pure ShowS diff --git a/src/Snap/Snaplet/Router/URL.hs b/src/Snap/Snaplet/Router/URL.hs --- a/src/Snap/Snaplet/Router/URL.hs +++ b/src/Snap/Snaplet/Router/URL.hs @@ -12,9 +12,8 @@ import Data.Text.Encoding (encodeUtf8) import Snap.Core (MonadSnap) import qualified Snap.Core as SC -import Snap.Snaplet import Snap.Snaplet.Router.Internal.Types -import Web.Routes (PathInfo, toPathInfoParams, fromPathInfo) +import Web.Routes (PathInfo, toPathInfoParams) ------------------------------------------------------------------------------