joinPath
This commit is contained in:
parent
9fada88b6e
commit
191b406fd5
@ -18,8 +18,6 @@ module Yesod.Dispatch
|
|||||||
, toWaiApp
|
, toWaiApp
|
||||||
, basicHandler
|
, basicHandler
|
||||||
, basicHandler'
|
, basicHandler'
|
||||||
-- * Utilities
|
|
||||||
, fullRender
|
|
||||||
#if TEST
|
#if TEST
|
||||||
, testSuite
|
, testSuite
|
||||||
#endif
|
#endif
|
||||||
@ -46,7 +44,6 @@ import qualified Network.Wai.Handler.CGI as CGI
|
|||||||
import System.Environment (getEnvironment)
|
import System.Environment (getEnvironment)
|
||||||
|
|
||||||
import qualified Data.ByteString.Char8 as B
|
import qualified Data.ByteString.Char8 as B
|
||||||
import Web.Routes (encodePathInfo)
|
|
||||||
|
|
||||||
import qualified Data.ByteString.UTF8 as S
|
import qualified Data.ByteString.UTF8 as S
|
||||||
|
|
||||||
@ -232,7 +229,7 @@ toWaiApp' y segments env = do
|
|||||||
pathSegments = filter (not . null) segments
|
pathSegments = filter (not . null) segments
|
||||||
eurl = parsePathSegments site pathSegments
|
eurl = parsePathSegments site pathSegments
|
||||||
render u = fromMaybe
|
render u = fromMaybe
|
||||||
(fullRender (approot y) (formatPathSegments site) u)
|
(joinPath y (approot y) $ formatPathSegments site u)
|
||||||
(urlRenderOverride y u)
|
(urlRenderOverride y u)
|
||||||
let errorHandler' = localNoCurrent . errorHandler
|
let errorHandler' = localNoCurrent . errorHandler
|
||||||
rr <- parseWaiRequest env session'
|
rr <- parseWaiRequest env session'
|
||||||
@ -268,19 +265,6 @@ toWaiApp' y segments env = do
|
|||||||
hs''' = ("Content-Type", S.fromString ct) : hs''
|
hs''' = ("Content-Type", S.fromString ct) : hs''
|
||||||
return $ W.Response s hs''' c
|
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 :: W.Request -> [ContentType]
|
||||||
httpAccept = map B.unpack
|
httpAccept = map B.unpack
|
||||||
. parseHttpAccept
|
. parseHttpAccept
|
||||||
@ -316,13 +300,6 @@ basicHandler' port mhost y = do
|
|||||||
SS.run port app
|
SS.run port app
|
||||||
Just _ -> CGI.run 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
|
parseWaiRequest :: W.Request
|
||||||
-> [(String, String)] -- ^ session
|
-> [(String, String)] -- ^ session
|
||||||
-> IO Request
|
-> IO Request
|
||||||
|
|||||||
@ -44,6 +44,7 @@ import Control.Monad.Trans.Class (MonadTrans (..))
|
|||||||
import Control.Monad.Attempt (Failure)
|
import Control.Monad.Attempt (Failure)
|
||||||
import qualified Data.ByteString as S
|
import qualified Data.ByteString as S
|
||||||
import qualified Network.Wai.Middleware.CleanPath
|
import qualified Network.Wai.Middleware.CleanPath
|
||||||
|
import Web.Routes (encodePathInfo)
|
||||||
|
|
||||||
-- | This class is automatically instantiated when you use the template haskell
|
-- | This class is automatically instantiated when you use the template haskell
|
||||||
-- mkYesod function. You should never need to deal with it directly.
|
-- 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 :: a -> S.ByteString -> Either S.ByteString [String]
|
||||||
splitPath _ = Network.Wai.Middleware.CleanPath.splitPath
|
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
|
data AuthResult = Authorized | AuthenticationRequired | Unauthorized String
|
||||||
deriving (Eq, Show, Read)
|
deriving (Eq, Show, Read)
|
||||||
|
|
||||||
|
|||||||
Loading…
Reference in New Issue
Block a user