tests/Goldens.hs

   1 -- For Golden
   2 {-# LANGUAGE ExistentialQuantification #-}
   3 -- For Golden
   4 {-# LANGUAGE RankNTypes #-}
   5
   6 module Goldens where
   7
   8 import Data.List qualified as List
   9 import Relude
  10 import Symantic.Classes (ProductFunctor (..), SumFunctor (..))
  11 import System.IO.Unsafe (unsafePerformIO)
  12 import Test.Tasty
  13 import Test.Tasty.Golden
  14 import Text.Printf (printf)
  15
  16 import Examples.Ex01 qualified as Ex01
  17 import Paths_webc
  18 import Utils
  19 import Webc
  20
  21 test :: TestTree
  22 test =
  23   testGroup
  24     "Goldens"
  25     [ testGroup "Generator" $
  26         (\f -> zipWith f goldens [1 :: Int ..]) $ \(Golden site) siteNum ->
  27           let siteDir = printf "Site%03d" siteNum
  28            in let expectedFile = getGoldenDir $ printf "Generator/%s/expected.txt" siteDir
  29                in goldenVsStringDiff
  30                     siteDir
  31                     goldenDiff
  32                     expectedFile
  33                     $ do
  34                       return $ fromString $ List.unlines $ show <$> generate site
  35     , testGroup "Encoder" $
  36         (\f -> zipWith f goldens [1 :: Int ..]) $ \(Golden site) siteNum ->
  37           let siteDir = printf "Site%03d" siteNum
  38            in testGroup siteDir $
  39                 (\f -> zipWith f (generate site) [1 :: Int ..]) $ \Gen{..} genNum ->
  40                   let expectedFile = getGoldenDir $ printf "Encoder/%s/output%02d.expected.txt" siteDir genNum
  41                    in goldenVsStringDiff
  42                         (printf "output%02d" genNum)
  43                         goldenDiff
  44                         expectedFile
  45                         $ do
  46                           return $ fromString $ show $ encode site genValue
  47     ]
  48
  49 getGoldenDir :: FilePath -> FilePath
  50 getGoldenDir p = unsafePerformIO $ getDataFileName $ "tests/Goldens/" <> p
  51
  52 goldenDiff :: FilePath -> FilePath -> [String]
  53 goldenDiff ref new = ["diff", "-u", "-w", "-B", ref, new]
  54
  55 data Golden = forall a. Show a => Golden (forall repr. Testable repr => repr a)
  56 goldens :: [Golden]
  57 goldens =
  58   [ Golden index
  59   , Golden ("foo" </> index)
  60   , Golden ("root" </> ("foo" </> index <+> "bar" </> index))
  61   , Golden
  62       ( "root"
  63           </> ("a" </> literalSlug "b" <+> "c" </> literalSlug "d")
  64           <.> ("A" </> literalSlug "B" <+> "C" </> literalSlug "D")
  65           <. index
  66       )
  67   , Golden Ex01.site
  68   ]