haskell/yesod
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

Wrote cleanupSegments

Browse Source
This commit is contained in:
Michael Snoyman 2010-04-11 12:58:48 -07:00
parent 45b4343747
commit c181fd624e
1 changed files with 5 additions and 4 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

9
Yesod/Yesod.hs
View File

@ -21,7 +21,8 @@ import qualified Data.ByteString.Char8 as B8
import Data.Maybe (fromMaybe) import Data.Maybe (fromMaybe)
import Web.Mime import Web.Mime
import Web.Encodings (parseHttpAccept) import Web.Encodings (parseHttpAccept)
import Web.Routes (Site (..), encodePathInfo) import Web.Routes (Site (..), encodePathInfo, decodePathInfo)
import Data.List (intercalate)
import qualified Network.Wai as W import qualified Network.Wai as W
import Network.Wai.Middleware.CleanPath import Network.Wai.Middleware.CleanPath
@ -141,7 +142,7 @@ toWaiApp' :: Yesod y
toWaiApp' y resource session env = do toWaiApp' y resource session env = do
let site = getSite getMethod (badMethod y) y let site = getSite getMethod (badMethod y) y
types = httpAccept env types = httpAccept env
pathSegments = map cleanupSegment resource pathSegments = cleanupSegments resource
eurl = parsePathSegments site pathSegments eurl = parsePathSegments site pathSegments
case eurl of case eurl of
Left _ -> error "FIXME: send 404 message" Left _ -> error "FIXME: send 404 message"
@ -158,8 +159,8 @@ getMethod f eh req cts =
let m = B8.unpack $ W.methodToBS $ W.requestMethod $ reqWaiRequest req let m = B8.unpack $ W.methodToBS $ W.requestMethod $ reqWaiRequest req
in f m eh req cts in f m eh req cts
cleanupSegment :: B.ByteString -> String cleanupSegments :: [B.ByteString] -> [String]
cleanupSegment = error "FIXME: cleanupSegment" cleanupSegments = decodePathInfo . intercalate "/" . map B8.unpack
httpAccept :: W.Request -> [ContentType] httpAccept :: W.Request -> [ContentType]
httpAccept = map contentTypeFromBS httpAccept = map contentTypeFromBS