snap-web-routes 0.2.0.0 → 0.3.0.0

raw patch · 6 files changed

+105/−74 lines, 6 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• TODO.md +0/−1
• snap-web-routes.cabal +3/−1
• src/Snap/Web/Routes.hs +7/−69
• src/Snap/Web/Routes/App.hs +74/−0
• src/Snap/Web/Routes/Heist.hs +3/−3
• src/Snap/Web/Routes/Text.hs +18/−0

@@ -1,6 +1,5 @@ # 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

@@ -1,5 +1,5 @@ name:                snap-web-routes-version:             0.2.0.0+version:             0.3.0.0 synopsis:            Type safe URLs for Snap description:     Type safe URL generation and routing for Snap using web-routes.@@ -30,7 +30,9 @@    exposed-modules:     Snap.Web.Routes+    Snap.Web.Routes.App     Snap.Web.Routes.Heist+    Snap.Web.Routes.Text     Snap.Web.Routes.Types    build-depends:

@@ -1,6 +1,3 @@-{-# LANGUAGE OverloadedStrings #-}-{-# LANGUAGE TypeFamilies      #-}- -- | -- This module provides a ready to use implementation of `web-routes` for Snap. --@@ -65,7 +62,7 @@ --          , ("", serveDirectory "static") --          ] ----- \-\- Define handlers for each data constructor in your URL data type.+-- \-\- Define handlers for each value constructor in your URL data type. -- routeAppUrl :: AppUrl -> Handler App App () -- routeAppUrl appUrl = --     case appUrl of@@ -74,7 +71,7 @@ --       (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+-- \-\- 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"@@ -105,70 +102,11 @@   , routeWithDebug   , renderRoute   , renderRouteWithPrefix-  , heistUrl+  , showUrl+  , showUrlParams+  , urlSplice   ) where -import Control.Monad.State (lift, gets)-import Data.Text (Text, append, pack)-import Heist (HeistT)-import Snap.Core-import Snap.Snaplet+import Snap.Web.Routes.App import Snap.Web.Routes.Heist-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 constructor-            -> [(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 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+import Snap.Web.Routes.Text

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

@@ -0,0 +1,18 @@+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