16f284d · hakyll · git.iko.soy

git.iko.soy/hakyll

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

commit16f284d7471c5de1ae7a51521924199f6f5dc768 authorJasper Van der Jeugt <jaspervdj@gmail.com> dateThu 10 Dec 2009, 14:18 (17 years ago) parentc630522

6 files changed+75−45

compare with master

unifiedsplit

hakyll.cabal+2 src/Text/Hakyll/Page.hs+23−29 src/Text/Hakyll/Render.hs+15−16 src/Text/Hakyll/Renderable.hs+14 src/Text/Hakyll/RenderableFilePath.hs+16 src/Text/Hakyll/Util.hs+5

hakyll.cabal+2

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

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

2222 pandoc >= 1

2323 exposed-modules: Text.Hakyll.Render

24+ Text.Hakyll.Renderable

2425 Text.Hakyll.Page

26+ Text.Hakyll.RenderableFilePath

2527 Text.Hakyll.Util

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

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

11module Text.Hakyll.Page

2− ( Page,

2+ ( Page (..),

33 PageValue,

44 addContext,

5− toURL,

6− getURL,

75 getBody,

86 readPage,

9− pageFromList,

10− concatPages,

11− concatPagesWith

7+ pageFromList

128 ) where

139

1410import qualified Data.Map as M

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

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

1713import Data.Maybe

1814import Control.Monad

15+import Control.Arrow

1916

2017import System.FilePath

2118import System.IO

2219

2320import Text.Hakyll.Util

21+import Text.Hakyll.Renderable

2422import Text.Pandoc

2523

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

2725-- 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

2930

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

3132type PageValue = B.ByteString

3233

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

3435addContext :: String -> String -> Page -> Page

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

36−

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

38−toURL :: FilePath -> FilePath

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

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

4037

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

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

43−getURL :: Page -> String

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

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

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

40+getPageURL :: Page -> String

41+getPageURL page =

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

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

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

4745

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

4947-- empty.

5048getBody :: Page -> PageValue

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

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

5250

5351writerOptions :: WriterOptions

5452writerOptions = defaultWriterOptions

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

8078 makeDirectories destination

8179 handle <- openFile destination WriteMode

8280 hPutStrLn handle "---"

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

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

8482 hPutStrLn handle "---"

8583 B.hPut handle $ getBody page

8684 hClose handle

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

108106 -- Render file

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

110108 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

112110

113111 -- Cache if needed

114112 if getFromCache then return () else cachePage page

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

118116

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

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

121−pageFromList = M.fromList . map packPair

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

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

123121 in seq pv (k, pv)

124122

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

126−concatPages :: [Page] -> PageValue

127−concatPages = concatPagesWith "body"

128−

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

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)

123+-- Make pages renderable

124+instance Renderable Page where

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

126+ getURL = getPageURL

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

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

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

11module Text.Hakyll.Render

22 ( depends,

3− renderPage,

3+ render,

44 writePage,

55 renderAndConcat,

66 renderChain,

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

88 staticDirectory

99 ) where

1010

11−import Text.Template

11+import Text.Template hiding (render)

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

1313import qualified Data.Map as M

1414import Control.Monad

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

1717import System.IO

1818

1919import Text.Hakyll.Page

20+import Text.Hakyll.Renderable

2021import Text.Hakyll.Util

2122

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

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

2425 valid <- isCacheValid (toDestination file) dependencies

2526 unless valid action

2627

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

32−renderPage templatePath page = do

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

29+render templatePath renderable = do

3330 handle <- openFile templatePath ReadMode

3431 templateString <- liftM B.pack $ hGetContents handle

3532 seq templateString $ hClose handle

36− let body = substitute templateString (createContext page)

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

33+ context <- toContext renderable

34+ let body = substitute templateString context

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

3836

3937writePage :: Page -> IO ()

4038writePage page = do

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

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

4846 concatRender' chunk path = do

4947 page <- readPage path

50− rendered <- renderPage templatePath page

48+ rendered <- render templatePath page

5149 let body = getBody rendered

5250 return $ B.append chunk $ body

5351

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

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

56− do page <- readPage pagePath

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

58− writePage result

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

53+renderChain templates renderable =

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

55+ do initialPage <- toContext renderable

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

57+ writePage result

5958

6059static :: FilePath -> IO ()

6160static 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 @@

11module Text.Hakyll.Util

22 ( toDestination,

33 toCache,

4+ toURL,

45 makeDirectories,

56 getRecursiveContents,

67 trim,

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

2021toCache :: FilePath -> FilePath

2122toCache path = "_cache" </> path

2223

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

25+toURL :: FilePath -> FilePath

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

27+

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

2429-- all directories on the path.

2530makeDirectories :: FilePath -> IO ()