Tissevert/hablo
1
0
Fork 0
Code Issues Pull requests Releases Wiki Activity

Also add end-to-end test to verify the HTML generated for the cards by lucid

Browse source
This commit is contained in:
Tissevert 2020-06-09 17:45:54 +02:00
parent 08990e8440
commit ce3003178f
13 changed files with 167 additions and 93 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

3
hablo.cabal
View file

@ -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

8
test/Mock/Blog.hs
View file

@ -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

8
test/Mock/Blog/URL.hs
View file

@ -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}

93
test/XML/Card.hs
View file

@ -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]

89
test/XML/Card/Component.hs Normal file
View file

@ -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]

52
test/XML/Card/Output.hs Normal file
View file

@ -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]

1
test/XML/Card/Output/longMain.html Normal file
View file

@ -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">

1
test/XML/Card/Output/longTesting.html Normal file
View file

@ -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">

1
test/XML/Card/Output/noDescription.html Normal file
View file

@ -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">

1
test/XML/Card/Output/noImage.html Normal file
View file

@ -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&#39;s a test"><meta property="og:site_name" content="The Test Blog">

1
test/XML/Card/Output/shortMain.html Normal file
View file

@ -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">

1
test/XML/Card/Output/shortTesting.html Normal file
View file

@ -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">

1
test/XML/Card/Output/simple.html Normal file
View file

@ -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&#39;s a test"><meta property="og:image" content="https://test.net/test.png"><meta property="og:site_name" content="The Test Blog">