blob: 6b193334140771fc1fabaca17a4bfc7aec5c206f (
plain)
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
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
|
--------------------------------------------------------------------------------
-- | Test utilities
module TestSuite.Util
( fromAssertions
, withTestStore
, newTestProvider
, testCompiler
, testCompilerDone
) where
--------------------------------------------------------------------------------
import Data.Monoid (mempty)
import System.Directory (removeDirectoryRecursive)
import Test.Framework
import Test.Framework.Providers.HUnit
import Test.HUnit hiding (Test)
--------------------------------------------------------------------------------
import Hakyll.Core.Compiler.Internal
import Hakyll.Core.Identifier
import qualified Hakyll.Core.Logger as Logger
import Hakyll.Core.Provider
import Hakyll.Core.Store (Store)
import qualified Hakyll.Core.Store as Store
--------------------------------------------------------------------------------
fromAssertions :: String -- ^ Name
-> [Assertion] -- ^ Cases
-> [Test] -- ^ Result tests
fromAssertions name = zipWith testCase names
where
names = map (\n -> name ++ " [" ++ show n ++ "]") [1 :: Int ..]
--------------------------------------------------------------------------------
withTestStore :: (Store -> IO a) -> IO a
withTestStore f = do
store <- Store.new True "_teststore"
result <- f store
removeDirectoryRecursive "_teststore"
return result
--------------------------------------------------------------------------------
newTestProvider :: Store -> IO Provider
newTestProvider store = newProvider store (const False) "tests/data"
--------------------------------------------------------------------------------
testCompiler :: Store -> Provider -> Identifier -> Compiler a
-> IO (CompilerResult a)
testCompiler store provider underlying compiler = do
logger <- Logger.new Logger.Debug (\_ -> return ())
let read' = CompilerRead
{ compilerUnderlying = underlying
, compilerProvider = provider
, compilerUniverse = []
, compilerRoutes = mempty
, compilerStore = store
, compilerLogger = logger
}
result <- runCompiler compiler read'
Logger.flush logger
return result
--------------------------------------------------------------------------------
testCompilerDone :: Store -> Provider -> Identifier -> Compiler a -> IO a
testCompilerDone store provider underlying compiler = do
result <- testCompiler store provider underlying compiler
case result of
CompilerDone x _ -> return x
CompilerError e -> error $
"TestSuite.Util.testCompilerDone: compiler " ++ show underlying ++
" threw: " ++ e
CompilerRequire i _ -> error $
"TestSuite.Util.testCompilerDone: compiler " ++ show underlying ++
" requires: " ++ show i
|
