test/Golden.hs

   1 module Golden where
   2
   3 import Control.Monad (Monad(..))
   4 import Data.Either (Either(..))
   5 import Data.Function (($))
   6 import Data.Semigroup (Semigroup(..))
   7 import Data.String (String, IsString(..))
   8 import System.IO (IO, FilePath)
   9 import Test.Tasty
  10 import Test.Tasty.Golden
  11 import qualified Data.ByteString.Lazy as BSL
  12 import qualified Data.IORef as IORef
  13 import qualified Data.Text.Lazy as TL
  14 import qualified Data.Text.Lazy.Encoding as TL
  15 import qualified Language.Haskell.TH.Syntax as TH
  16
  17 import qualified Symantic.Parser as P
  18 import Golden.Grammar
  19
  20 goldensIO :: IO TestTree
  21 goldensIO = return $ testGroup "Golden"
  22   [ goldensGrammar
  23   ]
  24
  25 goldensGrammar :: TestTree
  26 goldensGrammar = testGroup "Grammar"
  27   [ testGroup "DumpComb" $
  28     let file p = "test/Golden/Grammar/"<>p<>".dump" in
  29     let test name repr =
  30           goldenVsStringDiff (file name) diffGolden (file name) $ do
  31             -- XXX: Resetting 'TH.counter' makes 'makeLetName' deterministic,
  32             -- except when profiling is enabled, in this case those tests may fail
  33             -- due to a different numbering of the 'def' and 'ref' combinators.
  34             IORef.writeIORef TH.counter 0
  35             return $ fromString $ P.showGrammar repr in
  36     [ test "unit" P.unit
  37     , test "unit-unit" $ P.unit P.*> P.unit
  38     , test "boom" boom
  39     , test "brainfuck" brainfuck
  40     ]
  41   ]
  42
  43 -- * Golden testing utilities
  44
  45 diffGolden :: FilePath -> FilePath -> [String]
  46 diffGolden ref new = ["diff", "-u", ref, new]
  47
  48 unLeft :: Either String BSL.ByteString -> IO BSL.ByteString
  49 unLeft = \case
  50  Left err -> return $ TL.encodeUtf8 $ TL.pack err
  51  Right a  -> return a