Update more tests

hakyll.cabal

@@ -109,7 +109,6 @@ Library
     Hakyll.Core.Rules
     Hakyll.Core.Runtime
     Hakyll.Core.Store
-    Hakyll.Core.Util.Arrow
     Hakyll.Core.Util.File
     Hakyll.Core.Util.String
     Hakyll.Core.Writable

src/Hakyll.hs

@@ -13,7 +13,6 @@ module Hakyll
 #ifdef UNIX_FILTER
     , module Hakyll.Core.UnixFilter
 #endif
-    , module Hakyll.Core.Util.Arrow
     , module Hakyll.Core.Util.File
     , module Hakyll.Core.Util.String
     , module Hakyll.Core.Writable
@@ -46,7 +45,6 @@ import Hakyll.Core.Rules
 #ifdef UNIX_FILTER
 import Hakyll.Core.UnixFilter
 #endif
-import Hakyll.Core.Util.Arrow
 import Hakyll.Core.Util.File
 import Hakyll.Core.Util.String
 import Hakyll.Core.Writable

src/Hakyll/Core/UnixFilter.hs

@@ -26,7 +26,7 @@ import           Hakyll.Core.Compiler
 -- as a compiler.
 --
 -- > rev :: Compiler String
--- > rev = getResourceString >>= unixFilter "rev" []
+-- > rev = getResourceString >>= itemM (unixFilter "rev" [])
 --
 -- A more realistic example: one can use this to call, for example, the sass
 -- compiler on CSS files. More information about sass can be found here:
@@ -38,7 +38,7 @@ import           Hakyll.Core.Compiler
 -- > match "style.scss" $ do
 -- >     route   $ setExtension "css"
 -- >     compile $ getResourceString >>=
--- >         unixFilter "sass" ["-s", "--scss"] >>=
+-- >         itemM (unixFilter "sass" ["-s", "--scss"]) >>=
 -- >         compressCssCompiler
 unixFilter :: String           -- ^ Program name
            -> [String]         -- ^ Program args

src/Hakyll/Core/Util/Arrow.hs

@@ -1,40 +0,0 @@
---------------------------------------------------------------------------------
--- | Various arrow utility functions
-module Hakyll.Core.Util.Arrow
-    ( ArrowMap (..)
-    , constA
-    , sequenceA
-    , unitA
-    ) where
-
-
---------------------------------------------------------------------------------
-import           Control.Arrow (Arrow, ArrowChoice, arr, (&&&), (>>^))
-
-
---------------------------------------------------------------------------------
--- | Additional arrow typeclass for performance reasons.
-class ArrowChoice a => ArrowMap a where
-    mapA :: a b c -> a [b] [c]
-
-
---------------------------------------------------------------------------------
-instance ArrowMap (->) where
-    mapA = map
-
-
---------------------------------------------------------------------------------
-constA :: Arrow a => c -> a b c
-constA = arr . const
-
-
---------------------------------------------------------------------------------
-sequenceA :: Arrow a => [a b c] -> a b [c]
-sequenceA = foldr reduce $ constA []
-  where
-    reduce xa la = xa &&& la >>^ arr (uncurry (:))
-
-
---------------------------------------------------------------------------------
-unitA :: Arrow a => a b ()
-unitA = constA ()

tests/Hakyll/Core/Compiler/Tests.hs

@@ -1,36 +0,0 @@
-{-# LANGUAGE OverloadedStrings #-}
-module Hakyll.Core.Compiler.Tests
-    ( tests
-    ) where
-
-import qualified Data.Map as M
-
-import Test.Framework (Test)
-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.Util.Arrow
-import TestSuite.Util
-
-tests :: [Test]
-tests =
-    [ testCase "byExtension" byExtensionTest
-    ]
-
-byExtensionTest :: H.Assertion
-byExtensionTest = do
-    provider <- dummyResourceProvider $ M.empty
-    txt      <- runCompilerJobTest compiler "foo.txt" provider uni
-    css      <- runCompilerJobTest compiler "bar.css" provider uni
-    html     <- runCompilerJobTest compiler "qux.html" provider uni
-    H.assertEqual "byExtension" "txt" txt
-    H.assertEqual "byExtension" "css" css
-    H.assertEqual "byExtension" "unknown" html
-  where
-    uni      = ["foo.txt", "bar.css", "qux.html"]
-    compiler = byExtension (constA ("unknown" :: String))
-        [ (".txt", constA "txt")
-        , (".css", constA "css")
-        ]

tests/Hakyll/Core/Dependencies/Tests.hs

@@ -6,26 +6,23 @@ module Hakyll.Core.Dependencies.Tests
 
 
 --------------------------------------------------------------------------------
-import           Data.List                      (delete)
-import qualified Data.Map                       as M
-import qualified Data.Set                       as S
-import           Test.Framework                 (Test, testGroup)
-import           Test.Framework.Providers.HUnit (testCase)
-import           Test.HUnit                     (Assertion, (@=?))
+import           Data.List                (delete)
+import qualified Data.Map                 as M
+import qualified Data.Set                 as S
+import           Test.Framework           (Test, testGroup)
+import           Test.HUnit               (Assertion, (@=?))
 
 
 --------------------------------------------------------------------------------
 import           Hakyll.Core.Dependencies
 import           Hakyll.Core.Identifier
+import           TestSuite.Util
 
 
 --------------------------------------------------------------------------------
 tests :: Test
-tests = testGroup "Hakyll.Core.Dependencies.Tests"
-    [ testCase "case01" case01
-    , testCase "case02" case02
-    , testCase "case03" case03
-    ]
+tests = testGroup "Hakyll.Core.Dependencies.Tests" $
+    fromAssertions "analyze" [case01, case02, case03]
 
 
 --------------------------------------------------------------------------------

tests/Hakyll/Core/Util/Arrow/Tests.hs

@@ -1,14 +0,0 @@
-module Hakyll.Core.Util.Arrow.Tests
-    ( tests
-    ) where
-
-import Test.Framework (Test)
-import Test.HUnit ((@=?))
-
-import Hakyll.Core.Util.Arrow
-import TestSuite.Util
-
-tests :: [Test]
-tests = fromAssertions "sequenceA"
-    [ [8, 20, 1] @=? sequenceA [(+ 4), (* 5), signum] (4 :: Int)
-    ]

tests/Hakyll/Web/Urls/Relativize/Tests.hs

@@ -1,25 +1,35 @@
+--------------------------------------------------------------------------------
 {-# LANGUAGE OverloadedStrings #-}
 module Hakyll.Web.Urls.Relativize.Tests
     ( tests
     ) where
 
-import Test.Framework
-import Test.HUnit hiding (Test)
 
-import Hakyll.Web.Urls.Relativize
-import TestSuite.Util
+--------------------------------------------------------------------------------
+import           Test.Framework             (Test, testGroup)
+import           Test.HUnit                 ((@=?))
 
-tests :: [Test]
-tests = fromAssertions "relativizeUrls"
-    [ "<a href=\"../foo\">bar</a>" @=?
-        relativizeUrls ".." "<a href=\"/foo\">bar</a>"
-    , "<img src=\"../../images/lolcat.png\"></img>" @=?
-        relativizeUrls "../.." "<img src=\"/images/lolcat.png\" />"
-    , "<a href=\"http://haskell.org\">Haskell</a>" @=?
-        relativizeUrls "../.." "<a href=\"http://haskell.org\">Haskell</a>"
-    , "<a href=\"http://haskell.org\">Haskell</a>" @=?
-        relativizeUrls "../.." "<a href=\"http://haskell.org\">Haskell</a>"
-    , "<script src=\"//ajax.googleapis.com/jquery.min.js\"></script>" @=?
-        relativizeUrls "../.."
-            "<script src=\"//ajax.googleapis.com/jquery.min.js\"></script>"
-    ]
+
+--------------------------------------------------------------------------------
+import           Hakyll.Web.Urls.Relativize
+import           TestSuite.Util
+
+
+--------------------------------------------------------------------------------
+tests :: Test
+tests = testGroup "Hakyll.Web.Urls.Relativize.Tests" $
+    fromAssertions "relativizeUrls"
+        [ "<a href=\"../foo\">bar</a>" @=?
+            relativizeUrlsWith ".." "<a href=\"/foo\">bar</a>"
+        , "<img src=\"../../images/lolcat.png\"></img>" @=?
+            relativizeUrlsWith "../.." "<img src=\"/images/lolcat.png\" />"
+        , "<a href=\"http://haskell.org\">Haskell</a>" @=?
+            relativizeUrlsWith "../.."
+                "<a href=\"http://haskell.org\">Haskell</a>"
+        , "<a href=\"http://haskell.org\">Haskell</a>" @=?
+            relativizeUrlsWith "../.."
+                "<a href=\"http://haskell.org\">Haskell</a>"
+        , "<script src=\"//ajax.googleapis.com/jquery.min.js\"></script>" @=?
+            relativizeUrlsWith "../.."
+                "<script src=\"//ajax.googleapis.com/jquery.min.js\"></script>"
+        ]

tests/Hakyll/Web/Urls/Tests.hs

@@ -1,17 +1,23 @@
+--------------------------------------------------------------------------------
 module Hakyll.Web.Urls.Tests
     ( tests
     ) where
 
-import Data.Char (toUpper)
 
-import Test.Framework
-import Test.HUnit hiding (Test)
+--------------------------------------------------------------------------------
+import           Data.Char       (toUpper)
+import           Test.Framework  (Test, testGroup)
+import           Test.HUnit      (assert, (@=?))
 
-import Hakyll.Web.Urls
-import TestSuite.Util
 
-tests :: [Test]
-tests = concat
+--------------------------------------------------------------------------------
+import           Hakyll.Web.Urls
+import           TestSuite.Util
+
+
+--------------------------------------------------------------------------------
+tests :: Test
+tests = testGroup "Hakyll.Web.Urls.Tests" $ concat
     [ fromAssertions "withUrls"
         [ "<a href=\"FOO\">bar</a>" @=?
             withUrls (map toUpper) "<a href=\"foo\">bar</a>"
@@ -26,17 +32,20 @@ tests = concat
         , "<style>body > p { line-height: 1.3 }</style>" @=?
             withUrls id "<style>body > p { line-height: 1.3 }</style>"
         ]
+
     , fromAssertions "toUrl"
         [ "/foo/bar.html"    @=? toUrl "foo/bar.html"
         , "/"                @=? toUrl "/"
         , "/funny-pics.html" @=? toUrl "/funny-pics.html"
         ]
+
     , fromAssertions "toSiteRoot"
         [ ".."    @=? toSiteRoot "/foo/bar.html"
         , "."     @=? toSiteRoot "index.html"
         , "."     @=? toSiteRoot "/index.html"
         , "../.." @=? toSiteRoot "foo/bar/qux"
         ]
+
     , fromAssertions "isExternal"
         [ assert (isExternal "http://reddit.com")
         , assert (isExternal "https://mail.google.com")

tests/TestSuite.hs

@@ -15,6 +15,8 @@ import qualified Hakyll.Core.Provider.Tests
 import qualified Hakyll.Core.Store.Tests
 import qualified Hakyll.Core.UnixFilter.Tests
 import qualified Hakyll.Web.Template.Tests
+import qualified Hakyll.Web.Urls.Tests
+import qualified Hakyll.Web.Urls.Relativize.Tests
 
 
 --------------------------------------------------------------------------------
@@ -26,4 +28,6 @@ main = defaultMain
     , Hakyll.Core.Store.Tests.tests
     , Hakyll.Core.UnixFilter.Tests.tests
     , Hakyll.Web.Template.Tests.tests
+    , Hakyll.Web.Urls.Tests.tests
+    , Hakyll.Web.Urls.Relativize.Tests.tests
     ]

tests/TestSuite/Util.hs

@@ -17,6 +17,7 @@ import           System.Directory               (removeDirectoryRecursive)
 import           Test.Framework
 import           Test.Framework.Providers.HUnit
 import           Test.HUnit                     hiding (Test)
+import           Text.Printf                    (printf)
 
 
 --------------------------------------------------------------------------------
@@ -32,9 +33,8 @@ import qualified Hakyll.Core.Store              as Store
 fromAssertions :: String       -- ^ Name
                -> [Assertion]  -- ^ Cases
                -> [Test]       -- ^ Result tests
-fromAssertions name = zipWith testCase names
-  where
-    names = map (\n -> name ++ " [" ++ show n ++ "]") [1 :: Int ..]
+fromAssertions name =
+    zipWith testCase [printf "%s [%3d]" name n | n <- [1 :: Int ..]]
 
 
 --------------------------------------------------------------------------------