test/Golden.hs

   1 module Golden where
   2
   3 -- import qualified System.FilePath as Path
   4 -- import qualified Text.Blaze.Utils as Blaze
   5 import Control.Monad (Monad(..))
   6 import Data.Either (Either(..))
   7 import Data.Function (($), (.))
   8 import Data.Functor ((<$>))
   9 import Data.Semigroup (Semigroup(..))
  10 import Data.String (String)
  11 import System.IO (IO)
  12 import Text.Show (Show(..))
  13 import qualified Data.ByteString.Lazy as BS
  14 import qualified Data.List as List
  15 import qualified Data.Text.Lazy as TL
  16 import qualified Data.Text.Lazy.Encoding as TL
  17 import qualified Data.TreeSeq.Strict as TreeSeq
  18 import qualified Text.Blaze.Html.Renderer.Utf8 as Blaze
  19
  20 import Test.Tasty
  21 import Test.Tasty.Golden
  22
  23 import qualified Language.TCT as TCT
  24 import qualified Language.TCT.Debug as TCT
  25 import qualified Language.TCT.Write.HTML5 as TCT.Write.HTML5
  26 import qualified Language.TCT.Write.Plain as TCT.Write.Plain
  27 import qualified Language.TCT.Write.XML as TCT.Write.XML
  28
  29 diff :: String -> String -> [String]
  30 diff ref new = ["diff", "-u", ref, new]
  31
  32 readAST :: String -> IO (Either TCT.ErrorRead TCT.Roots)
  33 readAST inputFile = do
  34         inp <- BS.readFile inputFile
  35         return $ TCT.readTrees inputFile $ TL.decodeUtf8 inp
  36
  37 unLeft :: Show err => Either err BS.ByteString -> IO BS.ByteString
  38 unLeft = \case
  39  Left err -> return $ TL.encodeUtf8 $ TL.pack $ show err
  40  Right a -> return a
  41
  42 goldensIO :: IO TestTree
  43 goldensIO = do
  44         inputFiles <- List.sort <$> findByExtension [".tct"] "test/Golden"
  45         return $
  46                 testGroup "TCT"
  47                  [ testGroup "AST"
  48                          [ goldenVsStringDiff inputFile diff (inputFile <> ".ast") $
  49                                 (>>= unLeft) $
  50                                 readAST inputFile >>= \ast ->
  51                                         return $
  52                                                 TL.encodeUtf8
  53                                                  . TL.pack
  54                                                  . TCT.runPretty 0
  55                                                  <$> ast
  56                          | inputFile <- inputFiles
  57                          ]
  58                  , testGroup "Plain"
  59                          [ goldenVsStringDiff inputFile diff inputFile $
  60                                 (>>= unLeft) $
  61                                 readAST inputFile >>= \ast ->
  62                                         return $
  63                                                 TL.encodeUtf8
  64                                                  . (<> TL.singleton '\n')
  65                                                  . TCT.Write.Plain.document
  66                                                  <$> ast
  67                          | inputFile <- inputFiles
  68                          ]
  69                  , testGroup "HTML5"
  70                          [ goldenVsStringDiff inputFile diff (inputFile <> ".html5") $
  71                                 (>>= unLeft) $
  72                                 readAST inputFile >>= \ast ->
  73                                         return $
  74                                                 Blaze.renderHtml
  75                                                  . TCT.Write.HTML5.document
  76                                                  <$> ast
  77                          | inputFile <- inputFiles
  78                          ]
  79                  , testGroup "XML"
  80                          [ goldenVsStringDiff inputFile diff (inputFile <> ".xml") $
  81                                 (>>= unLeft) $
  82                                 readAST inputFile >>= \ast ->
  83                                         return $
  84                                                 TL.encodeUtf8
  85                                                  . TL.pack
  86                                                  . show
  87                                                  . TreeSeq.Pretty
  88                                                  . TCT.Write.XML.document
  89                                                  <$> ast
  90                          | inputFile <- inputFiles
  91                          ]
  92                  ]