tests/HUnits.hs

   1 {-# LANGUAGE ConstraintKinds #-}
   2 {-# LANGUAGE OverloadedStrings #-}
   3 {-# LANGUAGE RankNTypes #-}
   4 {-# LANGUAGE UndecidableInstances #-}
   5
   6 module HUnits where
   7
   8 import Network.URI.Slug ()
   9 import Relude
  10 import Test.Tasty
  11 import Test.Tasty.HUnit
  12
  13 import Examples.Ex01 qualified as Ex01
  14 import Utils
  15 import Webc
  16
  17 test :: TestTree
  18 test =
  19   testGroup
  20     "HUnits"
  21     [ testGroup
  22         "Generator"
  23         [ testGenerator
  24             "Ex01"
  25             Ex01.site
  26             [ Gen ["index.html"] $ Ex01.Index
  27             , Gen ["about.html"] $ Ex01.About
  28             , Gen ["user", "contact.html"] $ Ex01.Contact "user"
  29             , Gen ["post"] $ Ex01.Post []
  30             , Gen ["post", "dir"] $ Ex01.Post ["dir"]
  31             , Gen ["post", "dir", "dir"] $ Ex01.Post ["dir", "dir"]
  32             ]
  33             [ Ex01.Index
  34             , Ex01.About
  35             , Ex01.Contact "user"
  36             , Ex01.Post []
  37             , Ex01.Post ["dir"]
  38             , Ex01.Post ["dir", "dir"]
  39             ]
  40         ]
  41     , testGroup
  42         "CoderIsomorphism"
  43         [ testCoderIsomorphism "Ex01" Ex01.site
  44         ]
  45     , testGroup
  46         "Encoder"
  47         [ testEncoder
  48             "Ex01"
  49             Ex01.site
  50             [ Gen ["index.html"] $ Ex01.Index
  51             , Gen ["about.html"] $ Ex01.About
  52             , Gen ["user", "contact.html"] $ Ex01.Contact "user"
  53             , Gen ["post", "a", "b"] $ Ex01.Post ["a", "b"]
  54             ]
  55         ]
  56     , testGroup
  57         "Decoder"
  58         [ testDecoder
  59             "Ex01"
  60             Ex01.site
  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 testGenerator ::
  70   Eq a =>
  71   Show a =>
  72   String ->
  73   Generator a ->
  74   {-expected-} [Gen a] ->
  75   {-expected-} [a] ->
  76   TestTree
  77 testGenerator tn site expectedCheck expectedValues =
  78   testGroup
  79     tn
  80     [ testCase "generate" $ gen @?= expectedCheck
  81     , testCase "generateValues" $ genValue <$> gen @?= expectedValues
  82     ]
  83   where
  84     gen = generate site
  85
  86 testCoderIsomorphism ::
  87   Eq a =>
  88   Show a =>
  89   String ->
  90   (forall repr. Testable repr => repr a) ->
  91   TestTree
  92 testCoderIsomorphism tn site =
  93   testGroup tn $
  94     zipWith
  95       ( \n Gen{..} ->
  96           testGroup n $
  97             [ (testCase "decode . encode" $ decode site (encode site genValue) @?= Right genValue)
  98             , (testCase "encode . decode" $ encode site <$> decode site genSlugs @?= Right genSlugs)
  99             ]
 100       )
 101       (show <$> [1 :: Int ..])
 102       (generate site)
 103
 104 testDecoder :: (Eq a, Show a) => String -> Decoder a -> [Gen a] -> TestTree
 105 testDecoder tn site as =
 106   testGroup tn $
 107     zipWith
 108       (\n Gen{..} -> testCase n $ decode site genSlugs @?= Right genValue)
 109       (show <$> [1 :: Int ..])
 110       as
 111
 112 testEncoder :: String -> Encoder a -> [Gen a] -> TestTree
 113 testEncoder tn site as =
 114   testGroup tn $
 115     zipWith
 116       (\n Gen{..} -> testCase n $ encode site genValue @?= genSlugs)
 117       (show <$> [1 :: Int ..])
 118       as