Re-enable some tests

src/Hakyll/Core/Item.hs

@@ -5,6 +5,7 @@
 module Hakyll.Core.Item
     ( Item (..)
     , itemSetBody
+    , itemM
     ) where
 
 
@@ -39,3 +40,8 @@ instance Binary a => Binary (Item a) where
 --------------------------------------------------------------------------------
 itemSetBody :: a -> Item b -> Item a
 itemSetBody x (Item i _) = Item i x
+
+
+--------------------------------------------------------------------------------
+itemM :: Monad m => (a -> m b) -> Item a -> m (Item b)
+itemM f (Item i b) = f b >>= \b' -> return (Item i b')

tests/Hakyll/Core/DependencyAnalyzer/Tests.hs

@@ -1,70 +0,0 @@
-module Hakyll.Core.DependencyAnalyzer.Tests where
-
-import Control.Arrow (second)
-import qualified Data.Set as S
-import Data.Monoid (mempty)
-
-import Test.Framework
-import Test.Framework.Providers.HUnit
-import Test.HUnit hiding (Test)
-
-import Hakyll.Core.DirectedGraph
-import Hakyll.Core.DependencyAnalyzer
-
-tests :: [Test]
-tests =
-    [ testCase "step [1]" step1
-    , testCase "step [2]" step2
-    ]
-
-step1 :: Assertion
-step1 = Just (S.fromList [1, 2, 5, 6, 7, 8, 9]) @?=
-    stepAll (makeDependencyAnalyzer graph isOutOfDate prev)
-  where
-    node = curry $ second S.fromList
-
-    graph = fromList
-        [ node (8 :: Int) [2, 4, 6]
-        , node 2 [4, 3]
-        , node 4 [3]
-        , node 6 [4]
-        , node 3 []
-        , node 9 [5]
-        , node 5 [7]
-        , node 1 [7]
-        , node 7 []
-        ]
-
-    prev = fromList
-        [ node 8 [2, 4, 6]
-        , node 2 [4, 3]
-        , node 4 [3]
-        , node 6 [4]
-        , node 3 []
-        , node 9 [5]
-        , node 5 [7]
-        , node 1 [7]
-        , node 7 [8]
-        ]
-
-    isOutOfDate = (`elem` [5, 2, 6])
-
-step2 :: Assertion
-step2 = Nothing @?= stepAll (makeDependencyAnalyzer graph isOutOfDate mempty)
-  where
-    node = curry $ second S.fromList
-
-    -- Cycle: 4 -> 7 -> 5 -> 9 -> 4
-    graph = fromList
-        [ node (1 :: Int) [6]
-        , node 2 [3]
-        , node 3 []
-        , node 4 [1, 7, 8]
-        , node 5 [9]
-        , node 6 [3]
-        , node 7 [5]
-        , node 8 [2]
-        , node 9 [4]
-        ]
-
-    isOutOfDate = const True

tests/Hakyll/Core/Identifier/Tests.hs

@@ -1,21 +1,30 @@
+--------------------------------------------------------------------------------
 {-# LANGUAGE OverloadedStrings #-}
 module Hakyll.Core.Identifier.Tests
     ( tests
     ) where
 
-import Test.Framework
-import Test.HUnit hiding (Test)
 
-import Hakyll.Core.Identifier
+--------------------------------------------------------------------------------
-import Hakyll.Core.Identifier.Pattern
+import           Test.Framework                 (Test, testGroup)
-import TestSuite.Util
+import           Test.HUnit                     ((@=?))
 
-tests :: [Test]
+
-tests = concat
+--------------------------------------------------------------------------------
+import           Hakyll.Core.Identifier
+import           Hakyll.Core.Identifier.Pattern
+import           TestSuite.Util
+
+
+--------------------------------------------------------------------------------
+tests :: Test
+tests = testGroup "Hakyll.Core.Identifier.Tests" $ concat
     [ captureTests
     , matchesTests
     ]
 
+
+--------------------------------------------------------------------------------
 captureTests :: [Test]
 captureTests = fromAssertions "capture"
     [ Just ["bar"]              @=? capture "foo/**" "foo/bar"
@@ -35,12 +44,15 @@ captureTests = fromAssertions "capture"
     , Nothing                   @=? capture "\\*.jpg" "foo.jpg"
     ]
 
+
+--------------------------------------------------------------------------------
 matchesTests :: [Test]
 matchesTests = fromAssertions "matches"
-    [ True  @=? matches (list ["foo.markdown"]) "foo.markdown"
+    [ True  @=? matches (fromList ["foo.markdown"]) "foo.markdown"
-    , False @=? matches (list ["foo"]) (Identifier (Just "foo") "foo")
+    , False @=? matches (fromList ["foo"]) (setVersion (Just "x") "foo")
-    , True  @=? matches (regex "^foo/[^x]*$") "foo/bar"
+    , True  @=? matches (fromVersion (Just "xz")) (setVersion (Just "xz") "bar")
-    , False @=? matches (regex "^foo/[^x]*$") "foo/barx"
+    , True  @=? matches (fromRegex "^foo/[^x]*$") "foo/bar"
+    , False @=? matches (fromRegex "^foo/[^x]*$") "foo/barx"
     , True  @=? matches (complement "foo.markdown") "bar.markdown"
     , False @=? matches (complement "foo.markdown") "foo.markdown"
     ]

tests/Hakyll/Core/Store/Tests.hs

@@ -7,12 +7,12 @@ module Hakyll.Core.Store.Tests
 
 --------------------------------------------------------------------------------
 import           Data.Typeable                        (typeOf)
-import           Test.Framework
+import           Test.Framework                       (Test, testGroup)
-import           Test.Framework.Providers.HUnit
+import           Test.Framework.Providers.HUnit       (testCase)
-import           Test.Framework.Providers.QuickCheck2
+import           Test.Framework.Providers.QuickCheck2 (testProperty)
 import qualified Test.HUnit                           as H
-import           Test.QuickCheck
+import qualified Test.QuickCheck                      as Q
-import           Test.QuickCheck.Monadic
+import qualified Test.QuickCheck.Monadic              as Q
 
 
 --------------------------------------------------------------------------------
@@ -21,8 +21,8 @@ import           TestSuite.Util
 
 
 --------------------------------------------------------------------------------
-tests :: [Test]
+tests :: Test
-tests =
+tests = testGroup "Hakyll.Core.Store.Tests"
     [ testProperty "simple get . set"     simpleSetGet
     , testProperty "persistent get . set" persistentSetGet
     , testCase     "WrongType get . set"  wrongType
@@ -30,33 +30,34 @@ tests =
 
 
 --------------------------------------------------------------------------------
-simpleSetGet :: Property
+simpleSetGet :: Q.Property
-simpleSetGet = monadicIO $ do
+simpleSetGet = Q.monadicIO $ do
-    key   <- pick arbitrary
+    key   <- Q.pick Q.arbitrary
-    value <- pick arbitrary
+    value <- Q.pick Q.arbitrary
-    store <- run $ makeStoreTest
+    store <- Q.run newTestStore
-    run $ Store.set store key (value :: String)
+    Q.run $ Store.set store key (value :: String)
-    value' <- run $ Store.get store key
+    value' <- Q.run $ Store.get store key
-    assert $ Store.Found value == value'
+    Q.assert $ Store.Found value == value'
+    Q.run cleanTestStore
 
 
 --------------------------------------------------------------------------------
-persistentSetGet :: Property
+persistentSetGet :: Q.Property
-persistentSetGet = monadicIO $ do
+persistentSetGet = Q.monadicIO $ do
-    key    <- pick arbitrary
+    key    <- Q.pick Q.arbitrary
-    value  <- pick arbitrary
+    value  <- Q.pick Q.arbitrary
-    store1 <- run $ makeStoreTest
+    store1 <- Q.run newTestStore
-    run $ Store.set store1 key (value :: String)
+    Q.run $ Store.set store1 key (value :: String)
     -- Now Create another store from the same dir to test persistence
-    store2 <- run $ makeStoreTest
+    store2 <- Q.run newTestStore
-    value' <- run $ Store.get store2 key
+    value' <- Q.run $ Store.get store2 key
-    assert $ Store.Found value == value'
+    Q.assert $ Store.Found value == value'
+    Q.run cleanTestStore
 
 
 --------------------------------------------------------------------------------
 wrongType :: H.Assertion
-wrongType = do
+wrongType = withTestStore $ \store -> do
-    store <- makeStoreTest
     -- Store a string and try to fetch an int
     Store.set store ["foo", "bar"] ("qux" :: String)
     value <- Store.get store ["foo", "bar"] :: IO (Store.Result Int)

tests/Hakyll/Core/UnixFilter/Tests.hs

@@ -1,50 +1,37 @@
+--------------------------------------------------------------------------------
 {-# LANGUAGE OverloadedStrings #-}
 module Hakyll.Core.UnixFilter.Tests
-    where
+    ( tests
+    ) where
 
-import Control.Arrow ((>>>))
-import qualified Data.Map as M
 
-import Test.Framework (Test)
+--------------------------------------------------------------------------------
-import Test.Framework.Providers.HUnit (testCase)
+import           Test.Framework                 (Test, testGroup)
-import qualified Test.HUnit as H
+import           Test.Framework.Providers.HUnit (testCase)
-import qualified Data.Text.Lazy as TL
+import qualified Test.HUnit                     as H
-import qualified Data.Text.Lazy.Encoding as TL
 
-import Hakyll.Core.Compiler
-import Hakyll.Core.Resource.Provider.Dummy
-import Hakyll.Core.UnixFilter
-import TestSuite.Util
 
-tests :: [Test]
+--------------------------------------------------------------------------------
-tests =
+import           Hakyll.Core.Compiler
+import           Hakyll.Core.Item
+import           Hakyll.Core.UnixFilter
+import           TestSuite.Util
+
+
+--------------------------------------------------------------------------------
+tests :: Test
+tests = testGroup "Hakyll.Core.UnixFilter.Tests"
     [ testCase "unixFilter rev" unixFilterRev
     ]
 
-unixFilterRev :: H.Assertion
-unixFilterRev = do
-    provider <- dummyResourceProvider $ M.singleton "foo" $
-        TL.encodeUtf8 $ TL.pack text
-    output <- runCompilerJobTest compiler "foo" provider ["foo"]
-    H.assert $ rev text == lines output
-  where
-    compiler = getResource >>> getResourceString >>> unixFilter "rev" []
-    rev = map reverse . lines
 
-text :: String
+--------------------------------------------------------------------------------
-text = unlines
+unixFilterRev :: H.Assertion
-    [ "Статья 18"
+unixFilterRev = withTestStore $ \store -> do
-    , ""
+    provider <- newTestProvider store
-    , "Каждый человек имеет право на свободу мысли, совести и религии; это"
+    output   <- testCompilerDone store provider "russian.md" compiler
-    , "право включает свободу менять свою религию или убеждения и свободу"
+    expected <- testCompilerDone store provider "russian.md" getResourceString
-    , "исповедовать свою религию или убеждения как единолично, так и сообща с"
+    H.assert $ rev (itemBody expected) == lines (itemBody output)
-    , "другими, публичным или частным порядком в учении, богослужении и"
+  where
-    , "выполнении религиозных и ритуальных обрядов."
+    compiler = getResourceString >>= itemM (unixFilter "rev" [])
-    , ""
+    rev      = map reverse . lines
-    , "Статья 19"
-    , ""
-    , "Каждый человек имеет право на свободу убеждений и на свободное выражение"
-    , "их; это право включает свободу беспрепятственно придерживаться своих"
-    , "убеждений и свободу искать, получать и распространять информацию и идеи"
-    , "любыми средствами и независимо от государственных границ."
-    ]

tests/TestSuite.hs

@@ -5,12 +5,15 @@ module Main
 
 
 --------------------------------------------------------------------------------
-import Test.Framework (defaultMain)
+import           Test.Framework                 (defaultMain)
 
 
 --------------------------------------------------------------------------------
 import qualified Hakyll.Core.Dependencies.Tests
+import qualified Hakyll.Core.Identifier.Tests
 import qualified Hakyll.Core.Provider.Tests
+import qualified Hakyll.Core.Store.Tests
+import qualified Hakyll.Core.UnixFilter.Tests
 import qualified Hakyll.Web.Template.Tests
 
 
@@ -18,6 +21,9 @@ import qualified Hakyll.Web.Template.Tests
 main :: IO ()
 main = defaultMain
     [ Hakyll.Core.Dependencies.Tests.tests
+    , Hakyll.Core.Identifier.Tests.tests
     , Hakyll.Core.Provider.Tests.tests
+    , Hakyll.Core.Store.Tests.tests
+    , Hakyll.Core.UnixFilter.Tests.tests
     , Hakyll.Web.Template.Tests.tests
     ]

tests/TestSuite/Util.hs

@@ -2,6 +2,8 @@
 -- | Test utilities
 module TestSuite.Util
     ( fromAssertions
+    , newTestStore
+    , cleanTestStore
     , withTestStore
     , newTestProvider
     , testCompiler
@@ -35,12 +37,22 @@ fromAssertions name = zipWith testCase names
     names = map (\n -> name ++ " [" ++ show n ++ "]") [1 :: Int ..]
 
 
+--------------------------------------------------------------------------------
+newTestStore :: IO Store
+newTestStore = Store.new True "_teststore"
+
+
+--------------------------------------------------------------------------------
+cleanTestStore :: IO ()
+cleanTestStore = removeDirectoryRecursive "_teststore"
+
+
 --------------------------------------------------------------------------------
 withTestStore :: (Store -> IO a) -> IO a
 withTestStore f = do
-    store  <- Store.new True "_teststore"
+    store  <- newTestStore
     result <- f store
-    removeDirectoryRecursive "_teststore"
+    cleanTestStore
     return result
 
 

tests/data/russian.md

@@ -0,0 +1,14 @@
+Статья 18
+
+Каждый человек имеет право на свободу мысли, совести и религии; это
+право включает свободу менять свою религию или убеждения и свободу
+исповедовать свою религию или убеждения как единолично, так и сообща с
+другими, публичным или частным порядком в учении, богослужении и
+выполнении религиозных и ритуальных обрядов.
+
+Статья 19
+
+Каждый человек имеет право на свободу убеждений и на свободное выражение
+их; это право включает свободу беспрепятственно придерживаться своих
+убеждений и свободу искать, получать и распространять информацию и идеи
+любыми средствами и независимо от государственных границ.