on master help sign in
Make toSiteRoot work with /xxx URL's
commitcf71e295467aa75606d491627541610e17dd1c64 authorJasper Van der Jeugt <jaspervdj@gmail.com> dateTue 8 Mar 2011, 11:03 (16 years ago) parent1ea5678
4 files changed+32−2
src/Hakyll/Web/RelativizeUrls.hs+1−1 src/Hakyll/Web/Util/Url.hs+3−1 tests/Hakyll/Web/Util/Url/Tests.hs+25 tests/TestSuite.hs+3
src/Hakyll/Web/RelativizeUrls.hs+1−1
@@ -31,7 +31,7 @@ import Hakyll.Core.Compiler
3131import Hakyll.Web.Page
3232import Hakyll.Web.Util.Url
3333
34−-- | Compiler form of 'compressCss' which automatically picks the right root
34+-- | Compiler form of 'relativizeUrls' which automatically picks the right root
3535-- path
3636--
3737relativizeUrlsCompiler :: Compiler (Page String) (Page String)
src/Hakyll/Web/Util/Url.hs+3−1
@@ -24,8 +24,10 @@ toUrl url = '/' : url
2424-- | Get the relative url to the site root, for a given (absolute) url
2525--
2626toSiteRoot :: String -> String
27−toSiteRoot = emptyException . joinPath . map parent . splitPath . takeDirectory
27+toSiteRoot = emptyException . joinPath . map parent
28+ . splitPath . takeDirectory . dropLeadingSlash
2829 where
2930 parent = const ".."
3031 emptyException [] = "."
3132 emptyException x = x
33+ dropLeadingSlash = dropWhile (== '/')
tests/Hakyll/Web/Util/Url/Tests.hsnew file+25
@@ -0,0 +1,25 @@
1+module Hakyll.Web.Util.Url.Tests
2+ ( tests
3+ ) where
4+
5+import Test.Framework
6+import Test.HUnit hiding (Test)
7+
8+import Hakyll.Web.Util.Url
9+import TestSuite.Util
10+
11+tests :: [Test]
12+tests = concat
13+ [ fromAssertions "toUrl"
14+ [ "/foo/bar.html" @=? toUrl "foo/bar.html"
15+ , "/" @=? toUrl "/"
16+ , "/funny-pics.html" @=? toUrl "/funny-pics.html"
17+ ]
18+
19+ , fromAssertions "toSiteRoot"
20+ [ ".." @=? toSiteRoot "/foo/bar.html"
21+ , "." @=? toSiteRoot "index.html"
22+ , "." @=? toSiteRoot "/index.html"
23+ , "../.." @=? toSiteRoot "foo/bar/qux"
24+ ]
25+ ]
tests/TestSuite.hs+3
@@ -8,6 +8,7 @@ import qualified Hakyll.Core.Routes.Tests
88import qualified Hakyll.Web.Page.Tests
99import qualified Hakyll.Web.RelativizeUrls.Tests
1010import qualified Hakyll.Web.Template.Tests
11+import qualified Hakyll.Web.Util.Url.Tests
1112
1213main :: IO ()
1314main = defaultMain
@@ -23,4 +24,6 @@ main = defaultMain
2324 Hakyll.Web.RelativizeUrls.Tests.tests
2425 , testGroup "Hakyll.Web.Template.Tests"
2526 Hakyll.Web.Template.Tests.tests
27+ , testGroup "Hakyll.Web.Util.Url.Tests"
28+ Hakyll.Web.Util.Url.Tests.tests
2629 ]