tests/HUnits.hs

   1 {-# LANGUAGE OverloadedStrings #-}
   2 {-# LANGUAGE RankNTypes #-}
   3
   4 module HUnits where
   5
   6 import Network.URI.Slug ()
   7 import Relude
   8 import Symantic qualified as Sym
   9 import Test.Tasty
  10 import Test.Tasty.HUnit
  11
  12 import Examples.Ex01 qualified as Ex01
  13 import Examples.Ex02 qualified as Ex02
  14 import Text.Printf (printf)
  15 import Utils
  16 import Webc
  17
  18 test :: TestTree
  19 test =
  20   testGroup
  21     "HUnits"
  22     [ testGroup
  23         "Generator"
  24         [ testGenerator
  25             "Ex01"
  26             Ex01.site
  27             [
  28               ( ()
  29               ,
  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"]
  36                 ]
  37               )
  38             ]
  39         , testGenerator
  40             "Ex02"
  41             Ex02.site
  42             [
  43               ( Ex02.model0
  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"})})}]
  45               )
  46             ]
  47         ]
  48     , testGroup
  49         "CoderIsomorphism"
  50         [ testCoderIsomorphism "Ex01" Ex01.site ()
  51         , testCoderIsomorphism "Ex02" Ex02.site Ex02.model0
  52         ]
  53     , testGroup
  54         "Encoder"
  55         [ testEncoder
  56             "Ex01"
  57             Ex01.site
  58             [
  59               ( ()
  60               ,
  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     , testGroup
  70         "Decoder"
  71         [ testDecoder
  72             "Ex01"
  73             Ex01.site
  74             [
  75               ( ()
  76               ,
  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"]
  81                 ]
  82               )
  83             ]
  84         , testDecoder
  85             "Ex02"
  86             Ex02.site
  87             [
  88               ( Ex02.model0
  89               ,
  90                 [ Gen ["static"] $ Ex02.SiteStatic
  91                 , Gen
  92                     ["filter", "all", "tag0"]
  93                     $ Ex02.SiteFilter
  94                       Ex02.Filter
  95                         { Ex02.filterLang = Nothing
  96                         , Ex02.filterTag = Just (Ex02.Tag "tag0")
  97                         }
  98                 ]
  99               )
 100             ]
 101         ]
 102     ]
 103
 104 testGenerator ::
 105   Eq a =>
 106   Show a =>
 107   String ->
 108   Sym.Reader model Generator a ->
 109   [(model, [Gen a])] ->
 110   TestTree
 111 testGenerator tn site models =
 112   testGroup
 113     tn
 114     [ testCase (printf "Model%02d" modelNum) do
 115       generate (Sym.unReader site model) @?= expectedGens
 116     | (modelNum, (model, expectedGens)) <- ol models
 117     ]
 118
 119 testCoderIsomorphism ::
 120   Eq a =>
 121   Show a =>
 122   String ->
 123   (forall repr. Testable model repr => Sym.Reader model repr a) ->
 124   model ->
 125   TestTree
 126 testCoderIsomorphism tn site model =
 127   testGroup tn $
 128     [ testGroup (printf "Request%d" urlNum) $
 129       [ ( testCase "decode . encode" do
 130             decode @() decoder Request{requestSlugs = encode encoder genValue, requestBody = ""}
 131               >>= (@?= Right genValue)
 132         )
 133       , ( testCase "encode . decode" do
 134             dec <- decode @() decoder Request{requestSlugs = genSlugs, requestBody = ""}
 135             encode encoder <$> dec @?= Right genSlugs
 136         )
 137       ]
 138     | (urlNum, Gen{..}) <- ol $ generate (Sym.unReader site model)
 139     ]
 140   where
 141     decoder = Sym.unReader site model
 142     encoder = Sym.unReader site model
 143
 144 testDecoder ::
 145   Eq a =>
 146   Show a =>
 147   String ->
 148   Sym.Reader model (Decoder ()) a ->
 149   [(model, [Gen a])] ->
 150   TestTree
 151 testDecoder tn site models =
 152   testGroup
 153     tn
 154     [ testGroup
 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
 160       ]
 161     | (modelNum, (model, expectedGens)) <- ol models
 162     ]
 163
 164 testEncoder :: String -> Sym.Reader model Encoder a -> [(model, [Gen a])] -> TestTree
 165 testEncoder tn site models =
 166   testGroup
 167     tn
 168     [ testGroup
 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
 173       ]
 174     | (modelNum, (model, expectedGens)) <- ol models
 175     ]