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"]
44 , [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"})})}]
50 [ testCoderIsomorphism "Ex01" Ex01.site ()
51 , testCoderIsomorphism "Ex02" Ex02.site Ex02.model0
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"]
77 [ Gen ["index.html"] $ Ex01.Index
78 , Gen ["about.html"] $ Ex01.About
79 -- , Gen ["user", "contact.html"] $ Ex01.Contact "user"
80 -- , Gen ["post", "a", "b"] $ Ex01.Post ["a", "b"]
90 [ Gen ["static"] $ Ex02.SiteStatic
92 ["filter", "all", "tag0"]
95 { Ex02.filterLang = Nothing
96 , Ex02.filterTag = Just (Ex02.Tag "tag0")
108 Sym.Reader model Generator a ->
109 [(model, [Gen a])] ->
111 testGenerator tn site models =
114 [ testCase (printf "Model%02d" modelNum) do
115 generate (Sym.unReader site model) @?= expectedGens
116 | (modelNum, (model, expectedGens)) <- ol models
119 testCoderIsomorphism ::
123 (forall repr. Testable model repr => Sym.Reader model repr a) ->
126 testCoderIsomorphism tn site model =
128 [ testGroup (printf "Request%d" urlNum) $
129 [ ( testCase "decode . encode" do
130 decode @() decoder Request{requestSlugs = encode encoder genValue, requestBody = ""}
131 >>= (@?= Right genValue)
133 , ( testCase "encode . decode" do
134 dec <- decode @() decoder Request{requestSlugs = genSlugs, requestBody = ""}
135 encode encoder <$> dec @?= Right genSlugs
138 | (urlNum, Gen{..}) <- ol $ generate (Sym.unReader site model)
141 decoder = Sym.unReader site model
142 encoder = Sym.unReader site model
148 Sym.Reader model (Decoder ()) a ->
149 [(model, [Gen a])] ->
151 testDecoder tn site models =
155 (printf "Model%d" modelNum)
156 [ testCase (printf "Gen%d" genNum) do
157 decode (Sym.unReader site model) Request{requestSlugs = genSlugs, requestBody = ""}
158 >>= (@?= Right genValue)
159 | (genNum, Gen{..}) <- ol expectedGens
161 | (modelNum, (model, expectedGens)) <- ol models
164 testEncoder :: String -> Sym.Reader model Encoder a -> [(model, [Gen a])] -> TestTree
165 testEncoder tn site models =
169 (printf "Model%d" modelNum)
170 [ testCase (printf "Gen%d" genNum) do
171 encode (Sym.unReader site model) genValue @?= genSlugs
172 | (genNum, Gen{..}) <- ol expectedGens
174 | (modelNum, (model, expectedGens)) <- ol models