tests/Goldens.hs

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