diff --git a/test/Mock/Article.hs b/test/Mock/Article.hs
index 12f1cb1..e5cb4a3 100644
--- a/test/Mock/Article.hs
+++ b/test/Mock/Article.hs
@@ -1,12 +1,14 @@
module Mock.Article (
- noDescription
+ hostRelativeImage
+ , noDescription
, noImage
, noMeta
+ , remoteImage
, simple
) where
import Article (Article(..))
-import qualified Data.Map as Map (fromList)
+import qualified Data.Map as Map (fromList, insert)
import Markdown (Markdown(..))
import Mock.Markdown (article)
@@ -16,6 +18,16 @@ simple = Article article
noImage :: Article
noImage = Article $ article {metadata = Map.fromList [("summary", "It's a test")]}
+remoteImage :: Article
+remoteImage = Article $ article {metadata = setImage $ metadata article}
+ where
+ setImage = Map.insert "featuredImage" "https://somewhere.el.se/test.png"
+
+hostRelativeImage :: Article
+hostRelativeImage = Article $ article {metadata = setImage $ metadata article}
+ where
+ setImage = Map.insert "featuredImage" "/media/test.png"
+
noDescription :: Article
noDescription = Article $ article {metadata = Map.fromList [("featuredImage", "test.png")]}
diff --git a/test/Mock/Blog.hs b/test/Mock/Blog.hs
index fb182c0..182a726 100644
--- a/test/Mock/Blog.hs
+++ b/test/Mock/Blog.hs
@@ -3,6 +3,7 @@ module Mock.Blog (
noCards
, noRSS
, simple
+ , subPath
) where
import Blog (Blog(..))
@@ -12,7 +13,7 @@ import qualified Mock.Article (simple)
import qualified Mock.Blog.Path (defaultArticles)
import qualified Mock.Blog.Skin (simple)
import qualified Mock.Blog.Template (simple)
-import qualified Mock.Blog.URL (simple, noCards)
+import qualified Mock.Blog.URL (simple, subPath, noCards)
import qualified Mock.Blog.Wording (defaultWording)
simple :: IO Blog
@@ -32,6 +33,9 @@ simple =
, wording
}
+subPath :: IO Blog
+subPath = (\b -> b {urls = Mock.Blog.URL.subPath}) <$> simple
+
noCards :: IO Blog
noCards = (\b -> b {urls = Mock.Blog.URL.noCards}) <$> simple
diff --git a/test/Mock/Blog/URL.hs b/test/Mock/Blog/URL.hs
index 33ebe28..c945a81 100644
--- a/test/Mock/Blog/URL.hs
+++ b/test/Mock/Blog/URL.hs
@@ -1,13 +1,30 @@
module Mock.Blog.URL (
noCards
, simple
+ , subPath
) where
import Blog.URL (URLs(..))
+import Network.URL (Host(..), Protocol(..), URL(..), URLType(..))
simple :: URLs
simple = URLs {
- cards = Just "https://test.net"
+ cards = Just (URL {
+ url_type = Absolute (Host (HTTP True) "test.net" Nothing)
+ , url_path = ""
+ , url_params = []
+ })
+ , comments = Nothing
+ , rss = Nothing
+ }
+
+subPath :: URLs
+subPath = URLs {
+ cards = Just (URL {
+ url_type = Absolute (Host (HTTP True) "test.net" Nothing)
+ , url_path = "subPath"
+ , url_params = []
+ })
, comments = Nothing
, rss = Nothing
}
diff --git a/test/URLs.hs b/test/URLs.hs
new file mode 100644
index 0000000..60bd3be
--- /dev/null
+++ b/test/URLs.hs
@@ -0,0 +1,12 @@
+module URLs (
+ test
+ ) where
+
+import Blog.URL (URL(..))
+import Distribution.TestSuite
+import Utils (simpleTest, tag)
+
+test :: Test
+test = tag "URLs" . testGroup "URLs handling" $ simpleTest <$> [
+ ("nothing", return $ Finished Pass)
+ ]
diff --git a/test/XML/Card/Component.hs b/test/XML/Card/Component.hs
index db5a4bc..749b933 100644
--- a/test/XML/Card/Component.hs
+++ b/test/XML/Card/Component.hs
@@ -4,6 +4,7 @@ module XML.Card.Component (
) where
import Blog (Blog)
+import Blog.URL (pathRelative)
import Control.Monad.IO.Class (MonadIO(..))
import Control.Monad.Reader (runReaderT)
import Data.Text (Text)
@@ -14,9 +15,10 @@ import Mock.Article as Article (noDescription, noImage, simple)
import Mock.ArticlesList as ArticlesList (
longMain, longTesting, shortMain, shortTesting
)
+import Network.URL (URL)
import Utils (assertAll, assertEqual, simpleTest, tag)
-check :: HasCard a => IO Blog -> a -> (Text, Text, Maybe String, String, String) -> IO Progress
+check :: HasCard a => IO Blog -> a -> (Text, Text, Maybe URL, String, String) -> IO Progress
check getBlog input (expectedCT, expectedD, expectedI, expectedT, expectedU) =
getBlog >>= runReaderT (
sequence [
@@ -33,14 +35,14 @@ articleCard = tag "article" . testGroup "Article cards" $ simpleTest <$> [
("simple article components", check Blog.simple Article.simple (
"article"
, "It's a test"
- , Just "test.png"
+ , Just (pathRelative "test.png")
, "Some test"
, "articles/test.html"
))
, ("article components without description", check Blog.simple Article.noDescription (
"article"
, "A new article on The Test Blog"
- , Just "test.png"
+ , Just (pathRelative "test.png")
, "Some test"
, "articles/test.html"
))
diff --git a/test/XML/Card/Output.hs b/test/XML/Card/Output.hs
index 3da387b..746498e 100644
--- a/test/XML/Card/Output.hs
+++ b/test/XML/Card/Output.hs
@@ -9,8 +9,10 @@ import qualified Data.Text.Lazy.IO as Lazy (readFile)
import Distribution.TestSuite
import DOM.Card (HasCard(..), make)
import Lucid (renderTextT)
-import Mock.Blog as Blog (noCards, simple)
-import Mock.Article as Article (noDescription, noImage, simple)
+import Mock.Blog as Blog (noCards, simple, subPath)
+import Mock.Article as Article (
+ hostRelativeImage, noDescription, noImage, remoteImage, simple
+ )
import Mock.ArticlesList as ArticlesList (
longMain, longTesting, shortMain, shortTesting
)
@@ -31,8 +33,15 @@ check getBlog input expectedFile =
articleCard :: Test
articleCard = tag "article" . testGroup "Article cards" $ simpleTest <$> [
("simple article output", check Blog.simple Article.simple "simple.html")
- , ("article output without description", check Blog.simple Article.noDescription "noDescription.html")
- , ("article output without image", check Blog.simple Article.noImage "noImage.html")
+ , ("simple article output with subPath", check Blog.subPath Article.simple "subPath.html")
+ , ("article output without description"
+ , check Blog.simple Article.noDescription "noDescription.html")
+ , ("article output without image"
+ , check Blog.simple Article.noImage "noImage.html")
+ , ("article output with an image on a remote server"
+ , check Blog.simple Article.remoteImage "remoteImage.html")
+ , ("article output with an image in a host-relative folder"
+ , check Blog.simple Article.hostRelativeImage "hostRelativeImage.html")
, ("no card article output", check Blog.noCards Article.simple "/dev/null")
]
diff --git a/test/XML/Card/Output/hostRelativeImage.html b/test/XML/Card/Output/hostRelativeImage.html
new file mode 100644
index 0000000..720bbaa
--- /dev/null
+++ b/test/XML/Card/Output/hostRelativeImage.html
@@ -0,0 +1 @@
+
\ No newline at end of file
diff --git a/test/XML/Card/Output/remoteImage.html b/test/XML/Card/Output/remoteImage.html
new file mode 100644
index 0000000..3736736
--- /dev/null
+++ b/test/XML/Card/Output/remoteImage.html
@@ -0,0 +1 @@
+
\ No newline at end of file
diff --git a/test/XML/Card/Output/subPath.html b/test/XML/Card/Output/subPath.html
new file mode 100644
index 0000000..9571c32
--- /dev/null
+++ b/test/XML/Card/Output/subPath.html
@@ -0,0 +1 @@
+
\ No newline at end of file