summaryrefslogtreecommitdiff
path: root/src/Text
diff options
context:
space:
mode:
authorJasper Van der Jeugt <jaspervdj@gmail.com>2010-01-20 17:10:08 +0100
committerJasper Van der Jeugt <jaspervdj@gmail.com>2010-01-20 17:10:08 +0100
commit892cae9da263d9f2fad4d93dd6d6c50fb12add16 (patch)
treea3ec2acd763ade28d6377959471b1e015e3e3868 /src/Text
parent8602f23f7bcdcc3bec65ec98c70ee3f295482856 (diff)
downloadhakyll-892cae9da263d9f2fad4d93dd6d6c50fb12add16.tar.gz
Added caching again. But now the more sexy, stable and fast version.
Diffstat (limited to 'src/Text')
-rw-r--r--src/Text/Hakyll/Internal/Cache.hs16
-rw-r--r--src/Text/Hakyll/Page.hs16
2 files changed, 27 insertions, 5 deletions
diff --git a/src/Text/Hakyll/Internal/Cache.hs b/src/Text/Hakyll/Internal/Cache.hs
index 8e52bb4..454a4c5 100644
--- a/src/Text/Hakyll/Internal/Cache.hs
+++ b/src/Text/Hakyll/Internal/Cache.hs
@@ -3,10 +3,22 @@ module Text.Hakyll.Internal.Cache
, getFromCache
) where
+import Control.Monad.Reader (liftIO)
import Text.Hakyll.Hakyll (Hakyll)
+import Text.Hakyll.File
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 = 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)
diff --git a/src/Text/Hakyll/Page.hs b/src/Text/Hakyll/Page.hs
index a988dcb..5ab4117 100644
--- a/src/Text/Hakyll/Page.hs
+++ b/src/Text/Hakyll/Page.hs
@@ -18,6 +18,7 @@ import System.IO
import Text.Pandoc
+import Text.Hakyll.Internal.Cache
import Text.Hakyll.Hakyll (Hakyll)
import Text.Hakyll.File
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
-- meanings, like for example url, body and title.
data Page = Page Context
+ deriving (Show, Read)
-- | Create a Page from a key-value mapping.
fromContext :: Context -> Page
@@ -110,8 +112,8 @@ readSection renderFunction isFirst ls
-- | Read a page from a file. Metadata is supported, and if the filename
-- has a @.markdown@ extension, it will be rendered using pandoc.
-readPage :: FilePath -> Hakyll Page
-readPage path = do
+readPageFromFile :: FilePath -> Hakyll Page
+readPageFromFile path = do
let renderFunction = getRenderFunction $ takeExtension path
sectionFunctions = map (readSection renderFunction)
(True : repeat False)
@@ -128,11 +130,19 @@ readPage path = do
] ++ context
seq (($|) id rdeepseq context) $ liftIO $ hClose handle
-
return page
where
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.
instance Renderable Page where
getDependencies = (:[]) . getPagePath