Also add end-to-end test to verify the HTML generated for the cards by lucid
This commit is contained in:
parent
08990e8440
commit
ce3003178f
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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}
|
||||
|
|
|
|||
|
|
@ -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]
|
||||
|
|
|
|||
|
|
@ -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]
|
||||
|
|
@ -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]
|
||||
|
|
@ -0,0 +1 @@
|
|||
<meta property="og:url" content="https://test.net/all.html"><meta property="og:type" content="website"><meta property="og:title" content="The Test Blog"><meta property="og:description" content="All articles"><meta property="og:site_name" content="The Test Blog">
|
||||
|
|
@ -0,0 +1 @@
|
|||
<meta property="og:url" content="https://test.net/testing/all.html"><meta property="og:type" content="website"><meta property="og:title" content="The Test Blog - testing"><meta property="og:description" content="All articles tagged testing"><meta property="og:site_name" content="The Test Blog">
|
||||
|
|
@ -0,0 +1 @@
|
|||
<meta property="og:url" content="https://test.net/articles/test.html"><meta property="og:type" content="article"><meta property="og:title" content="Some test"><meta property="og:description" content="A new article on The Test Blog"><meta property="og:image" content="https://test.net/test.png"><meta property="og:site_name" content="The Test Blog">
|
||||
|
|
@ -0,0 +1 @@
|
|||
<meta property="og:url" content="https://test.net/articles/test.html"><meta property="og:type" content="article"><meta property="og:title" content="Some test"><meta property="og:description" content="It's a test"><meta property="og:site_name" content="The Test Blog">
|
||||
|
|
@ -0,0 +1 @@
|
|||
<meta property="og:url" content="https://test.net/index.html"><meta property="og:type" content="website"><meta property="og:title" content="The Test Blog"><meta property="og:description" content="Latest articles"><meta property="og:site_name" content="The Test Blog">
|
||||
|
|
@ -0,0 +1 @@
|
|||
<meta property="og:url" content="https://test.net/testing/index.html"><meta property="og:type" content="website"><meta property="og:title" content="The Test Blog - testing"><meta property="og:description" content="Latest articles tagged testing"><meta property="og:site_name" content="The Test Blog">
|
||||
|
|
@ -0,0 +1 @@
|
|||
<meta property="og:url" content="https://test.net/articles/test.html"><meta property="og:type" content="article"><meta property="og:title" content="Some test"><meta property="og:description" content="It's a test"><meta property="og:image" content="https://test.net/test.png"><meta property="og:site_name" content="The Test Blog">
|
||||
Loading…
Reference in New Issue