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
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
|
--------------------------------------------------------------------------------
-- | Test utilities
module TestSuite.Util
( fromAssertions
, newTestStore
, newTestProvider
, testCompiler
, testCompilerDone
, testCompilerError
, testConfiguration
, cleanTestEnv
, renderParagraphs
) where
--------------------------------------------------------------------------------
import Data.List (intercalate, isInfixOf)
import Data.Monoid (mempty)
import qualified Data.Set as S
import Test.Tasty
import Test.Tasty.HUnit
import Text.Printf (printf)
--------------------------------------------------------------------------------
import Hakyll.Core.Compiler.Internal
import Hakyll.Core.Configuration
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
import Hakyll.Core.Util.File
import Hakyll.Core.Item
--------------------------------------------------------------------------------
fromAssertions :: String -- ^ Name
-> [Assertion] -- ^ Cases
-> [TestTree] -- ^ Result tests
fromAssertions name =
zipWith testCase [printf "[%2d] %s" n name | n <- [1 :: Int ..]]
--------------------------------------------------------------------------------
newTestStore :: IO Store
newTestStore = Store.new True $ storeDirectory testConfiguration
--------------------------------------------------------------------------------
newTestProvider :: Store -> IO Provider
newTestProvider store = newProvider store (const $ return False) $
providerDirectory testConfiguration
--------------------------------------------------------------------------------
testCompiler :: Store -> Provider -> Identifier -> Compiler a
-> IO (CompilerResult a)
testCompiler store provider underlying compiler = do
logger <- Logger.new Logger.Error
let read' = CompilerRead
{ compilerConfig = testConfiguration
, compilerUnderlying = underlying
, compilerProvider = provider
, compilerUniverse = S.empty
, 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 -> fail $
"TestSuite.Util.testCompilerDone: compiler " ++ show underlying ++
" threw: " ++ intercalate "; " (compilerErrorMessages e)
CompilerRequire i _ -> fail $
"TestSuite.Util.testCompilerDone: compiler " ++ show underlying ++
" requires: " ++ show i
CompilerSnapshot _ _ -> fail
"TestSuite.Util.testCompilerDone: unexpected CompilerSnapshot"
testCompilerError :: Store -> Provider -> Identifier -> Compiler a -> String -> IO ()
testCompilerError store provider underlying compiler expectedMessage = do
result <- testCompiler store provider underlying compiler
case result of
CompilerError e ->
any (expectedMessage `isInfixOf`) (compilerErrorMessages e) @?
"Expecting '" ++ expectedMessage ++ "' error"
_ -> assertFailure "Expecting CompilerError"
--------------------------------------------------------------------------------
testConfiguration :: Configuration
testConfiguration = defaultConfiguration
{ destinationDirectory = "_testsite"
, storeDirectory = "_teststore"
, tmpDirectory = "_testtmp"
, providerDirectory = "tests/data"
}
--------------------------------------------------------------------------------
cleanTestEnv :: IO ()
cleanTestEnv = do
removeDirectory $ destinationDirectory testConfiguration
removeDirectory $ storeDirectory testConfiguration
removeDirectory $ tmpDirectory testConfiguration
--------------------------------------------------------------------------------
-- | like 'Hakyll.Web.Pandoc.renderPandoc'
-- | but allowing to test without the @usePandoc@ flag
renderParagraphs :: Item String -> Compiler (Item String)
renderParagraphs = withItemBody (return
. intercalate "\n" -- no trailing line
. map (("<p>"++) . (++"</p>"))
. lines)
|
