joinPath
This commit is contained in:
parent
9fada88b6e
commit
191b406fd5
@ -18,8 +18,6 @@ module Yesod.Dispatch
|
||||
, toWaiApp
|
||||
, basicHandler
|
||||
, basicHandler'
|
||||
-- * Utilities
|
||||
, fullRender
|
||||
#if TEST
|
||||
, testSuite
|
||||
#endif
|
||||
@ -46,7 +44,6 @@ import qualified Network.Wai.Handler.CGI as CGI
|
||||
import System.Environment (getEnvironment)
|
||||
|
||||
import qualified Data.ByteString.Char8 as B
|
||||
import Web.Routes (encodePathInfo)
|
||||
|
||||
import qualified Data.ByteString.UTF8 as S
|
||||
|
||||
@ -232,7 +229,7 @@ toWaiApp' y segments env = do
|
||||
pathSegments = filter (not . null) segments
|
||||
eurl = parsePathSegments site pathSegments
|
||||
render u = fromMaybe
|
||||
(fullRender (approot y) (formatPathSegments site) u)
|
||||
(joinPath y (approot y) $ formatPathSegments site u)
|
||||
(urlRenderOverride y u)
|
||||
let errorHandler' = localNoCurrent . errorHandler
|
||||
rr <- parseWaiRequest env session'
|
||||
@ -268,19 +265,6 @@ toWaiApp' y segments env = do
|
||||
hs''' = ("Content-Type", S.fromString ct) : hs''
|
||||
return $ W.Response s hs''' c
|
||||
|
||||
-- | Fully render a route to an absolute URL. Since Yesod does this for you
|
||||
-- internally, you will rarely need access to this. However, if you need to
|
||||
-- generate links /outside/ of the Handler monad, this may be useful.
|
||||
--
|
||||
-- For example, if you want to generate an e-mail which links to your site,
|
||||
-- this is the function you would want to use.
|
||||
fullRender :: String -- ^ approot, no trailing slash
|
||||
-> (url -> [String])
|
||||
-> url
|
||||
-> String
|
||||
fullRender ar render route =
|
||||
ar ++ '/' : encodePathInfo (fixSegs $ render route)
|
||||
|
||||
httpAccept :: W.Request -> [ContentType]
|
||||
httpAccept = map B.unpack
|
||||
. parseHttpAccept
|
||||
@ -316,13 +300,6 @@ basicHandler' port mhost y = do
|
||||
SS.run port app
|
||||
Just _ -> CGI.run app
|
||||
|
||||
fixSegs :: [String] -> [String]
|
||||
fixSegs [] = []
|
||||
fixSegs [x]
|
||||
| any (== '.') x = [x]
|
||||
| otherwise = [x, ""] -- append trailing slash
|
||||
fixSegs (x:xs) = x : fixSegs xs
|
||||
|
||||
parseWaiRequest :: W.Request
|
||||
-> [(String, String)] -- ^ session
|
||||
-> IO Request
|
||||
|
||||
@ -44,6 +44,7 @@ import Control.Monad.Trans.Class (MonadTrans (..))
|
||||
import Control.Monad.Attempt (Failure)
|
||||
import qualified Data.ByteString as S
|
||||
import qualified Network.Wai.Middleware.CleanPath
|
||||
import Web.Routes (encodePathInfo)
|
||||
|
||||
-- | This class is automatically instantiated when you use the template haskell
|
||||
-- mkYesod function. You should never need to deal with it directly.
|
||||
@ -150,6 +151,18 @@ class Eq (Route a) => Yesod a where
|
||||
splitPath :: a -> S.ByteString -> Either S.ByteString [String]
|
||||
splitPath _ = Network.Wai.Middleware.CleanPath.splitPath
|
||||
|
||||
-- | Join the pieces of a path together into an absolute URL. This should
|
||||
-- be the inverse of 'splitPath'.
|
||||
joinPath :: a -> String -> [String] -> String
|
||||
joinPath _ ar pieces =
|
||||
ar ++ '/' : encodePathInfo (fixSegs pieces)
|
||||
where
|
||||
fixSegs [] = []
|
||||
fixSegs [x]
|
||||
| any (== '.') x = [x]
|
||||
| otherwise = [x, ""] -- append trailing slash
|
||||
fixSegs (x:xs) = x : fixSegs xs
|
||||
|
||||
data AuthResult = Authorized | AuthenticationRequired | Unauthorized String
|
||||
deriving (Eq, Show, Read)
|
||||
|
||||
|
||||
Loading…
Reference in New Issue
Block a user