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