{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedStrings #-}
module XML.Card (
    test
  ) where

import Article (Article(..))
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, noMeta, simple)
import Text.Printf (printf)

simpleTest :: [String] -> (String, IO Progress) -> Test
simpleTest tags (name, run) = Test testInstance
  where
    testInstance = TestInstance {
          run
        , name
        , tags
        , options = []
        , setOption = \_ _ -> Right testInstance
      }

wrong :: Show a => String -> a -> a -> IO Progress
wrong message expected actual = return . Finished . Fail $
  printf "%s: %s vs. %s" message (show expected) (show actual)

assertAll :: [(Bool, IO Progress, String)] -> IO Progress
assertAll = foldr assert (return $ Finished Pass)
  where
    assert (bool, badIssue, checkMessage) next =
      if bool then return $ Progress checkMessage next else badIssue

assertEqual :: (Show a, Eq a) => String -> a -> a -> (Bool, IO Progress, String)
assertEqual what a b =
  (a == b, wrong (what ++ " do not match !") a b, what ++ " ok")

checkCard :: Blog -> Article -> (Text, Text, Maybe String, String, String) -> IO Progress
checkCard blog article (expectedCT, expectedD, expectedI, expectedT, expectedU) =
  flip runReaderT blog $
    sequence [
          assertEqual "card types" expectedCT <$> cardType article
        , assertEqual "descriptions" expectedD <$> description article
        , assertEqual "images" expectedI <$> image article
        , assertEqual "titles" expectedT <$> title article
        , assertEqual "urls" expectedU <$> urlPath article
      ] >>= liftIO . assertAll

articleCard :: Test
articleCard =
  testGroup "Article cards" $ simpleTest ["xml", "card", "article"] <$> [
      ("simple article", checkCard Blog.simple Article.simple (
              "article"
            , "It's a test"
            , Just "test.png"
            , "Some test"
            , "https://test.net/articles/test.html"
          )
        )
    ]

test :: Test
test = testGroup "Cards" [articleCard]