{-# 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" ) )) ] test :: Test test = tag "card" $ testGroup "Cards" [articleCard, articlesListCard]