Add test to catch faulty behaviour in favicon URLs

hablo.cabal

@@ -94,11 +94,13 @@ test-suite tests
                      , Mock.Blog.Wording
                      , Mock.Collection
                      , Mock.Markdown
+                     , Mock.URL
                      , Structure
                      , Utils
                      , XML.Card
                      , XML.Card.Component
                      , XML.Card.Output
+                     , XML.Favicon
   build-depends:       base
                      , Cabal
                      , containers

src/Blog/Skin.hs

@@ -4,6 +4,7 @@
 module Blog.Skin (
       Skin(..)
     , build
+    , findImage
   ) where
 
 import Arguments (Arguments)

test/Mock/Blog/URL.hs

@@ -5,12 +5,12 @@ module Mock.Blog.URL (
   ) where
 
 import Blog.URL (AbsoluteURL(..), URLs(..))
-import Network.URL (Host(..), Protocol(..))
+import Mock.URL (testHost)
 
 simple :: URLs
 simple = URLs {
       cards = Just (AbsoluteURL {
-            Blog.URL.host = Host (HTTP True) "test.net" Nothing
+            Blog.URL.host = testHost
           , urlPath = ""
           , urlParams = []
         })
@@ -21,7 +21,7 @@ simple = URLs {
 subPath :: URLs
 subPath = URLs {
       cards = Just (AbsoluteURL {
-            Blog.URL.host = Host (HTTP True) "test.net" Nothing
+            Blog.URL.host = testHost
           , urlPath = "subPath"
           , urlParams = []
         })

test/Mock/URL.hs

@@ -0,0 +1,35 @@
+module Mock.URL (
+      cdnFavicon
+    , localDiscovered
+    , localFavicon
+    , testHost
+  ) where
+
+import Network.URL (Host(..), Protocol(..), URL(..), URLType(..))
+
+testHost :: Host
+testHost = Host (HTTP True) "test.net" Nothing
+
+cdn :: Host
+cdn = Host (HTTP True) "cdn.net" Nothing
+
+cdnFavicon :: URL
+cdnFavicon = URL {
+      url_type = Absolute cdn
+    , url_path = "favicon.png"
+    , url_params = []
+  }
+
+localFavicon :: URL
+localFavicon = URL {
+      url_type = HostRelative
+    , url_path = "favicon.png"
+    , url_params = []
+  }
+
+localDiscovered :: URL
+localDiscovered = URL {
+      url_type = HostRelative
+    , url_path = "skin/favicon.png"
+    , url_params = []
+  }

test/Tests.hs

@@ -6,9 +6,11 @@ import Distribution.TestSuite
 import qualified Structure (test)
 import Utils (tag)
 import qualified XML.Card (test)
+import qualified XML.Favicon (test)
 
 tests :: IO [Test]
 tests = return $ tag "xml" <$> [
       XML.Card.test
+    , XML.Favicon.test
     , Structure.test
   ]

test/XML/Favicon.hs

@@ -0,0 +1,25 @@
+module XML.Favicon (
+    test
+  ) where
+
+import Blog.Skin (findImage)
+import Distribution.TestSuite
+import Mock.URL (cdnFavicon, localDiscovered, localFavicon)
+import Network.URL (URL)
+import Utils (assertAll, assertEqual, simpleTest, tag)
+
+check :: IO (Maybe URL) -> Maybe URL -> IO Progress
+check getter expected = do
+  actual <- getter
+  assertAll $ [
+      assertEqual "URLs" actual expected
+    ]
+
+test :: Test
+test = tag "favicon" . testGroup "Favicons" $ simpleTest <$> [
+      ("auto-discover", check (findImage "favicon" Nothing) (Just localDiscovered))
+    , ("none", check (findImage "blerp" Nothing) Nothing)
+    , ("manual absolute", check (findImage "" (Just "https://cdn.net/favicon.png")) (Just cdnFavicon))
+    , ("manual relative", check (findImage "" (Just "favicon.ico")) (Just localFavicon))
+    , ("manual host-relative", check (findImage "" (Just "/favicon.ico")) (Just localFavicon))
+  ]