Also add end-to-end test to verify the HTML generated for the cards by lucid

hablo.cabal

@@ -94,11 +94,14 @@ test-suite tests
                      , Mock.Markdown
                      , Utils
                      , XML.Card
+                     , XML.Card.Component
+                     , XML.Card.Output
   build-depends:       base
                      , containers
                      , filepath
                      , Cabal
                      , hablo-internals
+                     , lucid
                      , mtl
                      , text
   hs-source-dirs:      test

test/Mock/Blog.hs

@@ -1,7 +1,8 @@
 {-# LANGUAGE NamedFieldPuns #-}
 module Mock.Blog (
-      simple
+      noCards
     , noRSS
+    , simple
   ) where
 
 import Blog (Blog(..))
@@ -11,7 +12,7 @@ import qualified Mock.Article (simple)
 import qualified Mock.Blog.Path (simple)
 import qualified Mock.Blog.Skin (simple)
 import qualified Mock.Blog.Template (simple)
-import qualified Mock.Blog.URL (simple)
+import qualified Mock.Blog.URL (simple, noCards)
 import qualified Mock.Blog.Wording (defaultWording)
 
 simple :: IO Blog
@@ -31,5 +32,8 @@ simple =
       , wording
     }
 
+noCards :: IO Blog
+noCards = (\b -> b {urls = Mock.Blog.URL.noCards}) <$> simple
+
 noRSS :: IO Blog
 noRSS = (\b -> b {hasRSS = False}) <$> simple

test/Mock/Blog/URL.hs

@@ -1,12 +1,16 @@
 module Mock.Blog.URL (
-    simple
+      noCards
+    , simple
   ) where
 
 import Blog.URL (URL(..))
 
 simple :: URL
 simple = URL {
-      cards = Nothing
+      cards = Just "https://test.net"
     , comments = Nothing
     , rss = Nothing
   }
+
+noCards :: URL
+noCards = simple {cards = Nothing}

test/XML/Card.hs

@@ -1,96 +1,11 @@
-{-# LANGUAGE OverloadedStrings #-}
 module XML.Card (
     test
   ) where
 
-import Blog (Blog)
-import Control.Monad.IO.Class (MonadIO(..))
-import Control.Monad.Reader (runReaderT)
-import Data.Text (Text)
 import Distribution.TestSuite
-import DOM.Card (HasCard(..))
+import Utils (tag)
-import Mock.Blog as Blog (simple)
+import qualified XML.Card.Component as Component (test)
-import Mock.Article as Article (noDescription, noImage, simple)
+import qualified XML.Card.Output as Output (test)
-import Mock.ArticlesList as ArticlesList (
-    longMain, longTesting, shortMain, shortTesting
-  )
-import Utils (assertAll, assertEqual, simpleTest, tag)
-
-checkCard :: HasCard a => IO Blog -> a -> (Text, Text, Maybe String, String, String) -> IO Progress
-checkCard getBlog input (expectedCT, expectedD, expectedI, expectedT, expectedU) =
-  getBlog >>= runReaderT (
-      sequence [
-            assertEqual "card types" expectedCT <$> cardType input
-          , assertEqual "descriptions" expectedD <$> description input
-          , assertEqual "images" expectedI <$> image input
-          , assertEqual "titles" expectedT <$> title input
-          , assertEqual "urls" expectedU <$> urlPath input
-        ] >>= liftIO . assertAll
-    )
-
-articleCard :: Test
-articleCard = tag "article" . testGroup "Article cards" $ simpleTest <$> [
-      ("simple article", checkCard Blog.simple Article.simple (
-              "article"
-            , "It's a test"
-            , Just "test.png"
-            , "Some test"
-            , "articles/test.html"
-          )
-        )
-    , ("article without description", checkCard Blog.simple Article.noDescription (
-              "article"
-            , "A new article on The Test Blog"
-            , Just "test.png"
-            , "Some test"
-            , "articles/test.html"
-          )
-        )
-    , ("article without image", checkCard Blog.simple Article.noImage (
-              "article"
-            , "It's a test"
-            , Nothing
-            , "Some test"
-            , "articles/test.html"
-          )
-        )
-  ]
-
-articlesListCard :: Test
-articlesListCard = tag "articlesList" . testGroup "Articles list cards" $ simpleTest <$> [
-      ("short untagged page", ArticlesList.shortMain >>= (flip (checkCard Blog.simple) (
-              "website"
-            , "Latest articles"
-            , Nothing
-            , "The Test Blog"
-            , "index.html"
-          )
-        ))
-    , ("long untagged page", ArticlesList.longMain >>= (flip (checkCard Blog.simple) (
-              "website"
-            , "All articles"
-            , Nothing
-            , "The Test Blog"
-            , "all.html"
-          )
-        ))
-    , ("short tagged page", ArticlesList.shortTesting >>= (flip (checkCard Blog.simple) (
-              "website"
-            , "Latest articles tagged testing"
-            , Nothing
-            , "The Test Blog - testing"
-            , "testing/index.html"
-          )
-        ))
-    , ("long tagged page", ArticlesList.longTesting >>= (flip (checkCard Blog.simple) (
-              "website"
-            , "All articles tagged testing"
-            , Nothing
-            , "The Test Blog - testing"
-            , "testing/all.html"
-          )
-        ))
-  ]
 
 test :: Test
-test = tag "card" $ testGroup "Cards" [articleCard, articlesListCard]
+test = tag "card" $ testGroup "Cards" [Component.test, Output.test]

test/XML/Card/Component.hs

@@ -0,0 +1,89 @@
+{-# LANGUAGE OverloadedStrings #-}
+module XML.Card.Component (
+    test
+  ) where
+
+import Blog (Blog)
+import Control.Monad.IO.Class (MonadIO(..))
+import Control.Monad.Reader (runReaderT)
+import Data.Text (Text)
+import Distribution.TestSuite
+import DOM.Card (HasCard(..))
+import Mock.Blog as Blog (simple)
+import Mock.Article as Article (noDescription, noImage, simple)
+import Mock.ArticlesList as ArticlesList (
+    longMain, longTesting, shortMain, shortTesting
+  )
+import Utils (assertAll, assertEqual, simpleTest, tag)
+
+check :: HasCard a => IO Blog -> a -> (Text, Text, Maybe String, String, String) -> IO Progress
+check getBlog input (expectedCT, expectedD, expectedI, expectedT, expectedU) =
+  getBlog >>= runReaderT (
+      sequence [
+            assertEqual "card types" expectedCT <$> cardType input
+          , assertEqual "descriptions" expectedD <$> description input
+          , assertEqual "images" expectedI <$> image input
+          , assertEqual "titles" expectedT <$> title input
+          , assertEqual "urls" expectedU <$> urlPath input
+        ] >>= liftIO . assertAll
+    )
+
+articleCard :: Test
+articleCard = tag "article" . testGroup "Article cards" $ simpleTest <$> [
+      ("simple article components", check Blog.simple Article.simple (
+            "article"
+          , "It's a test"
+          , Just "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"
+          , "Some test"
+          , "articles/test.html"
+        ))
+    , ("article components without image", check Blog.simple Article.noImage (
+            "article"
+          , "It's a test"
+          , Nothing
+          , "Some test"
+          , "articles/test.html"
+        ))
+  ]
+
+articlesListCard :: Test
+articlesListCard = tag "articlesList" . testGroup "Articles list cards" $ simpleTest <$> [
+      ("short untagged page component", ArticlesList.shortMain >>= (flip (check Blog.simple) (
+            "website"
+          , "Latest articles"
+          , Nothing
+          , "The Test Blog"
+          , "index.html"
+        )))
+    , ("long untagged page component", ArticlesList.longMain >>= (flip (check Blog.simple) (
+            "website"
+          , "All articles"
+          , Nothing
+          , "The Test Blog"
+          , "all.html"
+        )))
+    , ("short tagged page component", ArticlesList.shortTesting >>= (flip (check Blog.simple) (
+            "website"
+          , "Latest articles tagged testing"
+          , Nothing
+          , "The Test Blog - testing"
+          , "testing/index.html"
+        )))
+    , ("long tagged page component", ArticlesList.longTesting >>= (flip (check Blog.simple) (
+            "website"
+          , "All articles tagged testing"
+          , Nothing
+          , "The Test Blog - testing"
+          , "testing/all.html"
+        )))
+  ]
+
+test :: Test
+test = tag "component" $ testGroup "Cards components" [articleCard, articlesListCard]

test/XML/Card/Output.hs

@@ -0,0 +1,52 @@
+module XML.Card.Output (
+    test
+  ) where
+
+import Blog (Blog(..), URL(..))
+import Control.Monad.IO.Class (MonadIO(..))
+import Control.Monad.Reader (asks, runReaderT)
+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.ArticlesList as ArticlesList (
+    longMain, longTesting, shortMain, shortTesting
+  )
+import Pretty ((.$))
+import System.FilePath ((</>))
+import Utils (assertAll, assertEqual, simpleTest, tag)
+
+testDataPath :: FilePath
+testDataPath = "test/XML/Card/Output"
+
+check :: HasCard a => IO Blog -> a -> FilePath -> IO Progress
+check getBlog input expectedFile =
+  getBlog >>= runReaderT (do
+      actual <- renderTextT $ maybe (return ()) (DOM.Card.make input) =<< (asks $urls.$cards)
+      expected <- liftIO . Lazy.readFile $ testDataPath </> expectedFile
+      liftIO $ assertAll [
+          assertEqual "card HTML output" expected actual
+        ]
+    )
+
+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")
+    , ("no card article output", check Blog.noCards Article.simple "/dev/null")
+  ]
+
+articlesListCard :: Test 
+articlesListCard = tag "article" . testGroup "Article cards" $ simpleTest <$> [
+      ("short untagged page output", ArticlesList.shortMain >>= flip (check Blog.simple) "shortMain.html")
+    , ("long untagged page output", ArticlesList.longMain >>= flip (check Blog.simple) "longMain.html")
+    , ("short tagged page output", ArticlesList.shortTesting >>= flip (check Blog.simple) "shortTesting.html")
+    , ("long tagged page output", ArticlesList.longTesting >>= flip (check Blog.simple) "longTesting.html")
+    , ("no card articlesList output", ArticlesList.shortMain >>= flip (check Blog.noCards) "/dev/null")
+  ]
+
+test :: Test
+test = tag "output" $ testGroup "Cards outputs" [articleCard, articlesListCard]

test/XML/Card/Output/longMain.html

@@ -0,0 +1 @@
+<meta property="og:url" content="https://test.net/all.html"><meta property="og:type" content="website"><meta property="og:title" content="The Test Blog"><meta property="og:description" content="All articles"><meta property="og:site_name" content="The Test Blog">

test/XML/Card/Output/longTesting.html

@@ -0,0 +1 @@
+<meta property="og:url" content="https://test.net/testing/all.html"><meta property="og:type" content="website"><meta property="og:title" content="The Test Blog - testing"><meta property="og:description" content="All articles tagged testing"><meta property="og:site_name" content="The Test Blog">

test/XML/Card/Output/noDescription.html

@@ -0,0 +1 @@
+<meta property="og:url" content="https://test.net/articles/test.html"><meta property="og:type" content="article"><meta property="og:title" content="Some test"><meta property="og:description" content="A new article on The Test Blog"><meta property="og:image" content="https://test.net/test.png"><meta property="og:site_name" content="The Test Blog">

test/XML/Card/Output/noImage.html

@@ -0,0 +1 @@
+<meta property="og:url" content="https://test.net/articles/test.html"><meta property="og:type" content="article"><meta property="og:title" content="Some test"><meta property="og:description" content="It&#39;s a test"><meta property="og:site_name" content="The Test Blog">

test/XML/Card/Output/shortMain.html

@@ -0,0 +1 @@
+<meta property="og:url" content="https://test.net/index.html"><meta property="og:type" content="website"><meta property="og:title" content="The Test Blog"><meta property="og:description" content="Latest articles"><meta property="og:site_name" content="The Test Blog">

test/XML/Card/Output/shortTesting.html

@@ -0,0 +1 @@
+<meta property="og:url" content="https://test.net/testing/index.html"><meta property="og:type" content="website"><meta property="og:title" content="The Test Blog - testing"><meta property="og:description" content="Latest articles tagged testing"><meta property="og:site_name" content="The Test Blog">

test/XML/Card/Output/simple.html

@@ -0,0 +1 @@
+<meta property="og:url" content="https://test.net/articles/test.html"><meta property="og:type" content="article"><meta property="og:title" content="Some test"><meta property="og:description" content="It&#39;s a test"><meta property="og:image" content="https://test.net/test.png"><meta property="og:site_name" content="The Test Blog">