yesod-static-1.6.1.0: test/GeneratorTestUtil.hs

{-# 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)