]> Git — Sourcephile - haskell/literate-web.git/blob - tests/HUnits.hs
feat(iface): add `OutputPath`
[haskell/literate-web.git] / tests / HUnits.hs
1 {-# LANGUAGE OverloadedStrings #-}
2 {-# LANGUAGE RankNTypes #-}
3
4 module HUnits where
5
6 import Relude
7 import Symantic qualified as Sym
8 import Test.Tasty
9 import Test.Tasty.HUnit
10
11 import Examples.Ex01 qualified as Ex01
12 import Examples.Ex02 qualified as Ex02
13 import Literate.Web
14 import Text.Printf (printf)
15 import Utils
16
17 test :: TestTree
18 test =
19 testGroup
20 "HUnits"
21 [ testGroup
22 "Generator"
23 [ testGenerator
24 "Ex01"
25 Ex01.site
26 [
27 ( ()
28 ,
29 [ Gen ["index.html"] $ Ex01.Index
30 , Gen ["about.html"] $ Ex01.About
31 -- , Gen ["user", "contact.html"] $ Ex01.Contact "user"
32 -- , Gen ["post"] $ Ex01.Post []
33 -- , Gen ["post", "dir"] $ Ex01.Post ["dir"]
34 -- , Gen ["post", "dir", "dir"] $ Ex01.Post ["dir", "dir"]
35 ]
36 )
37 ]
38 , testGenerator
39 "Ex02"
40 Ex02.site
41 [
42 ( Ex02.model0
43 , [Gen{genSlugs = ["static"], genValue = Ex02.SiteStatic}, Gen{genSlugs = ["feed"], genValue = Ex02.SiteFeeds}, Gen{genSlugs = ["filter", "all"], genValue = Ex02.SiteFilter (Ex02.Filter{filterLang = Nothing, filterTag = Nothing})}, Gen{genSlugs = ["filter", "all", "tag0"], genValue = Ex02.SiteFilter (Ex02.Filter{filterLang = Nothing, filterTag = Just (Ex02.Tag{unTag = "tag0"})})}, Gen{genSlugs = ["filter", "all", "tag1"], genValue = Ex02.SiteFilter (Ex02.Filter{filterLang = Nothing, filterTag = Just (Ex02.Tag{unTag = "tag1"})})}, Gen{genSlugs = ["filter", "fr"], genValue = Ex02.SiteFilter (Ex02.Filter{filterLang = Just Ex02.LangEn, filterTag = Nothing})}, Gen{genSlugs = ["filter", "fr", "tag0"], genValue = Ex02.SiteFilter (Ex02.Filter{filterLang = Just Ex02.LangEn, filterTag = Just (Ex02.Tag{unTag = "tag0"})})}, Gen{genSlugs = ["filter", "fr", "tag1"], genValue = Ex02.SiteFilter (Ex02.Filter{filterLang = Just Ex02.LangEn, filterTag = Just (Ex02.Tag{unTag = "tag1"})})}, Gen{genSlugs = ["filter", "en"], genValue = Ex02.SiteFilter (Ex02.Filter{filterLang = Just Ex02.LangFr, filterTag = Nothing})}, Gen{genSlugs = ["filter", "en", "tag0"], genValue = Ex02.SiteFilter (Ex02.Filter{filterLang = Just Ex02.LangFr, filterTag = Just (Ex02.Tag{unTag = "tag0"})})}, Gen{genSlugs = ["filter", "en", "tag1"], genValue = Ex02.SiteFilter (Ex02.Filter{filterLang = Just Ex02.LangFr, filterTag = Just (Ex02.Tag{unTag = "tag1"})})}]
44 )
45 ]
46 ]
47 , testGroup
48 "CoderIsomorphism"
49 [ testCoderIsomorphism "Ex01" Ex01.site ()
50 , testCoderIsomorphism "Ex02" Ex02.site Ex02.model0
51 ]
52 , testGroup
53 "Encoder"
54 [ testEncoder
55 "Ex01"
56 Ex01.site
57 [
58 ( ()
59 ,
60 [ Gen ["index.html"] $ Ex01.Index
61 , Gen ["about.html"] $ Ex01.About
62 -- , Gen ["user", "contact.html"] $ Ex01.Contact "user"
63 -- , Gen ["post", "a", "b"] $ Ex01.Post ["a", "b"]
64 ]
65 )
66 ]
67 ]
68 , testGroup
69 "Decoder"
70 [ testDecoder
71 "Ex01"
72 Ex01.site
73 [
74 ( ()
75 ,
76 [ Gen ["index.html"] $ Ex01.Index
77 , Gen ["about.html"] $ Ex01.About
78 -- , Gen ["user", "contact.html"] $ Ex01.Contact "user"
79 -- , Gen ["post", "a", "b"] $ Ex01.Post ["a", "b"]
80 ]
81 )
82 ]
83 , testDecoder
84 "Ex02"
85 Ex02.site
86 [
87 ( Ex02.model0
88 ,
89 [ {- Gen ["static"] $ Ex02.SiteStatic
90 , -} Gen
91 ["filter", "all", "tag0"]
92 $ Ex02.SiteFilter
93 Ex02.Filter
94 { Ex02.filterLang = Nothing
95 , Ex02.filterTag = Just (Ex02.Tag "tag0")
96 }
97 ]
98 )
99 ]
100 ]
101 ]
102
103 testGenerator ::
104 Eq a =>
105 Show a =>
106 String ->
107 Sym.Reader model Generator a ->
108 [(model, [Gen a])] ->
109 TestTree
110 testGenerator tn site models =
111 testGroup
112 tn
113 [ testCase (printf "Model%02d" modelNum) do
114 generate (Sym.unReader site model) @?= expectedGens
115 | (modelNum, (model, expectedGens)) <- ol models
116 ]
117
118 testCoderIsomorphism ::
119 Eq a =>
120 Show a =>
121 String ->
122 (forall repr. Testable model repr => Sym.Reader model repr a) ->
123 model ->
124 TestTree
125 testCoderIsomorphism tn site model =
126 testGroup tn $
127 [ testGroup (printf "Request%d" urlNum) $
128 [ ( testCase "decode . encode" do
129 decode @() decoder Request{requestSlugs = encode encoder genValue, requestBody = ""}
130 >>= (@?= Right genValue)
131 )
132 , ( testCase "encode . decode" do
133 dec <- decode @() decoder Request{requestSlugs = genSlugs, requestBody = ""}
134 encode encoder <$> dec @?= Right genSlugs
135 )
136 ]
137 | (urlNum, Gen{..}) <- ol $ generate (Sym.unReader site model)
138 ]
139 where
140 decoder = Sym.unReader site model
141 encoder = Sym.unReader site model
142
143 testDecoder ::
144 Eq a =>
145 Show a =>
146 String ->
147 Sym.Reader model (Decoder ()) a ->
148 [(model, [Gen a])] ->
149 TestTree
150 testDecoder tn site models =
151 testGroup
152 tn
153 [ testGroup
154 (printf "Model%d" modelNum)
155 [ testCase (printf "Gen%d" genNum) do
156 decode (Sym.unReader site model) Request{requestSlugs = genSlugs, requestBody = ""}
157 >>= (@?= Right genValue)
158 | (genNum, Gen{..}) <- ol expectedGens
159 ]
160 | (modelNum, (model, expectedGens)) <- ol models
161 ]
162
163 testEncoder :: String -> Sym.Reader model Encoder a -> [(model, [Gen a])] -> TestTree
164 testEncoder tn site models =
165 testGroup
166 tn
167 [ testGroup
168 (printf "Model%d" modelNum)
169 [ testCase (printf "Gen%d" genNum) do
170 encode (Sym.unReader site model) genValue @?= genSlugs
171 | (genNum, Gen{..}) <- ol expectedGens
172 ]
173 | (modelNum, (model, expectedGens)) <- ol models
174 ]