diff options
author | Jasper Van der Jeugt <jaspervdj@gmail.com> | 2010-12-31 12:38:12 +0100 |
---|---|---|
committer | Jasper Van der Jeugt <jaspervdj@gmail.com> | 2010-12-31 12:38:12 +0100 |
commit | 5b67f20eab333a0a63eddae93fa114d8f5158c61 (patch) | |
tree | 56dd5a9f9dfb42cf250dd2160b57d30b50506220 /src/Hakyll | |
parent | 70c7363b8c1ad250c5f68993867015ef68a8b46c (diff) | |
download | hakyll-5b67f20eab333a0a63eddae93fa114d8f5158c61.tar.gz |
Prototype of the 'cached' arrow transformer
Diffstat (limited to 'src/Hakyll')
-rw-r--r-- | src/Hakyll/Core/Compiler.hs | 23 | ||||
-rw-r--r-- | src/Hakyll/Core/Compiler/Internal.hs | 6 | ||||
-rw-r--r-- | src/Hakyll/Core/ResourceProvider.hs | 20 | ||||
-rw-r--r-- | src/Hakyll/Core/Run.hs | 3 | ||||
-rw-r--r-- | src/Hakyll/Core/Store.hs | 20 |
5 files changed, 50 insertions, 22 deletions
diff --git a/src/Hakyll/Core/Compiler.hs b/src/Hakyll/Core/Compiler.hs index 5678b0a..67724bd 100644 --- a/src/Hakyll/Core/Compiler.hs +++ b/src/Hakyll/Core/Compiler.hs @@ -8,6 +8,7 @@ module Hakyll.Core.Compiler , getResourceString , require , requireAll + , cached ) where import Prelude hiding ((.), id) @@ -26,6 +27,7 @@ import Hakyll.Core.CompiledItem import Hakyll.Core.Writable import Hakyll.Core.ResourceProvider import Hakyll.Core.Compiler.Internal +import Hakyll.Core.Store -- | Get the identifier of the item that is currently being compiled -- @@ -75,3 +77,24 @@ requireAll pattern f = deps <- getDeps . compilerResourceProvider <$> ask lookup' <- compilerDependencyLookup <$> ask return $ f x $ map (unCompiledItem . lookup') deps + +cached :: (Binary a) + => String + -> Compiler () a + -> Compiler () a +cached name (Compiler d j) = Compiler d $ const $ CompilerM $ do + provider <- compilerResourceProvider <$> ask + identifier <- compilerIdentifier <$> ask + store <- compilerStore <$> ask + modified <- liftIO $ resourceModified provider identifier store + liftIO $ putStrLn $ + show identifier ++ ": " ++ if modified then "MODIFIED" else "OK" + if modified + then do v <- unCompilerM $ j () + liftIO $ storeSet store name identifier v + return v + else do v <- liftIO $ storeGet store name identifier + case v of Just v' -> return v' + Nothing -> error' + where + error' = error "Hakyll.Core.Compiler.cached: Cache corrupt!" diff --git a/src/Hakyll/Core/Compiler/Internal.hs b/src/Hakyll/Core/Compiler/Internal.hs index eee67ef..4209bdc 100644 --- a/src/Hakyll/Core/Compiler/Internal.hs +++ b/src/Hakyll/Core/Compiler/Internal.hs @@ -24,6 +24,7 @@ import Control.Arrow (Arrow, arr, first) import Hakyll.Core.Identifier import Hakyll.Core.CompiledItem import Hakyll.Core.ResourceProvider +import Hakyll.Core.Store -- | A set of dependencies -- @@ -40,6 +41,7 @@ data CompilerEnvironment = CompilerEnvironment , compilerResourceProvider :: ResourceProvider -- ^ Resource provider , compilerDependencyLookup :: DependencyLookup -- ^ Dependency lookup , compilerRoute :: Maybe FilePath -- ^ Site route + , compilerStore :: Store -- ^ Compiler store } -- | The compiler monad @@ -73,8 +75,9 @@ runCompilerJob :: Compiler () a -- ^ Compiler to run -> ResourceProvider -- ^ Resource provider -> DependencyLookup -- ^ Dependency lookup table -> Maybe FilePath -- ^ Route + -> Store -- ^ Store -> IO a -runCompilerJob compiler identifier provider lookup' route = +runCompilerJob compiler identifier provider lookup' route store = runReaderT (unCompilerM $ compilerJob compiler ()) env where env = CompilerEnvironment @@ -82,6 +85,7 @@ runCompilerJob compiler identifier provider lookup' route = , compilerResourceProvider = provider , compilerDependencyLookup = lookup' , compilerRoute = route + , compilerStore = store } runCompilerDependencies :: Compiler () a diff --git a/src/Hakyll/Core/ResourceProvider.hs b/src/Hakyll/Core/ResourceProvider.hs index ba249ca..c522ab6 100644 --- a/src/Hakyll/Core/ResourceProvider.hs +++ b/src/Hakyll/Core/ResourceProvider.hs @@ -5,6 +5,7 @@ module Hakyll.Core.ResourceProvider ( ResourceProvider (..) , resourceDigest + , resourceModified ) where import Control.Monad ((<=<)) @@ -15,6 +16,7 @@ import OpenSSL.Digest.ByteString.Lazy (digest) import OpenSSL.Digest (MessageDigest (MD5)) import Hakyll.Core.Identifier +import Hakyll.Core.Store -- | A value responsible for retrieving and listing resources -- @@ -31,3 +33,21 @@ data ResourceProvider = ResourceProvider -- resourceDigest :: ResourceProvider -> Identifier -> IO [Word8] resourceDigest provider = digest MD5 <=< resourceLazyByteString provider + +-- | Check if a resource was modified +-- +resourceModified :: ResourceProvider -> Identifier -> Store -> IO Bool +resourceModified provider identifier store = do + -- Get the latest seen digest from the store + lastDigest <- storeGet store itemName identifier + -- Calculate the digest for the resource + newDigest <- resourceDigest provider identifier + -- Check digests + if Just newDigest == lastDigest + -- All is fine, not modified + then return False + -- Resource modified; store new digest + else do storeSet store itemName identifier newDigest + return True + where + itemName = "Hakyll.Core.ResourceProvider.resourceModified" diff --git a/src/Hakyll/Core/Run.hs b/src/Hakyll/Core/Run.hs index ccb731c..636f9e4 100644 --- a/src/Hakyll/Core/Run.hs +++ b/src/Hakyll/Core/Run.hs @@ -67,7 +67,8 @@ hakyllWith rules provider store = do where addTarget route' map' (id', comp) = do let url = runRoute route' id' - compiled <- runCompilerJob comp id' provider (dependencyLookup map') url + compiled <- runCompilerJob comp id' provider (dependencyLookup map') + url store putStrLn $ "Generated target: " ++ show id' case url of diff --git a/src/Hakyll/Core/Store.hs b/src/Hakyll/Core/Store.hs index 7e57df2..02b9b4e 100644 --- a/src/Hakyll/Core/Store.hs +++ b/src/Hakyll/Core/Store.hs @@ -5,7 +5,6 @@ module Hakyll.Core.Store , makeStore , storeSet , storeGet - , wasModified ) where import Control.Applicative ((<$>)) @@ -16,7 +15,6 @@ import Data.Binary (Binary, encodeFile, decodeFile) import Hakyll.Core.Identifier import Hakyll.Core.Util.File -import Hakyll.Core.ResourceProvider -- | Data structure used for the store -- @@ -53,21 +51,3 @@ storeGet store name identifier = do else return Nothing where path = makePath store name identifier - --- | Check if a resource was modified --- -wasModified :: Store -> ResourceProvider -> Identifier -> IO Bool -wasModified store provider identifier = do - -- Get the latest seen digest from the store - lastDigest <- storeGet store itemName identifier - -- Calculate the digest for the resource - newDigest <- resourceDigest provider identifier - -- Check digests - if Just newDigest == lastDigest - -- All is fine, not modified - then return False - -- Resource modified; store new digest - else do storeSet store itemName identifier newDigest - return True - where - itemName = "Hakyll.Core.Store.wasModified" |