diff options
| -rw-r--r-- | hakyll.cabal | 3 | ||||
| -rw-r--r-- | src/Text/Hakyll/Internal/Template.hs | 36 | ||||
| -rw-r--r-- | tests/Template.hs | 32 |
3 files changed, 35 insertions, 36 deletions
diff --git a/hakyll.cabal b/hakyll.cabal index 2b5047b..ab53efd 100644 --- a/hakyll.cabal +++ b/hakyll.cabal @@ -39,8 +39,7 @@ library old-locale >= 1, old-time >= 1, time >= 1, - binary >= 0.5, - QuickCheck >= 2 + binary >= 0.5 exposed-modules: Network.Hakyll.SimpleServer Text.Hakyll Text.Hakyll.Context diff --git a/src/Text/Hakyll/Internal/Template.hs b/src/Text/Hakyll/Internal/Template.hs index 2a9b588..8b4d6c7 100644 --- a/src/Text/Hakyll/Internal/Template.hs +++ b/src/Text/Hakyll/Internal/Template.hs @@ -1,5 +1,5 @@ module Text.Hakyll.Internal.Template - ( Template + ( Template (..) , fromString , readTemplate , substitute @@ -11,14 +11,11 @@ import qualified Data.Map as M import Data.List (isPrefixOf) import Data.Char (isAlphaNum) import Data.Binary -import Control.Monad (liftM, liftM2, replicateM) -import Control.Applicative ((<$>)) +import Control.Monad (liftM, liftM2) import Data.Maybe (fromMaybe) import System.FilePath ((</>)) import Control.Monad.Reader (liftIO) -import Test.QuickCheck - import Text.Hakyll.Context (Context) import Text.Hakyll.HakyllMonad (Hakyll) import Text.Hakyll.Internal.Cache @@ -91,32 +88,3 @@ instance Binary Template where 2 -> liftM EscapeCharacter get 3 -> return End _ -> 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' - Chunk chunk <$> template' - , do key <- key' - Identifier key <$> template' - , EscapeCharacter <$> template' - ] - 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 = [] diff --git a/tests/Template.hs b/tests/Template.hs index 9ba956a..9924efb 100644 --- a/tests/Template.hs +++ b/tests/Template.hs @@ -3,12 +3,15 @@ module Template ) where import qualified Data.Map as M +import Control.Applicative ((<$>)) +import Control.Monad (replicateM) import Data.Binary import Test.Framework (testGroup) import Test.Framework.Providers.HUnit import Test.Framework.Providers.QuickCheck2 import Test.HUnit +import Test.QuickCheck import Text.Hakyll.Internal.Template @@ -20,6 +23,35 @@ templateGroup = testGroup "Template" , testCase "test_substitute_2" test_substitute_2 ] +-- | Generate arbitrary templates from a given length. +arbitraryTemplate :: Int -> Gen Template +arbitraryTemplate 0 = return End +arbitraryTemplate length' = oneof [ do chunk <- chunk' + Chunk chunk <$> template' + , do key <- key' + Identifier key <$> template' + , EscapeCharacter <$> template' + ] + 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 = [] + -- Test encoding/decoding of templates. prop_template_encode_id :: Template -> Bool prop_template_encode_id template = decode (encode template) == template |