test/Golden.hs

   1 module Golden where
   2
   3 import Control.Monad (Monad(..), sequence)
   4 import Data.Either (Either(..))
   5 import Data.Function (($), (.))
   6 import Data.Functor ((<$>))
   7 import Data.Semigroup (Semigroup(..))
   8 import Data.String (String)
   9 import System.IO (IO, FilePath)
  10 import Text.Show (Show(..))
  11 import qualified Data.ByteString.Lazy as BSL
  12 import qualified Data.List as List
  13 import qualified Data.Text.Lazy          as TL
  14 import qualified Data.Text.Lazy.Encoding as TL
  15
  16 import Test.Tasty
  17 import Test.Tasty.Golden
  18
  19 import qualified Symantic.XML.RelaxNG as RelaxNG
  20 import qualified Symantic.Atom as Atom
  21
  22 goldensIO :: IO TestTree
  23 goldensIO =
  24   testGroup "Golden" <$>
  25   sequence
  26    [ goldensAtom
  27    ]
  28
  29 goldensAtom :: IO TestTree
  30 goldensAtom = do
  31   inputFiles <- List.sort <$> findByExtension [".xml"] "test/Golden"
  32   return $ testGroup "RelaxNG"
  33    [ testGroup "Validate"
  34      [ testGolden inputFile ".read" $
  35       ((TL.encodeUtf8 . TL.pack . show) <$>) <$>
  36       RelaxNG.readWithRelaxNG Atom.format inputFile
  37      | inputFile <- inputFiles
  38      ]
  39    , testGroup "Compact"
  40      [ testGroup "Write"
  41        [ testGolden "test/Golden/atom" ".rnc" $
  42           return $ Right $ TL.encodeUtf8 $
  43             RelaxNG.writeRNC Atom.format
  44        ]
  45      ]
  46    ]
  47
  48 -- * Golden testing utilities
  49 testGolden :: TestName -> TestName -> IO (Either String BSL.ByteString) -> TestTree
  50 testGolden testName expectedExt =
  51   goldenVsStringDiff testName diffGolden (testName <> expectedExt)
  52    . (>>= unLeft)
  53
  54 diffGolden :: FilePath -> FilePath -> [String]
  55 diffGolden ref new = ["diff", "-u", ref, new]
  56
  57 unLeft :: Either String BSL.ByteString -> IO BSL.ByteString
  58 unLeft = \case
  59  Left err -> return $ TL.encodeUtf8 $ TL.pack err
  60  Right a  -> return a