summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat
-rw-r--r--src/Hakyll/Core/Item.hs6
-rw-r--r--tests/Hakyll/Core/DependencyAnalyzer/Tests.hs70
-rw-r--r--tests/Hakyll/Core/Identifier/Tests.hs34
-rw-r--r--tests/Hakyll/Core/Store/Tests.hs53
-rw-r--r--tests/Hakyll/Core/UnixFilter/Tests.hs65
-rw-r--r--tests/TestSuite.hs8
-rw-r--r--tests/TestSuite/Util.hs16
-rw-r--r--tests/data/russian.md14
8 files changed, 117 insertions, 149 deletions
diff --git a/src/Hakyll/Core/Item.hs b/src/Hakyll/Core/Item.hs
index 1f9af8e..ccf9e9a 100644
--- a/src/Hakyll/Core/Item.hs
+++ b/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')
diff --git a/tests/Hakyll/Core/DependencyAnalyzer/Tests.hs b/tests/Hakyll/Core/DependencyAnalyzer/Tests.hs
deleted file mode 100644
index 891fa98..0000000
--- a/tests/Hakyll/Core/DependencyAnalyzer/Tests.hs
+++ /dev/null
@@ -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
diff --git a/tests/Hakyll/Core/Identifier/Tests.hs b/tests/Hakyll/Core/Identifier/Tests.hs
index c496a98..b477a7c 100644
--- a/tests/Hakyll/Core/Identifier/Tests.hs
+++ b/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 TestSuite.Util
+--------------------------------------------------------------------------------
+import Test.Framework (Test, testGroup)
+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"
- , False @=? matches (list ["foo"]) (Identifier (Just "foo") "foo")
- , True @=? matches (regex "^foo/[^x]*$") "foo/bar"
- , False @=? matches (regex "^foo/[^x]*$") "foo/barx"
+ [ True @=? matches (fromList ["foo.markdown"]) "foo.markdown"
+ , False @=? matches (fromList ["foo"]) (setVersion (Just "x") "foo")
+ , True @=? matches (fromVersion (Just "xz")) (setVersion (Just "xz") "bar")
+ , 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"
]
diff --git a/tests/Hakyll/Core/Store/Tests.hs b/tests/Hakyll/Core/Store/Tests.hs
index 3188c30..bd6cba2 100644
--- a/tests/Hakyll/Core/Store/Tests.hs
+++ b/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.Providers.HUnit
-import Test.Framework.Providers.QuickCheck2
+import Test.Framework (Test, testGroup)
+import Test.Framework.Providers.HUnit (testCase)
+import Test.Framework.Providers.QuickCheck2 (testProperty)
import qualified Test.HUnit as H
-import Test.QuickCheck
-import Test.QuickCheck.Monadic
+import qualified Test.QuickCheck as Q
+import qualified Test.QuickCheck.Monadic as Q
--------------------------------------------------------------------------------
@@ -21,8 +21,8 @@ import TestSuite.Util
--------------------------------------------------------------------------------
-tests :: [Test]
-tests =
+tests :: Test
+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 = monadicIO $ do
- key <- pick arbitrary
- value <- pick arbitrary
- store <- run $ makeStoreTest
- run $ Store.set store key (value :: String)
- value' <- run $ Store.get store key
- assert $ Store.Found value == value'
+simpleSetGet :: Q.Property
+simpleSetGet = Q.monadicIO $ do
+ key <- Q.pick Q.arbitrary
+ value <- Q.pick Q.arbitrary
+ store <- Q.run newTestStore
+ Q.run $ Store.set store key (value :: String)
+ value' <- Q.run $ Store.get store key
+ Q.assert $ Store.Found value == value'
+ Q.run cleanTestStore
--------------------------------------------------------------------------------
-persistentSetGet :: Property
-persistentSetGet = monadicIO $ do
- key <- pick arbitrary
- value <- pick arbitrary
- store1 <- run $ makeStoreTest
- run $ Store.set store1 key (value :: String)
+persistentSetGet :: Q.Property
+persistentSetGet = Q.monadicIO $ do
+ key <- Q.pick Q.arbitrary
+ value <- Q.pick Q.arbitrary
+ store1 <- Q.run newTestStore
+ Q.run $ Store.set store1 key (value :: String)
-- Now Create another store from the same dir to test persistence
- store2 <- run $ makeStoreTest
- value' <- run $ Store.get store2 key
- assert $ Store.Found value == value'
+ store2 <- Q.run newTestStore
+ value' <- Q.run $ Store.get store2 key
+ Q.assert $ Store.Found value == value'
+ Q.run cleanTestStore
--------------------------------------------------------------------------------
wrongType :: H.Assertion
-wrongType = do
- store <- makeStoreTest
+wrongType = withTestStore $ \store -> do
-- 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)
diff --git a/tests/Hakyll/Core/UnixFilter/Tests.hs b/tests/Hakyll/Core/UnixFilter/Tests.hs
index 0e8d88d..f5cbf9d 100644
--- a/tests/Hakyll/Core/UnixFilter/Tests.hs
+++ b/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 qualified Test.HUnit as H
-import qualified Data.Text.Lazy as TL
-import qualified Data.Text.Lazy.Encoding as TL
+--------------------------------------------------------------------------------
+import Test.Framework (Test, testGroup)
+import Test.Framework.Providers.HUnit (testCase)
+import qualified Test.HUnit as H
-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
+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 = getResource >>> getResourceString >>> unixFilter "rev" []
- rev = map reverse . lines
-
-text :: String
-text = unlines
- [ "Статья 18"
- , ""
- , "Каждый человек имеет право на свободу мысли, совести и религии; это"
- , "право включает свободу менять свою религию или убеждения и свободу"
- , "исповедовать свою религию или убеждения как единолично, так и сообща с"
- , "другими, публичным или частным порядком в учении, богослужении и"
- , "выполнении религиозных и ритуальных обрядов."
- , ""
- , "Статья 19"
- , ""
- , "Каждый человек имеет право на свободу убеждений и на свободное выражение"
- , "их; это право включает свободу беспрепятственно придерживаться своих"
- , "убеждений и свободу искать, получать и распространять информацию и идеи"
- , "любыми средствами и независимо от государственных границ."
- ]
+ compiler = getResourceString >>= itemM (unixFilter "rev" [])
+ rev = map reverse . lines
diff --git a/tests/TestSuite.hs b/tests/TestSuite.hs
index 4244bc9..55fe8ce 100644
--- a/tests/TestSuite.hs
+++ b/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
]
diff --git a/tests/TestSuite/Util.hs b/tests/TestSuite/Util.hs
index 6b19333..9403ce5 100644
--- a/tests/TestSuite/Util.hs
+++ b/tests/TestSuite/Util.hs
@@ -2,6 +2,8 @@
-- | Test utilities
module TestSuite.Util
( fromAssertions
+ , newTestStore
+ , cleanTestStore
, withTestStore
, newTestProvider
, testCompiler
@@ -36,11 +38,21 @@ fromAssertions name = zipWith testCase names
--------------------------------------------------------------------------------
+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
diff --git a/tests/data/russian.md b/tests/data/russian.md
new file mode 100644
index 0000000..4659f26
--- /dev/null
+++ b/tests/data/russian.md
@@ -0,0 +1,14 @@
+Статья 18
+
+Каждый человек имеет право на свободу мысли, совести и религии; это
+право включает свободу менять свою религию или убеждения и свободу
+исповедовать свою религию или убеждения как единолично, так и сообща с
+другими, публичным или частным порядком в учении, богослужении и
+выполнении религиозных и ритуальных обрядов.
+
+Статья 19
+
+Каждый человек имеет право на свободу убеждений и на свободное выражение
+их; это право включает свободу беспрепятственно придерживаться своих
+убеждений и свободу искать, получать и распространять информацию и идеи
+любыми средствами и независимо от государственных границ.
generated by cgit v1.2.3 (git 2.39.1) at 2024-11-27 11:14:58 +0000