1fdffc6 · hakyll · git.iko.soy

git.iko.soy/hakyll

on master help sign in

Added context manipulating functions and associated render functions. Also, version bump.

1fdffc6Jasper Van der Jeugt17 years ago

hakyll.cabal+5−2

compare with master

unifiedsplit

@@ -1,5 +1,5 @@

1Name: hakyll

2−Version: 0.3.2

2+Version: 0.4

4Synopsis: A simple static site generator library.

5Description:

@@ -27,7 +27,9 @@ library

27 pandoc >= 1,

28 regex-compat >= 0.92,

29 network >= 2,

30− mtl >= 1.1

30+ mtl >= 1.1,

31+ old-locale >= 1,

32+ time >= 1

31 exposed-modules: Text.Hakyll

33 exposed-modules: Text.Hakyll

32 Text.Hakyll.Render

34 Text.Hakyll.Render

33 Text.Hakyll.Renderable

35 Text.Hakyll.Renderable

@@ -37,4 +39,5 @@ library

37 Text.Hakyll.Page

39 Text.Hakyll.Page

38 Text.Hakyll.Util

40 Text.Hakyll.Util

39 Text.Hakyll.Tags

41 Text.Hakyll.Tags

42+ Text.Hakyll.Context

40 Network.Hakyll.SimpleServer

43 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

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

2 ( Page

3 , fromContext

4 , getValue

5− , copyValueWith

6 , getBody

5 , getBody

7 , readPage

6 , readPage

8 , writePage

7 , writePage

@@ -36,17 +35,6 @@ fromContext = Page

36getValue :: String -> Page -> B.ByteString

35getValue :: String -> Page -> B.ByteString

37getValue str (Page page) = fromMaybe B.empty $ M.lookup (B.pack str) page

36getValue str (Page page) = fromMaybe B.empty $ M.lookup (B.pack str) page

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−

50-- | Auxiliary function to pack a pair.

38-- | Auxiliary function to pack a pair.

51packPair :: (String, String) -> (B.ByteString, B.ByteString)

39packPair :: (String, String) -> (B.ByteString, B.ByteString)

52packPair (a, b) = (B.pack a, B.pack b)

40packPair (a, b) = (B.pack a, B.pack b)

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

@@ -1,8 +1,11 @@

1module Text.Hakyll.Render

2 ( depends

3 , render

4+ , renderWith

4 , renderAndConcat

5 , renderAndConcat

6+ , renderAndConcatWith

5 , renderChain

7 , renderChain

8+ , renderChainWith

6 , static

9 , static

7 , css

10 , css

8 ) where

11 ) where

@@ -15,6 +18,7 @@ import Control.Monad (unless, liftM, foldM)

15import System.Directory (copyFile)

18import System.Directory (copyFile)

16import System.IO

19import System.IO

21+import Text.Hakyll.Context (ContextManipulation)

18import Text.Hakyll.Page

22import Text.Hakyll.Page

19import Text.Hakyll.Renderable

23import Text.Hakyll.Renderable

20import Text.Hakyll.File

24import Text.Hakyll.File

@@ -34,21 +38,41 @@ render :: Renderable a

34 => FilePath -- ^ Template to use for rendering.

38 => FilePath -- ^ Template to use for rendering.

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

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

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

40 -> IO Page -- ^ The body of the result will contain the render.

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.

37−render templatePath renderable = do

50+renderWith manipulation templatePath renderable = do

38 handle <- openFile templatePath ReadMode

51 handle <- openFile templatePath ReadMode

39 templateString <- liftM B.pack $ hGetContents handle

52 templateString <- liftM B.pack $ hGetContents handle

40 seq templateString $ hClose handle

53 seq templateString $ hClose handle

41− context <- toContext renderable

54+ context <- liftM manipulation $ toContext renderable

42 let body = substitute templateString context

55 let body = substitute templateString context

43 return $ fromContext (M.insert (B.pack "body") body context)

56 return $ fromContext (M.insert (B.pack "body") body context)

45-- | Render each renderable with the given template, then concatenate the

58-- | Render each renderable with the given template, then concatenate the

46-- result.

59-- result.

47renderAndConcat :: Renderable a => FilePath -> [a] -> IO B.ByteString

60renderAndConcat :: Renderable a => FilePath -> [a] -> IO B.ByteString

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 =

48−renderAndConcat templatePath renderables = foldM concatRender' B.empty renderables

72+ foldM concatRender' B.empty renderables

49 where concatRender' :: Renderable a => B.ByteString -> a -> IO B.ByteString

73 where concatRender' :: Renderable a => B.ByteString -> a -> IO B.ByteString

50 concatRender' chunk renderable = do

74 concatRender' chunk renderable = do

51− rendered <- render templatePath renderable

75+ rendered <- renderWith manipulation templatePath renderable

52 let body = getBody rendered

76 let body = getBody rendered

53 return $ B.append chunk $ body

77 return $ B.append chunk $ body

@@ -56,9 +80,15 @@ renderAndConcat templatePath renderables = foldM concatRender' B.empty renderabl

56-- also write the result to the site destination. This is the preferred way

80-- also write the result to the site destination. This is the preferred way

57-- to do general rendering.

81-- to do general rendering.

58renderChain :: Renderable a => [FilePath] -> a -> IO ()

82renderChain :: Renderable a => [FilePath] -> a -> IO ()

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 ()

59−renderChain templates renderable =

89+renderChainWith manipulation templates renderable =

60 depends (getURL renderable) (getDependencies renderable ++ templates) $

90 depends (getURL renderable) (getDependencies renderable ++ templates) $

61− do initialPage <- toContext renderable

91+ do initialPage <- liftM manipulation $ toContext renderable

62 result <- foldM (flip render) (fromContext initialPage) templates

92 result <- foldM (flip render) (fromContext initialPage) templates

63 writePage result

93 writePage result