5b67f20 · hakyll · git.iko.soy

git.iko.soy/hakyll

Prototype of the 'cached' arrow transformer

commit5b67f20eab333a0a63eddae93fa114d8f5158c61 authorJasper Van der Jeugt <jaspervdj@gmail.com> dateFri 31 Dec 2010, 12:38 (16 years ago) parent70c7363

5 files changed+50−22

compare with master

unifiedsplit

src/Hakyll/Core/Compiler.hs+23 src/Hakyll/Core/Compiler/Internal.hs+5−1 src/Hakyll/Core/ResourceProvider.hs+20 src/Hakyll/Core/Run.hs+2−1 src/Hakyll/Core/Store.hs−20

src/Hakyll/Core/Compiler.hs+23

@@ -8,6 +8,7 @@ module Hakyll.Core.Compiler

88 , getResourceString

99 , require

1010 , requireAll

11+ , cached

1112 ) where

1213

1314import Prelude hiding ((.), id)

@@ -26,6 +27,7 @@ import Hakyll.Core.CompiledItem

2627import Hakyll.Core.Writable

2728import Hakyll.Core.ResourceProvider

2829import Hakyll.Core.Compiler.Internal

30+import Hakyll.Core.Store

2931

3032-- | Get the identifier of the item that is currently being compiled

3133--

@@ -75,3 +77,24 @@ requireAll pattern f =

7577 deps <- getDeps . compilerResourceProvider <$> ask

7678 lookup' <- compilerDependencyLookup <$> ask

7779 return $ f x $ map (unCompiledItem . lookup') deps

80+

81+cached :: (Binary a)

82+ => String

83+ -> Compiler () a

84+ -> Compiler () a

85+cached name (Compiler d j) = Compiler d $ const $ CompilerM $ do

86+ provider <- compilerResourceProvider <$> ask

87+ identifier <- compilerIdentifier <$> ask

88+ store <- compilerStore <$> ask

89+ modified <- liftIO $ resourceModified provider identifier store

90+ liftIO $ putStrLn $

91+ show identifier ++ ": " ++ if modified then "MODIFIED" else "OK"

92+ if modified

93+ then do v <- unCompilerM $ j ()

94+ liftIO $ storeSet store name identifier v

95+ return v

96+ else do v <- liftIO $ storeGet store name identifier

97+ case v of Just v' -> return v'

98+ Nothing -> error'

99+ where

100+ error' = error "Hakyll.Core.Compiler.cached: Cache corrupt!"

src/Hakyll/Core/Compiler/Internal.hs+5−1

@@ -24,6 +24,7 @@ import Control.Arrow (Arrow, arr, first)

2424import Hakyll.Core.Identifier

2525import Hakyll.Core.CompiledItem

2626import Hakyll.Core.ResourceProvider

27+import Hakyll.Core.Store

2728

2829-- | A set of dependencies

2930--

@@ -40,6 +41,7 @@ data CompilerEnvironment = CompilerEnvironment

4041 , compilerResourceProvider :: ResourceProvider -- ^ Resource provider

4142 , compilerDependencyLookup :: DependencyLookup -- ^ Dependency lookup

4243 , compilerRoute :: Maybe FilePath -- ^ Site route

44+ , compilerStore :: Store -- ^ Compiler store

4345 }

4446

4547-- | The compiler monad

@@ -73,8 +75,9 @@ runCompilerJob :: Compiler () a -- ^ Compiler to run

7375 -> ResourceProvider -- ^ Resource provider

7476 -> DependencyLookup -- ^ Dependency lookup table

7577 -> Maybe FilePath -- ^ Route

78+ -> Store -- ^ Store

7679 -> IO a

77−runCompilerJob compiler identifier provider lookup' route =

80+runCompilerJob compiler identifier provider lookup' route store =

7881 runReaderT (unCompilerM $ compilerJob compiler ()) env

7982 where

8083 env = CompilerEnvironment

@@ -82,6 +85,7 @@ runCompilerJob compiler identifier provider lookup' route =

8285 , compilerResourceProvider = provider

8386 , compilerDependencyLookup = lookup'

8487 , compilerRoute = route

88+ , compilerStore = store

8589 }

8690

8791runCompilerDependencies :: Compiler () a

src/Hakyll/Core/ResourceProvider.hs+20

@@ -5,6 +5,7 @@

55module Hakyll.Core.ResourceProvider

66 ( ResourceProvider (..)

77 , resourceDigest

8+ , resourceModified

89 ) where

910

1011import Control.Monad ((<=<))

@@ -15,6 +16,7 @@ import OpenSSL.Digest.ByteString.Lazy (digest)

1516import OpenSSL.Digest (MessageDigest (MD5))

1617

1718import Hakyll.Core.Identifier

19+import Hakyll.Core.Store

1820

1921-- | A value responsible for retrieving and listing resources

2022--

@@ -31,3 +33,21 @@ data ResourceProvider = ResourceProvider

3133--

3234resourceDigest :: ResourceProvider -> Identifier -> IO [Word8]

3335resourceDigest provider = digest MD5 <=< resourceLazyByteString provider

36+

37+-- | Check if a resource was modified

38+--

39+resourceModified :: ResourceProvider -> Identifier -> Store -> IO Bool

40+resourceModified provider identifier store = do

41+ -- Get the latest seen digest from the store

42+ lastDigest <- storeGet store itemName identifier

43+ -- Calculate the digest for the resource

44+ newDigest <- resourceDigest provider identifier

45+ -- Check digests

46+ if Just newDigest == lastDigest

47+ -- All is fine, not modified

48+ then return False

49+ -- Resource modified; store new digest

50+ else do storeSet store itemName identifier newDigest

51+ return True

52+ where

53+ itemName = "Hakyll.Core.ResourceProvider.resourceModified"

src/Hakyll/Core/Run.hs+2−1

@@ -67,7 +67,8 @@ hakyllWith rules provider store = do

6767 where

6868 addTarget route' map' (id', comp) = do

6969 let url = runRoute route' id'

70− compiled <- runCompilerJob comp id' provider (dependencyLookup map') url

70+ compiled <- runCompilerJob comp id' provider (dependencyLookup map')

71+ url store

7172 putStrLn $ "Generated target: " ++ show id'

7273

7374 case url of

src/Hakyll/Core/Store.hs−20

@@ -5,7 +5,6 @@ module Hakyll.Core.Store

55 , makeStore

66 , storeSet

77 , storeGet

8− , wasModified

98 ) where

109

1110import Control.Applicative ((<$>))

@@ -16,7 +15,6 @@ import Data.Binary (Binary, encodeFile, decodeFile)

1615

1716import Hakyll.Core.Identifier

1817import Hakyll.Core.Util.File

19−import Hakyll.Core.ResourceProvider

2018

2119-- | Data structure used for the store

2220--

@@ -53,21 +51,3 @@ storeGet store name identifier = do

5351 else return Nothing

5452 where

5553 path = makePath store name identifier

56−

57−-- | Check if a resource was modified

58−--

59−wasModified :: Store -> ResourceProvider -> Identifier -> IO Bool

60−wasModified store provider identifier = do

61− -- Get the latest seen digest from the store

62− lastDigest <- storeGet store itemName identifier

63− -- Calculate the digest for the resource

64− newDigest <- resourceDigest provider identifier

65− -- Check digests

66− if Just newDigest == lastDigest

67− -- All is fine, not modified

68− then return False

69− -- Resource modified; store new digest

70− else do storeSet store itemName identifier newDigest

71− return True

72− where

73− itemName = "Hakyll.Core.Store.wasModified"