Changed test system. Wrote some test cases.
This commit is contained in:
parent
42bacee41a
commit
d97a53b6b4
6 changed files with 114 additions and 147 deletions
11
hakyll.cabal
11
hakyll.cabal
|
@ -34,7 +34,8 @@ library
|
||||||
mtl >= 1.1,
|
mtl >= 1.1,
|
||||||
old-locale >= 1,
|
old-locale >= 1,
|
||||||
time >= 1,
|
time >= 1,
|
||||||
binary >= 0.5
|
binary >= 0.5,
|
||||||
|
QuickCheck >= 2
|
||||||
exposed-modules: Network.Hakyll.SimpleServer
|
exposed-modules: Network.Hakyll.SimpleServer
|
||||||
Text.Hakyll
|
Text.Hakyll
|
||||||
Text.Hakyll.Context
|
Text.Hakyll.Context
|
||||||
|
@ -47,7 +48,7 @@ library
|
||||||
Text.Hakyll.Page
|
Text.Hakyll.Page
|
||||||
Text.Hakyll.Util
|
Text.Hakyll.Util
|
||||||
Text.Hakyll.Tags
|
Text.Hakyll.Tags
|
||||||
other-modules: Text.Hakyll.Internal.Cache
|
Text.Hakyll.Internal.Cache
|
||||||
Text.Hakyll.Internal.CompressCSS
|
Text.Hakyll.Internal.CompressCSS
|
||||||
Text.Hakyll.Internal.Render
|
Text.Hakyll.Internal.Render
|
||||||
Text.Hakyll.Internal.Template
|
Text.Hakyll.Internal.Template
|
||||||
|
|
|
@ -11,21 +11,25 @@ import qualified Data.Map as M
|
||||||
import Data.List (isPrefixOf)
|
import Data.List (isPrefixOf)
|
||||||
import Data.Char (isAlphaNum)
|
import Data.Char (isAlphaNum)
|
||||||
import Data.Binary
|
import Data.Binary
|
||||||
import Control.Monad (liftM, liftM2)
|
import Control.Monad (liftM, liftM2, replicateM)
|
||||||
import Data.Maybe (fromMaybe)
|
import Data.Maybe (fromMaybe)
|
||||||
import System.FilePath ((</>))
|
import System.FilePath ((</>))
|
||||||
import Control.Monad.Reader (liftIO)
|
import Control.Monad.Reader (liftIO)
|
||||||
|
|
||||||
|
import Test.QuickCheck
|
||||||
|
|
||||||
import Text.Hakyll.Hakyll (Hakyll)
|
import Text.Hakyll.Hakyll (Hakyll)
|
||||||
import Text.Hakyll.Context (Context)
|
import Text.Hakyll.Context (Context)
|
||||||
import Text.Hakyll.Internal.Cache
|
import Text.Hakyll.Internal.Cache
|
||||||
|
|
||||||
|
-- | Datatype used for template substitutions.
|
||||||
data Template = Chunk String Template
|
data Template = Chunk String Template
|
||||||
| Identifier String Template
|
| Identifier String Template
|
||||||
| EscapeCharacter Template
|
| EscapeCharacter Template
|
||||||
| End
|
| End
|
||||||
deriving (Show, Read)
|
deriving (Show, Read, Eq)
|
||||||
|
|
||||||
|
-- | Construct a "Template" from a string.
|
||||||
fromString :: String -> Template
|
fromString :: String -> Template
|
||||||
fromString [] = End
|
fromString [] = End
|
||||||
fromString string
|
fromString string
|
||||||
|
@ -37,6 +41,8 @@ fromString string
|
||||||
where
|
where
|
||||||
tail' = tail string
|
tail' = tail string
|
||||||
|
|
||||||
|
-- | Read a "Template" from a file. This function might fetch the "Template"
|
||||||
|
-- from the cache, if available.
|
||||||
readTemplate :: FilePath -> Hakyll Template
|
readTemplate :: FilePath -> Hakyll Template
|
||||||
readTemplate path = do
|
readTemplate path = do
|
||||||
isCacheMoreRecent' <- isCacheMoreRecent fileName [path]
|
isCacheMoreRecent' <- isCacheMoreRecent fileName [path]
|
||||||
|
@ -84,3 +90,32 @@ instance Binary Template where
|
||||||
2 -> liftM EscapeCharacter get
|
2 -> liftM EscapeCharacter get
|
||||||
3 -> return End
|
3 -> return End
|
||||||
_ -> error "Error reading template"
|
_ -> error "Error reading template"
|
||||||
|
|
||||||
|
-- | Generate arbitrary templates from a given length.
|
||||||
|
arbitraryTemplate :: Int -> Gen Template
|
||||||
|
arbitraryTemplate 0 = return End
|
||||||
|
arbitraryTemplate length' = oneof [ do chunk <- chunk'
|
||||||
|
template' >>= return . Chunk chunk
|
||||||
|
, do key <- key'
|
||||||
|
template' >>= return . Identifier key
|
||||||
|
, template' >>= return . EscapeCharacter
|
||||||
|
]
|
||||||
|
where
|
||||||
|
template' = arbitraryTemplate (length' - 1)
|
||||||
|
-- Generate keys.
|
||||||
|
key' = do l <- choose (5, 10)
|
||||||
|
replicateM l $ choose ('a', 'z')
|
||||||
|
-- Generate non-empty chunks.
|
||||||
|
chunk' = do string <- arbitrary
|
||||||
|
let sanitized = filter (/= '$') string
|
||||||
|
return $ if null sanitized then "foo"
|
||||||
|
else sanitized
|
||||||
|
|
||||||
|
-- | Make "Template" testable.
|
||||||
|
instance Arbitrary Template where
|
||||||
|
arbitrary = choose (0, 20) >>= arbitraryTemplate
|
||||||
|
|
||||||
|
shrink (Chunk chunk template) = [template, Chunk chunk End]
|
||||||
|
shrink (Identifier key template) = [template, Identifier key End]
|
||||||
|
shrink (EscapeCharacter template) = [template, EscapeCharacter End]
|
||||||
|
shrink End = []
|
||||||
|
|
23
tests/Main.hs
Normal file
23
tests/Main.hs
Normal file
|
@ -0,0 +1,23 @@
|
||||||
|
module Main where
|
||||||
|
|
||||||
|
import Control.Monad (mapM_)
|
||||||
|
import Test.QuickCheck
|
||||||
|
|
||||||
|
import Template
|
||||||
|
import Util
|
||||||
|
|
||||||
|
main = do
|
||||||
|
runTests "Template" $ do
|
||||||
|
quickCheck prop_template_encode_id
|
||||||
|
quickCheck prop_substitute_id
|
||||||
|
quickCheck prop_substitute_case1
|
||||||
|
|
||||||
|
runTests "Util" $ do
|
||||||
|
quickCheck prop_trim_length
|
||||||
|
quickCheck prop_trim_id
|
||||||
|
quickCheck prop_stripHTML_length
|
||||||
|
quickCheck prop_stripHTML_id
|
||||||
|
|
||||||
|
where
|
||||||
|
runTests name action = do putStrLn name
|
||||||
|
action
|
25
tests/Template.hs
Normal file
25
tests/Template.hs
Normal file
|
@ -0,0 +1,25 @@
|
||||||
|
module Template where
|
||||||
|
|
||||||
|
import qualified Data.Map as M
|
||||||
|
|
||||||
|
import Test.QuickCheck
|
||||||
|
import Data.Binary
|
||||||
|
|
||||||
|
import Text.Hakyll.Internal.Template
|
||||||
|
|
||||||
|
-- Test encoding/decoding of templates.
|
||||||
|
prop_template_encode_id :: Template -> Bool
|
||||||
|
prop_template_encode_id template = decode (encode template) == template
|
||||||
|
|
||||||
|
-- Check we get the same sting with empty substitutions.
|
||||||
|
prop_substitute_id string =
|
||||||
|
regularSubstitute (fromString string) M.empty == string
|
||||||
|
|
||||||
|
-- substitute test case 1.
|
||||||
|
prop_substitute_case1 string1 string2 =
|
||||||
|
finalSubstitute template context == string1 ++ " costs $" ++ string2 ++ "."
|
||||||
|
where
|
||||||
|
template = fromString "$product costs $$$price."
|
||||||
|
context = M.fromList [ ("product", string1)
|
||||||
|
, ("price", string2)
|
||||||
|
]
|
140
tests/Tests.hs
140
tests/Tests.hs
|
@ -1,140 +0,0 @@
|
||||||
import Data.Char
|
|
||||||
import qualified Data.Map as M
|
|
||||||
|
|
||||||
import Test.Framework (defaultMain, testGroup)
|
|
||||||
import Test.Framework.Providers.QuickCheck2
|
|
||||||
import Test.Framework.Providers.HUnit
|
|
||||||
import Test.QuickCheck
|
|
||||||
import Test.HUnit
|
|
||||||
|
|
||||||
import Text.Hakyll.CompressCSS
|
|
||||||
import Text.Hakyll.Util
|
|
||||||
import Text.Hakyll.Regex
|
|
||||||
import Text.Hakyll.Context
|
|
||||||
import Text.Hakyll.File
|
|
||||||
|
|
||||||
main = defaultMain tests
|
|
||||||
|
|
||||||
tests = [ testGroup "Util group"
|
|
||||||
[ testProperty "trim length" prop_trim_length
|
|
||||||
-- , testProperty "trim id" prop_trim_id
|
|
||||||
-- , testProperty "trim empty" prop_trim_empty
|
|
||||||
, testCase "stripHTML 1" test_strip_html1
|
|
||||||
, testCase "stripHTML 2" test_strip_html2
|
|
||||||
, testCase "stripHTML 3" test_strip_html3
|
|
||||||
, testCase "link 1" test_link1
|
|
||||||
, testCase "link 2" test_link2
|
|
||||||
]
|
|
||||||
|
|
||||||
, testGroup "Regex group"
|
|
||||||
[ testCase "splitRegex 1" test_split_regex1
|
|
||||||
, testCase "splitRegex 2" test_split_regex2
|
|
||||||
]
|
|
||||||
|
|
||||||
, testGroup "CompressCSS group"
|
|
||||||
[ testProperty "compressCSS length" prop_compress_css_length
|
|
||||||
, testCase "compressCSS 1" test_compress_css1
|
|
||||||
, testCase "compressCSS 2" test_compress_css2
|
|
||||||
, testCase "compressCSS 3" test_compress_css3
|
|
||||||
, testCase "compressCSS 4" test_compress_css4
|
|
||||||
]
|
|
||||||
|
|
||||||
, testGroup "Context group"
|
|
||||||
[ testCase "renderDate 1" test_render_date1
|
|
||||||
, testCase "renderDate 2" test_render_date1
|
|
||||||
, testCase "changeExtension 1" test_change_extension1
|
|
||||||
]
|
|
||||||
|
|
||||||
, testGroup "File group"
|
|
||||||
[ testCase "toRoot 1" test_to_root1
|
|
||||||
, testCase "toRoot 2" test_to_root2
|
|
||||||
, testCase "toRoot 3" test_to_root3
|
|
||||||
, testCase "removeSpaces 1" test_remove_spaces1
|
|
||||||
, testCase "removeSpaces 2" test_remove_spaces2
|
|
||||||
-- , testProperty "havingExtension count" prop_having_extension_count
|
|
||||||
, testCase "havingExtension 1" test_having_extension1
|
|
||||||
, testCase "havingExtension 2" test_having_extension2
|
|
||||||
]
|
|
||||||
]
|
|
||||||
|
|
||||||
-- Test that a string always becomes shorter when trimmed.
|
|
||||||
prop_trim_length str = length str >= length (trim str)
|
|
||||||
|
|
||||||
-- Check that a string which does not start or end with a space is not trimmed.
|
|
||||||
prop_trim_id str = isAlreadyTrimmed ==> str == (trim str)
|
|
||||||
where
|
|
||||||
isAlreadyTrimmed :: Bool
|
|
||||||
isAlreadyTrimmed = (not $ isSpace $ head str) && (not $ isSpace $ last str)
|
|
||||||
|
|
||||||
-- An string of only spaces should be reduced to an empty string.
|
|
||||||
prop_trim_empty str = (all isSpace str) ==> null (trim str)
|
|
||||||
|
|
||||||
-- Strip HTML test cases.
|
|
||||||
test_strip_html1 = stripHTML "<b>text</b>" @?= "text"
|
|
||||||
test_strip_html2 = stripHTML "text" @?= "text"
|
|
||||||
test_strip_html3 =
|
|
||||||
stripHTML "<b>Hakyll</b>, a <i>website</i> generator<img src=\"foo.png\" />"
|
|
||||||
@?= "Hakyll, a website generator"
|
|
||||||
|
|
||||||
-- Link test cases.
|
|
||||||
test_link1 = link "foo bar" "/foo/bar.html"
|
|
||||||
@?= "<a href=\"/foo/bar.html\">foo bar</a>"
|
|
||||||
test_link2 = link "back home" "/" @?= "<a href=\"/\">back home</a>"
|
|
||||||
|
|
||||||
-- Split Regex test cases.
|
|
||||||
test_split_regex1 = splitRegex "," "1,2,3" @?= ["1", "2", "3"]
|
|
||||||
test_split_regex2 = splitRegex "," ",1,2," @?= ["1", "2"]
|
|
||||||
|
|
||||||
-- CSS compression should always decrease the text length.
|
|
||||||
prop_compress_css_length str = length str >= length (compressCSS str)
|
|
||||||
|
|
||||||
-- Compress CSS test cases.
|
|
||||||
test_compress_css1 = compressCSS "a { \n color : red; }" @?= "a{color:red}"
|
|
||||||
test_compress_css2 = compressCSS "img {border :none;;;; }"
|
|
||||||
@?= "img{border:none}"
|
|
||||||
test_compress_css3 =
|
|
||||||
compressCSS "p {font-size : 90%;} h1 {color :white;;; }"
|
|
||||||
@?= "p{font-size:90%}h1{color:white}"
|
|
||||||
test_compress_css4 = compressCSS "a { /* /* red is pretty cool */ color: red; }"
|
|
||||||
@?= "a{color:red}"
|
|
||||||
|
|
||||||
-- Date rendering test cases.
|
|
||||||
test_render_date1 =
|
|
||||||
M.lookup "date" rendered @?= Just "December 30, 2009"
|
|
||||||
where
|
|
||||||
rendered = renderDate "date" "%B %e, %Y" "Unknown date"
|
|
||||||
(M.singleton "path" "2009-12-30-a-title.markdown")
|
|
||||||
|
|
||||||
test_render_date2 = M.lookup "date" rendered @?= Just "Unknown date"
|
|
||||||
where
|
|
||||||
rendered = renderDate "date" "%B %e, %Y" "Unknown date" $
|
|
||||||
M.singleton "path" "2009-badness-30-a-title.markdown"
|
|
||||||
|
|
||||||
-- changeExtension test cases.
|
|
||||||
test_change_extension1 = M.lookup "url" rendered @?= Just "foo.php"
|
|
||||||
where
|
|
||||||
rendered = changeExtension "php" (M.singleton "url" "foo.html")
|
|
||||||
|
|
||||||
-- toRoot test cases
|
|
||||||
test_to_root1 = toRoot "/posts/foo.html" @?= ".."
|
|
||||||
test_to_root2 = toRoot "posts/foo.html" @?= ".."
|
|
||||||
test_to_root3 = toRoot "foo.html" @?= "."
|
|
||||||
|
|
||||||
-- removeSpaces test cases
|
|
||||||
test_remove_spaces1 = removeSpaces "$root/tags/random crap.html"
|
|
||||||
@?= "$root/tags/random-crap.html"
|
|
||||||
test_remove_spaces2 = removeSpaces "another simple example.zip"
|
|
||||||
@?= "another-simple-example.zip"
|
|
||||||
|
|
||||||
-- Add an extension, and test that they have that extension
|
|
||||||
prop_having_extension_count names extension =
|
|
||||||
not (any ('.' `elem`) names || any (`elem` extension) "./\\")
|
|
||||||
==> havingExtension fullExtension withExtensions == withExtensions
|
|
||||||
where
|
|
||||||
fullExtension = '.' : extension
|
|
||||||
withExtensions = map (++ fullExtension) names
|
|
||||||
|
|
||||||
-- Having extension test cases
|
|
||||||
test_having_extension1 = havingExtension ".foo" ["file.bar", "file.txt"] @?= []
|
|
||||||
test_having_extension2 = havingExtension ".foo" ["file.foo", "file.txt"]
|
|
||||||
@?= ["file.foo"]
|
|
23
tests/Util.hs
Normal file
23
tests/Util.hs
Normal file
|
@ -0,0 +1,23 @@
|
||||||
|
module Util where
|
||||||
|
|
||||||
|
import Data.Char
|
||||||
|
|
||||||
|
import Test.QuickCheck
|
||||||
|
|
||||||
|
import Text.Hakyll.Util
|
||||||
|
|
||||||
|
-- Test that a string always becomes shorter when trimmed.
|
||||||
|
prop_trim_length str = length str >= length (trim str)
|
||||||
|
|
||||||
|
-- Check that a string which does not start or end with a space is not trimmed.
|
||||||
|
prop_trim_id str = (not $ null str) && isAlreadyTrimmed ==> str == (trim str)
|
||||||
|
where
|
||||||
|
isAlreadyTrimmed :: Bool
|
||||||
|
isAlreadyTrimmed = (not $ isSpace $ head str) && (not $ isSpace $ last str)
|
||||||
|
|
||||||
|
-- Check that a stripped string is shorter.
|
||||||
|
prop_stripHTML_length str = length str >= length (stripHTML str)
|
||||||
|
|
||||||
|
-- Check that strings without tags remain untouched.
|
||||||
|
prop_stripHTML_id str = (not $ any (`elem` ['>', '<']) str)
|
||||||
|
==> str == stripHTML str
|
Loading…
Reference in a new issue