Added caching again. But now the more sexy, stable and fast version.

This commit is contained in:
Jasper Van der Jeugt 2010-01-20 17:10:08 +01:00
parent 8602f23f7b
commit 892cae9da2
2 changed files with 27 additions and 5 deletions

View file

@ -3,10 +3,22 @@ module Text.Hakyll.Internal.Cache
, getFromCache , getFromCache
) where ) where
import Control.Monad.Reader (liftIO)
import Text.Hakyll.Hakyll (Hakyll) import Text.Hakyll.Hakyll (Hakyll)
import Text.Hakyll.File
storeInCache :: (Show a) => a -> FilePath -> Hakyll () storeInCache :: (Show a) => a -> FilePath -> Hakyll ()
storeInCache = undefined storeInCache value path = do
cachePath <- toCache path
makeDirectories cachePath
liftIO $ writeFile cachePath (show value)
getFromCache :: (Read a) => FilePath -> Hakyll (Maybe a) getFromCache :: (Read a) => FilePath -> Hakyll (Maybe a)
getFromCache = undefined getFromCache path = do
cachePath <- toCache path
valid <- isMoreRecent cachePath [path]
if valid then liftIO (getFromCache' cachePath) >>= return . Just
else return Nothing
where
getFromCache' cachePath = do c <- readFile cachePath
return (read c)

View file

@ -18,6 +18,7 @@ import System.IO
import Text.Pandoc import Text.Pandoc
import Text.Hakyll.Internal.Cache
import Text.Hakyll.Hakyll (Hakyll) import Text.Hakyll.Hakyll (Hakyll)
import Text.Hakyll.File import Text.Hakyll.File
import Text.Hakyll.Util (trim) import Text.Hakyll.Util (trim)
@ -28,6 +29,7 @@ import Text.Hakyll.Regex (substituteRegex, matchesRegex)
-- | A Page is basically key-value mapping. Certain keys have special -- | A Page is basically key-value mapping. Certain keys have special
-- meanings, like for example url, body and title. -- meanings, like for example url, body and title.
data Page = Page Context data Page = Page Context
deriving (Show, Read)
-- | Create a Page from a key-value mapping. -- | Create a Page from a key-value mapping.
fromContext :: Context -> Page fromContext :: Context -> Page
@ -110,8 +112,8 @@ readSection renderFunction isFirst ls
-- | Read a page from a file. Metadata is supported, and if the filename -- | Read a page from a file. Metadata is supported, and if the filename
-- has a @.markdown@ extension, it will be rendered using pandoc. -- has a @.markdown@ extension, it will be rendered using pandoc.
readPage :: FilePath -> Hakyll Page readPageFromFile :: FilePath -> Hakyll Page
readPage path = do readPageFromFile path = do
let renderFunction = getRenderFunction $ takeExtension path let renderFunction = getRenderFunction $ takeExtension path
sectionFunctions = map (readSection renderFunction) sectionFunctions = map (readSection renderFunction)
(True : repeat False) (True : repeat False)
@ -128,11 +130,19 @@ readPage path = do
] ++ context ] ++ context
seq (($|) id rdeepseq context) $ liftIO $ hClose handle seq (($|) id rdeepseq context) $ liftIO $ hClose handle
return page return page
where where
url = toURL path url = toURL path
-- | Read a page. Might fetch it from the cache if available.
readPage :: FilePath -> Hakyll Page
readPage path = do
cacheResult <- getFromCache path
case cacheResult of (Just page) -> return page
Nothing -> do page <- readPageFromFile path
storeInCache page path
return page
-- Make pages renderable. -- Make pages renderable.
instance Renderable Page where instance Renderable Page where
getDependencies = (:[]) . getPagePath getDependencies = (:[]) . getPagePath