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     ]