From ce3003178f597f466ccfc76a9d39298c4e4ae718 Mon Sep 17 00:00:00 2001 From: Tissevert Date: Tue, 9 Jun 2020 17:45:54 +0200 Subject: [PATCH] Also add end-to-end test to verify the HTML generated for the cards by lucid --- hablo.cabal | 3 + test/Mock/Blog.hs | 8 ++- test/Mock/Blog/URL.hs | 8 ++- test/XML/Card.hs | 93 ++----------------------- test/XML/Card/Component.hs | 89 +++++++++++++++++++++++ test/XML/Card/Output.hs | 52 ++++++++++++++ test/XML/Card/Output/longMain.html | 1 + test/XML/Card/Output/longTesting.html | 1 + test/XML/Card/Output/noDescription.html | 1 + test/XML/Card/Output/noImage.html | 1 + test/XML/Card/Output/shortMain.html | 1 + test/XML/Card/Output/shortTesting.html | 1 + test/XML/Card/Output/simple.html | 1 + 13 files changed, 167 insertions(+), 93 deletions(-) create mode 100644 test/XML/Card/Component.hs create mode 100644 test/XML/Card/Output.hs create mode 100644 test/XML/Card/Output/longMain.html create mode 100644 test/XML/Card/Output/longTesting.html create mode 100644 test/XML/Card/Output/noDescription.html create mode 100644 test/XML/Card/Output/noImage.html create mode 100644 test/XML/Card/Output/shortMain.html create mode 100644 test/XML/Card/Output/shortTesting.html create mode 100644 test/XML/Card/Output/simple.html diff --git a/hablo.cabal b/hablo.cabal index 88e3628..f5e4f4c 100644 --- a/hablo.cabal +++ b/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 diff --git a/test/Mock/Blog.hs b/test/Mock/Blog.hs index 92bd3d0..279646c 100644 --- a/test/Mock/Blog.hs +++ b/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 diff --git a/test/Mock/Blog/URL.hs b/test/Mock/Blog/URL.hs index 6954787..5d14fa4 100644 --- a/test/Mock/Blog/URL.hs +++ b/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} diff --git a/test/XML/Card.hs b/test/XML/Card.hs index 58fb402..315ade7 100644 --- a/test/XML/Card.hs +++ b/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 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) - -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" - ) - )) - ] +import Utils (tag) +import qualified XML.Card.Component as Component (test) +import qualified XML.Card.Output as Output (test) test :: Test -test = tag "card" $ testGroup "Cards" [articleCard, articlesListCard] +test = tag "card" $ testGroup "Cards" [Component.test, Output.test] diff --git a/test/XML/Card/Component.hs b/test/XML/Card/Component.hs new file mode 100644 index 0000000..db5a4bc --- /dev/null +++ b/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] diff --git a/test/XML/Card/Output.hs b/test/XML/Card/Output.hs new file mode 100644 index 0000000..4e316e2 --- /dev/null +++ b/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] diff --git a/test/XML/Card/Output/longMain.html b/test/XML/Card/Output/longMain.html new file mode 100644 index 0000000..4c130b3 --- /dev/null +++ b/test/XML/Card/Output/longMain.html @@ -0,0 +1 @@ + \ No newline at end of file diff --git a/test/XML/Card/Output/longTesting.html b/test/XML/Card/Output/longTesting.html new file mode 100644 index 0000000..90cdb49 --- /dev/null +++ b/test/XML/Card/Output/longTesting.html @@ -0,0 +1 @@ + \ No newline at end of file diff --git a/test/XML/Card/Output/noDescription.html b/test/XML/Card/Output/noDescription.html new file mode 100644 index 0000000..2568e41 --- /dev/null +++ b/test/XML/Card/Output/noDescription.html @@ -0,0 +1 @@ + \ No newline at end of file diff --git a/test/XML/Card/Output/noImage.html b/test/XML/Card/Output/noImage.html new file mode 100644 index 0000000..920bac5 --- /dev/null +++ b/test/XML/Card/Output/noImage.html @@ -0,0 +1 @@ + \ No newline at end of file diff --git a/test/XML/Card/Output/shortMain.html b/test/XML/Card/Output/shortMain.html new file mode 100644 index 0000000..2442979 --- /dev/null +++ b/test/XML/Card/Output/shortMain.html @@ -0,0 +1 @@ + \ No newline at end of file diff --git a/test/XML/Card/Output/shortTesting.html b/test/XML/Card/Output/shortTesting.html new file mode 100644 index 0000000..95c3cc5 --- /dev/null +++ b/test/XML/Card/Output/shortTesting.html @@ -0,0 +1 @@ + \ No newline at end of file diff --git a/test/XML/Card/Output/simple.html b/test/XML/Card/Output/simple.html new file mode 100644 index 0000000..8477739 --- /dev/null +++ b/test/XML/Card/Output/simple.html @@ -0,0 +1 @@ + \ No newline at end of file