tests/Goldens.hs

   1 {-# LANGUAGE AllowAmbiguousTypes #-}
   2 -- For Golden
   3 {-# LANGUAGE ExistentialQuantification #-}
   4 {-# LANGUAGE ImportQualifiedPost #-}
   5 -- For Golden
   6 {-# LANGUAGE RankNTypes #-}
   7 {-# LANGUAGE TypeApplications #-}
   8 {-# OPTIONS_GHC -Wno-orphans #-}
   9
  10 module Goldens where
  11
  12 import Data.List qualified as List
  13 import Relude
  14 import Symantic qualified as Sym
  15 import Symantic.Classes (ProductFunctor (..), SumFunctor (..))
  16 import System.IO.Unsafe (unsafePerformIO)
  17 import Test.Tasty
  18 import Test.Tasty.Golden
  19 import Text.Printf (printf)
  20
  21 import Examples.Ex01 qualified as Ex01
  22 import Examples.Ex02 qualified as Ex02
  23 import Paths_webc
  24 import Utils
  25 import Webc
  26
  27 test :: TestTree
  28 test =
  29   testGroup
  30     "Goldens"
  31     [ testGroup
  32         "Generator"
  33         [ testGroup
  34           (printf "Site%03d" siteNum)
  35           [ goldenVsStringDiff
  36             (printf "Model%02d" modelNum)
  37             goldenDiff
  38             (getGoldenDir (printf "Generator/Site%03d/Model%02d/expected.txt" siteNum modelNum))
  39             do
  40               return $ fromString $ List.unlines $ show <$> generate (Sym.unReader site model)
  41           | (modelNum, model) <- ol models
  42           ]
  43         | (siteNum, Golden site models) <- ol goldens
  44         ]
  45     , testGroup
  46         "Encoder"
  47         [ testGroup
  48           (printf "Site%03d" siteNum)
  49           [ testGroup
  50             (printf "Model%02d" modelNum)
  51             [ goldenVsStringDiff
  52               (printf "Gen%03d" genNum)
  53               goldenDiff
  54               (getGoldenDir (printf "Encoder/Site%03d/Model%02d/Gen%03d.expected.txt" siteNum modelNum genNum))
  55               do
  56                 return $ fromString $ show $ encode (Sym.unReader site model) genValue
  57             | (genNum, Gen{..}) <- ol $ generate (Sym.unReader site model)
  58             ]
  59           | (modelNum, model) <- ol models
  60           ]
  61         | (siteNum, Golden site models) <- ol goldens
  62         ]
  63     ]
  64
  65 getGoldenDir :: FilePath -> FilePath
  66 getGoldenDir p = unsafePerformIO $ getDataFileName $ "tests/Goldens/" <> p
  67
  68 goldenDiff :: FilePath -> FilePath -> [String]
  69 goldenDiff ref new = ["diff", "-u", "-w", "-B", ref, new]
  70
  71 data Golden
  72   = forall a model.
  73     ( Show a
  74     , Typeable a
  75     ) =>
  76     Golden
  77       (forall repr. Testable model repr => Sym.Reader model repr a)
  78       [model]
  79
  80 goldens :: [Golden]
  81 goldens =
  82   [ Golden @() index [()]
  83   , Golden @()
  84       ("foo" </> index)
  85       [()]
  86   , Golden @(Either () ())
  87       ("root" </> ("foo" </> index <+> "bar" </> index))
  88       [()]
  89   , Golden @(Either () (), Either () ())
  90       ( "root"
  91           </> ("a" </> literalSlug "b" <+> "c" </> literalSlug "d")
  92           <.> ("A" </> literalSlug "B" <+> "C" </> literalSlug "D")
  93           <. index
  94       )
  95       [()]
  96   , Golden @Ex01.Site Ex01.site [()]
  97   , Golden @Ex02.Site Ex02.site [Ex02.model0]
  98   ]