aef33d1 · hakyll · git.iko.soy

hakyll.cabal+1

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

4747 Text.Hakyll.Tags

4848 Text.Hakyll.Context

4949 Text.Hakyll.Regex

50+ Text.Hakyll.Template

5051 Network.Hakyll.SimpleServer

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

5253 Text.Hakyll.Internal.Cache

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

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

1313import Data.Maybe (fromMaybe)

1414import Control.Monad (liftM)

1515import Control.Monad.Reader (liftIO)

16−import System.FilePath (takeExtension)

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

1717

1818import Text.Pandoc

1919import Data.Binary

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

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

136136readPage :: FilePath -> Hakyll Page

137137readPage path = do

138− isCacheMoreRecent' <- isCacheMoreRecent path [path]

139− if isCacheMoreRecent' then getFromCache path

138+ isCacheMoreRecent' <- isCacheMoreRecent fileName [path]

139+ if isCacheMoreRecent' then getFromCache fileName

140140 else do page <- readPageFromFile path

141− storeInCache page path

141+ storeInCache page fileName

142142 return page

143+ where

144+ fileName = "pages" </> path

143145

144146-- Make pages renderable.

145147instance Renderable Page where

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

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

1616import Control.Monad.Reader (liftIO)

1717import System.Directory (copyFile)

1818

19+import Text.Hakyll.Template (readTemplate)

1920import Text.Hakyll.Hakyll (Hakyll)

2021import Text.Hakyll.Context (ContextManipulation)

2122import Text.Hakyll.Page

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

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

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

5152renderWith manipulation templatePath renderable = do

52− template <- liftIO $ readFile templatePath

53+ template <- readTemplate templatePath

5354 context <- toContext renderable

5455 return $ fromContext $ pureRenderWith manipulation template context

5556

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

7879 -> [a]

7980 -> Hakyll String

8081renderAndConcatWith manipulation templatePaths renderables = do

81− templates <- liftIO $ mapM readFile templatePaths

82+ templates <- mapM readTemplate templatePaths

8283 contexts <- mapM toContext renderables

8384 return $ pureRenderAndConcatWith manipulation templates contexts

8485

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

103104 depends (getURL renderable) dependencies render'

104105 where

105106 dependencies = getDependencies renderable ++ templatePaths

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

107− context <- toContext renderable

108− let result = pureRenderChainWith manipulation templates context

109− writePage $ fromContext result

107+ render' = do

108+ templates <- mapM readTemplate templatePaths

109+ context <- toContext renderable

110+ let result = pureRenderChainWith manipulation templates context

111+ writePage $ fromContext result

110112

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

112114-- generated.

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

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

1010 ) where

1111

1212import qualified Data.Map as M

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

1413import Control.Monad.Reader (liftIO)

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

16−import Data.Char (isAlphaNum)

14+import Data.List (foldl')

1715import Data.Maybe (fromMaybe)

1816

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

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

1919import Text.Hakyll.Renderable

2020import Text.Hakyll.Page

2121import Text.Hakyll.File

2222import Text.Hakyll.Hakyll

2323

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−

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

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

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

4226regularSubstitute = substitute "$$"

4327

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

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

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

4630finalSubstitute = substitute "$"

4731

4832-- | A pure render function.

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

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

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

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

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

5337pureRenderWith manipulation template context =

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

5943

6044-- | A pure renderAndConcat function.

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

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

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

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

6448 -> String

6549pureRenderAndConcatWith manipulation templates =

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

7054

7155-- | A pure renderChain function.

7256pureRenderChainWith :: ContextManipulation

73− -> [String]

57+ -> [Template]

7458 -> Context

7559 -> Context

7660pureRenderChainWith manipulation templates context =

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

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

8771 makeDirectories destination

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

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

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

74+ context

9075 where

9176 url = getURL page

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

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

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

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

3333import Text.Hakyll.Regex

34+import Text.Hakyll.Template

3435import Text.Hakyll.Util

3536import Text.Hakyll.Page

3637import Text.Hakyll.Internal.Cache

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

5051 storeInCache (M.toAscList tagMap) fileName

5152 return tagMap

5253 where

53− fileName = "_tagmap" </> identifier

54+ fileName = "tagmaps" </> identifier

5455

5556 readTagMap' = foldM addPaths M.empty paths

5657 addPaths current path = do

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

6970 where

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

7172 renderTag (tag, count) =

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

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

74− , ("url", urlFunction tag)

75− , ("tag", tag)

76− ]

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

74+ , ("url", urlFunction tag)

75+ , ("tag", tag)

76+ ]

77+ linkTemplate =

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

7779

7880 sizeTag :: Float -> String

7981 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

7+

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"