Added Template type (experimental).

5 files changed, 106 insertions, 41 deletions

diff --git a/src/Text/Hakyll/Page.hs b/src/Text/Hakyll/Page.hs
index 0cf86ee..e522605 100644
--- a/src/Text/Hakyll/Page.hs
+++ b/src/Text/Hakyll/Page.hs
@@ -13,7 +13,7 @@ import Data.Char (isSpace)
 import Data.Maybe (fromMaybe)
 import Control.Monad (liftM)
 import Control.Monad.Reader (liftIO)
-import System.FilePath (takeExtension)
+import System.FilePath (takeExtension, (</>))
 
 import Text.Pandoc
 import Data.Binary
@@ -135,11 +135,13 @@ readPageFromFile path = do
 --   read it from the file given and store it in the cache.
 readPage :: FilePath -> Hakyll Page
 readPage path = do
-    isCacheMoreRecent' <- isCacheMoreRecent path [path]
-    if isCacheMoreRecent' then getFromCache path
+    isCacheMoreRecent' <- isCacheMoreRecent fileName [path]
+    if isCacheMoreRecent' then getFromCache fileName
                           else do page <- readPageFromFile path
-                                  storeInCache page path
+                                  storeInCache page fileName
                                   return page
+  where
+    fileName = "pages" </> path
 
 -- Make pages renderable.
 instance Renderable Page where
diff --git a/src/Text/Hakyll/Render.hs b/src/Text/Hakyll/Render.hs
index e1041a0..9484859 100644
--- a/src/Text/Hakyll/Render.hs
+++ b/src/Text/Hakyll/Render.hs
@@ -16,6 +16,7 @@ import Control.Monad (unless)
 import Control.Monad.Reader (liftIO)
 import System.Directory (copyFile)
 
+import Text.Hakyll.Template (readTemplate)
 import Text.Hakyll.Hakyll (Hakyll)
 import Text.Hakyll.Context (ContextManipulation)
 import Text.Hakyll.Page
@@ -49,7 +50,7 @@ renderWith :: Renderable a
            -> a -- ^ Renderable object to render with given template.
            -> Hakyll Page -- ^ The body of the result will contain the render.
 renderWith manipulation templatePath renderable = do
-    template <- liftIO $ readFile templatePath
+    template <- readTemplate templatePath
     context <- toContext renderable
     return $ fromContext $ pureRenderWith manipulation template context
 
@@ -78,7 +79,7 @@ renderAndConcatWith :: Renderable a
                     -> [a]
                     -> Hakyll String
 renderAndConcatWith manipulation templatePaths renderables = do
-    templates <- liftIO $ mapM readFile templatePaths
+    templates <- mapM readTemplate templatePaths
     contexts <- mapM toContext renderables
     return $ pureRenderAndConcatWith manipulation templates contexts
 
@@ -103,10 +104,11 @@ renderChainWith manipulation templatePaths renderable =
     depends (getURL renderable) dependencies render'
   where
     dependencies = getDependencies renderable ++ templatePaths
-    render' = do templates <- liftIO $ mapM readFile templatePaths
-                 context <- toContext renderable
-                 let result = pureRenderChainWith manipulation templates context
-                 writePage $ fromContext result
+    render' = do
+        templates <- mapM readTemplate templatePaths
+        context <- toContext renderable
+        let result = pureRenderChainWith manipulation templates context
+        writePage $ fromContext result
 
 -- | Mark a certain file as static, so it will just be copied when the site is
 --   generated.
diff --git a/src/Text/Hakyll/Render/Internal.hs b/src/Text/Hakyll/Render/Internal.hs
index 03210ac..3ebc67f 100644
--- a/src/Text/Hakyll/Render/Internal.hs
+++ b/src/Text/Hakyll/Render/Internal.hs
@@ -10,44 +10,28 @@ module Text.Hakyll.Render.Internal
     ) where
 
 import qualified Data.Map as M
-import Text.Hakyll.Context (Context, ContextManipulation)
 import Control.Monad.Reader (liftIO)
-import Data.List (isPrefixOf, foldl')
-import Data.Char (isAlphaNum)
+import Data.List (foldl')
 import Data.Maybe (fromMaybe)
 
+import Text.Hakyll.Template (Template, substitute, fromString)
+import Text.Hakyll.Context (Context, ContextManipulation)
 import Text.Hakyll.Renderable
 import Text.Hakyll.Page
 import Text.Hakyll.File
 import Text.Hakyll.Hakyll
 
--- | Substitutes @$identifiers@ in the given string by values from the given
---   "Context". When a key is not found, it is left as it is. You can here
---   specify the characters used to replace escaped dollars (@$$@).
-substitute :: String -> String -> Context -> String 
-substitute _ [] _ = []
-substitute escaper string context 
-    | "$$" `isPrefixOf` string = escaper ++ substitute' (tail tail')
-    | "$" `isPrefixOf` string = substituteKey
-    | otherwise = head string : substitute' tail'
-  where
-    tail' = tail string
-    (key, rest) = span isAlphaNum tail'
-    replacement = fromMaybe ('$' : key) $ M.lookup key context
-    substituteKey = replacement ++ substitute' rest
-    substitute' str = substitute escaper str context
-
 -- | "substitute" for use during a chain.
-regularSubstitute :: String -> Context -> String
+regularSubstitute :: Template -> Context -> String
 regularSubstitute = substitute "$$"
 
 -- | "substitute" for the end of a chain (just before writing).
-finalSubstitute :: String -> Context -> String
+finalSubstitute :: Template -> Context -> String
 finalSubstitute = substitute "$"
 
 -- | A pure render function.
 pureRenderWith :: ContextManipulation -- ^ Manipulation to apply on the context.
-               -> String -- ^ Template to use for rendering.
+               -> Template -- ^ Template to use for rendering.
                -> Context -- ^ Renderable object to render with given template.
                -> Context -- ^ The body of the result will contain the render.
 pureRenderWith manipulation template context =
@@ -59,7 +43,7 @@ pureRenderWith manipulation template context =
 
 -- | A pure renderAndConcat function.
 pureRenderAndConcatWith :: ContextManipulation -- ^ Manipulation to apply.
-                        -> [String] -- ^ Templates to use.
+                        -> [Template] -- ^ Templates to use.
                         -> [Context] -- ^ Different renderables.
                         -> String
 pureRenderAndConcatWith manipulation templates =
@@ -70,7 +54,7 @@ pureRenderAndConcatWith manipulation templates =
 
 -- | A pure renderChain function.
 pureRenderChainWith :: ContextManipulation
-                    -> [String]
+                    -> [Template]
                     -> Context
                     -> Context
 pureRenderChainWith manipulation templates context =
@@ -86,6 +70,7 @@ writePage page = do
     let context = additionalContext' `M.union` M.singleton "root" (toRoot url)
     makeDirectories destination
     -- Substitute $root here, just before writing.
-    liftIO $ writeFile destination $ finalSubstitute (getBody page) context
+    liftIO $ writeFile destination $ finalSubstitute (fromString $ getBody page)
+                                                     context
   where
     url = getURL page
diff --git a/src/Text/Hakyll/Tags.hs b/src/Text/Hakyll/Tags.hs
index efd7bed..77f52fe 100644
--- a/src/Text/Hakyll/Tags.hs
+++ b/src/Text/Hakyll/Tags.hs
@@ -31,6 +31,7 @@ import Text.Hakyll.Hakyll (Hakyll)
 import Text.Hakyll.Context (ContextManipulation, changeValue)
 import Text.Hakyll.Render.Internal (finalSubstitute)
 import Text.Hakyll.Regex
+import Text.Hakyll.Template
 import Text.Hakyll.Util
 import Text.Hakyll.Page
 import Text.Hakyll.Internal.Cache
@@ -50,7 +51,7 @@ readTagMap identifier paths = do
                                   storeInCache (M.toAscList tagMap) fileName
                                   return tagMap
   where
-    fileName = "_tagmap" </> identifier
+    fileName = "tagmaps" </> identifier
 
     readTagMap' = foldM addPaths M.empty paths
     addPaths current path = do
@@ -69,11 +70,12 @@ renderTagCloud tagMap urlFunction minSize maxSize =
   where
     renderTag :: (String, Float) -> String
     renderTag (tag, count) = 
-        finalSubstitute "<a style=\"font-size: $size\" href=\"$url\">$tag</a>" $
-                        M.fromList [ ("size", sizeTag count)
-                                   , ("url", urlFunction tag)
-                                   , ("tag", tag)
-                                   ]
+        finalSubstitute linkTemplate $ M.fromList [ ("size", sizeTag count)
+                                                  , ("url", urlFunction tag)
+                                                  , ("tag", tag)
+                                                  ]
+    linkTemplate =
+        fromString "<a style=\"font-size: $size\" href=\"$url\">$tag</a>"
 
     sizeTag :: Float -> String
     sizeTag count = show size' ++ "%"
diff --git a/src/Text/Hakyll/Template.hs b/src/Text/Hakyll/Template.hs
new file mode 100644
index 0000000..9ba30fb
--- /dev/null
+++ b/src/Text/Hakyll/Template.hs
@@ -0,0 +1,74 @@
+module Text.Hakyll.Template
+    ( Template
+    , fromString
+    , readTemplate
+    , substitute
+    ) where
+
+import qualified Data.Map as M
+import Data.List (isPrefixOf)
+import Data.Char (isAlphaNum)
+import Data.Binary
+import Control.Monad (liftM, liftM2)
+import Data.Maybe (fromMaybe)
+import System.FilePath ((</>))
+import Control.Monad.Reader (liftIO)
+
+import Text.Hakyll.Hakyll (Hakyll)
+import Text.Hakyll.Context (Context)
+import Text.Hakyll.Internal.Cache
+
+data Template = Chunk String Template
+              | Identifier String Template
+              | EscapeCharacter Template
+              | End
+              deriving (Show, Read)
+
+fromString :: String -> Template
+fromString [] = End
+fromString string
+    | "$$" `isPrefixOf` string = EscapeCharacter (fromString $ tail tail')
+    | "$" `isPrefixOf` string = let (key, rest) = span isAlphaNum tail'
+                                in Identifier key (fromString rest)
+    | otherwise = let (chunk, rest) = break (== '$') string
+                  in Chunk chunk (fromString rest)
+  where
+    tail' = tail string
+
+readTemplate :: FilePath -> Hakyll Template
+readTemplate path = do
+    isCacheMoreRecent' <- isCacheMoreRecent fileName [path]
+    if isCacheMoreRecent' then getFromCache fileName
+                          else do content <- liftIO $ readFile path
+                                  let template = fromString content
+                                  storeInCache template fileName
+                                  return template
+  where 
+    fileName = "templates" </> path
+
+-- | Substitutes @$identifiers@ in the given string by values from the given
+--   "Context". When a key is not found, it is left as it is. You can here
+--   specify the characters used to replace escaped dollars (@$$@).
+substitute :: String -> Template -> Context -> String 
+substitute escaper (Chunk chunk template) context =
+    chunk ++ substitute escaper template context
+substitute escaper (Identifier key template) context =
+    replacement ++ substitute escaper template context
+  where
+    replacement = fromMaybe ('$' : key) $ M.lookup key context
+substitute escaper (EscapeCharacter template) context =
+    escaper ++ substitute escaper template context
+substitute _ End _ = []
+    
+instance Binary Template where
+    put (Chunk string template) = put (0 :: Word8) >> put string >> put template
+    put (Identifier key template) = put (1 :: Word8) >> put key >> put template
+    put (EscapeCharacter template) = put (2 :: Word8) >> put template
+    put (End) = put (3 :: Word8)
+
+    get = do tag <- getWord8
+             case tag of 0 -> liftM2 Chunk get get
+                         1 -> liftM2 Identifier get get
+                         2 -> liftM EscapeCharacter get
+                         3 -> return End
+                         _ -> error "Error reading template"