hablo/test/URLs.hs

74 lines
2.5 KiB
Haskell

{-# LANGUAGE OverloadedStrings #-}
module URLs (
test
) where
import Blog.URL (defaultOn, pathOn, localPrefix)
import Data.Text (Text)
import Distribution.TestSuite
import Mock.URL (
cdnFavicon, hostFavicon, localDiscovered, localFavicon, prefixedTestSite
, testSite
)
import Utils (simpleTest, tag)
check :: Text -> Text -> IO Progress
check actual expected =
return . Finished $
if actual == expected
then Pass
else Fail $ "Expected " ++ show expected ++ " but got " ++ show actual
testPathOn :: Test
testPathOn = tag "pathOn" . testGroup "Concat path" $ simpleTest <$> [
("no prefix / relative path",
check (pathOn testSite "tag/all.html") "https://test.net/tag/all.html")
, ("no prefix / absolute path",
check
(pathOn testSite "/media/logo.png")
"https://test.net/media/logo.png")
, ("prefixed / relative path",
check
(pathOn prefixedTestSite "tag/all.html")
"https://test.net/subPath/tag/all.html")
, ("prefixed / absolute path ",
check
(pathOn prefixedTestSite "/media/logo.png")
"https://test.net/media/logo.png")
]
testDefaultOn :: Test
testDefaultOn = tag "defaultOn" . testGroup "Concat path or pick URL" $ simpleTest <$> [
("external resource", -- shouldn't even touch the first argument when the second is an absolute URL
check (defaultOn undefined cdnFavicon) "https://cdn.net/favicon.png")
, ("host relative",
check (defaultOn testSite hostFavicon) "https://test.net/favicon.png")
, ("host relative / prefix",
check
(defaultOn prefixedTestSite hostFavicon)
"https://test.net/favicon.png")
, ("relative",
check
(defaultOn testSite localDiscovered)
"https://test.net/skin/favicon.png")
, ("relative / prefix",
check
(defaultOn prefixedTestSite localDiscovered)
"https://test.net/subPath/skin/favicon.png")
]
testLocalPrefix :: Test
testLocalPrefix = tag "localPrefix" . testGroup "Prefixed URLs" $ simpleTest <$> [
("absolute URL", check (localPrefix ".." cdnFavicon) "https://cdn.net/favicon.png")
, ("host relative", check (localPrefix ".." hostFavicon) "/favicon.png")
, ("relative path", check (localPrefix ".." localDiscovered) "../skin/favicon.png")
, ("relative path no prefix", check (localPrefix "" localFavicon) "favicon.png")
]
test :: Test
test = tag "URLs" $ testGroup "URLs handling" [
testPathOn
, testDefaultOn
, testLocalPrefix
]