mjml-0.1.0.0: test/Main.hs

-- | Render every fixture and compare it with the HTML MJML itself produced.
--
-- @fixtures/NAME.mjml@ is the input and @fixtures/NAME.html@ MJML 5's output,
-- regenerated by @scripts/update-fixtures.mjs@. Arguments restrict the run to
-- fixtures whose name contains one of them; @--verbose@ prints each result.
module Main (main) where

import Control.Monad (forM, unless, when)
import Data.Char (isAlphaNum, isAscii)
import Data.List (isInfixOf, isSuffixOf, sort)
import Data.Text (Text)
import Data.Text qualified as T
import Data.Text.IO qualified as T
import System.Directory (doesFileExist, listDirectory)
import System.Environment (getArgs)
import System.Exit (exitFailure)
import System.FilePath (dropExtension, (</>))

import HtmlCompare (compareHtml)
import Text.Mjml (MjmlError (..), defaultOptions, renderText)


fixtureDir :: FilePath
fixtureDir = "test/fixtures"


main :: IO ()
main = do
    args <- getArgs
    let verbose = "--verbose" `elem` args
        filters = filter (/= "--verbose") args
    names <-
        sort . map dropExtension . filter (".mjml" `isSuffixOf`) <$> listDirectory fixtureDir
    let selected = [n | n <- names, null filters || any (`isInfixOf` n) filters]
    results <- forM selected $ \n -> do
        let html = fixtureDir </> n <> ".html"
        present <- doesFileExist html
        if not present
            then pure Nothing
            else do
                source <- T.readFile (fixtureDir </> n <> ".mjml")
                expected <- T.readFile html
                let outcome = case renderText defaultOptions source of
                        Left (MjmlError e) -> Just ("render error: " <> e)
                        Right out -> compareHtml (normalizeIds expected) (normalizeIds out)
                case outcome of
                    Nothing -> when verbose (putStrLn ("ok   " <> n))
                    Just why -> do
                        putStrLn ("FAIL " <> n)
                        when (verbose || length selected <= 3) (T.putStrLn why)
                pure (Just (n, outcome))
    let ran = [r | Just r <- results]
        failed = [n | (n, Just _) <- ran]
    putStrLn (show (length ran - length failed) <> "/" <> show (length ran) <> " fixtures match MJML")
    unless (null failed) exitFailure


-- | Generated identifiers are random in MJML; both sides use zeros.
--
-- As in mrml's fixture script: an identifier a @for@ attribute points at
-- (accordion, navbar) becomes @00000000@ in both its @for@ and its @id@, and a
-- carousel's identifier becomes @00000000@ wherever it names a class or radio.
normalizeIds :: Text -> Text
normalizeIds = normalizeCarouselIds . normalizeForIds


normalizeForIds :: Text -> Text
normalizeForIds t = foldr replaceId t ids
  where
    ids =
        [ v
        | chunk <- drop 1 (T.splitOn "for=\"" t)
        , let v = T.takeWhile (/= '"') chunk
        , not (T.null v)
        , T.all isAsciiAlphaNum v
        ]
    replaceId v =
        T.replace ("for=\"" <> v <> "\"") "for=\"00000000\""
            . T.replace ("id=\"" <> v <> "\"") "id=\"00000000\""


normalizeCarouselIds :: Text -> Text
normalizeCarouselIds t = foldr replaceId t ids
  where
    ids =
        [ v
        | chunk <- drop 1 (T.splitOn "mj-carousel-" t)
        , let v = T.takeWhile isAsciiAlphaNum chunk
        , T.length v >= 12 && T.length v <= 16
        , T.take 1 (T.drop (T.length v) chunk) == "-"
        ]
    replaceId v =
        T.replace ("mj-carousel-" <> v <> "-") "mj-carousel-00000000-"
            . T.replace ("mj-carousel-radio-" <> v) "mj-carousel-radio-00000000"


isAsciiAlphaNum :: Char -> Bool
isAsciiAlphaNum c = isAscii c && isAlphaNum c