diff options
Diffstat (limited to 'src/Text/Hakyll/Internal')
-rw-r--r-- | src/Text/Hakyll/Internal/Template.hs | 39 |
1 files changed, 37 insertions, 2 deletions
diff --git a/src/Text/Hakyll/Internal/Template.hs b/src/Text/Hakyll/Internal/Template.hs index 41d279c..155189b 100644 --- a/src/Text/Hakyll/Internal/Template.hs +++ b/src/Text/Hakyll/Internal/Template.hs @@ -11,21 +11,25 @@ import qualified Data.Map as M import Data.List (isPrefixOf) import Data.Char (isAlphaNum) import Data.Binary -import Control.Monad (liftM, liftM2) +import Control.Monad (liftM, liftM2, replicateM) import Data.Maybe (fromMaybe) import System.FilePath ((</>)) import Control.Monad.Reader (liftIO) +import Test.QuickCheck + import Text.Hakyll.Hakyll (Hakyll) import Text.Hakyll.Context (Context) import Text.Hakyll.Internal.Cache +-- | Datatype used for template substitutions. data Template = Chunk String Template | Identifier String Template | EscapeCharacter Template | End - deriving (Show, Read) + deriving (Show, Read, Eq) +-- | Construct a "Template" from a string. fromString :: String -> Template fromString [] = End fromString string @@ -37,6 +41,8 @@ fromString string where 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 path = do isCacheMoreRecent' <- isCacheMoreRecent fileName [path] @@ -84,3 +90,32 @@ 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' + 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 = [] |