Added custom Template system. Highly experimental.

8 files changed, 91 insertions, 83 deletions

diff --git a/src/Text/Hakyll/CompressCSS.hs b/src/Text/Hakyll/CompressCSS.hs
index 85c061d..4b35558 100644
--- a/src/Text/Hakyll/CompressCSS.hs
+++ b/src/Text/Hakyll/CompressCSS.hs
@@ -3,7 +3,7 @@ module Text.Hakyll.CompressCSS
     ) where
 
 import Data.List (isPrefixOf)
-import Text.Hakyll.Regex (substitute)
+import Text.Hakyll.Regex (substituteRegex)
 
 -- | Compress CSS to speed up your site.
 compressCSS :: String -> String
@@ -13,13 +13,13 @@ compressCSS = compressSeparators
 
 -- | Compresses certain forms of separators.
 compressSeparators :: String -> String
-compressSeparators = substitute "; *}" "}" 
-                   . substitute " *([{};:]) *" "\\1"
-                   . substitute ";;*" ";"
+compressSeparators = substituteRegex "; *}" "}" 
+                   . substituteRegex " *([{};:]) *" "\\1"
+                   . substituteRegex ";;*" ";"
 
 -- | Compresses all whitespace.
 compressWhitespace :: String -> String
-compressWhitespace = substitute "[ \t\n][ \t\n]*" " "
+compressWhitespace = substituteRegex "[ \t\n][ \t\n]*" " "
 
 -- | Function that strips CSS comments away.
 stripComments :: String -> String
diff --git a/src/Text/Hakyll/Context.hs b/src/Text/Hakyll/Context.hs
index 22409bf..074c88f 100644
--- a/src/Text/Hakyll/Context.hs
+++ b/src/Text/Hakyll/Context.hs
@@ -1,20 +1,23 @@
 -- | Module containing various functions to manipulate contexts.
 module Text.Hakyll.Context
-    ( ContextManipulation
+    ( Context
+    , ContextManipulation
     , renderValue
     , renderDate
     ) where
 
 import qualified Data.Map as M
-import qualified Data.ByteString.Lazy.Char8 as B
+import Data.Map (Map)
 
 import System.Locale (defaultTimeLocale)
 import System.FilePath (takeFileName)
-import Text.Template (Context)
 import Data.Time.Format (parseTime, formatTime)
 import Data.Time.Clock (UTCTime)
 import Data.Maybe (fromMaybe)
-import Text.Hakyll.Regex (substitute)
+import Text.Hakyll.Regex (substituteRegex)
+
+-- | Type for a context.
+type Context = Map String String
 
 -- | Type for context manipulating functions.
 type ContextManipulation = Context -> Context
@@ -22,11 +25,11 @@ type ContextManipulation = Context -> Context
 -- | Do something with a value of a context.
 renderValue :: String -- ^ Key of which the value should be copied.
             -> String -- ^ Key the value should be copied to.
-            -> (B.ByteString -> B.ByteString) -- ^ Function to apply on the value.
+            -> (String -> String) -- ^ Function to apply on the value.
             -> ContextManipulation
-renderValue src dst f context = case M.lookup (B.pack src) context of
+renderValue src dst f context = case M.lookup src context of
     Nothing      -> context
-    (Just value) -> M.insert (B.pack dst) (f value) context
+    (Just value) -> M.insert dst (f value) context
 
 -- | When the context has a key called `path` in a `yyyy-mm-dd-title.extension`
 --   format (default for pages), this function can render the date.
@@ -34,12 +37,11 @@ renderDate :: String -- ^ Key in which the rendered date should be placed.
            -> String -- ^ Format to use on the date.
            -> String -- ^ Default value when the date cannot be parsed.
            -> ContextManipulation
-renderDate key format defaultValue context =
-    M.insert (B.pack key) (B.pack value) context
+renderDate key format defaultValue context = M.insert key value context
     where value = fromMaybe defaultValue pretty
-          pretty = do filePath <- M.lookup (B.pack "path") context
-                      let dateString = substitute "^([0-9]*-[0-9]*-[0-9]*).*" "\\1"
-                                                  (takeFileName $ B.unpack filePath)
+          pretty = do filePath <- M.lookup "path" context
+                      let dateString = substituteRegex "^([0-9]*-[0-9]*-[0-9]*).*" "\\1"
+                                                       (takeFileName filePath)
                       time <- parseTime defaultTimeLocale
                                         "%Y-%m-%d"
                                         dateString :: Maybe UTCTime
diff --git a/src/Text/Hakyll/Page.hs b/src/Text/Hakyll/Page.hs
index 83ca654..f70d898 100644
--- a/src/Text/Hakyll/Page.hs
+++ b/src/Text/Hakyll/Page.hs
@@ -8,7 +8,6 @@ module Text.Hakyll.Page
 
 import qualified Data.Map as M
 import qualified Data.List as L
-import qualified Data.ByteString.Lazy.Char8 as B
 import Data.Maybe (fromMaybe)
 
 import System.FilePath (FilePath, takeExtension)
@@ -16,10 +15,10 @@ import System.IO
 
 import Text.Hakyll.File
 import Text.Hakyll.Util (trim)
+import Text.Hakyll.Context (Context)
 import Text.Hakyll.Renderable
 import Text.Pandoc
 
-import Text.Template (Context)
 
 -- | A Page is basically key-value mapping. Certain keys have special
 --   meanings, like for example url, body and title.
@@ -31,26 +30,22 @@ fromContext = Page
 
 -- | Obtain a value from a page. Will resturn an empty string when nothing is
 --   found.
-getValue :: String -> Page -> B.ByteString
-getValue str (Page page) = fromMaybe B.empty $ M.lookup (B.pack str) page
-
--- | Auxiliary function to pack a pair.
-packPair :: (String, String) -> (B.ByteString, B.ByteString)
-packPair (a, b) = (B.pack a, B.pack b)
+getValue :: String -> Page -> String
+getValue str (Page page) = fromMaybe [] $ M.lookup str page
 
 -- | Get the URL for a certain page. This should always be defined. If
 --   not, it will error.
 getPageURL :: Page -> String
-getPageURL (Page page) = B.unpack $ fromMaybe (error "No page url") $ M.lookup (B.pack "url") page
+getPageURL (Page page) = fromMaybe (error "No page url") $ M.lookup "url" page
 
 -- | Get the original page path.
 getPagePath :: Page -> String
-getPagePath (Page page) = B.unpack $ fromMaybe (error "No page path") $ M.lookup (B.pack "path") page
+getPagePath (Page page) = fromMaybe (error "No page path") $ M.lookup "path" page
 
 -- | Get the body for a certain page. When not defined, the body will be
 --   empty.
-getBody :: Page -> B.ByteString
-getBody (Page page) = fromMaybe B.empty $ M.lookup (B.pack "body") page
+getBody :: Page -> String
+getBody (Page page) = fromMaybe [] $ M.lookup "body" page
 
 -- | The default writer options for pandoc rendering.
 writerOptions :: WriterOptions
@@ -86,13 +81,13 @@ cachePage page@(Page mapping) = do
     makeDirectories destination
     handle <- openFile destination WriteMode
     hPutStrLn handle "---"
-    mapM_ (writePair handle) $ M.toList $ M.delete (B.pack "body") mapping
+    mapM_ (writePair handle) $ M.toList $ M.delete "body" mapping
     hPutStrLn handle "---"
-    B.hPut handle $ getBody page
+    hPutStr handle $ getBody page
     hClose handle
-    where writePair h (k, v) = B.hPut h k >>
-                               B.hPut h (B.pack ": ") >>
-                               B.hPut h v >>
+    where writePair h (k, v) = hPutStr h k >>
+                               hPutStr h ": " >>
+                               hPutStr h v >>
                                hPutStrLn h ""
 
 -- | Read a page from a file. Metadata is supported, and if the filename
@@ -114,13 +109,13 @@ readPage pagePath = do
                             else hGetContents handle >>= \b -> return ([], line ++ b)
 
     -- Render file
-    let rendered = B.pack $ (renderFunction $ takeExtension path) body
+    let rendered = (renderFunction $ takeExtension path) body
     seq rendered $ hClose handle
     let page = fromContext $ M.fromList $
-            [ (B.pack "body", rendered)
-            , packPair ("url", url)
-            , packPair ("path", pagePath)
-            ] ++ map packPair context
+            [ ("body", rendered)
+            , ("url", url)
+            , ("path", pagePath)
+            ] ++ context
 
     -- Cache if needed
     if getFromCache then return () else cachePage page
diff --git a/src/Text/Hakyll/Regex.hs b/src/Text/Hakyll/Regex.hs
index e2e21bc..37bbc7e 100644
--- a/src/Text/Hakyll/Regex.hs
+++ b/src/Text/Hakyll/Regex.hs
@@ -1,8 +1,8 @@
 -- | A module that exports a simple regex interface. This code is mostly copied
 --   from the regex-compat package at hackage.
 module Text.Hakyll.Regex
-    ( split
-    , substitute
+    ( splitRegex
+    , substituteRegex
     ) where
 
 import Text.Regex.TDFA
@@ -13,10 +13,10 @@ matchRegexAll :: Regex -> String -> Maybe (String, String, String, [String])
 matchRegexAll p str = matchM p str
 
 -- | Replaces every occurance of the given regexp with the replacement string.
-subRegex :: Regex                          -- ^ Search pattern
-      -> String                         -- ^ Input string
-      -> String                         -- ^ Replacement text
-      -> String                         -- ^ Output string
+subRegex :: Regex -- ^ Search pattern
+         -> String -- ^ Input string
+         -> String -- ^ Replacement text
+         -> String -- ^ Output string
 subRegex _ "" _ = ""
 subRegex regexp inp replacement =
   let -- bre matches a backslash then capture either a backslash or some digits
@@ -43,9 +43,9 @@ subRegex regexp inp replacement =
 
 -- | Splits a string based on a regular expression.  The regular expression
 --   should identify one delimiter.
-splitRegex :: Regex -> String -> [String]
-splitRegex _ [] = []
-splitRegex delim strIn = loop strIn where
+splitRegex' :: Regex -> String -> [String]
+splitRegex' _ [] = []
+splitRegex' delim strIn = loop strIn where
   loop str = case matchOnceText delim str of
                 Nothing -> [str]
                 Just (firstline, _, remainder) ->
@@ -54,13 +54,13 @@ splitRegex delim strIn = loop strIn where
                     else firstline : loop remainder
 
 -- | Split a list at a certain element.
-split :: String -> String -> [String]
-split pattern = filter (not . null)
-              . splitRegex (makeRegex pattern)
+splitRegex :: String -> String -> [String]
+splitRegex pattern = filter (not . null)
+                   . splitRegex' (makeRegex pattern)
 
 -- | Substitute a regex. Simplified interface.
-substitute :: String -- ^ Pattern to replace (regex).
-           -> String -- ^ Replacement string.
-           -> String -- ^ Input string.
-           -> String -- ^ Result.
-substitute pattern replacement str = subRegex (makeRegex pattern) str replacement
+substituteRegex :: String -- ^ Pattern to replace (regex).
+                -> String -- ^ Replacement string.
+                -> String -- ^ Input string.
+                -> String -- ^ Result.
+substituteRegex pattern replacement str = subRegex (makeRegex pattern) str replacement
diff --git a/src/Text/Hakyll/Render.hs b/src/Text/Hakyll/Render.hs
index d3e4a34..1719e83 100644
--- a/src/Text/Hakyll/Render.hs
+++ b/src/Text/Hakyll/Render.hs
@@ -10,15 +10,16 @@ module Text.Hakyll.Render
     , css
     ) where
 
-import Text.Template hiding (render)
-import qualified Data.ByteString.Lazy.Char8 as B
 import qualified Data.Map as M
+import Data.List (isPrefixOf)
 import Control.Monad (unless, liftM, foldM)
+import Data.Char (isAlpha)
+import Data.Maybe (fromMaybe)
 
 import System.Directory (copyFile)
 import System.IO
 
-import Text.Hakyll.Context (ContextManipulation)
+import Text.Hakyll.Context (Context, ContextManipulation)
 import Text.Hakyll.Page
 import Text.Hakyll.Renderable
 import Text.Hakyll.File
@@ -33,6 +34,19 @@ depends file dependencies action = do
     valid <- isCacheValid (toDestination file) dependencies
     unless valid action
 
+-- | Substitutes `$identifiers` in the given string by values from the given
+--   "Context". When a key is not found, it is left as it is.
+substitute :: String -> Context -> String 
+substitute [] _ = []
+substitute string context 
+    | "$$" `isPrefixOf` string = "$$" ++ (substitute (tail tail') context)
+    | "$" `isPrefixOf` string = substitute'
+    | otherwise = (head string) : (substitute tail' context)
+    where tail' = tail string
+          (key, rest) = break (not . isAlpha) tail'
+          replacement = fromMaybe ('$' : key) $ M.lookup key context
+          substitute' = replacement ++ substitute rest context
+
 -- | Render to a Page.
 render :: Renderable a
        => FilePath -- ^ Template to use for rendering.
@@ -49,18 +63,18 @@ renderWith :: Renderable a
            -> IO Page -- ^ The body of the result will contain the render.
 renderWith manipulation templatePath renderable = do
     handle <- openFile templatePath ReadMode
-    templateString <- liftM B.pack $ hGetContents handle
+    templateString <- hGetContents handle
     seq templateString $ hClose handle
     context <- liftM manipulation $ toContext renderable
     -- Ignore $root when substituting here. We will only replace that in the
     -- final render (just before writing).
-    let contextIgnoringRoot = M.insert (B.pack "root") (B.pack "$root") context
+    let contextIgnoringRoot = M.insert "root" "$root" context
         body = substitute templateString contextIgnoringRoot
-    return $ fromContext (M.insert (B.pack "body") body context)
+    return $ fromContext (M.insert "body" body context)
 
 -- | Render each renderable with the given template, then concatenate the
 --   result.
-renderAndConcat :: Renderable a => FilePath -> [a] -> IO B.ByteString
+renderAndConcat :: Renderable a => FilePath -> [a] -> IO String
 renderAndConcat = renderAndConcatWith id
 
 -- | Render each renderable with the given template, then concatenate the
@@ -70,14 +84,14 @@ renderAndConcatWith :: Renderable a
                     => ContextManipulation
                     -> FilePath
                     -> [a]
-                    -> IO B.ByteString
+                    -> IO String
 renderAndConcatWith manipulation templatePath renderables =
-    foldM concatRender' B.empty renderables
-    where concatRender' :: Renderable a => B.ByteString -> a -> IO B.ByteString
+    foldM concatRender' [] renderables
+    where concatRender' :: Renderable a => String -> a -> IO String
           concatRender' chunk renderable = do
               rendered <- renderWith manipulation templatePath renderable
               let body = getBody rendered
-              return $ B.append chunk $ body
+              return $ chunk ++ body
 
 -- | Chain a render action for a page with a number of templates. This will
 --   also write the result to the site destination. This is the preferred way
@@ -100,11 +114,11 @@ writePage :: Page -> IO ()
 writePage page = do
     let destination = toDestination url
     makeDirectories destination
-    B.writeFile destination body
+    writeFile destination body
     where url = getURL page
-          -- Substitute $root here, just before writing.
-          body = substitute (getBody page)
-                            (M.singleton (B.pack "root") (B.pack $ toRoot url))
+          -- Substitute $root here, just before writing.
+          body = substitute (getBody page)
+                            (M.singleton "root" $ toRoot url)
 
 -- | Mark a certain file as static, so it will just be copied when the site is
 --   generated.
diff --git a/src/Text/Hakyll/Renderable.hs b/src/Text/Hakyll/Renderable.hs
index 4ca6f46..c8e780e 100644
--- a/src/Text/Hakyll/Renderable.hs
+++ b/src/Text/Hakyll/Renderable.hs
@@ -3,7 +3,7 @@ module Text.Hakyll.Renderable
     ) where
 
 import System.FilePath (FilePath)
-import Text.Template (Context)
+import Text.Hakyll.Context (Context)
 
 -- | A class for datatypes that can be rendered to pages.
 class Renderable a where
diff --git a/src/Text/Hakyll/Renderables.hs b/src/Text/Hakyll/Renderables.hs
index bd474e2..26d1e86 100644
--- a/src/Text/Hakyll/Renderables.hs
+++ b/src/Text/Hakyll/Renderables.hs
@@ -6,7 +6,6 @@ module Text.Hakyll.Renderables
     ) where
 
 import System.FilePath (FilePath)
-import qualified Data.ByteString.Lazy.Char8 as B
 import qualified Data.Map as M
 import Text.Hakyll.Page
 import Text.Hakyll.Renderable
@@ -16,13 +15,13 @@ import Text.Hakyll.File
 data CustomPage = CustomPage 
     { url :: String,
       dependencies :: [FilePath],
-      mapping :: [(String, Either String (IO B.ByteString))]
+      mapping :: [(String, Either String (IO String))]
     }
 
 -- | Create a custom page.
 createCustomPage :: String -- ^ Destination of the page, relative to _site.
                  -> [FilePath] -- ^ Dependencies of the page.
-                 -> [(String, Either String (IO B.ByteString))] -- ^ Key - value mapping for rendering.
+                 -> [(String, Either String (IO String))] -- ^ Key - value mapping for rendering.
                  -> CustomPage
 createCustomPage = CustomPage
 
@@ -30,10 +29,9 @@ instance Renderable CustomPage where
     getDependencies = dependencies
     getURL = url
     toContext page = do
-        values <- mapM (either (return . B.pack) (>>= return) . snd) (mapping page)
-        let keys = map (B.pack . fst) (mapping page)
-        return $ M.fromList $ [ (B.pack "url", B.pack $ url page)
-                              ] ++ zip keys values 
+        values <- mapM (either (return) (>>= return) . snd) (mapping page)
+        return $ M.fromList $ [ ("url", url page)
+                              ] ++ zip (map fst $ mapping page) values 
 
 -- | PagePath is a class that wraps a FilePath. This is used to render Pages
 --   without reading them first through use of caching.
diff --git a/src/Text/Hakyll/Tags.hs b/src/Text/Hakyll/Tags.hs
index 69386be..801b9b1 100644
--- a/src/Text/Hakyll/Tags.hs
+++ b/src/Text/Hakyll/Tags.hs
@@ -7,7 +7,6 @@ module Text.Hakyll.Tags
     ) where
 
 import qualified Data.Map as M
-import qualified Data.ByteString.Lazy.Char8 as B
 import Data.List (intercalate)
 import Control.Monad (foldM)
 
@@ -24,7 +23,7 @@ readTagMap :: [FilePath] -> IO (M.Map String [FilePath])
 readTagMap paths = foldM addPaths M.empty paths
     where addPaths current path = do
             page <- readPage path
-            let tags = map trim $ split "," $ B.unpack $ getValue ("tags") page
+            let tags = map trim $ splitRegex "," $ getValue ("tags") page
             return $ foldr (\t -> M.insertWith (++) t [path]) current tags
 
 -- | Render a tag cloud.
@@ -57,6 +56,6 @@ renderTagCloud tagMap urlFunction minSize maxSize =
 renderTagLinks :: (String -> String) -- ^ Function that produces an url for a tag.
                -> ContextManipulation
 renderTagLinks urlFunction = renderValue "tags" "tags" renderTagLinks'
-    where renderTagLinks' = B.pack . intercalate ", "
+    where renderTagLinks' = intercalate ", "
                           . map (\t -> link t $ urlFunction t)
-                          . map trim . split "," . B.unpack
+                          . map trim . splitRegex ","