hablo/test/XML/Card/Component.hs

91 lines
3.2 KiB
Haskell
Raw Permalink Normal View History

{-# 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 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
)
2023-08-20 22:24:58 +02:00
import Test.HUnit (Test(..), assertEqual)
import Utils (labeled, testGroup)
2023-08-20 22:24:58 +02:00
check :: HasCard a => IO Blog -> a -> (Text, Text, Maybe String, String, String) -> IO ()
check getBlog input (expectedCT, expectedD, expectedI, expectedT, expectedU) =
2023-08-20 22:24:58 +02:00
getBlog >>= runReaderT checkCard
where
checkCard = do
liftIO . assertEqual "card types" expectedCT =<< cardType input
liftIO . assertEqual "descriptions" expectedD =<< description input
liftIO . assertEqual "images" expectedI =<< image input
liftIO . assertEqual "titles" expectedT =<< title input
liftIO . assertEqual "urls" expectedU =<< urlPath input
articleCard :: Test
2023-08-20 22:24:58 +02:00
articleCard = testGroup "Article cards" $ labeled
[ ("simple article components"
, TestCase $ check Blog.simple Article.simple
( "article"
, "It's a test"
, Just "test.png"
, "Some test"
, "articles/test.html" ))
, ("article components without description"
, TestCase $ 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"
, TestCase $ check Blog.simple Article.noImage
( "article"
, "It's a test"
, Nothing
, "Some test"
, "articles/test.html" )) ]
articlesListCard :: Test
2023-08-20 22:24:58 +02:00
articlesListCard = testGroup "Articles list cards" $ labeled
[ ("short untagged page component"
, TestCase (ArticlesList.shortMain >>=
(flip (check Blog.simple)
( "website"
, "Latest articles"
, Nothing
, "The Test Blog"
, "index.html"))))
, ("long untagged page component"
, TestCase (ArticlesList.longMain >>=
(flip (check Blog.simple)
( "website"
, "All articles"
, Nothing
, "The Test Blog"
, "all.html"))))
, ("short tagged page component"
, TestCase (ArticlesList.shortTesting >>=
(flip (check Blog.simple)
( "website"
, "Latest articles tagged testing"
, Nothing
, "The Test Blog - testing"
, "testing/index.html"))))
, ("long tagged page component"
, TestCase (ArticlesList.longTesting >>=
(flip (check Blog.simple)
( "website"
, "All articles tagged testing"
, Nothing
, "The Test Blog - testing"
, "testing/all.html")))) ]
test :: Test
2023-08-20 22:24:58 +02:00
test = testGroup "Cards components" [articleCard, articlesListCard]