97 lines
3.1 KiB
Haskell
97 lines
3.1 KiB
Haskell
{-# 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]
|