tests/Goldens.hs

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