002cf4d · hakyll · git.iko.soy

src/Hakyll/Web.hs+12

compare with master

unifiedsplit

@@ -12,12 +12,16 @@ import Prelude hiding (id)

12import Control.Category (id)

13import Control.Arrow (arr, (>>>), (>>^), (&&&))

14

15+import Text.Hamlet (HamletSettings, defaultHamletSettings)

16+

15import Hakyll.Core.Compiler

17import Hakyll.Core.Compiler

16import Hakyll.Core.Writable

18import Hakyll.Core.Writable

17import Hakyll.Core.Identifier

19import Hakyll.Core.Identifier

18import Hakyll.Web.Page

20import Hakyll.Web.Page

19import Hakyll.Web.Pandoc

21import Hakyll.Web.Pandoc

20import Hakyll.Web.Template

22import Hakyll.Web.Template

23+import Hakyll.Web.Template.Read.Hakyll

24+import Hakyll.Web.Template.Read.Hamlet

21import Hakyll.Web.RelativizeUrls

25import Hakyll.Web.RelativizeUrls

22import Hakyll.Web.Util.String

26import Hakyll.Web.Util.String

23import Hakyll.Web.CompressCss

27import Hakyll.Web.CompressCss

@@ -36,6 +40,14 @@ defaultTemplateRead :: Compiler () Template

36defaultTemplateRead = cached "Hakyll.Web.defaultTemplateRead" $

40defaultTemplateRead = cached "Hakyll.Web.defaultTemplateRead" $

37 getResourceString >>^ readTemplate

41 getResourceString >>^ readTemplate

38

42

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+

39defaultCopyFile :: Compiler () CopyFile

51defaultCopyFile :: Compiler () CopyFile

40defaultCopyFile = getIdentifier >>^ CopyFile . toFilePath

52defaultCopyFile = getIdentifier >>^ CopyFile . toFilePath

41

53

src/Hakyll/Web/Page.hs+7

@@ -6,6 +6,7 @@

6module Hakyll.Web.Page

7 ( Page (..)

8 , fromBody

9+ , fromMap

9 , toMap

10 , toMap

10 , pageRead

11 , pageRead

11 , addDefaultFields

12 , addDefaultFields

@@ -15,6 +16,7 @@ import Prelude hiding (id)

15import Control.Category (id)

16import Control.Category (id)

16import Control.Arrow ((>>^), (&&&), (>>>))

17import Control.Arrow ((>>^), (&&&), (>>>))

17import System.FilePath (takeBaseName, takeDirectory)

18import System.FilePath (takeBaseName, takeDirectory)

19+import Data.Monoid (Monoid, mempty)

18import Data.Map (Map)

20import Data.Map (Map)

19import qualified Data.Map as M

21import qualified Data.Map as M

20

22

@@ -30,6 +32,11 @@ import Hakyll.Web.Util.String

30fromBody :: a -> Page a

32fromBody :: a -> Page a

31fromBody = Page M.empty

33fromBody = Page M.empty

32

34

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+

33-- | Convert a page to a map. The body will be placed in the @body@ key.

40-- | Convert a page to a map. The body will be placed in the @body@ key.

34--

41--

35toMap :: Page String -> Map String String

42toMap :: Page String -> Map String String

src/Hakyll/Web/Template.hs+3−30

@@ -1,46 +1,19 @@

1module Hakyll.Web.Template

2 ( Template

3− , readTemplate

4 , applyTemplate

3 , applyTemplate

5 , applySelf

4 , applySelf

6 ) where

5 ) where

7

6

8−import Data.List (isPrefixOf)

9−import Data.Char (isAlphaNum)

10import Data.Maybe (fromMaybe)

7import Data.Maybe (fromMaybe)

11import qualified Data.Map as M

8import qualified Data.Map as M

12

9

13import Hakyll.Web.Template.Internal

10import Hakyll.Web.Template.Internal

11+import Hakyll.Web.Template.Read.Hakyll (readTemplate)

14import Hakyll.Web.Page

12import Hakyll.Web.Page

15

13

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−

41-- | Substitutes @$identifiers@ in the given @Template@ by values from the given

14-- | 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

15+-- "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.

16+-- the characters used to replace escaped dollars (@$$@) here.

44--

17--

45applyTemplate :: Template -> Page String -> Page String

18applyTemplate :: Template -> Page String -> Page String

46applyTemplate template page =

19applyTemplate 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)

11

12import Hakyll.Core.DirectedGraph

13import Hakyll.Core.DirectedGraph.DependencySolver

14−import Hakyll.Core.DirectedGraph.ObsoleteFilter

15

14

16tests :: [Test]

15tests :: [Test]

17tests =

16tests =

18 [ testCase "solveDependencies [1]" solveDependencies1

17 [ testCase "solveDependencies [1]" solveDependencies1

19− , testCase "filterObsolete [1]" filterObsolete1

20− , testCase "filterObsolete [2]" filterObsolete2

21 ]

18 ]

22

19

23node :: Ord a => a -> [a] -> (a, Set a)

20node :: Ord a => a -> [a] -> (a, Set a)

@@ -37,12 +34,3 @@ solveDependencies1 = result == [3, 4, 2, 6, 8] || result == [3, 4, 2, 6, 8]

37 @? "solveDependencies1"

34 @? "solveDependencies1"

38 where

35 where

39 result = solveDependencies testGraph01

36 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

8import Test.HUnit hiding (Test)

9

10import Hakyll.Core.Identifier.Pattern

11+import TestSuite.Util

11

12

12tests :: [Test]

13tests :: [Test]

13−tests = zipWith testCase names matchCases

14+tests = fromAssertions "match"

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"

15+ [ Just ["bar"] @=? match "foo/**" "foo/bar"

22− , Just [["foo", "bar"]] @=? match "**" "foo/bar"

16+ , Just ["foo/bar"] @=? match "**" "foo/bar"

23− , Nothing @=? match "*" "foo/bar"

17+ , Nothing @=? match "*" "foo/bar"

24− , Just [] @=? match "foo" "foo"

18+ , Just [] @=? match "foo" "foo"

25− , Just [["foo"]] @=? match "*/bar" "foo/bar"

19+ , Just ["foo"] @=? match "*/bar" "foo/bar"

26− , Just [["foo", "bar"]] @=? match "**/qux" "foo/bar/qux"

20+ , Just ["foo/bar"] @=? match "**/qux" "foo/bar/qux"

27− , Just [["foo", "bar"], ["qux"]] @=? match "**/*" "foo/bar/qux"

21+ , Just ["foo/bar", "qux"] @=? match "**/*" "foo/bar/qux"

28− , Just [["foo"], ["bar", "qux"]] @=? match "*/**" "foo/bar/qux"

22+ , Just ["foo", "bar/qux"] @=? match "*/**" "foo/bar/qux"

29 ]

23 ]

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)

4

5import qualified Hakyll.Core.DirectedGraph.Tests

6import 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

8

9

9main :: IO ()

10main :: IO ()

10main = defaultMain

11main = defaultMain

@@ -12,6 +13,8 @@ main = defaultMain

12 Hakyll.Core.DirectedGraph.Tests.tests

13 Hakyll.Core.DirectedGraph.Tests.tests

13 , testGroup "Hakyll.Core.Identifier.Tests"

14 , testGroup "Hakyll.Core.Identifier.Tests"

14 Hakyll.Core.Identifier.Tests.tests

15 Hakyll.Core.Identifier.Tests.tests

15− , testGroup "Hakyll.Core.Route.Tests"

16+ , testGroup "Hakyll.Core.Routes.Tests"

16− Hakyll.Core.Route.Tests.tests

17+ Hakyll.Core.Routes.Tests.tests

18+ , testGroup "Hakyll.Web.Template.Tests"

19+ Hakyll.Web.Template.Tests.tests

17 ]

20 ]

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 ..]