snap-web-routes 0.3.0.1 → 0.4.0.0

raw patch · 13 files changed

+335/−209 lines, 13 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• README.md +92/−72
• changelog +4/−0
• snap-web-routes.cabal +6/−6
• src/Snap/Snaplet/Router.hs +68/−0
• src/Snap/Snaplet/Router/Heist.hs +32/−0
• src/Snap/Snaplet/Router/Internal/Types.hs +56/−0
• src/Snap/Snaplet/Router/Types.hs +11/−0
• src/Snap/Snaplet/Router/URL.hs +66/−0
• src/Snap/Web/Routes.hs +0/−16
• src/Snap/Web/Routes/App.hs +0/−74
• src/Snap/Web/Routes/Heist.hs +0/−13
• src/Snap/Web/Routes/Text.hs +0/−18
• src/Snap/Web/Routes/Types.hs +0/−10

@@ -12,98 +12,118 @@  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. -    -- Enable a few extensions-    {-# LANGUAGE FlexibleInstances #-} -- Needed by-    {-# LANGUAGE TypeFamilies      #-} -- web-routes-    {-# LANGUAGE DeriveGeneric     #-} -- Needed to derive Generic-                                       -- for our URL data type+```haskell+-- Enable a few extensions+{-# LANGUAGE FlexibleInstances #-} -- Needed by+{-# LANGUAGE TypeFamilies      #-} -- web-routes+{-# LANGUAGE DeriveGeneric     #-} -- Needed to derive Generic+                                   -- for our URL data type -    -- Paths and params use Text.-    import Data.Text (Text)+-- Used in HasRouter instances+import Control.Monad.State (get) -    -- Snap.Web.Routes.Types exports everything you need to-    -- define your PathInfo and MonadRoute instances.-    import Snap.Web.Routes.Types+-- Paths and params use Text.+import Data.Text (Text) -    -- 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)+-- Snap.Snaplet.Router.Types exports everything you need to+-- define your PathInfo and HasRouter instances.+import Snap.Web.Routes.Types -    -- Extend your App type to include a routing function.-    data App = App-        { _routeFn :: AppUrl -> [(Text, Maybe Text)] -> Text-        }+-- Your URL data type.  Deriving a `Generic` allows you to+-- get a free `PathInfo` instance.+data AppUrl+    = Count Int+    | Echo Text+    | Paths [Text]+      deriving (Generic) -    -- 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+-- Extend your App type to include the router snaplet.+data App = App+    { _heist :: Snaplet (Heist App)+    , _router :: Snaplet RouterState+    } -    -- 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+-- Thanks to Generic, an empty instance definition is all+-- you need. Alternately, you can implement 'toPathSegments'+-- and 'fromPathSegments' yourself or use web-routes-th.+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 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.+instance HasRouter (Handler b RouterState) where+    type URL (Handler b RouterState) = AppUrl+    getRouterState = get+```+ ### `Site.hs` -Moving on to `Site.hs`, we'll setup handlers for each URL, as well initialise our app with a routing function.+Moving on to `Site.hs`, we'll setup handlers for each URL, as well initialise our app with the router snaplet.. -    -- Snap.Web.Routes provides routing functions-    import Snap.Web.Routes+```haskell+-- Snap.Snaplet.Router provides routing functions+import Snap.Snaplet.Router -    -- Add your new routes using routeWith-    routes :: [(ByteString, Handler App App ())]-    routes = [ ("", routeWith routeAppUrl)-             , ("", serveDirectory "static")-             ]+-- Add your new routes using routeWith+routes :: [(ByteString, Handler App App ())]+routes = [ ("", routeWith routeAppUrl)+         , ("", serveDirectory "static")+         ] -    -- Define handlers for each value 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+-- Define handlers for each value 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 value 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"+-- You'll note that these are normal Snap handlers, except they can take+-- values from the value 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+-- Add the router snaplet to your app.+app :: SnapletInit App App+app = makeSnaplet "app" "An example snap-web-routes app." Nothing $ do+    h <- nestSnaplet "" heist $ heistInit "templates"+    r <- nestSnaplet "router" router $ initRouter ""+    addRoutes routes+    return $ App h r+``` -If you prefixed the routes in routeWith (e.g. `("/prefix", routeWith routeAppUrl)`) then use `renderRouteWithPrefix` instead:+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: -    return . App $ renderRouteWithPrefix "/prefix"+```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.+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  Helper functions are provided for rendering URLs: -    echo :: T.Text -> Handler App App ()-    echo msg = do-        url <- showUrl $ Echo "this is a test"-        if msg == "test" then redirect (encodeUtf8 url) else renderEcho-      where-        renderEcho = heistLocal (I.bindSplices echoSplices) $ render "echo"-        echoSplices = do-            "message"  ## I.textSplice msg-            "countUrl" ## urlSplice (Count 10)--In the example above you'll find we use `urlSplice` to turn a URL into a splice, and `showUrl` to render a URL as Text.-+```haskell+echo :: T.Text -> Handler App App ()+echo msg = do+    if msg == "test" then redirectURL (Echo "test passed") else renderEcho+  where+    renderEcho = heistLocal (I.bindSplices echoSplices) $ render "echo"+    echoSplices = do+        "message"  ## I.textSplice msg+        "countUrl" ## urlSplice (Count 10)+``` +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.

@@ -1,3 +1,7 @@+2014-05-07 0.4.0.0++* Make router a snaplet+ 2014-05-06 0.3.0.1  * Move tutorial to readme as it didn't show up on Hackage

@@ -1,5 +1,5 @@ name:                snap-web-routes-version:             0.3.0.1+version:             0.4.0.0 synopsis:            Type safe URLs for Snap description:     Type safe URL generation and routing for Snap using web-routes.@@ -29,11 +29,11 @@   hs-source-dirs:      src    exposed-modules:-    Snap.Web.Routes-    Snap.Web.Routes.App-    Snap.Web.Routes.Heist-    Snap.Web.Routes.Text-    Snap.Web.Routes.Types+    Snap.Snaplet.Router+    Snap.Snaplet.Router.Heist+    Snap.Snaplet.Router.Internal.Types+    Snap.Snaplet.Router.Types+    Snap.Snaplet.Router.URL    build-depends:     base                      >= 4.4     && < 5,

@@ -0,0 +1,68 @@+{-# LANGUAGE FlexibleContexts  #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE TypeFamilies      #-}++module Snap.Snaplet.Router+   ( RouterState (..)+   , HasRouter (..)+   , initRouter+   , urlPath+   , urlPathParams+   , redirectURL+   , redirectURLParams+   , routeWith+   , routeWithDebug+   , urlSplice+   , urlParamsSplice+   ) where+++import           Data.Text+import           Snap.Core (MonadSnap)+import qualified Snap.Core as SC+import           Snap.Snaplet+import           Web.Routes (PathInfo, toPathInfoParams, fromPathInfo)+------------------------------------------------------------------------------+import           Snap.Snaplet.Router.Heist+import           Snap.Snaplet.Router.URL+import           Snap.Snaplet.Router.Internal.Types++++------------------------------------------------------------------------------+-- | Snaplet initializer.+initRouter :: Text  -- ^ Prefix to add to paths.+           -> SnapletInit b RouterState+initRouter prefix = makeSnaplet "router" "Snap router" Nothing $+    return $ RouterState prefix+++------------------------------------------------------------------------------+-- | 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 SC.pass+++------------------------------------------------------------------------------+-- | 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 (failIfNotLocal . SC.writeText)+++------------------------------------------------------------------------------+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+         (Right url) -> router url

@@ -0,0 +1,32 @@+{-# 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]

@@ -0,0 +1,56 @@+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE TypeFamilies      #-}++module Snap.Snaplet.Router.Internal.Types+  ( Path+  , RouterState (..)+  , HasRouter (..)+  ) where+++import Control.Monad.State (lift)+import Data.Text+import Heist (HeistT)++++type Path = Text+++data RouterState = RouterState+    { _prefix :: Text+    }+++------------------------------------------------------------------------------+-- | Instantiate this type class for @Handler App App@ and @Handler b+-- RouterState@ so that the snaplet can find its state. An instance requires+-- a type for @URL m@ - being the URL data type you have defined - and an+-- instance of @getRouterState@. Assuming your URL data type is called+-- @AppUrl@, the instance for @Handler b RouterState@ would be+--+-- @+-- instance HasRouter (Handler b RouterState) where+--     type URL (Handler b RouterState) = AppUrl+--     getRouterState = get+-- @+--+-- If the lens for the "Router" snaplet is @router@, your @Handler App App@+-- instance would be+--+-- @+-- instance HasRouter (Handler App App) where+--     type URL (Handler App App) = AppUrl+--     getRouterState = with router get+-- @++class (Monad m) => HasRouter m where+    type URL m+    getRouterState :: m RouterState+++------------------------------------------------------------------------------+instance (HasRouter m) => HasRouter (HeistT n m) where+    type URL (HeistT n m) = URL m+    getRouterState = lift getRouterState

@@ -0,0 +1,11 @@+module Snap.Snaplet.Router.Types+  ( RouterState (..)+  , HasRouter (..)+  , PathInfo (..)+  -- * Re-exported for convenience+  , Generic+  ) where+++import Snap.Snaplet.Router.Internal.Types+import Web.Routes (PathInfo, Generic)

@@ -0,0 +1,66 @@+{-# LANGUAGE FlexibleContexts  #-}++module Snap.Snaplet.Router.URL+  ( urlPath+  , urlPathParams+  , redirectURL+  , redirectURLParams+  ) where+++import           Data.Text+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)+++------------------------------------------------------------------------------+-- | Returns the path for the given URL+urlPath :: (HasRouter m, PathInfo (URL m)) => URL m   -- ^ URL data type+         -> m Path                                    -- ^ Path of route+urlPath u = urlPathParams u []+++------------------------------------------------------------------------------+-- | Returns the path with query string for the given URL and params+urlPathParams :: (HasRouter m, PathInfo (URL m)) => URL m  -- ^ URL data type+               -> [(Text, Maybe Text)]                     -- ^ Params+               -> m Path                                   -- ^ Path of route+                                                           -- with params as+                                                           -- query string+urlPathParams u p = do+    state <- getRouterState+    return $ urlPathParamsWithPrefix (_prefix state) u p+++------------------------------------------------------------------------------+-- | Redirect to the path for the given URL+redirectURL+    :: (HasRouter m, MonadSnap m, PathInfo (URL m)) =>+       URL m  -- ^ URL data type+    -> m ()+redirectURL u = redirectURLParams u []+++------------------------------------------------------------------------------+-- | Redirect to the path for the given URL with params as query string+redirectURLParams+    :: (HasRouter m, MonadSnap m, PathInfo (URL m)) =>+       URL m                 -- ^ URL data type+    -> [(Text, Maybe Text)]  -- ^ Params+    -> m ()+redirectURLParams u p = SC.redirect . encodeUtf8 =<< urlPathParams u p+++------------------------------------------------------------------------------+-- | Turn a route and params into a path with the given prefix.+urlPathParamsWithPrefix+    :: PathInfo url =>+       Text                 -- ^ Route prefix+    -> url                  -- ^ URL data type+    -> [(Text, Maybe Text)] -- ^ Params+    -> Path+urlPathParamsWithPrefix prefix u p = prefix `append` toPathInfoParams u p

@@ -1,16 +0,0 @@--- |--- This module provides a ready to use implementation of `web-routes` for Snap.----module Snap.Web.Routes-  ( routeWith-  , routeWithDebug-  , renderRoute-  , renderRouteWithPrefix-  , showUrl-  , showUrlParams-  , urlSplice-  ) where--import Snap.Web.Routes.App-import Snap.Web.Routes.Heist-import Snap.Web.Routes.Text

@@ -1,74 +0,0 @@-{-# LANGUAGE OverloadedStrings #-}-{-# LANGUAGE TypeFamilies      #-}--module Snap.Web.Routes.App-  ( routeWith-  , routeWithDebug-  , renderRoute-  , renderRouteWithPrefix-  ) where---import Control.Monad.State (lift, gets)-import Data.Text (Text, append, pack)-import Heist (HeistT)-import Snap.Core-import Snap.Snaplet-import Web.Routes------------------------------------------------------------------------------------ | 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------------------------------------------------------------------------------------ | 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) -> onLeft . pack $ e-         (Right url) -> router url------------------------------------------------------------------------------------ | Turn a route and params into a path.-renderRoute :: PathInfo url =>-               url -- ^ URL data type-            -> [(Text, Maybe Text)] -- ^ parameters-            -> Text -- ^ rendered route-renderRoute = renderRouteWithPrefix ""------------------------------------------------------------------------------------ | Turn a route and params into a path with the given prefix.-renderRouteWithPrefix-    :: PathInfo url =>-       Text -- ^ route prefix-    -> url -- ^ URL data type-    -> [(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

@@ -1,13 +0,0 @@-module Snap.Web.Routes.Heist-  ( urlSplice-  ) where--import Text.XmlHtml hiding (render)-import Web.Routes----------------------------------------------------------------------------------- | Render a url as a `Heist` splice.-urlSplice :: MonadRoute m => URL m -> m [Node]-urlSplice u =-    do t <- showURL u-       return [TextNode t]

@@ -1,18 +0,0 @@-module Snap.Web.Routes.Text-  ( showUrl-  , showUrlParams-  ) where--import Data.Text-import Web.Routes--showUrl :: MonadRoute m =>-           URL m -- ^ URL data type-        -> m Text -- ^ rendered route-showUrl = showURL--showUrlParams :: MonadRoute m =>-                 URL m -- ^ URL data type-              -> [(Text, Maybe Text)] -- ^ parameters-              -> m Text -- ^ rendered route-showUrlParams = showURLParams

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