]> Git — Sourcephile - webc.git/blob - tests/Goldens.hs
068da21abfad37442d464c466344ba6ca82fa18e
[webc.git] / 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 ]