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

Precede null path segments with dashes (#421)

Browse Source
This commit is contained in:
Michael Snoyman 2012-09-21 14:23:38 +03:00
parent c6aa648884
commit cf4fed8cb9
4 changed files with 60 additions and 3 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

13
yesod-core/Yesod/Internal/Core.hs
View File

@ -227,10 +227,13 @@ $doctype 5
cleanPath :: a -> [Text] -> Either [Text] [Text]
cleanPath _ s =
if corrected == s
then Right s
then Right $ map dropDash s
else Left corrected
where
corrected = filter (not . T.null) s
dropDash t
| T.all (== '-') t = T.drop 1 t
| otherwise = t
-- | Builds an absolute URL by concatenating the application root with the
-- pieces of a path and a query string, if any.
@ -240,12 +243,16 @@ $doctype 5
-> [T.Text] -- ^ path pieces
-> [(T.Text, T.Text)] -- ^ query string
-> Builder
joinPath _ ar pieces' qs' = fromText ar `mappend` encodePath pieces qs
joinPath _ ar pieces' qs' =
fromText ar `mappend` encodePath pieces qs
where
pieces = if null pieces' then [""] else pieces'
pieces = if null pieces' then [""] else map addDash pieces'
qs = map (TE.encodeUtf8 *** go) qs'
go "" = Nothing
go x = Just $ TE.encodeUtf8 x
addDash t
| T.all (== '-') t = T.cons '-' t
| otherwise = t
-- | This function is used to store some static content to be served as an
-- external file. The most common case of this is stashing CSS and

13
yesod-core/test/YesodCoreTest/CleanPath.hs
View File

@ -14,6 +14,11 @@ import Network.HTTP.Types (status200, decodePathSegments)
import qualified Data.ByteString.Lazy.Char8 as L8
import qualified Data.Text as TS
import qualified Data.Text.Encoding as TE
import Control.Arrow ((***))
import Network.HTTP.Types (encodePath)
import Data.Monoid (mappend)
import Blaze.ByteString.Builder.Char.Utf8 (fromText)
data Subsite = Subsite
@ -52,6 +57,14 @@ instance Yesod Y where
where
corrected = filter (not . TS.null) s
joinPath Y ar pieces' qs' =
fromText ar `mappend` encodePath pieces qs
where
pieces = if null pieces' then [""] else pieces'
qs = map (TE.encodeUtf8 *** go) qs'
go "" = Nothing
go x = Just $ TE.encodeUtf8 x
getFooR :: Handler RepPlain
getFooR = return $ RepPlain "foo"

35
yesod-core/test/YesodCoreTest/Links.hs
View File

@ -8,11 +8,17 @@ import Test.Hspec.HUnit ()
import Yesod.Core hiding (Request)
import Text.Hamlet
import Network.Wai
import Network.Wai.Test
import Data.Text (Text)
import Control.Monad.IO.Class (liftIO)
import Blaze.ByteString.Builder (toByteString)
data Y = Y
mkYesod "Y" [parseRoutes|
/ RootR GET
/single/#Text TextR GET
/multi/*Texts TextsR GET
|]
instance Yesod Y
@ -20,9 +26,16 @@ instance Yesod Y
getRootR :: Handler RepHtml
getRootR = defaultLayout $ toWidget [hamlet|<a href=@{RootR}>|]
getTextR :: Text -> Handler RepHtml
getTextR foo = defaultLayout $ toWidget [hamlet|%#{foo}%|]
getTextsR :: [Text] -> Handler RepHtml
getTextsR foos = defaultLayout $ toWidget [hamlet|%#{show foos}%|]
linksTest :: Spec
linksTest = describe "Test.Links" $ do
it "linkToHome" case_linkToHome
it "blank path pieces" case_blanks
runner :: Session () -> IO ()
runner f = toWaiApp Y >>= runSession f
@ -31,3 +44,25 @@ case_linkToHome :: IO ()
case_linkToHome = runner $ do
res <- request defaultRequest
assertBody "<!DOCTYPE html>\n<html><head><title></title></head><body><a href=\"/\"></a>\n</body></html>" res
case_blanks :: IO ()
case_blanks = runner $ do
liftIO $ do
let go r =
let (ps, qs) = renderRoute r
in toByteString $ joinPath Y "" ps qs
(go $ TextR "-") `shouldBe` "/single/--"
(go $ TextR "") `shouldBe` "/single/-"
(go $ TextsR ["", "-", "foo", "", "bar"]) `shouldBe` "/multi/-/--/foo/-/bar"
res1 <- request defaultRequest
{ pathInfo = ["single", "-"]
, rawPathInfo = "dummy1"
}
assertBody "<!DOCTYPE html>\n<html><head><title></title></head><body>%%</body></html>" res1
res2 <- request defaultRequest
{ pathInfo = ["multi", "foo", "-", "bar"]
, rawPathInfo = "dummy2"
}
assertBody "<!DOCTYPE html>\n<html><head><title></title></head><body>%[&quot;foo&quot;,&quot;&quot;,&quot;bar&quot;]%</body></html>" res2

2
yesod-core/yesod-core.cabal
View File

@ -119,8 +119,10 @@ test-suite tests
,text
,http-types
, random
, blaze-builder
,HUnit
,QuickCheck >= 2 && < 3
,transformers
ghc-options: -Wall
source-repository head