1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
|
{-# LANGUAGE TemplateHaskell, QuasiQuotes, OverloadedStrings #-}
module GeneratorTestUtil where
import Control.Applicative
import Control.Monad (when)
import Data.List (sortBy)
import Language.Haskell.TH
import Test.HUnit
import Yesod.EmbeddedStatic.Types as Y
import qualified Data.ByteString.Lazy as BL
import RIO (HasCallStack)
-- We test the generators by executing them at compile time
-- and sticking the result into the GenTestResult. We then
-- test the GenTestResult at runtime. But to test the ebDevelReload
-- we must run the action at runtime so that is also embedded.
-- Because of template haskell stage restrictions, this code
-- needs to be in a separate module.
data GenTestResult = GenError String
| GenSuccessWithDevel (IO BL.ByteString)
-- | Creates a GenTestResult at compile time by testing the entry.
testEntry :: Maybe String -> Y.Location -> IO BL.ByteString -> Entry -> ExpQ
testEntry name _ _ e | ebHaskellName e /= (mkName Control.Applicative.<$> name) =
[| GenError ("haskell name " ++ $(litE $ stringL $ show $ ebHaskellName e)
++ " /= "
++ $(litE $ stringL $ show name)) |]
testEntry _ loc _ e | ebLocation e /= loc =
[| GenError ("location " ++ $(litE $ stringL $ show $ ebLocation e)) |]
testEntry _ _ act e = do
expected <- fmap stripCR $ runIO act
actual <- fmap stripCR $ runIO $ ebProductionContent e
if expected == actual
then [| GenSuccessWithDevel $(ebDevelReload e) |]
else [| GenError $ "production content: " ++ $(litE $ stringL $ show (expected, actual)) |]
-- | Remove all carriage returns, for Windows testing
stripCR :: BL.ByteString -> BL.ByteString
stripCR = BL.filter (/= 13)
testOneEntry :: Maybe String -> Y.Location -> IO BL.ByteString -> [Entry] -> ExpQ
testOneEntry name loc ct [e] = testEntry name loc ct e
testOneEntry _ _ _ _ = [| GenError "not exactly one entry" |]
-- | Tests a list of entries
testEntries :: [(Maybe String, Y.Location, IO BL.ByteString)] -> [Entry] -> ExpQ
testEntries a b | length a /= length b = [| [GenError "lengths differ"] |]
testEntries a b = listE $ zipWith f a' b'
where
a' = sortBy (\(_,l1,_) (_,l2,_) -> compare l1 l2) a
b' = sortBy (\e1 e2 -> ebLocation e1 `compare` ebLocation e2) b
f (name, loc, ct) e = testEntry name loc ct e
-- | Use this at runtime to assert the 'GenTestResult' is OK
assertGenResult :: HasCallStack
=> (IO BL.ByteString) -- ^ expected development content
-> GenTestResult -- ^ test result created at compile time
-> Assertion
assertGenResult _ (GenError e) = assertFailure ("invalid " ++ e)
assertGenResult mexpected (GenSuccessWithDevel mactual) = do
expected <- fmap stripCR mexpected
actual <- fmap stripCR mactual
when (expected /= actual) $
assertFailure $ "invalid devel content: " ++ show (expected, actual)
|
