snap-web-routes 0.1.0.0 → 0.2.0.0

raw patch · 6 files changed

+193/−107 lines, 6 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• TODO.md +6/−0
• changelog +9/−0
• snap-web-routes.cabal +18/−3
• src/Snap/Web/Routes.hs +148/−103
• src/Snap/Web/Routes/Heist.hs +2/−1
• src/Snap/Web/Routes/Types.hs +10/−0

@@ -0,0 +1,6 @@+# Todo++* proper handling of non-routable paths (current error message isn't suitable for production)+* use generics to generate list of routable paths+* better support/documentation for customising path rendering+* tests

@@ -0,0 +1,9 @@+2014-05-06 0.2.0.0++* Document functions properly+* pass if routing fails+* Fix haddocks & improve tutorial++2014-05-03 0.1.0.0++* Initial release.

@@ -1,8 +1,16 @@ name:                snap-web-routes-version:             0.1.0.0+version:             0.2.0.0 synopsis:            Type safe URLs for Snap-description:         Type safe URL generation and routing for Snap using web-routes-homepage:            http://github.com/lukerandall/snap-web-routes+description:+    Type safe URL generation and routing for Snap using web-routes.+    .+    To get started, run through the tutorial in Snap.Web.Routes.+    .+    This builds on <https://github.com/stepcut/snap-web-routes-demo work>+    done by Jeremy Shaw. Thanks Jeremy!++homepage:            https://github.com/lukerandall/snap-web-routes+bug-reports:         https://github.com/lukerandall/snap-web-routes/issues license:             BSD3 license-file:        LICENSE author:              Luke Randall@@ -14,6 +22,8 @@ extra-source-files:   LICENSE,   README.md+  TODO.md+  changelog  library   hs-source-dirs:      src@@ -21,6 +31,7 @@   exposed-modules:     Snap.Web.Routes     Snap.Web.Routes.Heist+    Snap.Web.Routes.Types    build-depends:     base                      >= 4.4     && < 5,@@ -33,3 +44,7 @@     xmlhtml                   >= 0.1    default-language:    Haskell2010++source-repository head+  type:     git+  location: https://github.com/lukerandall/snap-web-routes.git

@@ -1,129 +1,174 @@-{-|--This module provides a ready to use implementation of `web-routes` for Snap.--To get going, you'll need to add a few things to `Application.hs`.--> {-# LANGUAGE DeriveGeneric     #-}-> {-# LANGUAGE FlexibleInstances #-}-> {-# LANGUAGE TypeFamilies      #-}--DeriveGeneric is used to derive the `PathInfo` instance for your URL data type,-the rest are needed by `web-routes`.--> import Data.Text (Text)-> import Snap.Web.Routes--"Snap.Web.Routes" exports the data types needed to define your `PathInfo` and-`MonadRoute` instances below.--> data AppUrl->     = Count Int->     | Echo Text->     | Paths [Text]->       deriving (Generic)--Define your application's URL data type. Deriving a `Generic` instance gives-you a `PathInfo` instance for free.--> data App = App->     { _routeFn :: AppUrl -> [(Text, Maybe Text)] -> Text->     }--Extend your App type to include a routing function.--> instance PathInfo AppUrl--Get your free PathInfo instance. Alternatives are to use `web-routes-th` or-implement PathInfo yourself.--> instance MonadRoute (Handler App App) where->    type URL (Handler App App) = AppUrl->    askRouteFn = gets _routeFn--Define your MonadRoute instance. In particular, `type URL (Handler App App)`-must be set to your URL data type defined above and `askRouteFn` should point-to the routing function you added to your App type.--Moving on to `Site.hs`.--> import Snap.Web.Routes--Snap.Web.Routes provides a convenience router function you'll need.--> routes :: [(ByteString, Handler App App ())]-> routes = [ ("",          serveDirectory "static")->          , ("",          routeWith routeAppUrl)->          ]--Add your routes to the bottom of the routes list using routeWith.--> routeAppUrl :: AppUrl -> Handler App App ()-> routeAppUrl appUrl =->     case appUrl of->       (Count n)   -> writeText $ ("Count = " `T.append` (T.pack $ show n))->       (Echo text) -> echo text->       (Paths ps)  -> writeText $ T.intercalate " " ps--> echo :: T.Text -> Handler App App ()-> echo msg = heistLocal (bindString "message" msg) $ render "echo"--Define the handler for each data constructor in your URL data type.--> app :: SnapletInit App App-> app = makeSnaplet "app" "An example application with snap-web-routes." Nothing $ do->     addRoutes routes->     return $ App renderRoute--Lastly, add the routing function to your app. If you prefixed the routes in routeWith:-->          , ("/prefix",          routeWith routeAppUrl)--then use `renderRouteWithPrefix` instead:-->     return . App $ renderRouteWithPrefix "/prefix"--|-}- {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE TypeFamilies      #-} +-- |+-- This module provides a ready to use implementation of `web-routes` for Snap.+--+-- The tutorial assumes you have a standard Snap app with an Application.hs and+-- Site.hs.+--+-- To get going, you'll need to add a few things to Application.hs+--+-- @+-- -- Enable a few extensions+--+-- \-\- Needed to derive a generic instance for our URL data type+-- \{\-\# LANGUAGE DeriveGeneric     \#\-\}+--+-- \-\- Needed by web-routes+-- \{\-\# LANGUAGE FlexibleInstances \#\-\}+-- \{\-\# LANGUAGE TypeFamilies      \#\-\}+--+-- \-\- Paths and params are of type Text.+-- import Data.Text (Text)+--+-- \-\- Snap.Web.Routes.Types exports everything you need to+-- \-\- define your PathInfo and MonadRoute instances.+-- import Snap.Web.Routes.Types+--+-- \-\- Your URL data type.  Deriving a `Generic` instance gives+-- \-\- you a `PathInfo` instance for free.+-- data AppUrl+--     = Count Int+--     | Echo Text+--     | Paths [Text]+--       deriving (Generic)+--+-- \-\- Extend your App type to include a routing function.+-- data App = App+--     { _routeFn :: AppUrl -> [(Text, Maybe Text)] -> Text+--     }+--+-- \-\- Thanks to the wonders of Generic, an empty instance+-- \-\- definition is all we need. Alternately, you can implement+-- \-\- toPathSegments and fromPathSegments yourself or use+-- \-\- web-routes-th.+-- instance PathInfo AppUrl+--+-- \-\- Set URL (Handler App App) to your URL data type defined above+-- \-\- and askRouteFn must point to the routing function you added to+-- \-\- your App.+-- instance MonadRoute (Handler App App) where+--    type URL (Handler App App) = AppUrl+--    askRouteFn = gets _routeFn+-- @+--+-- Moving on to Site.hs.+--+-- @+-- \-\- Snap.Web.Routes provides routing functions+-- import Snap.Web.Routes+--+-- \-\- Add your new routes using routeWith+-- routes :: [(ByteString, Handler App App ())]+-- routes = [ ("", routeWith routeAppUrl)+--          , ("", serveDirectory "static")+--          ]+--+-- \-\- Define handlers for each data constructor in your URL data type.+-- routeAppUrl :: AppUrl -> Handler App App ()+-- routeAppUrl appUrl =+--     case appUrl of+--       (Count n)   -> writeText $ ("Count = " `T.append` (T.pack $ show n))+--       (Echo text) -> echo text+--       (Paths ps)  -> writeText $ T.intercalate " " ps+--+-- \-\- You'll note that these are normal Snap handlers, except they can take+-- \-\- values from the data constructor as arguments. This is a lot nicer than+-- \-\- having to use getParam.+-- echo :: T.Text -> Handler App App ()+-- echo msg = heistLocal (bindString "message" msg) $ render "echo"+--+-- \-\- Add the routing function to your app.+-- app :: SnapletInit App App+-- app = makeSnaplet "app" "An example snap-web-routes app." Nothing $ do+--     addRoutes routes+--     return $ App renderRoute+-- @+--+-- If you prefixed the routes in routeWith+--+-- > ("/prefix", routeWith routeAppUrl)+--+-- then use `renderRouteWithPrefix` instead:+--+-- > return . App $ renderRouteWithPrefix "/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.++ module Snap.Web.Routes-  ( renderRoute+  ( routeWith+  , routeWithDebug+  , renderRoute   , renderRouteWithPrefix-  , routeWith   , heistUrl-  , gets-  , Generic-  , MonadRoute(..)-  , PathInfo(..)   ) where  import Control.Monad.State (lift, gets) import Data.Text (Text, append, pack) import Heist (HeistT) import Snap.Core-import Snap.Web.Routes.Heist import Snap.Snaplet+import Snap.Web.Routes.Heist import Web.Routes  -instance (MonadRoute m) => MonadRoute (HeistT n m) where-    type URL (HeistT n m) = URL m-    askRouteFn = lift askRouteFn+------------------------------------------------------------------------------+-- | Given a routing function, routes matching requests or calls+-- 'Snap.Core.pass'.+routeWith :: (PathInfo url, MonadSnap m) =>+             (url -> m ()) -- ^ routing function+          -> m ()+routeWith = flip routeWithOr $ const pass  -routeWith :: (PathInfo url, MonadSnap m) => (url -> m ()) -> m ()-routeWith router =+------------------------------------------------------------------------------+-- | Given a routing function, routes matching requests or returns debugging+-- information. This is __not suitable for production__, but can be useful in+-- seeing what paths are available or determining why a path isn't routing as+-- expected.+routeWithDebug :: (PathInfo url, MonadSnap m) =>+                  (url -> m ()) -- ^ routing function+               -> m ()+routeWithDebug = flip routeWithOr (\err -> writeText err)+++------------------------------------------------------------------------------+routeWithOr+    :: (PathInfo url, MonadSnap m) => (url -> m ()) -> (Text -> m ()) -> m ()+routeWithOr router onLeft =     do rq <- getRequest        case fromPathInfo $ rqPathInfo rq of-         (Left e) -> writeText (pack e)+         (Left e) -> onLeft . pack $ e          (Right url) -> router url  -renderRoute :: PathInfo url => url -> [(Text, Maybe Text)] -> Text+------------------------------------------------------------------------------+-- | Turn a route and params into a path.+renderRoute :: PathInfo url =>+               url -- ^ URL data constructor+            -> [(Text, Maybe Text)] -- ^ parameters+            -> Text -- ^ rendered route renderRoute = renderRouteWithPrefix ""  -renderRouteWithPrefix :: PathInfo url => Text -> url -> [(Text, Maybe Text)] -> Text-renderRouteWithPrefix prefix url params = prefix `append` toPathInfoParams url params+------------------------------------------------------------------------------+-- | Turn a route and params into a path with the given prefix.+renderRouteWithPrefix+    :: PathInfo url =>+       Text -- ^ route prefix+    -> url -- ^ URL data constructor+    -> [(Text, Maybe Text)] -- ^ parameters+    -> Text -- ^ rendered route+renderRouteWithPrefix p u params = p `append` toPathInfoParams u params+++------------------------------------------------------------------------------+-- | MonadRoute instance for 'HeistT'.+instance (MonadRoute m) => MonadRoute (HeistT n m) where+    type URL (HeistT n m) = URL m+    askRouteFn = lift askRouteFn

@@ -5,7 +5,8 @@ import Text.XmlHtml hiding (render) import Web.Routes -+------------------------------------------------------------------------------+-- | Render a url as a `Heist` splice. heistUrl :: MonadRoute m => URL m -> m [Node] heistUrl u =     do t <- showURL u

@@ -0,0 +1,10 @@+module Snap.Web.Routes.Types+  ( gets+  , Generic+  , MonadRoute(..)+  , PathInfo(..)+  ) where++import Control.Monad.State (gets)+import Snap.Core+import Web.Routes