hablo/test/XML/Card/Output.hs

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]