hablo/test/XML/Card/Output.hs
2023-08-20 22:35:03 +02:00

61 lines
2.3 KiB
Haskell

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 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 Test.HUnit (Test(..), assertEqual)
import Utils (labeled, testDataPath, testGroup)
check :: HasCard a => IO Blog -> a -> FilePath -> IO ()
check getBlog input expectedFile = getBlog >>= runReaderT checkHTML
where
checkHTML = do
actual <- renderTextT $ maybe (return ()) (DOM.Card.make input) =<< (asks $urls.$cards)
expected <- liftIO . Lazy.readFile $ testDataPath "XML/Card/Output" </> expectedFile
liftIO $ assertEqual "card HTML output" expected actual
articleCard :: Test
articleCard = testGroup "Article cards" $ labeled
[ ("simple article output"
, TestCase $ check Blog.simple Article.simple "simple.html")
, ("article output without description"
, TestCase $ check Blog.simple Article.noDescription "noDescription.html")
, ("article output without image"
, TestCase $ check Blog.simple Article.noImage "noImage.html")
, ("no card article output"
, TestCase $ check Blog.noCards Article.simple "/dev/null") ]
articlesListCard :: Test
articlesListCard = testGroup "Article list cards" $ labeled
[ ("short untagged page output"
, TestCase
(ArticlesList.shortMain >>= flip (check Blog.simple) "shortMain.html"))
, ("long untagged page output"
, TestCase
(ArticlesList.longMain >>= flip (check Blog.simple) "longMain.html"))
, ("short tagged page output"
, TestCase
(ArticlesList.shortTesting
>>= flip (check Blog.simple) "shortTesting.html"))
, ("long tagged page output"
, TestCase
(ArticlesList.longTesting
>>= flip (check Blog.simple) "longTesting.html"))
, ("no card articlesList output"
, TestCase
(ArticlesList.shortMain >>= flip (check Blog.noCards) "/dev/null")) ]
test :: Test
test = testGroup "Cards outputs" [articleCard, articlesListCard]