From d1d28b9349549297f89ade80616eb7b14083e600 Mon Sep 17 00:00:00 2001 From: Jasper Van der Jeugt Date: Thu, 23 Dec 2010 14:51:38 +0100 Subject: Add tests for the directed graph modules --- tests/Hakyll/Core/DirectedGraph/Tests.hs | 48 ++++++++++++++++++++++++++++++++ 1 file changed, 48 insertions(+) create mode 100644 tests/Hakyll/Core/DirectedGraph/Tests.hs (limited to 'tests/Hakyll/Core/DirectedGraph/Tests.hs') diff --git a/tests/Hakyll/Core/DirectedGraph/Tests.hs b/tests/Hakyll/Core/DirectedGraph/Tests.hs new file mode 100644 index 0000000..4ce5944 --- /dev/null +++ b/tests/Hakyll/Core/DirectedGraph/Tests.hs @@ -0,0 +1,48 @@ +module Hakyll.Core.DirectedGraph.Tests + ( tests + ) where + +import Data.Set (Set) +import qualified Data.Set as S + +import Test.Framework +import Test.Framework.Providers.HUnit +import Test.HUnit hiding (Test) + +import Hakyll.Core.DirectedGraph +import Hakyll.Core.DirectedGraph.DependencySolver +import Hakyll.Core.DirectedGraph.ObsoleteFilter + +tests :: [Test] +tests = + [ testCase "solveDependencies01" solveDependencies01 + , testCase "filterObsolete01" filterObsolete01 + , testCase "filterObsolete02" filterObsolete02 + ] + +node :: Ord a => a -> [a] -> (a, Set a) +node t n = (t, S.fromList n) + +testGraph01 :: DirectedGraph Int +testGraph01 = fromList + [ node 8 [2, 4, 6] + , node 2 [4, 3] + , node 4 [3] + , node 6 [4] + , node 3 [] + ] + +solveDependencies01 :: Assertion +solveDependencies01 = result == [3, 4, 2, 6, 8] || result == [3, 4, 2, 6, 8] + @? "solveDependencies01" + where + result = solveDependencies testGraph01 + +filterObsolete01 :: Assertion +filterObsolete01 = nodes (filterObsolete [6] testGraph01) == S.fromList [6, 8] + @? "filterObsolete01" + +filterObsolete02 :: Assertion +filterObsolete02 = + nodes (filterObsolete [4] testGraph01) == S.fromList [4, 2, 6, 8] + @? "filterObsolete02" -- cgit v1.2.3 From 3fdf8ab204cfc6f60a250b8ef0cccce8e82a4bcf Mon Sep 17 00:00:00 2001 From: Jasper Van der Jeugt Date: Thu, 23 Dec 2010 17:19:21 +0100 Subject: Add identifier/pattern modules --- src/Hakyll/Core/Identifier.hs | 47 +++++++++++++++++ src/Hakyll/Core/Identifier/Pattern.hs | 91 ++++++++++++++++++++++++++++++++ tests/Hakyll/Core/DirectedGraph/Tests.hs | 24 ++++----- tests/Hakyll/Core/Identifier/Tests.hs | 29 ++++++++++ tests/TestSuite.hs | 3 ++ 5 files changed, 182 insertions(+), 12 deletions(-) create mode 100644 src/Hakyll/Core/Identifier.hs create mode 100644 src/Hakyll/Core/Identifier/Pattern.hs create mode 100644 tests/Hakyll/Core/Identifier/Tests.hs (limited to 'tests/Hakyll/Core/DirectedGraph/Tests.hs') diff --git a/src/Hakyll/Core/Identifier.hs b/src/Hakyll/Core/Identifier.hs new file mode 100644 index 0000000..609e722 --- /dev/null +++ b/src/Hakyll/Core/Identifier.hs @@ -0,0 +1,47 @@ +-- | An identifier is a type used to uniquely identify a resource, target... +-- +-- One can think of an identifier as something similar to a file path. An +-- identifier is a path as well, with the different elements in the path +-- separated by @/@ characters. Examples of identifiers are: +-- +-- * @posts/foo.markdown@ +-- +-- * @index@ +-- +-- * @error/404@ +-- +module Hakyll.Core.Identifier + ( Identifier (..) + , parseIdentifier + , toFilePath + ) where + +import Control.Arrow (second) + +import GHC.Exts (IsString, fromString) +import System.FilePath (joinPath) + +-- | An identifier used to uniquely identify a value +-- +newtype Identifier = Identifier {unIdentifier :: [String]} + deriving (Eq, Ord) + +instance Show Identifier where + show = toFilePath + +instance IsString Identifier where + fromString = parseIdentifier + +-- | Parse an identifier from a string +-- +parseIdentifier :: String -> Identifier +parseIdentifier = Identifier . filter (not . null) . split' + where + split' [] = [[]] + split' str = let (pre, post) = second (drop 1) $ break (== '/') str + in pre : split' post + +-- | Convert an identifier to a relative 'FilePath' +-- +toFilePath :: Identifier -> FilePath +toFilePath = joinPath . unIdentifier diff --git a/src/Hakyll/Core/Identifier/Pattern.hs b/src/Hakyll/Core/Identifier/Pattern.hs new file mode 100644 index 0000000..02b023f --- /dev/null +++ b/src/Hakyll/Core/Identifier/Pattern.hs @@ -0,0 +1,91 @@ +-- | Module providing pattern matching and capturing on 'Identifier's. +-- +-- TODO: Documentation +-- +module Hakyll.Core.Identifier.Pattern + ( Pattern + , parsePattern + , match + , doesMatch + , matches + ) where + +import Data.List (intercalate) +import Control.Monad (msum) +import Data.Maybe (isJust) + +import GHC.Exts (IsString, fromString) + +import Hakyll.Core.Identifier + +-- | One base element of a pattern +-- +data PatternComponent = CaptureOne + | CaptureMany + | Literal String + deriving (Eq) + +instance Show PatternComponent where + show CaptureOne = "*" + show CaptureMany = "**" + show (Literal s) = s + +-- | Type that allows matching on identifiers +-- +newtype Pattern = Pattern {unPattern :: [PatternComponent]} + deriving (Eq) + +instance Show Pattern where + show = intercalate "/" . map show . unPattern + +instance IsString Pattern where + fromString = parsePattern + +-- | Parse a pattern from a string +-- +parsePattern :: String -> Pattern +parsePattern = Pattern . map toPattern . unIdentifier . parseIdentifier + where + toPattern x | x == "*" = CaptureOne + | x == "**" = CaptureMany + | otherwise = Literal x + +-- | Match an identifier against a pattern, generating a list of captures +-- +match :: Pattern -> Identifier -> Maybe [[String]] +match (Pattern p) (Identifier i) = match' p i + +-- | Check if an identifier matches a pattern +-- +doesMatch :: Pattern -> Identifier -> Bool +doesMatch p = isJust . match p + +-- | Given a list of identifiers, retain only those who match the given pattern +-- +matches :: Pattern -> [Identifier] -> [Identifier] +matches p = filter (doesMatch p) + +-- | Split a list at every possible point, generate a list of (init, tail) cases +-- +splits :: [a] -> [([a], [a])] +splits ls = reverse $ splits' [] ls + where + splits' lx ly = (lx, ly) : case ly of + [] -> [] + (y : ys) -> splits' (lx ++ [y]) ys + +-- | Internal verion of 'match' +-- +match' :: [PatternComponent] -> [String] -> Maybe [[String]] +match' [] [] = Just [] -- An empty match +match' [] _ = Nothing -- No match +match' _ [] = Nothing -- No match +match' (m : ms) (s : ss) = case m of + -- Take one string and one literal, fail on mismatch + Literal l -> if s == l then match' ms ss else Nothing + -- Take one string and one capture + CaptureOne -> fmap ([s] :) $ match' ms ss + -- Take one string, and one or many captures + CaptureMany -> + let take' (i, t) = fmap (i :) $ match' ms t + in msum $ map take' $ splits (s : ss) diff --git a/tests/Hakyll/Core/DirectedGraph/Tests.hs b/tests/Hakyll/Core/DirectedGraph/Tests.hs index 4ce5944..1a9b406 100644 --- a/tests/Hakyll/Core/DirectedGraph/Tests.hs +++ b/tests/Hakyll/Core/DirectedGraph/Tests.hs @@ -15,9 +15,9 @@ import Hakyll.Core.DirectedGraph.ObsoleteFilter tests :: [Test] tests = - [ testCase "solveDependencies01" solveDependencies01 - , testCase "filterObsolete01" filterObsolete01 - , testCase "filterObsolete02" filterObsolete02 + [ testCase "solveDependencies [1]" solveDependencies1 + , testCase "filterObsolete [1]" filterObsolete1 + , testCase "filterObsolete [2]" filterObsolete2 ] node :: Ord a => a -> [a] -> (a, Set a) @@ -32,17 +32,17 @@ testGraph01 = fromList , node 3 [] ] -solveDependencies01 :: Assertion -solveDependencies01 = result == [3, 4, 2, 6, 8] || result == [3, 4, 2, 6, 8] - @? "solveDependencies01" +solveDependencies1 :: Assertion +solveDependencies1 = result == [3, 4, 2, 6, 8] || result == [3, 4, 2, 6, 8] + @? "solveDependencies1" where result = solveDependencies testGraph01 -filterObsolete01 :: Assertion -filterObsolete01 = nodes (filterObsolete [6] testGraph01) == S.fromList [6, 8] - @? "filterObsolete01" +filterObsolete1 :: Assertion +filterObsolete1 = nodes (filterObsolete [6] testGraph01) == S.fromList [6, 8] + @? "filterObsolete1" -filterObsolete02 :: Assertion -filterObsolete02 = +filterObsolete2 :: Assertion +filterObsolete2 = nodes (filterObsolete [4] testGraph01) == S.fromList [4, 2, 6, 8] - @? "filterObsolete02" + @? "filterObsolete2" diff --git a/tests/Hakyll/Core/Identifier/Tests.hs b/tests/Hakyll/Core/Identifier/Tests.hs new file mode 100644 index 0000000..910bca3 --- /dev/null +++ b/tests/Hakyll/Core/Identifier/Tests.hs @@ -0,0 +1,29 @@ +{-# LANGUAGE OverloadedStrings #-} +module Hakyll.Core.Identifier.Tests + ( tests + ) where + +import Test.Framework +import Test.Framework.Providers.HUnit +import Test.HUnit hiding (Test) + +import Hakyll.Core.Identifier.Pattern + +tests :: [Test] +tests = zipWith testCase names matchCases + where + names = map (\n -> "match [" ++ show n ++ "]") [1 :: Int ..] + +-- | Collection of simple cases +-- +matchCases :: [Assertion] +matchCases = + [ Just [["bar"]] @=? match "foo/**" "foo/bar" + , Just [["foo", "bar"]] @=? match "**" "foo/bar" + , Nothing @=? match "*" "foo/bar" + , Just [] @=? match "foo" "foo" + , Just [["foo"]] @=? match "*/bar" "foo/bar" + , Just [["foo", "bar"]] @=? match "**/qux" "foo/bar/qux" + , Just [["foo", "bar"], ["qux"]] @=? match "**/*" "foo/bar/qux" + , Just [["foo"], ["bar", "qux"]] @=? match "*/**" "foo/bar/qux" + ] diff --git a/tests/TestSuite.hs b/tests/TestSuite.hs index 26b26f0..f75001f 100644 --- a/tests/TestSuite.hs +++ b/tests/TestSuite.hs @@ -3,9 +3,12 @@ module TestSuite where import Test.Framework (defaultMain, testGroup) import qualified Hakyll.Core.DirectedGraph.Tests +import qualified Hakyll.Core.Identifier.Tests main :: IO () main = defaultMain [ testGroup "Hakyll.Core.DirectedGraph.Tests" Hakyll.Core.DirectedGraph.Tests.tests + , testGroup "Hakyll.Core.Identifier.Tests" + Hakyll.Core.Identifier.Tests.tests ] -- cgit v1.2.3 From 002cf4de32db979d515c2a9cdcd8c8f42859a797 Mon Sep 17 00:00:00 2001 From: Jasper Van der Jeugt Date: Wed, 9 Feb 2011 18:11:24 +0100 Subject: Add hamlet templates and restructure tests --- src/Hakyll/Web.hs | 12 ++++++++ src/Hakyll/Web/Page.hs | 7 +++++ src/Hakyll/Web/Template.hs | 33 ++------------------- src/Hakyll/Web/Template/Read/Hakyll.hs | 36 +++++++++++++++++++++++ src/Hakyll/Web/Template/Read/Hamlet.hs | 50 ++++++++++++++++++++++++++++++++ tests/Hakyll/Core/DirectedGraph/Tests.hs | 12 -------- tests/Hakyll/Core/Identifier/Tests.hs | 26 +++++++---------- tests/Hakyll/Core/Route/Tests.hs | 25 ---------------- tests/Hakyll/Core/Routes/Tests.hs | 19 ++++++++++++ tests/Hakyll/Web/Template/Tests.hs | 46 +++++++++++++++++++++++++++++ tests/TestSuite.hs | 9 ++++-- tests/TestSuite/Util.hs | 18 ++++++++++++ 12 files changed, 207 insertions(+), 86 deletions(-) create mode 100644 src/Hakyll/Web/Template/Read/Hakyll.hs create mode 100644 src/Hakyll/Web/Template/Read/Hamlet.hs delete mode 100644 tests/Hakyll/Core/Route/Tests.hs create mode 100644 tests/Hakyll/Core/Routes/Tests.hs create mode 100644 tests/Hakyll/Web/Template/Tests.hs create mode 100644 tests/TestSuite/Util.hs (limited to 'tests/Hakyll/Core/DirectedGraph/Tests.hs') diff --git a/src/Hakyll/Web.hs b/src/Hakyll/Web.hs index 4172283..f991e21 100644 --- a/src/Hakyll/Web.hs +++ b/src/Hakyll/Web.hs @@ -12,12 +12,16 @@ import Prelude hiding (id) import Control.Category (id) import Control.Arrow (arr, (>>>), (>>^), (&&&)) +import Text.Hamlet (HamletSettings, defaultHamletSettings) + import Hakyll.Core.Compiler import Hakyll.Core.Writable import Hakyll.Core.Identifier import Hakyll.Web.Page import Hakyll.Web.Pandoc import Hakyll.Web.Template +import Hakyll.Web.Template.Read.Hakyll +import Hakyll.Web.Template.Read.Hamlet import Hakyll.Web.RelativizeUrls import Hakyll.Web.Util.String import Hakyll.Web.CompressCss @@ -36,6 +40,14 @@ defaultTemplateRead :: Compiler () Template defaultTemplateRead = cached "Hakyll.Web.defaultTemplateRead" $ getResourceString >>^ readTemplate +defaultHamletTemplateRead :: Compiler () Template +defaultHamletTemplateRead = defaultHamletTemplateReadWith defaultHamletSettings + +defaultHamletTemplateReadWith :: HamletSettings -> Compiler () Template +defaultHamletTemplateReadWith settings = + cached "Hakyll.Web.defaultHamletTemplateReadWith" $ + getResourceString >>^ readHamletTemplateWith settings + defaultCopyFile :: Compiler () CopyFile defaultCopyFile = getIdentifier >>^ CopyFile . toFilePath diff --git a/src/Hakyll/Web/Page.hs b/src/Hakyll/Web/Page.hs index a7c237a..c7de026 100644 --- a/src/Hakyll/Web/Page.hs +++ b/src/Hakyll/Web/Page.hs @@ -6,6 +6,7 @@ module Hakyll.Web.Page ( Page (..) , fromBody + , fromMap , toMap , pageRead , addDefaultFields @@ -15,6 +16,7 @@ import Prelude hiding (id) import Control.Category (id) import Control.Arrow ((>>^), (&&&), (>>>)) import System.FilePath (takeBaseName, takeDirectory) +import Data.Monoid (Monoid, mempty) import Data.Map (Map) import qualified Data.Map as M @@ -30,6 +32,11 @@ import Hakyll.Web.Util.String fromBody :: a -> Page a fromBody = Page M.empty +-- | Create a metadata page, without a body +-- +fromMap :: Monoid a => Map String String -> Page a +fromMap m = Page m mempty + -- | Convert a page to a map. The body will be placed in the @body@ key. -- toMap :: Page String -> Map String String diff --git a/src/Hakyll/Web/Template.hs b/src/Hakyll/Web/Template.hs index 06fa8d4..83fd7eb 100644 --- a/src/Hakyll/Web/Template.hs +++ b/src/Hakyll/Web/Template.hs @@ -1,46 +1,19 @@ module Hakyll.Web.Template ( Template - , readTemplate , applyTemplate , applySelf ) where -import Data.List (isPrefixOf) -import Data.Char (isAlphaNum) import Data.Maybe (fromMaybe) import qualified Data.Map as M import Hakyll.Web.Template.Internal +import Hakyll.Web.Template.Read.Hakyll (readTemplate) import Hakyll.Web.Page --- | Construct a @Template@ from a string. --- -readTemplate :: String -> Template -readTemplate = Template . readTemplate' - where - readTemplate' [] = [] - readTemplate' string - | "$$" `isPrefixOf` string = - Escaped : readTemplate' (drop 2 string) - | "$" `isPrefixOf` string = - case readIdentifier (drop 1 string) of - Just (key, rest) -> Identifier key : readTemplate' rest - Nothing -> Chunk "$" : readTemplate' (drop 1 string) - | otherwise = - let (chunk, rest) = break (== '$') string - in Chunk chunk : readTemplate' rest - - -- Parse an identifier into (identifier, rest) if it's valid, and return - -- Nothing otherwise - readIdentifier string = - let (identifier, rest) = span isAlphaNum string - in if not (null identifier) && "$" `isPrefixOf` rest - then Just (identifier, drop 1 rest) - else Nothing - -- | Substitutes @$identifiers@ in the given @Template@ by values from the given --- "Page". When a key is not found, it is left as it is. You can specify --- the characters used to replace escaped dollars (@$$@) here. +-- "Page". When a key is not found, it is left as it is. You can specify +-- the characters used to replace escaped dollars (@$$@) here. -- applyTemplate :: Template -> Page String -> Page String applyTemplate template page = diff --git a/src/Hakyll/Web/Template/Read/Hakyll.hs b/src/Hakyll/Web/Template/Read/Hakyll.hs new file mode 100644 index 0000000..fbbfee2 --- /dev/null +++ b/src/Hakyll/Web/Template/Read/Hakyll.hs @@ -0,0 +1,36 @@ +-- | Read templates in Hakyll's native format +-- +module Hakyll.Web.Template.Read.Hakyll + ( readTemplate + ) where + +import Data.List (isPrefixOf) +import Data.Char (isAlphaNum) +import Data.Maybe (fromMaybe) + +import Hakyll.Web.Template.Internal + +-- | Construct a @Template@ from a string. +-- +readTemplate :: String -> Template +readTemplate = Template . readTemplate' + where + readTemplate' [] = [] + readTemplate' string + | "$$" `isPrefixOf` string = + Escaped : readTemplate' (drop 2 string) + | "$" `isPrefixOf` string = + case readIdentifier (drop 1 string) of + Just (key, rest) -> Identifier key : readTemplate' rest + Nothing -> Chunk "$" : readTemplate' (drop 1 string) + | otherwise = + let (chunk, rest) = break (== '$') string + in Chunk chunk : readTemplate' rest + + -- Parse an identifier into (identifier, rest) if it's valid, and return + -- Nothing otherwise + readIdentifier string = + let (identifier, rest) = span isAlphaNum string + in if not (null identifier) && "$" `isPrefixOf` rest + then Just (identifier, drop 1 rest) + else Nothing diff --git a/src/Hakyll/Web/Template/Read/Hamlet.hs b/src/Hakyll/Web/Template/Read/Hamlet.hs new file mode 100644 index 0000000..1c9bbf6 --- /dev/null +++ b/src/Hakyll/Web/Template/Read/Hamlet.hs @@ -0,0 +1,50 @@ +-- | Read templates in the hamlet format +-- +{-# LANGUAGE MultiParamTypeClasses #-} +module Hakyll.Web.Template.Read.Hamlet + ( readHamletTemplate + , readHamletTemplateWith + ) where + +import Control.Monad.Trans (liftIO) +import System.FilePath (takeExtension) + +import Text.Hamlet (HamletSettings (..), defaultHamletSettings) +import Text.Hamlet.RT +import Control.Failure + +import Hakyll.Web.Template.Internal + +-- | Read a hamlet template using the default settings +-- +readHamletTemplate :: String -> Template +readHamletTemplate = readHamletTemplateWith defaultHamletSettings + +-- | Read a hamlet template using the specified settings +-- +readHamletTemplateWith :: HamletSettings -> String -> Template +readHamletTemplateWith settings string = + let result = parseHamletRT settings string + in case result of + Just hamlet -> fromHamletRT hamlet + Nothing -> error + "Hakyll.Web.Template.Read.Hamlet.readHamletTemplateWith: \ + \Could not parse Hamlet file" + +-- | Convert a 'HamletRT' to a 'Template' +-- +fromHamletRT :: HamletRT -- ^ Hamlet runtime template + -> Template -- ^ Hakyll template +fromHamletRT (HamletRT sd) = Template $ map fromSimpleDoc sd + where + fromSimpleDoc :: SimpleDoc -> TemplateElement + fromSimpleDoc (SDRaw chunk) = Chunk chunk + fromSimpleDoc (SDVar [var]) = Identifier var + fromSimpleDoc (SDVar _) = error + "Hakyll.Web.Template.Read.Hamlet.fromHamletRT: \ + \Hakyll does not support '.' in identifier names when using \ + \hamlet templates." + fromSimpleDoc _ = error + "Hakyll.Web.Template.Read.Hamlet.fromHamletRT: \ + \Only simple $key$ identifiers are allowed when using hamlet \ + \templates." diff --git a/tests/Hakyll/Core/DirectedGraph/Tests.hs b/tests/Hakyll/Core/DirectedGraph/Tests.hs index 1a9b406..3e04b49 100644 --- a/tests/Hakyll/Core/DirectedGraph/Tests.hs +++ b/tests/Hakyll/Core/DirectedGraph/Tests.hs @@ -11,13 +11,10 @@ import Test.HUnit hiding (Test) import Hakyll.Core.DirectedGraph import Hakyll.Core.DirectedGraph.DependencySolver -import Hakyll.Core.DirectedGraph.ObsoleteFilter tests :: [Test] tests = [ testCase "solveDependencies [1]" solveDependencies1 - , testCase "filterObsolete [1]" filterObsolete1 - , testCase "filterObsolete [2]" filterObsolete2 ] node :: Ord a => a -> [a] -> (a, Set a) @@ -37,12 +34,3 @@ solveDependencies1 = result == [3, 4, 2, 6, 8] || result == [3, 4, 2, 6, 8] @? "solveDependencies1" where result = solveDependencies testGraph01 - -filterObsolete1 :: Assertion -filterObsolete1 = nodes (filterObsolete [6] testGraph01) == S.fromList [6, 8] - @? "filterObsolete1" - -filterObsolete2 :: Assertion -filterObsolete2 = - nodes (filterObsolete [4] testGraph01) == S.fromList [4, 2, 6, 8] - @? "filterObsolete2" diff --git a/tests/Hakyll/Core/Identifier/Tests.hs b/tests/Hakyll/Core/Identifier/Tests.hs index 910bca3..a7d49e9 100644 --- a/tests/Hakyll/Core/Identifier/Tests.hs +++ b/tests/Hakyll/Core/Identifier/Tests.hs @@ -8,22 +8,16 @@ import Test.Framework.Providers.HUnit import Test.HUnit hiding (Test) import Hakyll.Core.Identifier.Pattern +import TestSuite.Util tests :: [Test] -tests = zipWith testCase names matchCases - where - names = map (\n -> "match [" ++ show n ++ "]") [1 :: Int ..] - --- | Collection of simple cases --- -matchCases :: [Assertion] -matchCases = - [ Just [["bar"]] @=? match "foo/**" "foo/bar" - , Just [["foo", "bar"]] @=? match "**" "foo/bar" - , Nothing @=? match "*" "foo/bar" - , Just [] @=? match "foo" "foo" - , Just [["foo"]] @=? match "*/bar" "foo/bar" - , Just [["foo", "bar"]] @=? match "**/qux" "foo/bar/qux" - , Just [["foo", "bar"], ["qux"]] @=? match "**/*" "foo/bar/qux" - , Just [["foo"], ["bar", "qux"]] @=? match "*/**" "foo/bar/qux" +tests = fromAssertions "match" + [ Just ["bar"] @=? match "foo/**" "foo/bar" + , Just ["foo/bar"] @=? match "**" "foo/bar" + , Nothing @=? match "*" "foo/bar" + , Just [] @=? match "foo" "foo" + , Just ["foo"] @=? match "*/bar" "foo/bar" + , Just ["foo/bar"] @=? match "**/qux" "foo/bar/qux" + , Just ["foo/bar", "qux"] @=? match "**/*" "foo/bar/qux" + , Just ["foo", "bar/qux"] @=? match "*/**" "foo/bar/qux" ] diff --git a/tests/Hakyll/Core/Route/Tests.hs b/tests/Hakyll/Core/Route/Tests.hs deleted file mode 100644 index 17a4123..0000000 --- a/tests/Hakyll/Core/Route/Tests.hs +++ /dev/null @@ -1,25 +0,0 @@ -{-# LANGUAGE OverloadedStrings #-} -module Hakyll.Core.Route.Tests - ( tests - ) where - -import Test.Framework -import Test.Framework.Providers.HUnit -import Test.HUnit hiding (Test) - -import Hakyll.Core.Route - -tests :: [Test] -tests = zipWith testCase names matchCases - where - names = map (\n -> "runRoute [" ++ show n ++ "]") [1 :: Int ..] - --- | Collection of simple cases --- -matchCases :: [Assertion] -matchCases = - [ Just "foo.html" @=? runRoute (setExtension "html") "foo" - , Just "foo.html" @=? runRoute (setExtension ".html") "foo" - , Just "foo.html" @=? runRoute (setExtension "html") "foo.markdown" - , Just "foo.html" @=? runRoute (setExtension ".html") "foo.markdown" - ] diff --git a/tests/Hakyll/Core/Routes/Tests.hs b/tests/Hakyll/Core/Routes/Tests.hs new file mode 100644 index 0000000..cca2ee4 --- /dev/null +++ b/tests/Hakyll/Core/Routes/Tests.hs @@ -0,0 +1,19 @@ +{-# LANGUAGE OverloadedStrings #-} +module Hakyll.Core.Routes.Tests + ( tests + ) where + +import Test.Framework +import Test.Framework.Providers.HUnit +import Test.HUnit hiding (Test) + +import Hakyll.Core.Routes +import TestSuite.Util + +tests :: [Test] +tests = fromAssertions "runRoutes" + [ Just "foo.html" @=? runRoutes (setExtension "html") "foo" + , Just "foo.html" @=? runRoutes (setExtension ".html") "foo" + , Just "foo.html" @=? runRoutes (setExtension "html") "foo.markdown" + , Just "foo.html" @=? runRoutes (setExtension ".html") "foo.markdown" + ] diff --git a/tests/Hakyll/Web/Template/Tests.hs b/tests/Hakyll/Web/Template/Tests.hs new file mode 100644 index 0000000..d95b151 --- /dev/null +++ b/tests/Hakyll/Web/Template/Tests.hs @@ -0,0 +1,46 @@ +{-# LANGUAGE OverloadedStrings #-} +module Hakyll.Web.Template.Tests + ( tests + ) where + +import Test.Framework +import Test.Framework.Providers.HUnit +import Test.HUnit hiding (Test) + +import qualified Data.Map as M + +import Hakyll.Web.Page +import Hakyll.Web.Template +import Hakyll.Web.Template.Read.Hakyll +import Hakyll.Web.Template.Read.Hamlet +import TestSuite.Util + +tests :: [Test] +tests = fromAssertions "applyTemplate" + -- Hakyll templates + [ applyTemplateAssertion readTemplate + "bar" "$foo$" [("foo", "bar")] + + , applyTemplateAssertion readTemplate + "$ barqux" "$$ $foo$$bar$" [("foo", "bar"), ("bar", "qux")] + + -- Hamlet templates + , applyTemplateAssertion readHamletTemplate + "noticeA paragraph" + "#{title}\n\ + \ Template) -- ^ Template parser + -> String -- ^ Expected + -> String -- ^ Template + -> [(String, String)] -- ^ Page + -> Assertion -- ^ Resulting assertion +applyTemplateAssertion parser expected template page = + expected @=? pageBody (applyTemplate (parser template) + (fromMap $ M.fromList page)) diff --git a/tests/TestSuite.hs b/tests/TestSuite.hs index 68c4f28..aaf4481 100644 --- a/tests/TestSuite.hs +++ b/tests/TestSuite.hs @@ -4,7 +4,8 @@ import Test.Framework (defaultMain, testGroup) import qualified Hakyll.Core.DirectedGraph.Tests import qualified Hakyll.Core.Identifier.Tests -import qualified Hakyll.Core.Route.Tests +import qualified Hakyll.Core.Routes.Tests +import qualified Hakyll.Web.Template.Tests main :: IO () main = defaultMain @@ -12,6 +13,8 @@ main = defaultMain Hakyll.Core.DirectedGraph.Tests.tests , testGroup "Hakyll.Core.Identifier.Tests" Hakyll.Core.Identifier.Tests.tests - , testGroup "Hakyll.Core.Route.Tests" - Hakyll.Core.Route.Tests.tests + , testGroup "Hakyll.Core.Routes.Tests" + Hakyll.Core.Routes.Tests.tests + , testGroup "Hakyll.Web.Template.Tests" + Hakyll.Web.Template.Tests.tests ] diff --git a/tests/TestSuite/Util.hs b/tests/TestSuite/Util.hs new file mode 100644 index 0000000..66f101e --- /dev/null +++ b/tests/TestSuite/Util.hs @@ -0,0 +1,18 @@ +-- | Test utilities +-- +module TestSuite.Util + ( fromAssertions + ) where + +import Test.Framework +import Test.Framework.Providers.HUnit +import Test.HUnit hiding (Test) + +import Hakyll.Core.Identifier.Pattern + +fromAssertions :: String -- ^ Name + -> [Assertion] -- ^ Cases + -> [Test] -- ^ Result tests +fromAssertions name = zipWith testCase names + where + names = map (\n -> name ++ " [" ++ show n ++ "]") [1 :: Int ..] -- cgit v1.2.3