aef33d1 · hakyll · git.iko.soy

git.iko.soy/hakyll

on master help sign in

Added Template type (experimental).

aef33d1Jasper Van der Jeugt17 years ago

hakyll.cabal+1

compare with master

unifiedsplit

@@ -47,6 +47,7 @@ library

47 Text.Hakyll.Tags

48 Text.Hakyll.Context

49 Text.Hakyll.Regex

50+ Text.Hakyll.Template

50 Network.Hakyll.SimpleServer

51 Network.Hakyll.SimpleServer

51 other-modules: Text.Hakyll.Render.Internal

52 other-modules: Text.Hakyll.Render.Internal

52 Text.Hakyll.Internal.Cache

53 Text.Hakyll.Internal.Cache

src/Text/Hakyll/Page.hs+6−4

@@ -13,7 +13,7 @@ import Data.Char (isSpace)

13import Data.Maybe (fromMaybe)

14import Control.Monad (liftM)

15import Control.Monad.Reader (liftIO)

16−import System.FilePath (takeExtension)

16+import System.FilePath (takeExtension, (</>))

18import Text.Pandoc

19import Data.Binary

@@ -135,11 +135,13 @@ readPageFromFile path = do

135-- read it from the file given and store it in the cache.

136readPage :: FilePath -> Hakyll Page

137readPage path = do

138− isCacheMoreRecent' <- isCacheMoreRecent path [path]

138+ isCacheMoreRecent' <- isCacheMoreRecent fileName [path]

139− if isCacheMoreRecent' then getFromCache path

139+ if isCacheMoreRecent' then getFromCache fileName

140 else do page <- readPageFromFile path

141− storeInCache page path

141+ storeInCache page fileName

142 return page

143+ where

144+ fileName = "pages" </> path

143

145

144-- Make pages renderable.

146-- Make pages renderable.

145instance Renderable Page where

147instance Renderable Page where

src/Text/Hakyll/Render.hs+8−6

@@ -16,6 +16,7 @@ import Control.Monad (unless)

16import Control.Monad.Reader (liftIO)

17import System.Directory (copyFile)

19+import Text.Hakyll.Template (readTemplate)

19import Text.Hakyll.Hakyll (Hakyll)

20import Text.Hakyll.Hakyll (Hakyll)

20import Text.Hakyll.Context (ContextManipulation)

21import Text.Hakyll.Context (ContextManipulation)

21import Text.Hakyll.Page

22import Text.Hakyll.Page

@@ -49,7 +50,7 @@ renderWith :: Renderable a

49 -> a -- ^ Renderable object to render with given template.

50 -> a -- ^ Renderable object to render with given template.

50 -> Hakyll Page -- ^ The body of the result will contain the render.

51 -> Hakyll Page -- ^ The body of the result will contain the render.

51renderWith manipulation templatePath renderable = do

52renderWith manipulation templatePath renderable = do

52− template <- liftIO $ readFile templatePath

53+ template <- readTemplate templatePath

53 context <- toContext renderable

54 context <- toContext renderable

54 return $ fromContext $ pureRenderWith manipulation template context

55 return $ fromContext $ pureRenderWith manipulation template context

@@ -78,7 +79,7 @@ renderAndConcatWith :: Renderable a

78 -> [a]

79 -> [a]

79 -> Hakyll String

80 -> Hakyll String

80renderAndConcatWith manipulation templatePaths renderables = do

81renderAndConcatWith manipulation templatePaths renderables = do

81− templates <- liftIO $ mapM readFile templatePaths

82+ templates <- mapM readTemplate templatePaths

82 contexts <- mapM toContext renderables

83 contexts <- mapM toContext renderables

83 return $ pureRenderAndConcatWith manipulation templates contexts

84 return $ pureRenderAndConcatWith manipulation templates contexts

@@ -103,10 +104,11 @@ renderChainWith manipulation templatePaths renderable =

103 depends (getURL renderable) dependencies render'

104 depends (getURL renderable) dependencies render'

104 where

105 where

105 dependencies = getDependencies renderable ++ templatePaths

106 dependencies = getDependencies renderable ++ templatePaths

107+ render' = do

106− render' = do templates <- liftIO $ mapM readFile templatePaths

108+ templates <- mapM readTemplate templatePaths

107− context <- toContext renderable

109+ context <- toContext renderable

108− let result = pureRenderChainWith manipulation templates context

110+ let result = pureRenderChainWith manipulation templates context

109− writePage $ fromContext result

111+ writePage $ fromContext result

110

112

111-- | Mark a certain file as static, so it will just be copied when the site is

113-- | Mark a certain file as static, so it will just be copied when the site is

112-- generated.

114-- generated.

src/Text/Hakyll/Render/Internal.hs+10−25

@@ -10,44 +10,28 @@ module Text.Hakyll.Render.Internal

10 ) where

12import qualified Data.Map as M

13−import Text.Hakyll.Context (Context, ContextManipulation)

14import Control.Monad.Reader (liftIO)

13import Control.Monad.Reader (liftIO)

15−import Data.List (isPrefixOf, foldl')

14+import Data.List (foldl')

16−import Data.Char (isAlphaNum)

17import Data.Maybe (fromMaybe)

15import Data.Maybe (fromMaybe)

17+import Text.Hakyll.Template (Template, substitute, fromString)

18+import Text.Hakyll.Context (Context, ContextManipulation)

19import Text.Hakyll.Renderable

20import Text.Hakyll.Page

21import Text.Hakyll.File

22import Text.Hakyll.Hakyll

24−-- | Substitutes @$identifiers@ in the given string by values from the given

25−-- "Context". When a key is not found, it is left as it is. You can here

26−-- specify the characters used to replace escaped dollars (@$$@).

27−substitute :: String -> String -> Context -> String

28−substitute _ [] _ = []

29−substitute escaper string context

30− | "$$" `isPrefixOf` string = escaper ++ substitute' (tail tail')

31− | "$" `isPrefixOf` string = substituteKey

32− | otherwise = head string : substitute' tail'

33− where

34− tail' = tail string

35− (key, rest) = span isAlphaNum tail'

36− replacement = fromMaybe ('$' : key) $ M.lookup key context

37− substituteKey = replacement ++ substitute' rest

38− substitute' str = substitute escaper str context

39−

40-- | "substitute" for use during a chain.

24-- | "substitute" for use during a chain.

41−regularSubstitute :: String -> Context -> String

25+regularSubstitute :: Template -> Context -> String

42regularSubstitute = substitute "$$"

26regularSubstitute = substitute "$$"

44-- | "substitute" for the end of a chain (just before writing).

28-- | "substitute" for the end of a chain (just before writing).

45−finalSubstitute :: String -> Context -> String

29+finalSubstitute :: Template -> Context -> String

46finalSubstitute = substitute "$"

30finalSubstitute = substitute "$"

48-- | A pure render function.

32-- | A pure render function.

49pureRenderWith :: ContextManipulation -- ^ Manipulation to apply on the context.

33pureRenderWith :: ContextManipulation -- ^ Manipulation to apply on the context.

50− -> String -- ^ Template to use for rendering.

34+ -> Template -- ^ Template to use for rendering.

51 -> Context -- ^ Renderable object to render with given template.

35 -> Context -- ^ Renderable object to render with given template.

52 -> Context -- ^ The body of the result will contain the render.

36 -> Context -- ^ The body of the result will contain the render.

53pureRenderWith manipulation template context =

37pureRenderWith manipulation template context =

@@ -59,7 +43,7 @@ pureRenderWith manipulation template context =

60-- | A pure renderAndConcat function.

44-- | A pure renderAndConcat function.

61pureRenderAndConcatWith :: ContextManipulation -- ^ Manipulation to apply.

45pureRenderAndConcatWith :: ContextManipulation -- ^ Manipulation to apply.

62− -> [String] -- ^ Templates to use.

46+ -> [Template] -- ^ Templates to use.

63 -> [Context] -- ^ Different renderables.

47 -> [Context] -- ^ Different renderables.

64 -> String

48 -> String

65pureRenderAndConcatWith manipulation templates =

49pureRenderAndConcatWith manipulation templates =

@@ -70,7 +54,7 @@ pureRenderAndConcatWith manipulation templates =

71-- | A pure renderChain function.

55-- | A pure renderChain function.

72pureRenderChainWith :: ContextManipulation

56pureRenderChainWith :: ContextManipulation

73− -> [String]

57+ -> [Template]

74 -> Context

58 -> Context

75 -> Context

59 -> Context

76pureRenderChainWith manipulation templates context =

60pureRenderChainWith manipulation templates context =

@@ -86,6 +70,7 @@ writePage page = do

86 let context = additionalContext' `M.union` M.singleton "root" (toRoot url)

70 let context = additionalContext' `M.union` M.singleton "root" (toRoot url)

87 makeDirectories destination

71 makeDirectories destination

88 -- Substitute $root here, just before writing.

72 -- Substitute $root here, just before writing.

89− liftIO $ writeFile destination $ finalSubstitute (getBody page) context

73+ liftIO $ writeFile destination $ finalSubstitute (fromString $ getBody page)

74+ context

90 where

75 where

91 url = getURL page

76 url = getURL page

src/Text/Hakyll/Tags.hs+8−6

@@ -31,6 +31,7 @@ import Text.Hakyll.Hakyll (Hakyll)

31import Text.Hakyll.Context (ContextManipulation, changeValue)

32import Text.Hakyll.Render.Internal (finalSubstitute)

33import Text.Hakyll.Regex

34+import Text.Hakyll.Template

34import Text.Hakyll.Util

35import Text.Hakyll.Util

35import Text.Hakyll.Page

36import Text.Hakyll.Page

36import Text.Hakyll.Internal.Cache

37import Text.Hakyll.Internal.Cache

@@ -50,7 +51,7 @@ readTagMap identifier paths = do

50 storeInCache (M.toAscList tagMap) fileName

51 storeInCache (M.toAscList tagMap) fileName

51 return tagMap

52 return tagMap

52 where

53 where

53− fileName = "_tagmap" </> identifier

54+ fileName = "tagmaps" </> identifier

55 readTagMap' = foldM addPaths M.empty paths

56 readTagMap' = foldM addPaths M.empty paths

56 addPaths current path = do

57 addPaths current path = do

@@ -69,11 +70,12 @@ renderTagCloud tagMap urlFunction minSize maxSize =

69 where

70 where

70 renderTag :: (String, Float) -> String

71 renderTag :: (String, Float) -> String

71 renderTag (tag, count) =

72 renderTag (tag, count) =

72− finalSubstitute "<a style=\"font-size: $size\" href=\"$url\">$tag</a>" $

73− M.fromList [ ("size", sizeTag count)

73+ finalSubstitute linkTemplate $ M.fromList [ ("size", sizeTag count)

74− , ("url", urlFunction tag)

74+ , ("url", urlFunction tag)

75− , ("tag", tag)

75+ , ("tag", tag)

76− ]

76+ ]

77+ linkTemplate =

78+ fromString "<a style=\"font-size: $size\" href=\"$url\">$tag</a>"

78 sizeTag :: Float -> String

80 sizeTag :: Float -> String

79 sizeTag count = show size' ++ "%"

81 sizeTag count = show size' ++ "%"

src/Text/Hakyll/Template.hsnew file+74

@@ -0,0 +1,74 @@

1+module Text.Hakyll.Template

2+ ( Template

3+ , fromString

4+ , readTemplate

5+ , substitute

6+ ) where

8+import qualified Data.Map as M

9+import Data.List (isPrefixOf)

10+import Data.Char (isAlphaNum)

11+import Data.Binary

12+import Control.Monad (liftM, liftM2)

13+import Data.Maybe (fromMaybe)

14+import System.FilePath ((</>))

15+import Control.Monad.Reader (liftIO)

16+

17+import Text.Hakyll.Hakyll (Hakyll)

18+import Text.Hakyll.Context (Context)

19+import Text.Hakyll.Internal.Cache

20+

21+data Template = Chunk String Template

22+ | Identifier String Template

23+ | EscapeCharacter Template

24+ | End

25+ deriving (Show, Read)

26+

27+fromString :: String -> Template

28+fromString [] = End

29+fromString string

30+ | "$$" `isPrefixOf` string = EscapeCharacter (fromString $ tail tail')

31+ | "$" `isPrefixOf` string = let (key, rest) = span isAlphaNum tail'

32+ in Identifier key (fromString rest)

33+ | otherwise = let (chunk, rest) = break (== '$') string

34+ in Chunk chunk (fromString rest)

35+ where

36+ tail' = tail string

37+

38+readTemplate :: FilePath -> Hakyll Template

39+readTemplate path = do

40+ isCacheMoreRecent' <- isCacheMoreRecent fileName [path]

41+ if isCacheMoreRecent' then getFromCache fileName

42+ else do content <- liftIO $ readFile path

43+ let template = fromString content

44+ storeInCache template fileName

45+ return template

46+ where

47+ fileName = "templates" </> path

48+

49+-- | Substitutes @$identifiers@ in the given string by values from the given

50+-- "Context". When a key is not found, it is left as it is. You can here

51+-- specify the characters used to replace escaped dollars (@$$@).

52+substitute :: String -> Template -> Context -> String

53+substitute escaper (Chunk chunk template) context =

54+ chunk ++ substitute escaper template context

55+substitute escaper (Identifier key template) context =

56+ replacement ++ substitute escaper template context

57+ where

58+ replacement = fromMaybe ('$' : key) $ M.lookup key context

59+substitute escaper (EscapeCharacter template) context =

60+ escaper ++ substitute escaper template context

61+substitute _ End _ = []

62+

63+instance Binary Template where

64+ put (Chunk string template) = put (0 :: Word8) >> put string >> put template

65+ put (Identifier key template) = put (1 :: Word8) >> put key >> put template

66+ put (EscapeCharacter template) = put (2 :: Word8) >> put template

67+ put (End) = put (3 :: Word8)

68+

69+ get = do tag <- getWord8

70+ case tag of 0 -> liftM2 Chunk get get

71+ 1 -> liftM2 Identifier get get

72+ 2 -> liftM EscapeCharacter get

73+ 3 -> return End

74+ _ -> error "Error reading template"