reanimate-svg-0.12.0.0: test/W3C.hs

module Main (main) where

import           Test.Tasty
import           Test.Tasty.Ingredients.Rerun (defaultMainWithRerun)
import           Test.Tasty.ExpectedFailure
import           Test.Tasty.HUnit
import qualified Data.ByteString.Char8 as BS
import Graphics.SvgTree
import Graphics.SvgTree.Printer
import System.Process
import System.Directory
import System.FilePath
import Data.List
import System.Environment
import Data.Algorithm.Diff
import Data.Algorithm.DiffOutput
import Data.Char

main :: IO ()
main = do
  args <- getArgs
  case args of
    [path] -> do
      haveFile <- doesFileExist path
      if haveFile
        then do
          raw <- readFile path
          golden <- sanitizeSvg raw
          cycled <- sanitizeSvg (cycleSvg golden)
          if golden == cycled
            then putStrLn "Good"
            else do
              putStrLn "Mismatch!"
              let d = getGroupedDiff (lines golden) (lines cycled) :: [Diff [String]]
                  ranges = diffToLineRanges d
              print (prettyDiffs ranges)
        else runTestSuite
    _ -> runTestSuite

runTestSuite :: IO ()
runTestSuite = do
  print =<< getCurrentDirectory
  good <- unitTestFolder "test/good"
  bad <- unitTestFolder "test/bad"
  defaultMainWithRerun $ testGroup "tests" [good, expectFail bad]

unitTestFolder :: FilePath -> IO TestTree
unitTestFolder path = do
  files <- sort <$> getDirectoryContents path
  return $ testGroup "animate"
    [ testSvg fullPath
    | file <- files
    , let fullPath = path </> file
    , takeExtension fullPath == ".svg"
    ]

testSvg :: FilePath -> TestTree
testSvg path = testCase (takeBaseName path) $ do
  raw <- readFile path
  golden <- prettyPrintSvg =<< sanitizeSvg raw
  cycled <- prettyPrintSvg (cycleSvg golden)
  assert (golden == cycled)

-- Sanitize SVG using rsvg-convert
sanitizeSvg :: String -> IO String
sanitizeSvg = readProcess "rsvg-convert" ["--format", "png"]

-- Ugly hack to ignore the differences between #FFF and #fff.
lowerHashValues :: String -> String
lowerHashValues ('#':more) = '#' : map toLower before ++ lowerHashValues after
  where
    (before, after) = splitAt 6 more
lowerHashValues (c:cs) = c:lowerHashValues cs
lowerHashValues [] = []

prettyPrintSvg :: String -> IO String
prettyPrintSvg = fmap lowerHashValues .
  readProcess "svgo" ["--input=-", "--output=-", "--pretty"
    , "--enable=sortAttrs,convertColors"
    , "--disable=cleanupIDs,prefixIds,convertTransform,mergePaths,collapseGroups" ]

-- Parse and print SVG with reanimate-svg library.
cycleSvg :: String -> String
cycleSvg = 
  maybe "Failed to parse" ppDocument . parseSvgFile "input" . BS.pack