Speedup of factor 4 by switching to the Data.Binary library for serialization.

2 files changed, 13 insertions, 8 deletions

diff --git a/src/Text/Hakyll/Internal/Cache.hs b/src/Text/Hakyll/Internal/Cache.hs
index 454a4c5..9b9fab1 100644
--- a/src/Text/Hakyll/Internal/Cache.hs
+++ b/src/Text/Hakyll/Internal/Cache.hs
@@ -6,19 +6,17 @@ module Text.Hakyll.Internal.Cache
 import Control.Monad.Reader (liftIO)
 import Text.Hakyll.Hakyll (Hakyll)
 import Text.Hakyll.File
+import Data.Binary
 
-storeInCache :: (Show a) => a -> FilePath -> Hakyll ()
+storeInCache :: (Binary a) => a -> FilePath -> Hakyll ()
 storeInCache value path = do
     cachePath <- toCache path
     makeDirectories cachePath
-    liftIO $ writeFile cachePath (show value)
+    liftIO $ encodeFile cachePath value
 
-getFromCache :: (Read a) => FilePath -> Hakyll (Maybe a)
+getFromCache :: (Binary a) => FilePath -> Hakyll (Maybe a)
 getFromCache path = do
     cachePath <- toCache path
     valid <- isMoreRecent cachePath [path]
-    if valid then liftIO (getFromCache' cachePath) >>= return . Just
+    if valid then liftIO (decodeFile 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 5ab4117..7b40ada 100644
--- a/src/Text/Hakyll/Page.hs
+++ b/src/Text/Hakyll/Page.hs
@@ -11,12 +11,14 @@ import qualified Data.Map as M
 import Data.List (isPrefixOf)
 import Data.Char (isSpace)
 import Data.Maybe (fromMaybe)
-import Control.Parallel.Strategies (rdeepseq, ($|))
+import Control.Monad (liftM)
 import Control.Monad.Reader (liftIO)
+import Control.Parallel.Strategies (rdeepseq, ($|))
 import System.FilePath (takeExtension)
 import System.IO
 
 import Text.Pandoc
+import Data.Binary
 
 import Text.Hakyll.Internal.Cache
 import Text.Hakyll.Hakyll (Hakyll)
@@ -148,3 +150,8 @@ instance Renderable Page where
     getDependencies = (:[]) . getPagePath
     getURL = getPageURL
     toContext (Page page) = return page
+
+-- Make pages serializable.
+instance Binary Page where
+    put (Page context) = put $ M.toList context
+    get = liftM (Page . M.fromList) get