module Snap.Snaplet.Router
( RouterState (..)
, HasRouter (..)
, initRouter
, urlPath
, urlPathParams
, redirectURL
, redirectURLParams
, routeWith
, routeWithDebug
, urlSplice
, urlParamsSplice
) 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, fromPathInfo)
import Snap.Snaplet.Router.HeistSplices
import Snap.Snaplet.Router.URL
import Snap.Snaplet.Router.Internal.Types
initRouter :: Text
-> SnapletInit b RouterState
initRouter prefix = makeSnaplet "router" "Snap router" Nothing $
return $ RouterState prefix
routeWith :: (PathInfo url, MonadSnap m) =>
(url -> m ())
-> m ()
routeWith = flip routeWithOr $ const SC.pass
routeWithDebug :: (PathInfo url, MonadSnap m) =>
(url -> m ())
-> m ()
routeWithDebug = flip routeWithOr (failIfNotLocal . SC.writeText)
routeWithOr
:: (PathInfo url, MonadSnap m) => (url -> m ()) -> (Text -> m ()) -> m ()
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