1 {-# LANGUAGE OverloadedStrings #-}
2 {-# LANGUAGE RankNTypes #-}
6 import Network.URI.Slug ()
8 import Symantic qualified as Sym
10 import Test.Tasty.HUnit
12 import Examples.Ex01 qualified as Ex01
13 import Examples.Ex02 qualified as Ex02
14 import Text.Printf (printf)
30 [ Gen ["index.html"] $ Ex01.Index
31 , Gen ["about.html"] $ Ex01.About
32 -- , Gen ["user", "contact.html"] $ Ex01.Contact "user"
33 -- , Gen ["post"] $ Ex01.Post []
34 -- , Gen ["post", "dir"] $ Ex01.Post ["dir"]
35 -- , Gen ["post", "dir", "dir"] $ Ex01.Post ["dir", "dir"]
45 [ Gen ["static"] $ Ex02.SiteStatic
46 , Gen ["feed"] $ Ex02.SiteFeeds
47 , Gen ["filter", "all"] $ Ex02.SiteFilter Ex02.Filter{filterLang = Nothing, filterTag = Nothing}
48 , Gen ["filter", "all", "tag0"] $ Ex02.SiteFilter Ex02.Filter{filterLang = Nothing, filterTag = Just (Ex02.Tag{Ex02.unTag = "tag0"})}
49 , Gen ["filter", "fr"] $ Ex02.SiteFilter Ex02.Filter{filterLang = Just Ex02.LangEn, filterTag = Nothing}
50 , Gen ["filter", "fr", "tag0"] $ Ex02.SiteFilter Ex02.Filter{filterLang = Just Ex02.LangEn, filterTag = Just (Ex02.Tag{Ex02.unTag = "tag0"})}
51 , Gen ["filter", "en"] $ Ex02.SiteFilter Ex02.Filter{filterLang = Just Ex02.LangFr, filterTag = Nothing}
52 , Gen ["filter", "en", "tag0"] $ Ex02.SiteFilter Ex02.Filter{filterLang = Just Ex02.LangFr, filterTag = Just (Ex02.Tag{Ex02.unTag = "tag0"})}
59 [ testCoderIsomorphism "Ex01" Ex01.site ()
60 , testCoderIsomorphism "Ex02" Ex02.site Ex02.model0
70 [ Gen ["index.html"] $ Ex01.Index
71 , Gen ["about.html"] $ Ex01.About
72 -- , Gen ["user", "contact.html"] $ Ex01.Contact "user"
73 -- , Gen ["post", "a", "b"] $ Ex01.Post ["a", "b"]
86 [ Gen ["index.html"] $ Ex01.Index
87 , Gen ["about.html"] $ Ex01.About
88 -- , Gen ["user", "contact.html"] $ Ex01.Contact "user"
89 -- , Gen ["post", "a", "b"] $ Ex01.Post ["a", "b"]
99 [ Gen ["static"] $ Ex02.SiteStatic
101 ["filter", "all", "tag0"]
104 { Ex02.filterLang = Nothing
105 , Ex02.filterTag = Just (Ex02.Tag "tag0")
117 Sym.Reader model Generator a ->
118 [(model, [Gen a])] ->
120 testGenerator tn site models =
123 [ testCase (printf "Model%02d" modelNum) do
124 generate (Sym.unReader site model) @?= expectedGens
125 | (modelNum, (model, expectedGens)) <- ol models
128 testCoderIsomorphism ::
132 (forall repr. Testable model repr => Sym.Reader model repr a) ->
135 testCoderIsomorphism tn site model =
137 [ testGroup (printf "Url%d" urlNum) $
138 [ ( testCase "decode . encode" do
139 decode @() decoder (encode encoder genValue)
140 >>= (@?= Right genValue)
142 , ( testCase "encode . decode" do
143 dec <- decode @() decoder genSlugs
144 encode encoder <$> dec @?= Right genSlugs
147 | (urlNum, Gen{..}) <- ol $ generate (Sym.unReader site model)
150 decoder = Sym.unReader site model
151 encoder = Sym.unReader site model
157 Sym.Reader model (Decoder ()) a ->
158 [(model, [Gen a])] ->
160 testDecoder tn site models =
164 (printf "Model%d" modelNum)
165 [ testCase (printf "Gen%d" genNum) do
166 decode (Sym.unReader site model) genSlugs
167 >>= (@?= Right genValue)
168 | (genNum, Gen{..}) <- ol expectedGens
170 | (modelNum, (model, expectedGens)) <- ol models
173 testEncoder :: String -> Sym.Reader model Encoder a -> [(model, [Gen a])] -> TestTree
174 testEncoder tn site models =
178 (printf "Model%d" modelNum)
179 [ testCase (printf "Gen%d" genNum) do
180 encode (Sym.unReader site model) genValue @?= genSlugs
181 | (genNum, Gen{..}) <- ol expectedGens
183 | (modelNum, (model, expectedGens)) <- ol models