git.iko.soy/hakyll
on master help sign in
Added context manipulating functions and associated render functions. Also, version bump.
commit1fdffc6a19ffad86a3f00408a72d19082fc5c6db authorJasper Van der Jeugt <jaspervdj@gmail.com> dateSun 3 Jan 2010, 12:21 (17 years ago) parent36056f1
4 files changed+88−20
compare with master
unifiedsplit
hakyll.cabal+5−2 src/Text/Hakyll/Context.hs+47 src/Text/Hakyll/Page.hs−12 src/Text/Hakyll/Render.hs+36−6
hakyll.cabal+5−2
@@ -1,5 +1,5 @@
11Name: hakyll
2−Version: 0.3.2
2+Version: 0.4
33
44Synopsis: A simple static site generator library.
55Description:
@@ -27,7 +27,9 @@ library
2727 pandoc >= 1,
2828 regex-compat >= 0.92,
2929 network >= 2,
30− mtl >= 1.1
30+ mtl >= 1.1,
31+ old-locale >= 1,
32+ time >= 1
3133 exposed-modules: Text.Hakyll
3234 Text.Hakyll.Render
3335 Text.Hakyll.Renderable
@@ -37,4 +39,5 @@ library
3739 Text.Hakyll.Page
3840 Text.Hakyll.Util
3941 Text.Hakyll.Tags
42+ Text.Hakyll.Context
4043 Network.Hakyll.SimpleServer
src/Text/Hakyll/Context.hsnew file+47
@@ -0,0 +1,47 @@
1+-- | Module containing various functions to manipulate contexts.
2+module Text.Hakyll.Context
3+ ( ContextManipulation
4+ , renderValue
5+ , renderDate
6+ ) where
7+
8+import qualified Data.Map as M
9+import qualified Data.ByteString.Lazy.Char8 as B
10+
11+import System.Locale (defaultTimeLocale)
12+import System.FilePath (takeFileName)
13+import Text.Regex (subRegex, mkRegex)
14+import Text.Template (Context)
15+import Data.Time.Format (parseTime, formatTime)
16+import Data.Time.Clock (UTCTime)
17+import Data.Maybe (fromMaybe)
18+
19+-- | Type for context manipulating functions.
20+type ContextManipulation = Context -> Context
21+
22+-- | Do something with a value of a context.
23+renderValue :: String -- ^ Key of which the value should be copied.
24+ -> String -- ^ Key the value should be copied to.
25+ -> (B.ByteString -> B.ByteString) -- ^ Function to apply on the value.
26+ -> ContextManipulation
27+renderValue src dst f context = case M.lookup (B.pack src) context of
28+ Nothing -> context
29+ (Just value) -> M.insert (B.pack dst) (f value) context
30+
31+-- | When the context has a key called `path` in a `yyyy-mm-dd-title.extension`
32+-- format (default for pages), this function can render the date.
33+renderDate :: String -- ^ Key in which the rendered date should be placed.
34+ -> String -- ^ Format to use on the date.
35+ -> String -- ^ Default value when the date cannot be parsed.
36+ -> ContextManipulation
37+renderDate key format defaultValue context =
38+ M.insert (B.pack key) (B.pack value) context
39+ where value = fromMaybe defaultValue pretty
40+ pretty = do filePath <- M.lookup (B.pack "path") context
41+ let dateString = subRegex (mkRegex "^([0-9]*-[0-9]*-[0-9]*).*")
42+ (takeFileName $ B.unpack filePath)
43+ "\\1"
44+ time <- parseTime defaultTimeLocale
45+ "%Y-%m-%d"
46+ dateString :: Maybe UTCTime
47+ return $ formatTime defaultTimeLocale format time
src/Text/Hakyll/Page.hs−12
@@ -2,7 +2,6 @@ module Text.Hakyll.Page
22 ( Page
33 , fromContext
44 , getValue
5− , copyValueWith
65 , getBody
76 , readPage
87 , writePage
@@ -36,17 +35,6 @@ fromContext = Page
3635getValue :: String -> Page -> B.ByteString
3736getValue str (Page page) = fromMaybe B.empty $ M.lookup (B.pack str) page
3837
39−-- | Do something with a value of the page.
40−copyValueWith :: String -- ^ Key of which the value should be copied.
41− -> String -- ^ Key the value should be copied to.
42− -> (B.ByteString -> B.ByteString) -- ^ Function to apply on the value.
43− -> Page -- ^ Page on which to apply this modification.
44− -> Page -- ^ Result.
45−copyValueWith src dst f p@(Page page) = case M.lookup (B.pack src) page of
46− Nothing -> p
47− (Just value) -> Page $ M.insert (B.pack dst) (f value) page
48−
49−
5038-- | Auxiliary function to pack a pair.
5139packPair :: (String, String) -> (B.ByteString, B.ByteString)
5240packPair (a, b) = (B.pack a, B.pack b)
src/Text/Hakyll/Render.hs+36−6
@@ -1,8 +1,11 @@
11module Text.Hakyll.Render
22 ( depends
33 , render
4+ , renderWith
45 , renderAndConcat
6+ , renderAndConcatWith
57 , renderChain
8+ , renderChainWith
69 , static
710 , css
811 ) where
@@ -15,6 +18,7 @@ import Control.Monad (unless, liftM, foldM)
1518import System.Directory (copyFile)
1619import System.IO
1720
21+import Text.Hakyll.Context (ContextManipulation)
1822import Text.Hakyll.Page
1923import Text.Hakyll.Renderable
2024import Text.Hakyll.File
@@ -34,21 +38,41 @@ render :: Renderable a
3438 => FilePath -- ^ Template to use for rendering.
3539 -> a -- ^ Renderable object to render with given template.
3640 -> IO Page -- ^ The body of the result will contain the render.
37−render templatePath renderable = do
41+render = renderWith id
42+
43+-- | Render to a Page. This function allows you to manipulate the context
44+-- first.
45+renderWith :: Renderable a
46+ => ContextManipulation -- ^ Manipulation to apply on the context.
47+ -> FilePath -- ^ Template to use for rendering.
48+ -> a -- ^ Renderable object to render with given template.
49+ -> IO Page -- ^ The body of the result will contain the render.
50+renderWith manipulation templatePath renderable = do
3851 handle <- openFile templatePath ReadMode
3952 templateString <- liftM B.pack $ hGetContents handle
4053 seq templateString $ hClose handle
41− context <- toContext renderable
54+ context <- liftM manipulation $ toContext renderable
4255 let body = substitute templateString context
4356 return $ fromContext (M.insert (B.pack "body") body context)
4457
4558-- | Render each renderable with the given template, then concatenate the
4659-- result.
4760renderAndConcat :: Renderable a => FilePath -> [a] -> IO B.ByteString
48−renderAndConcat templatePath renderables = foldM concatRender' B.empty renderables
61+renderAndConcat = renderAndConcatWith id
62+
63+-- | Render each renderable with the given template, then concatenate the
64+-- result. This function allows you to specify a "ContextManipulation" to
65+-- apply on every "Renderable".
66+renderAndConcatWith :: Renderable a
67+ => ContextManipulation
68+ -> FilePath
69+ -> [a]
70+ -> IO B.ByteString
71+renderAndConcatWith manipulation templatePath renderables =
72+ foldM concatRender' B.empty renderables
4973 where concatRender' :: Renderable a => B.ByteString -> a -> IO B.ByteString
5074 concatRender' chunk renderable = do
51− rendered <- render templatePath renderable
75+ rendered <- renderWith manipulation templatePath renderable
5276 let body = getBody rendered
5377 return $ B.append chunk $ body
5478
@@ -56,9 +80,15 @@ renderAndConcat templatePath renderables = foldM concatRender' B.empty renderabl
5680-- also write the result to the site destination. This is the preferred way
5781-- to do general rendering.
5882renderChain :: Renderable a => [FilePath] -> a -> IO ()
59−renderChain templates renderable =
83+renderChain = renderChainWith id
84+
85+-- | A more custom render chain that allows you to specify a
86+-- "ContextManipulation" which to apply on the context when it is read first.
87+renderChainWith :: Renderable a
88+ => ContextManipulation -> [FilePath] -> a -> IO ()
89+renderChainWith manipulation templates renderable =
6090 depends (getURL renderable) (getDependencies renderable ++ templates) $
61− do initialPage <- toContext renderable
91+ do initialPage <- liftM manipulation $ toContext renderable
6292 result <- foldM (flip render) (fromContext initialPage) templates
6393 writePage result
6494