]> Git — Sourcephile - webc.git/blob - tests/HUnits.hs
doc: update `ChangeLog.md`
[webc.git] / tests / HUnits.hs
1 {-# LANGUAGE ConstraintKinds #-}
2 {-# LANGUAGE OverloadedStrings #-}
3 {-# LANGUAGE RankNTypes #-}
4 {-# LANGUAGE UndecidableInstances #-}
5
6 module HUnits where
7
8 import Network.URI.Slug ()
9 import Relude
10 import Test.Tasty
11 import Test.Tasty.HUnit
12
13 import Examples.Ex01 qualified as Ex01
14 import Utils
15 import Webc
16
17 test :: TestTree
18 test =
19 testGroup
20 "HUnits"
21 [ testGroup
22 "Generator"
23 [ testGenerator
24 "Ex01"
25 Ex01.site
26 [ Gen ["index.html"] $ Ex01.Index
27 , Gen ["about.html"] $ Ex01.About
28 , Gen ["user", "contact.html"] $ Ex01.Contact "user"
29 , Gen ["post"] $ Ex01.Post []
30 , Gen ["post", "dir"] $ Ex01.Post ["dir"]
31 , Gen ["post", "dir", "dir"] $ Ex01.Post ["dir", "dir"]
32 ]
33 [ Ex01.Index
34 , Ex01.About
35 , Ex01.Contact "user"
36 , Ex01.Post []
37 , Ex01.Post ["dir"]
38 , Ex01.Post ["dir", "dir"]
39 ]
40 ]
41 , testGroup
42 "CoderIsomorphism"
43 [ testCoderIsomorphism "Ex01" Ex01.site
44 ]
45 , testGroup
46 "Encoder"
47 [ testEncoder
48 "Ex01"
49 Ex01.site
50 [ Gen ["index.html"] $ Ex01.Index
51 , Gen ["about.html"] $ Ex01.About
52 , Gen ["user", "contact.html"] $ Ex01.Contact "user"
53 , Gen ["post", "a", "b"] $ Ex01.Post ["a", "b"]
54 ]
55 ]
56 , testGroup
57 "Decoder"
58 [ testDecoder
59 "Ex01"
60 Ex01.site
61 [ Gen ["index.html"] $ Ex01.Index
62 , Gen ["about.html"] $ Ex01.About
63 , Gen ["user", "contact.html"] $ Ex01.Contact "user"
64 , Gen ["post", "a", "b"] $ Ex01.Post ["a", "b"]
65 ]
66 ]
67 ]
68
69 testGenerator ::
70 Eq a =>
71 Show a =>
72 String ->
73 Generator a ->
74 {-expected-} [Gen a] ->
75 {-expected-} [a] ->
76 TestTree
77 testGenerator tn site expectedCheck expectedValues =
78 testGroup
79 tn
80 [ testCase "generate" $ gen @?= expectedCheck
81 , testCase "generateValues" $ genValue <$> gen @?= expectedValues
82 ]
83 where
84 gen = generate site
85
86 testCoderIsomorphism ::
87 Eq a =>
88 Show a =>
89 String ->
90 (forall repr. Testable repr => repr a) ->
91 TestTree
92 testCoderIsomorphism tn site =
93 testGroup tn $
94 zipWith
95 ( \n Gen{..} ->
96 testGroup n $
97 [ (testCase "decode . encode" $ decode site (encode site genValue) @?= Right genValue)
98 , (testCase "encode . decode" $ encode site <$> decode site genSlugs @?= Right genSlugs)
99 ]
100 )
101 (show <$> [1 :: Int ..])
102 (generate site)
103
104 testDecoder :: (Eq a, Show a) => String -> Decoder a -> [Gen a] -> TestTree
105 testDecoder tn site as =
106 testGroup tn $
107 zipWith
108 (\n Gen{..} -> testCase n $ decode site genSlugs @?= Right genValue)
109 (show <$> [1 :: Int ..])
110 as
111
112 testEncoder :: String -> Encoder a -> [Gen a] -> TestTree
113 testEncoder tn site as =
114 testGroup tn $
115 zipWith
116 (\n Gen{..} -> testCase n $ encode site genValue @?= genSlugs)
117 (show <$> [1 :: Int ..])
118 as