Add tests again

1 files changed, 67 insertions, 30 deletions

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