hablo/test/URLs.hs

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