91 lines
3.2 KiB
Haskell
91 lines
3.2 KiB
Haskell
{-# 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
|
|
)
|
|
import Test.HUnit (Test(..), assertEqual)
|
|
import Utils (labeled, testGroup)
|
|
|
|
check :: HasCard a => IO Blog -> a -> (Text, Text, Maybe String, String, String) -> IO ()
|
|
check getBlog input (expectedCT, expectedD, expectedI, expectedT, expectedU) =
|
|
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
|
|
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
|
|
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
|
|
test = testGroup "Cards components" [articleCard, articlesListCard]
|