{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE QuasiQuotes #-} {-# LANGUAGE TypeApplications #-} module HTMLRenderTests where import Control.Monad ( unless ) import qualified Data.List as L import Data.String ( fromString ) import Data.Text ( Text ) import qualified Data.Text as T import qualified Data.Text.Lazy as TL import Lens.Micro ( (^.), (.~), (%~), (&) ) import Test.Tasty import Test.Tasty.HUnit import Text.HTML.Parser ( parseTokens, renderToken , canonicalizeTokens , Token( TagOpen, TagSelfClose ) ) import SampleTables import TestQQDefs import qualified Data.KVITable as KVI import qualified Data.KVITable.Render as KTR import qualified Data.KVITable.Render.HTML as KTRH cmpTables :: Text -> Text -> Text -> IO () cmpTables nm actual expected = do let expH = normalize $ parseTokens $ T.concat $ fmap T.strip $ T.lines expected actH = normalize $ parseTokens actual normalize = fmap sortAttrs . canonicalizeTokens sortAttrs (TagOpen n a) = TagOpen n $ L.sort a sortAttrs (TagSelfClose n a) = TagSelfClose n $ L.sort a sortAttrs t = t unless (expH == actH) $ do let dl (e,a) = if e == a then db e else de " ↱" e <> "\n " <> da " ↳" a db b = "| > " <> b de m e = "|" <> m <> "expect> " <> e da m a = "|" <> m <> "actual> " <> a el = fmap (TL.toStrict . renderToken) expH al = fmap (TL.toStrict . renderToken) actH addnum n l = let nt = T.pack (show n) nl = T.length nt in T.take (4 - nl) " " <> nt <> l let details = ("MISMATCH between " <> T.pack (show $ length el) <> " expected and " <> T.pack (show $ length al) <> " actual for " <> nm) : (fmap (uncurry addnum) $ zip [1..] $ concat $ -- Highly simplistic "diff" output assumes -- correlated lines: added or removed lines just -- cause everything to shown as different from that -- point forward. [ fmap dl $ zip el al , fmap (de "∌ ") $ drop (length al) el , fmap (da "∹ ") $ drop (length el) al ]) -- writeFile "test.html" $ T.unpack $ T.unlines al assertFailure $ T.unpack $ T.unlines details testHTMLRendering = testGroup "HTML rendering" $ let kvi0 = mempty :: KVI.KVITable Text cfg0 = KTR.defaultRenderConfig cfgWBlankRows = cfg0 { KTR.hideBlankRows = False } in [ testCase "empty table, hide blank" $ cmpTables "empty table, hide blank" (KTRH.render cfg0 kvi0) [sq| ****
Value |
|---|
Value |
|---|
foo |
dog |
Value |
|---|