From 88ffd3c5bea6b5e5cb1004173130b5691a7591f6 Mon Sep 17 00:00:00 2001 From: Jasper Van der Jeugt Date: Mon, 19 Nov 2012 14:59:55 +0100 Subject: Add tests again --- tests/TestSuite/Util.hs | 97 ++++++++++++++++++++++++++++++++++--------------- 1 file changed, 67 insertions(+), 30 deletions(-) (limited to 'tests/TestSuite') diff --git a/tests/TestSuite/Util.hs b/tests/TestSuite/Util.hs index 4fd87bf..6b19333 100644 --- a/tests/TestSuite/Util.hs +++ b/tests/TestSuite/Util.hs @@ -1,24 +1,32 @@ +-------------------------------------------------------------------------------- -- | Test utilities --- module TestSuite.Util ( fromAssertions - , makeStoreTest - , runCompilerJobTest + , withTestStore + , newTestProvider + , testCompiler + , testCompilerDone ) where -import Data.Monoid (mempty) -import Test.Framework -import Test.Framework.Providers.HUnit -import Test.HUnit hiding (Test) +-------------------------------------------------------------------------------- +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 Hakyll.Core.Logger -import Hakyll.Core.Resource.Provider -import Hakyll.Core.Store (Store) -import qualified Hakyll.Core.Store as Store +-------------------------------------------------------------------------------- +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 @@ -26,20 +34,49 @@ fromAssertions name = zipWith testCase names where names = map (\n -> name ++ " [" ++ show n ++ "]") [1 :: Int ..] --- | Create a store for testing --- -makeStoreTest :: IO Store -makeStoreTest = Store.new True "_store" - --- | Testing for 'runCompilerJob' --- -runCompilerJobTest :: Compiler () a - -> Identifier () - -> ResourceProvider - -> [Identifier ()] - -> IO a -runCompilerJobTest compiler id' provider uni = do - store <- makeStoreTest - logger <- makeLogger $ const $ return () - Right x <- runCompilerJob compiler id' provider uni mempty store True logger - return x + +-------------------------------------------------------------------------------- +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 -- cgit v1.2.3