--------------------------------------------------------------------------------
module Hakyll.Web.Html.Tests
( tests
) where
--------------------------------------------------------------------------------
import Data.Char (toUpper)
import Test.Tasty (TestTree, testGroup)
import Test.Tasty.HUnit ((@=?))
import qualified Text.HTML.TagSoup as TS
--------------------------------------------------------------------------------
import Hakyll.Web.Html
import TestSuite.Util
--------------------------------------------------------------------------------
tests :: TestTree
tests = testGroup "Hakyll.Web.Html.Tests" $ concat
[ fromAssertions "demoteHeaders"
[ "
A h1 title
" @=?
demoteHeaders "A h1 title
" -- Assert single-step demotion
, "A h6 title
" @=?
demoteHeaders "A h6 title
" -- Assert maximum demotion is h6
]
, fromAssertions "demoteHeadersBy"
[ "A h1 title
" @=?
demoteHeadersBy 2 "A h1 title
"
, "A h5 title
" @=?
demoteHeadersBy 2 "A h5 title
" -- Assert that h6 is the lowest possible demoted header.
, "A h4 title
" @=?
demoteHeadersBy 0 "A h4 title
" -- Assert that a demotion of @N < 1@ is a no-op.
]
, fromAssertions "getUrls"
[ ["/image1.png", "/image2.jpeg", "https://example.com", "/game.swf", "/poster.jpeg"] @=?
getUrls [
TS.TagOpen "img" [("src", "/image1.png")]
, TS.TagOpen "img" [("src", "/image2.jpeg")]
, TS.TagOpen "a" [("href", "https://example.com")]
, TS.TagOpen "object" [("data", "/game.swf")]
, TS.TagOpen "video" [("poster", "/poster.jpeg")]
]
, ["/image1.png", "/image2.jpeg", "/image3.bmp"] @=?
getUrls [ TS.TagOpen "img" [("srcset", "/image1.png 10w, /image2.jpeg, /image3.bmp 1.3x")] ]
-- Invalid srcset specification means no URLs are extracted
, [] @=?
getUrls [ TS.TagOpen "img" [("srcset", "/image1.png 10wide, /image2.jpeg, /image3.bmp 1.3px")] ]
]
, fromAssertions "withUrls"
[ "bar" @=?
withUrls (map toUpper) "bar"
, "
" @=?
withUrls (map toUpper) "
"
-- Test escaping
, "" @=?
withUrls id ""
, "<stdio>
" @=?
withUrls id "<stdio>
"
, "" @=?
withUrls id ""
-- Test minimizing elements
, "" @=?
withUrls id ""
-- Test that URLs are extracted from img's srcset
, "
" @=?
withUrls (const "foo") "
"
, "
" @=?
withUrls (const "bar") "
"
-- Invalid srcsets are left unchanged
, "
" @=?
withUrls (const "bar") "
"
]
, fromAssertions "toUrl"
[ "/foo/bar.html" @=? toUrl "foo/bar.html"
, "/foo/bar.html" @=? toUrl "foo\\bar.html" -- Windows-specific
, "/" @=? toUrl "/"
, "/funny-pics.html" @=? toUrl "/funny-pics.html"
, "/funny%20pics.html" @=? toUrl "funny pics.html"
-- Test various reserved characters (RFC 3986, section 2.2)
, "/%21%2A%27%28%29%3B%3A%40%26.html" @=? toUrl "/!*'();:@&.html"
, "/%3D%2B%24%2C/%3F%23%5B%5D.html" @=? toUrl "=+$,/?#[].html"
-- Test various characters that are nor reserved, nor unreserved.
, "/%E3%81%82%F0%9D%90%87%E2%88%80" @=? toUrl "\12354\119815\8704"
]
, fromAssertions "toSiteRoot"
[ ".." @=? toSiteRoot "/foo/bar.html"
, "." @=? toSiteRoot "index.html"
, "." @=? toSiteRoot "/index.html"
, "../.." @=? toSiteRoot "foo/bar/qux"
, ".." @=? toSiteRoot "./foo/bar.html"
, ".." @=? toSiteRoot "/foo/./bar.html"
]
, fromAssertions "isExternal"
[ True @=? isExternal "http://reddit.com"
, True @=? isExternal "https://mail.google.com"
, True @=? isExternal "//ajax.googleapis.com"
, False @=? isExternal "../header.png"
, False @=? isExternal "/foo/index.html"
]
, fromAssertions "stripTags"
[ "foo" @=? stripTags "foo
"
, "foo bar" @=? stripTags "foo
bar"
, "foo" @=? stripTags "foo
"
]
]