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               ,
  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"})}
  53                 ]
  54               )
  55             ]
  56         ]
  57     , testGroup
  58         "CoderIsomorphism"
  59         [ testCoderIsomorphism "Ex01" Ex01.site ()
  60         , testCoderIsomorphism "Ex02" Ex02.site Ex02.model0
  61         ]
  62     , testGroup
  63         "Encoder"
  64         [ testEncoder
  65             "Ex01"
  66             Ex01.site
  67             [
  68               ( ()
  69               ,
  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"]
  74                 ]
  75               )
  76             ]
  77         ]
  78     , testGroup
  79         "Decoder"
  80         [ testDecoder
  81             "Ex01"
  82             Ex01.site
  83             [
  84               ( ()
  85               ,
  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"]
  90                 ]
  91               )
  92             ]
  93         , testDecoder
  94             "Ex02"
  95             Ex02.site
  96             [
  97               ( Ex02.model0
  98               ,
  99                 [ Gen ["static"] $ Ex02.SiteStatic
 100                 , Gen
 101                     ["filter", "all", "tag0"]
 102                     $ Ex02.SiteFilter
 103                       Ex02.Filter
 104                         { Ex02.filterLang = Nothing
 105                         , Ex02.filterTag = Just (Ex02.Tag "tag0")
 106                         }
 107                 ]
 108               )
 109             ]
 110         ]
 111     ]
 112
 113 testGenerator ::
 114   Eq a =>
 115   Show a =>
 116   String ->
 117   Sym.Reader model Generator a ->
 118   [(model, [Gen a])] ->
 119   TestTree
 120 testGenerator tn site models =
 121   testGroup
 122     tn
 123     [ testCase (printf "Model%02d" modelNum) do
 124       generate (Sym.unReader site model) @?= expectedGens
 125     | (modelNum, (model, expectedGens)) <- ol models
 126     ]
 127
 128 testCoderIsomorphism ::
 129   Eq a =>
 130   Show a =>
 131   String ->
 132   (forall repr. Testable model repr => Sym.Reader model repr a) ->
 133   model ->
 134   TestTree
 135 testCoderIsomorphism tn site model =
 136   testGroup tn $
 137     [ testGroup (printf "Url%d" urlNum) $
 138       [ ( testCase "decode . encode" do
 139             decode @() decoder (encode encoder genValue)
 140               >>= (@?= Right genValue)
 141         )
 142       , ( testCase "encode . decode" do
 143             dec <- decode @() decoder genSlugs
 144             encode encoder <$> dec @?= Right genSlugs
 145         )
 146       ]
 147     | (urlNum, Gen{..}) <- ol $ generate (Sym.unReader site model)
 148     ]
 149   where
 150     decoder = Sym.unReader site model
 151     encoder = Sym.unReader site model
 152
 153 testDecoder ::
 154   Eq a =>
 155   Show a =>
 156   String ->
 157   Sym.Reader model (Decoder ()) a ->
 158   [(model, [Gen a])] ->
 159   TestTree
 160 testDecoder tn site models =
 161   testGroup
 162     tn
 163     [ testGroup
 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
 169       ]
 170     | (modelNum, (model, expectedGens)) <- ol models
 171     ]
 172
 173 testEncoder :: String -> Sym.Reader model Encoder a -> [(model, [Gen a])] -> TestTree
 174 testEncoder tn site models =
 175   testGroup
 176     tn
 177     [ testGroup
 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
 182       ]
 183     | (modelNum, (model, expectedGens)) <- ol models
 184     ]