hablo/test/XML/Card/Output.hs

59 lines
2.6 KiB
Haskell
Raw Normal View History

module XML.Card.Output (
test
) where
import Blog (Blog(..), URLs(..))
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, subPath)
import Mock.Article as Article (
hostRelativeImage, noDescription, noImage, remoteImage, simple
)
import Mock.ArticlesList as ArticlesList (
longMain, longTesting, shortMain, shortTesting
)
import Pretty ((.$))
import System.FilePath ((</>))
import Utils (assertAll, assertEqual, simpleTest, tag, testDataPath)
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 "XML/Card/Output" </> 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")
, ("simple article output with subPath", check Blog.subPath Article.simple "subPath.html")
, ("article output without description"
, check Blog.simple Article.noDescription "noDescription.html")
, ("article output without image"
, check Blog.simple Article.noImage "noImage.html")
, ("article output with an image on a remote server"
, check Blog.simple Article.remoteImage "remoteImage.html")
, ("article output with an image in a host-relative folder"
, check Blog.simple Article.hostRelativeImage "hostRelativeImage.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]