@@ -1,24 +1,32 @@
1+--------------------------------------------------------------------------------
12-- | Test utilities
2−--
33module TestSuite.Util
44 ( fromAssertions
5− , makeStoreTest
6− , runCompilerJobTest
5+ , withTestStore
6+ , newTestProvider
7+ , testCompiler
8+ , testCompilerDone
79 ) where
810
9−import Data.Monoid (mempty)
1011
11−import Test.Framework
12−import Test.Framework.Providers.HUnit
13−import Test.HUnit hiding (Test)
12+--------------------------------------------------------------------------------
13+import Data.Monoid (mempty)
14+import System.Directory (removeDirectoryRecursive)
15+import Test.Framework
16+import Test.Framework.Providers.HUnit
17+import Test.HUnit hiding (Test)
1418
15−import Hakyll.Core.Compiler.Internal
16−import Hakyll.Core.Identifier
17−import Hakyll.Core.Logger
18−import Hakyll.Core.Resource.Provider
19−import Hakyll.Core.Store (Store)
20−import qualified Hakyll.Core.Store as Store
2119
20+--------------------------------------------------------------------------------
21+import Hakyll.Core.Compiler.Internal
22+import Hakyll.Core.Identifier
23+import qualified Hakyll.Core.Logger as Logger
24+import Hakyll.Core.Provider
25+import Hakyll.Core.Store (Store)
26+import qualified Hakyll.Core.Store as Store
27+
28+
29+--------------------------------------------------------------------------------
2230fromAssertions :: String -- ^ Name
2331 -> [Assertion] -- ^ Cases
2432 -> [Test] -- ^ Result tests
@@ -26,20 +34,49 @@ fromAssertions name = zipWith testCase names
2634 where
2735 names = map (\n -> name ++ " [" ++ show n ++ "]") [1 :: Int ..]
2836
29−-- | Create a store for testing
30−--
31−makeStoreTest :: IO Store
32−makeStoreTest = Store.new True "_store"
33−
34−-- | Testing for 'runCompilerJob'
35−--
36−runCompilerJobTest :: Compiler () a
37− -> Identifier ()
38− -> ResourceProvider
39− -> [Identifier ()]
40− -> IO a
41−runCompilerJobTest compiler id' provider uni = do
42− store <- makeStoreTest
43− logger <- makeLogger $ const $ return ()
44− Right x <- runCompilerJob compiler id' provider uni mempty store True logger
45− return x
37+
38+--------------------------------------------------------------------------------
39+withTestStore :: (Store -> IO a) -> IO a
40+withTestStore f = do
41+ store <- Store.new True "_teststore"
42+ result <- f store
43+ removeDirectoryRecursive "_teststore"
44+ return result
45+
46+
47+--------------------------------------------------------------------------------
48+newTestProvider :: Store -> IO Provider
49+newTestProvider store = newProvider store (const False) "tests/data"
50+
51+
52+--------------------------------------------------------------------------------
53+testCompiler :: Store -> Provider -> Identifier -> Compiler a
54+ -> IO (CompilerResult a)
55+testCompiler store provider underlying compiler = do
56+ logger <- Logger.new Logger.Debug (\_ -> return ())
57+ let read' = CompilerRead
58+ { compilerUnderlying = underlying
59+ , compilerProvider = provider
60+ , compilerUniverse = []
61+ , compilerRoutes = mempty
62+ , compilerStore = store
63+ , compilerLogger = logger
64+ }
65+
66+ result <- runCompiler compiler read'
67+ Logger.flush logger
68+ return result
69+
70+
71+--------------------------------------------------------------------------------
72+testCompilerDone :: Store -> Provider -> Identifier -> Compiler a -> IO a
73+testCompilerDone store provider underlying compiler = do
74+ result <- testCompiler store provider underlying compiler
75+ case result of
76+ CompilerDone x _ -> return x
77+ CompilerError e -> error $
78+ "TestSuite.Util.testCompilerDone: compiler " ++ show underlying ++
79+ " threw: " ++ e
80+ CompilerRequire i _ -> error $
81+ "TestSuite.Util.testCompilerDone: compiler " ++ show underlying ++
82+ " requires: " ++ show i