git.iko.soy/hakyll
on master help sign in
Add hamlet templates and restructure tests
commit002cf4de32db979d515c2a9cdcd8c8f42859a797 authorJasper Van der Jeugt <jaspervdj@gmail.com> dateWed 9 Feb 2011, 18:11 (16 years ago) parent7da7e0b
12 files changed+207−86
compare with master
unifiedsplit
src/Hakyll/Web.hs+12 src/Hakyll/Web/Page.hs+7 src/Hakyll/Web/Template.hs+3−30 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+10−16 tests/Hakyll/Core/Route/Tests.hs−25 tests/Hakyll/Core/Routes/Tests.hs+19 tests/Hakyll/Web/Template/Tests.hs+46 tests/TestSuite.hs+6−3 tests/TestSuite/Util.hs+18
src/Hakyll/Web.hs+12
@@ -12,12 +12,16 @@ import Prelude hiding (id)
1212import Control.Category (id)
1313import Control.Arrow (arr, (>>>), (>>^), (&&&))
1414
15+import Text.Hamlet (HamletSettings, defaultHamletSettings)
16+
1517import Hakyll.Core.Compiler
1618import Hakyll.Core.Writable
1719import Hakyll.Core.Identifier
1820import Hakyll.Web.Page
1921import Hakyll.Web.Pandoc
2022import Hakyll.Web.Template
23+import Hakyll.Web.Template.Read.Hakyll
24+import Hakyll.Web.Template.Read.Hamlet
2125import Hakyll.Web.RelativizeUrls
2226import Hakyll.Web.Util.String
2327import Hakyll.Web.CompressCss
@@ -36,6 +40,14 @@ defaultTemplateRead :: Compiler () Template
3640defaultTemplateRead = cached "Hakyll.Web.defaultTemplateRead" $
3741 getResourceString >>^ readTemplate
3842
43+defaultHamletTemplateRead :: Compiler () Template
44+defaultHamletTemplateRead = defaultHamletTemplateReadWith defaultHamletSettings
45+
46+defaultHamletTemplateReadWith :: HamletSettings -> Compiler () Template
47+defaultHamletTemplateReadWith settings =
48+ cached "Hakyll.Web.defaultHamletTemplateReadWith" $
49+ getResourceString >>^ readHamletTemplateWith settings
50+
3951defaultCopyFile :: Compiler () CopyFile
4052defaultCopyFile = getIdentifier >>^ CopyFile . toFilePath
4153
src/Hakyll/Web/Page.hs+7
@@ -6,6 +6,7 @@
66module Hakyll.Web.Page
77 ( Page (..)
88 , fromBody
9+ , fromMap
910 , toMap
1011 , pageRead
1112 , addDefaultFields
@@ -15,6 +16,7 @@ import Prelude hiding (id)
1516import Control.Category (id)
1617import Control.Arrow ((>>^), (&&&), (>>>))
1718import System.FilePath (takeBaseName, takeDirectory)
19+import Data.Monoid (Monoid, mempty)
1820import Data.Map (Map)
1921import qualified Data.Map as M
2022
@@ -30,6 +32,11 @@ import Hakyll.Web.Util.String
3032fromBody :: a -> Page a
3133fromBody = Page M.empty
3234
35+-- | Create a metadata page, without a body
36+--
37+fromMap :: Monoid a => Map String String -> Page a
38+fromMap m = Page m mempty
39+
3340-- | Convert a page to a map. The body will be placed in the @body@ key.
3441--
3542toMap :: Page String -> Map String String
src/Hakyll/Web/Template.hs+3−30
@@ -1,46 +1,19 @@
11module Hakyll.Web.Template
22 ( Template
3− , readTemplate
43 , applyTemplate
54 , applySelf
65 ) where
76
8−import Data.List (isPrefixOf)
9−import Data.Char (isAlphaNum)
107import Data.Maybe (fromMaybe)
118import qualified Data.Map as M
129
1310import Hakyll.Web.Template.Internal
11+import Hakyll.Web.Template.Read.Hakyll (readTemplate)
1412import Hakyll.Web.Page
1513
16−-- | Construct a @Template@ from a string.
17−--
18−readTemplate :: String -> Template
19−readTemplate = Template . readTemplate'
20− where
21− readTemplate' [] = []
22− readTemplate' string
23− | "$$" `isPrefixOf` string =
24− Escaped : readTemplate' (drop 2 string)
25− | "$" `isPrefixOf` string =
26− case readIdentifier (drop 1 string) of
27− Just (key, rest) -> Identifier key : readTemplate' rest
28− Nothing -> Chunk "$" : readTemplate' (drop 1 string)
29− | otherwise =
30− let (chunk, rest) = break (== '$') string
31− in Chunk chunk : readTemplate' rest
32−
33− -- Parse an identifier into (identifier, rest) if it's valid, and return
34− -- Nothing otherwise
35− readIdentifier string =
36− let (identifier, rest) = span isAlphaNum string
37− in if not (null identifier) && "$" `isPrefixOf` rest
38− then Just (identifier, drop 1 rest)
39− else Nothing
40−
4114-- | Substitutes @$identifiers@ in the given @Template@ by values from the given
42−-- "Page". When a key is not found, it is left as it is. You can specify
43−-- the characters used to replace escaped dollars (@$$@) here.
15+-- "Page". When a key is not found, it is left as it is. You can specify
16+-- the characters used to replace escaped dollars (@$$@) here.
4417--
4518applyTemplate :: Template -> Page String -> Page String
4619applyTemplate template page =
src/Hakyll/Web/Template/Read/Hakyll.hsnew file+36
@@ -0,0 +1,36 @@
1+-- | Read templates in Hakyll's native format
2+--
3+module Hakyll.Web.Template.Read.Hakyll
4+ ( readTemplate
5+ ) where
6+
7+import Data.List (isPrefixOf)
8+import Data.Char (isAlphaNum)
9+import Data.Maybe (fromMaybe)
10+
11+import Hakyll.Web.Template.Internal
12+
13+-- | Construct a @Template@ from a string.
14+--
15+readTemplate :: String -> Template
16+readTemplate = Template . readTemplate'
17+ where
18+ readTemplate' [] = []
19+ readTemplate' string
20+ | "$$" `isPrefixOf` string =
21+ Escaped : readTemplate' (drop 2 string)
22+ | "$" `isPrefixOf` string =
23+ case readIdentifier (drop 1 string) of
24+ Just (key, rest) -> Identifier key : readTemplate' rest
25+ Nothing -> Chunk "$" : readTemplate' (drop 1 string)
26+ | otherwise =
27+ let (chunk, rest) = break (== '$') string
28+ in Chunk chunk : readTemplate' rest
29+
30+ -- Parse an identifier into (identifier, rest) if it's valid, and return
31+ -- Nothing otherwise
32+ readIdentifier string =
33+ let (identifier, rest) = span isAlphaNum string
34+ in if not (null identifier) && "$" `isPrefixOf` rest
35+ then Just (identifier, drop 1 rest)
36+ else Nothing
src/Hakyll/Web/Template/Read/Hamlet.hsnew file+50
@@ -0,0 +1,50 @@
1+-- | Read templates in the hamlet format
2+--
3+{-# LANGUAGE MultiParamTypeClasses #-}
4+module Hakyll.Web.Template.Read.Hamlet
5+ ( readHamletTemplate
6+ , readHamletTemplateWith
7+ ) where
8+
9+import Control.Monad.Trans (liftIO)
10+import System.FilePath (takeExtension)
11+
12+import Text.Hamlet (HamletSettings (..), defaultHamletSettings)
13+import Text.Hamlet.RT
14+import Control.Failure
15+
16+import Hakyll.Web.Template.Internal
17+
18+-- | Read a hamlet template using the default settings
19+--
20+readHamletTemplate :: String -> Template
21+readHamletTemplate = readHamletTemplateWith defaultHamletSettings
22+
23+-- | Read a hamlet template using the specified settings
24+--
25+readHamletTemplateWith :: HamletSettings -> String -> Template
26+readHamletTemplateWith settings string =
27+ let result = parseHamletRT settings string
28+ in case result of
29+ Just hamlet -> fromHamletRT hamlet
30+ Nothing -> error
31+ "Hakyll.Web.Template.Read.Hamlet.readHamletTemplateWith: \
32+ \Could not parse Hamlet file"
33+
34+-- | Convert a 'HamletRT' to a 'Template'
35+--
36+fromHamletRT :: HamletRT -- ^ Hamlet runtime template
37+ -> Template -- ^ Hakyll template
38+fromHamletRT (HamletRT sd) = Template $ map fromSimpleDoc sd
39+ where
40+ fromSimpleDoc :: SimpleDoc -> TemplateElement
41+ fromSimpleDoc (SDRaw chunk) = Chunk chunk
42+ fromSimpleDoc (SDVar [var]) = Identifier var
43+ fromSimpleDoc (SDVar _) = error
44+ "Hakyll.Web.Template.Read.Hamlet.fromHamletRT: \
45+ \Hakyll does not support '.' in identifier names when using \
46+ \hamlet templates."
47+ fromSimpleDoc _ = error
48+ "Hakyll.Web.Template.Read.Hamlet.fromHamletRT: \
49+ \Only simple $key$ identifiers are allowed when using hamlet \
50+ \templates."
tests/Hakyll/Core/DirectedGraph/Tests.hs−12
@@ -11,13 +11,10 @@ import Test.HUnit hiding (Test)
1111
1212import Hakyll.Core.DirectedGraph
1313import Hakyll.Core.DirectedGraph.DependencySolver
14−import Hakyll.Core.DirectedGraph.ObsoleteFilter
1514
1615tests :: [Test]
1716tests =
1817 [ testCase "solveDependencies [1]" solveDependencies1
19− , testCase "filterObsolete [1]" filterObsolete1
20− , testCase "filterObsolete [2]" filterObsolete2
2118 ]
2219
2320node :: Ord a => a -> [a] -> (a, Set a)
@@ -37,12 +34,3 @@ solveDependencies1 = result == [3, 4, 2, 6, 8] || result == [3, 4, 2, 6, 8]
3734 @? "solveDependencies1"
3835 where
3936 result = solveDependencies testGraph01
40−
41−filterObsolete1 :: Assertion
42−filterObsolete1 = nodes (filterObsolete [6] testGraph01) == S.fromList [6, 8]
43− @? "filterObsolete1"
44−
45−filterObsolete2 :: Assertion
46−filterObsolete2 =
47− nodes (filterObsolete [4] testGraph01) == S.fromList [4, 2, 6, 8]
48− @? "filterObsolete2"
tests/Hakyll/Core/Identifier/Tests.hs+10−16
@@ -8,22 +8,16 @@ import Test.Framework.Providers.HUnit
88import Test.HUnit hiding (Test)
99
1010import Hakyll.Core.Identifier.Pattern
11+import TestSuite.Util
1112
1213tests :: [Test]
13−tests = zipWith testCase names matchCases
14− where
15− names = map (\n -> "match [" ++ show n ++ "]") [1 :: Int ..]
16−
17−-- | Collection of simple cases
18−--
19−matchCases :: [Assertion]
20−matchCases =
21− [ Just [["bar"]] @=? match "foo/**" "foo/bar"
22− , Just [["foo", "bar"]] @=? match "**" "foo/bar"
23− , Nothing @=? match "*" "foo/bar"
24− , Just [] @=? match "foo" "foo"
25− , Just [["foo"]] @=? match "*/bar" "foo/bar"
26− , Just [["foo", "bar"]] @=? match "**/qux" "foo/bar/qux"
27− , Just [["foo", "bar"], ["qux"]] @=? match "**/*" "foo/bar/qux"
28− , Just [["foo"], ["bar", "qux"]] @=? match "*/**" "foo/bar/qux"
14+tests = fromAssertions "match"
15+ [ Just ["bar"] @=? match "foo/**" "foo/bar"
16+ , Just ["foo/bar"] @=? match "**" "foo/bar"
17+ , Nothing @=? match "*" "foo/bar"
18+ , Just [] @=? match "foo" "foo"
19+ , Just ["foo"] @=? match "*/bar" "foo/bar"
20+ , Just ["foo/bar"] @=? match "**/qux" "foo/bar/qux"
21+ , Just ["foo/bar", "qux"] @=? match "**/*" "foo/bar/qux"
22+ , Just ["foo", "bar/qux"] @=? match "*/**" "foo/bar/qux"
2923 ]
tests/Hakyll/Core/Route/Tests.hsdeleted−25
@@ -1,25 +0,0 @@
1−{-# LANGUAGE OverloadedStrings #-}
2−module Hakyll.Core.Route.Tests
3− ( tests
4− ) where
5−
6−import Test.Framework
7−import Test.Framework.Providers.HUnit
8−import Test.HUnit hiding (Test)
9−
10−import Hakyll.Core.Route
11−
12−tests :: [Test]
13−tests = zipWith testCase names matchCases
14− where
15− names = map (\n -> "runRoute [" ++ show n ++ "]") [1 :: Int ..]
16−
17−-- | Collection of simple cases
18−--
19−matchCases :: [Assertion]
20−matchCases =
21− [ Just "foo.html" @=? runRoute (setExtension "html") "foo"
22− , Just "foo.html" @=? runRoute (setExtension ".html") "foo"
23− , Just "foo.html" @=? runRoute (setExtension "html") "foo.markdown"
24− , Just "foo.html" @=? runRoute (setExtension ".html") "foo.markdown"
25− ]
tests/Hakyll/Core/Routes/Tests.hsnew file+19
@@ -0,0 +1,19 @@
1+{-# LANGUAGE OverloadedStrings #-}
2+module Hakyll.Core.Routes.Tests
3+ ( tests
4+ ) where
5+
6+import Test.Framework
7+import Test.Framework.Providers.HUnit
8+import Test.HUnit hiding (Test)
9+
10+import Hakyll.Core.Routes
11+import TestSuite.Util
12+
13+tests :: [Test]
14+tests = fromAssertions "runRoutes"
15+ [ Just "foo.html" @=? runRoutes (setExtension "html") "foo"
16+ , Just "foo.html" @=? runRoutes (setExtension ".html") "foo"
17+ , Just "foo.html" @=? runRoutes (setExtension "html") "foo.markdown"
18+ , Just "foo.html" @=? runRoutes (setExtension ".html") "foo.markdown"
19+ ]
tests/Hakyll/Web/Template/Tests.hsnew file+46
@@ -0,0 +1,46 @@
1+{-# LANGUAGE OverloadedStrings #-}
2+module Hakyll.Web.Template.Tests
3+ ( tests
4+ ) where
5+
6+import Test.Framework
7+import Test.Framework.Providers.HUnit
8+import Test.HUnit hiding (Test)
9+
10+import qualified Data.Map as M
11+
12+import Hakyll.Web.Page
13+import Hakyll.Web.Template
14+import Hakyll.Web.Template.Read.Hakyll
15+import Hakyll.Web.Template.Read.Hamlet
16+import TestSuite.Util
17+
18+tests :: [Test]
19+tests = fromAssertions "applyTemplate"
20+ -- Hakyll templates
21+ [ applyTemplateAssertion readTemplate
22+ "bar" "$foo$" [("foo", "bar")]
23+
24+ , applyTemplateAssertion readTemplate
25+ "$ barqux" "$$ $foo$$bar$" [("foo", "bar"), ("bar", "qux")]
26+
27+ -- Hamlet templates
28+ , applyTemplateAssertion readHamletTemplate
29+ "<head><title>notice</title></head><body>A paragraph</body>"
30+ "<head\n\
31+ \ <title>#{title}\n\
32+ \<body\n\
33+ \ A paragraph\n"
34+ [("title", "notice")]
35+ ]
36+
37+-- | Utility function to create quick template tests
38+--
39+applyTemplateAssertion :: (String -> Template) -- ^ Template parser
40+ -> String -- ^ Expected
41+ -> String -- ^ Template
42+ -> [(String, String)] -- ^ Page
43+ -> Assertion -- ^ Resulting assertion
44+applyTemplateAssertion parser expected template page =
45+ expected @=? pageBody (applyTemplate (parser template)
46+ (fromMap $ M.fromList page))
tests/TestSuite.hs+6−3
@@ -4,7 +4,8 @@ import Test.Framework (defaultMain, testGroup)
44
55import qualified Hakyll.Core.DirectedGraph.Tests
66import qualified Hakyll.Core.Identifier.Tests
7−import qualified Hakyll.Core.Route.Tests
7+import qualified Hakyll.Core.Routes.Tests
8+import qualified Hakyll.Web.Template.Tests
89
910main :: IO ()
1011main = defaultMain
@@ -12,6 +13,8 @@ main = defaultMain
1213 Hakyll.Core.DirectedGraph.Tests.tests
1314 , testGroup "Hakyll.Core.Identifier.Tests"
1415 Hakyll.Core.Identifier.Tests.tests
15− , testGroup "Hakyll.Core.Route.Tests"
16− Hakyll.Core.Route.Tests.tests
16+ , testGroup "Hakyll.Core.Routes.Tests"
17+ Hakyll.Core.Routes.Tests.tests
18+ , testGroup "Hakyll.Web.Template.Tests"
19+ Hakyll.Web.Template.Tests.tests
1720 ]
tests/TestSuite/Util.hsnew file+18
@@ -0,0 +1,18 @@
1+-- | Test utilities
2+--
3+module TestSuite.Util
4+ ( fromAssertions
5+ ) where
6+
7+import Test.Framework
8+import Test.Framework.Providers.HUnit
9+import Test.HUnit hiding (Test)
10+
11+import Hakyll.Core.Identifier.Pattern
12+
13+fromAssertions :: String -- ^ Name
14+ -> [Assertion] -- ^ Cases
15+ -> [Test] -- ^ Result tests
16+fromAssertions name = zipWith testCase names
17+ where
18+ names = map (\n -> name ++ " [" ++ show n ++ "]") [1 :: Int ..]