{-# 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 ]