16f284d · hakyll · git.iko.soy

git.iko.soy/hakyll

on master help sign in

Made an abstract Renderable class. Still need some cleanup now.

16f284dJasper Van der Jeugt17 years ago

hakyll.cabal+2

compare with master

unifiedsplit

@@ -21,5 +21,7 @@ library

21 build-depends: base >= 4 && < 5, template, filepath, directory, containers, bytestring,

22 pandoc >= 1

23 exposed-modules: Text.Hakyll.Render

24+ Text.Hakyll.Renderable

24 Text.Hakyll.Page

25 Text.Hakyll.Page

26+ Text.Hakyll.RenderableFilePath

25 Text.Hakyll.Util

27 Text.Hakyll.Util

src/Text/Hakyll/Page.hs+23−29

@@ -1,14 +1,10 @@

1module Text.Hakyll.Page

2− ( Page,

2+ ( Page (..),

3 PageValue,

4 addContext,

5− toURL,

6− getURL,

7 getBody,

5 getBody,

8 readPage,

6 readPage,

9− pageFromList,

7+ pageFromList

10− concatPages,

11− concatPagesWith

12 ) where

8 ) where

14import qualified Data.Map as M

10import qualified Data.Map as M

@@ -16,39 +12,41 @@ import qualified Data.List as L

16import qualified Data.ByteString.Lazy.Char8 as B

12import qualified Data.ByteString.Lazy.Char8 as B

17import Data.Maybe

13import Data.Maybe

18import Control.Monad

14import Control.Monad

15+import Control.Arrow

20import System.FilePath

17import System.FilePath

21import System.IO

18import System.IO

23import Text.Hakyll.Util

20import Text.Hakyll.Util

21+import Text.Hakyll.Renderable

24import Text.Pandoc

22import Text.Pandoc

26-- | A Page is basically key-value mapping. Certain keys have special

24-- | A Page is basically key-value mapping. Certain keys have special

27-- meanings, like for example url, body and title.

25-- meanings, like for example url, body and title.

28−type Page = M.Map String PageValue

26+data Page = Page (M.Map String PageValue)

27+

28+getContext :: Page -> M.Map String PageValue

29+getContext (Page page) = page

30-- | We use a ByteString for obvious reasons.

31-- | We use a ByteString for obvious reasons.

31type PageValue = B.ByteString

32type PageValue = B.ByteString

33-- | Add a key-value mapping to the Page.

34-- | Add a key-value mapping to the Page.

34addContext :: String -> String -> Page -> Page

35addContext :: String -> String -> Page -> Page

35−addContext key value = M.insert key (B.pack value)

36+addContext key value (Page page) = Page $ M.insert key (B.pack value) page

36−

37−-- | Get the url for a given page.

38−toURL :: FilePath -> FilePath

39−toURL = flip addExtension ".html" . dropExtension

41-- | Get the URL for a certain page. This should always be defined. If

38-- | Get the URL for a certain page. This should always be defined. If

42-- not, it will return trash.html.

39-- not, it will return trash.html.

43−getURL :: Page -> String

40+getPageURL :: Page -> String

41+getPageURL page =

44−getURL context = let result = M.lookup "url" context

42+ let result = M.lookup "url" $ getContext page

45− in case result of (Just url) -> B.unpack url

43+ in case result of (Just url) -> B.unpack url

46− Nothing -> error "URL is not defined."

44+ Nothing -> error "URL is not defined."

48-- | Get the body for a certain page. When not defined, the body will be

46-- | Get the body for a certain page. When not defined, the body will be

49-- empty.

47-- empty.

50getBody :: Page -> PageValue

48getBody :: Page -> PageValue

51−getBody context = fromMaybe B.empty $ M.lookup "body" context

49+getBody = fromMaybe B.empty . M.lookup "body" . getContext

53writerOptions :: WriterOptions

51writerOptions :: WriterOptions

54writerOptions = defaultWriterOptions

52writerOptions = defaultWriterOptions

@@ -80,7 +78,7 @@ cachePage page = do

80 makeDirectories destination

78 makeDirectories destination

81 handle <- openFile destination WriteMode

79 handle <- openFile destination WriteMode

82 hPutStrLn handle "---"

80 hPutStrLn handle "---"

83− mapM_ (writePair handle) $ M.toList page

81+ mapM_ (writePair handle) $ M.toList $ getContext page

84 hPutStrLn handle "---"

82 hPutStrLn handle "---"

85 B.hPut handle $ getBody page

83 B.hPut handle $ getBody page

86 hClose handle

84 hClose handle

@@ -108,7 +106,7 @@ readPage pagePath = do

108 -- Render file

106 -- Render file

109 let rendered = B.pack $ (renderFunction $ takeExtension path) body

107 let rendered = B.pack $ (renderFunction $ takeExtension path) body

110 seq rendered $ hClose handle

108 seq rendered $ hClose handle

111− let page = M.insert "body" rendered $ addContext "url" url $ pageFromList context

109+ let page = addContext "url" url $ Page $ M.fromList $ ("body", rendered) : map (second B.pack) context

112

110

113 -- Cache if needed

111 -- Cache if needed

114 if getFromCache then return () else cachePage page

112 if getFromCache then return () else cachePage page

@@ -118,16 +116,12 @@ readPage pagePath = do

118

116

119-- | Create a key-value mapping page from an association list.

117-- | Create a key-value mapping page from an association list.

120pageFromList :: [(String, String)] -> Page

118pageFromList :: [(String, String)] -> Page

121−pageFromList = M.fromList . map packPair

119+pageFromList = Page . M.fromList . map packPair

122 where packPair (k, v) = let pv = B.pack v

120 where packPair (k, v) = let pv = B.pack v

123 in seq pv (k, pv)

121 in seq pv (k, pv)

124

122

125−-- | Concat the bodies of pages, and return the result.

123+-- Make pages renderable

126−concatPages :: [Page] -> PageValue

124+instance Renderable Page where

127−concatPages = concatPagesWith "body"

125+ getDependencies = (:[]) . flip addExtension ".html" . dropExtension . getPageURL

128−

126+ getURL = getPageURL

129−-- | Concat certain values of pages, and return the result.

127+ toContext = return . M.mapKeys B.pack . getContext

130−concatPagesWith :: String -- ^ Key of which to concat the values.

131− -> [Page] -- ^ Pages to get the values from.

132− -> PageValue -- ^ The concatenation.

133−concatPagesWith key = B.concat . map (fromMaybe B.empty . M.lookup key)

src/Text/Hakyll/Render.hs+15−16

@@ -1,6 +1,6 @@

1module Text.Hakyll.Render

2 ( depends,

3− renderPage,

3+ render,

4 writePage,

5 renderAndConcat,

6 renderChain,

@@ -8,7 +8,7 @@ module Text.Hakyll.Render

8 staticDirectory

9 ) where

11−import Text.Template

11+import Text.Template hiding (render)

12import qualified Data.ByteString.Lazy.Char8 as B

13import qualified Data.Map as M

14import Control.Monad

@@ -17,6 +17,7 @@ import System.Directory

17import System.IO

19import Text.Hakyll.Page

20+import Text.Hakyll.Renderable

20import Text.Hakyll.Util

21import Text.Hakyll.Util

22depends :: FilePath -> [FilePath] -> IO () -> IO ()

23depends :: FilePath -> [FilePath] -> IO () -> IO ()

@@ -24,17 +25,14 @@ depends file dependencies action = do

24 valid <- isCacheValid (toDestination file) dependencies

25 valid <- isCacheValid (toDestination file) dependencies

25 unless valid action

26 unless valid action

27−createContext :: Page -> Context

28−createContext = M.fromList . map packPair . M.toList

29− where packPair (a, b) = (B.pack a, b)

30−

31−renderPage :: FilePath -> Page -> IO Page

28+render :: Renderable a => FilePath -> a -> IO Page

32−renderPage templatePath page = do

29+render templatePath renderable = do

33 handle <- openFile templatePath ReadMode

30 handle <- openFile templatePath ReadMode

34 templateString <- liftM B.pack $ hGetContents handle

31 templateString <- liftM B.pack $ hGetContents handle

35 seq templateString $ hClose handle

32 seq templateString $ hClose handle

33+ context <- toContext renderable

36− let body = substitute templateString (createContext page)

34+ let body = substitute templateString context

37− return $ M.insert "body" body page

35+ return $ Page (M.insert "body" body $ M.mapKeys (B.unpack) context)

39writePage :: Page -> IO ()

37writePage :: Page -> IO ()

40writePage page = do

38writePage page = do

@@ -47,15 +45,16 @@ renderAndConcat templatePath paths = foldM concatRender' B.empty paths

47 where concatRender' :: B.ByteString -> FilePath -> IO B.ByteString

45 where concatRender' :: B.ByteString -> FilePath -> IO B.ByteString

48 concatRender' chunk path = do

46 concatRender' chunk path = do

49 page <- readPage path

47 page <- readPage path

50− rendered <- renderPage templatePath page

48+ rendered <- render templatePath page

51 let body = getBody rendered

49 let body = getBody rendered

52 return $ B.append chunk $ body

50 return $ B.append chunk $ body

54−renderChain :: [FilePath] -> FilePath -> IO ()

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

55−renderChain templates pagePath = depends (toURL pagePath) (pagePath : templates) $

53+renderChain templates renderable =

56− do page <- readPage pagePath

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

55+ do initialPage <- toContext renderable

57− result <- foldM (flip renderPage) page templates

56+ result <- foldM (flip render) (Page $ M.mapKeys B.unpack initialPage) templates

58− writePage result

57+ writePage result

60static :: FilePath -> IO ()

59static :: FilePath -> IO ()

61static source = do

60static source = do

src/Text/Hakyll/Renderable.hsnew file+14

@@ -0,0 +1,14 @@

1+module Text.Hakyll.Renderable

2+ ( Renderable,

3+ toContext,

4+ getDependencies,

5+ getURL

6+ ) where

8+import System.FilePath

9+import Text.Template

10+

11+class Renderable a where

12+ toContext :: a -> IO Context

13+ getDependencies :: a -> [FilePath]

14+ getURL :: a -> FilePath

src/Text/Hakyll/RenderableFilePath.hsnew file+16

@@ -0,0 +1,16 @@

1+module Text.Hakyll.RenderableFilePath

2+ ( RenderableFilePath (..)

3+ ) where

5+import System.FilePath

6+import Text.Hakyll.Renderable

7+import Text.Hakyll.Util

8+import Text.Hakyll.Page

10+newtype RenderableFilePath = RenderableFilePath FilePath

11+

12+-- We can render filepaths

13+instance Renderable RenderableFilePath where

14+ getDependencies (RenderableFilePath path) = return path

15+ getURL (RenderableFilePath path) = toURL path

16+ toContext (RenderableFilePath path) = readPage path >>= toContext

src/Text/Hakyll/Util.hs+5

@@ -1,6 +1,7 @@

1module Text.Hakyll.Util

2 ( toDestination,

3 toCache,

4+ toURL,

4 makeDirectories,

5 makeDirectories,

5 getRecursiveContents,

6 getRecursiveContents,

6 trim,

7 trim,

@@ -20,6 +21,10 @@ toDestination path = "_site" </> path

20toCache :: FilePath -> FilePath

21toCache :: FilePath -> FilePath

21toCache path = "_cache" </> path

22toCache path = "_cache" </> path

24+-- | Get the url for a given page.

25+toURL :: FilePath -> FilePath

26+toURL = flip addExtension ".html" . dropExtension

27+

23-- | Given a path to a file, try to make the path writable by making

28-- | Given a path to a file, try to make the path writable by making

24-- all directories on the path.

29-- all directories on the path.

25makeDirectories :: FilePath -> IO ()

30makeDirectories :: FilePath -> IO ()