77c7d8d · hakyll · git.iko.soy

git.iko.soy/hakyll

on master help sign in

Add in-memory map to store

77c7d8dJasper Van der Jeugt16 years ago

src/Hakyll/Core/Compiler.hs+9−15

compare with master

unifiedsplit

@@ -37,15 +37,14 @@ import Hakyll.Core.Store

37runCompiler :: Compiler () CompiledItem -- ^ Compiler to run

38 -> Identifier -- ^ Target identifier

39 -> ResourceProvider -- ^ Resource provider

40− -> DependencyLookup -- ^ Dependency lookup table

41 -> Maybe FilePath -- ^ Route

40 -> Maybe FilePath -- ^ Route

42 -> Store -- ^ Store

41 -> Store -- ^ Store

43 -> Bool -- ^ Was the resource modified?

42 -> Bool -- ^ Was the resource modified?

44 -> IO CompiledItem -- ^ Resulting item

43 -> IO CompiledItem -- ^ Resulting item

45−runCompiler compiler identifier provider lookup' route store modified = do

44+runCompiler compiler identifier provider route store modified = do

46 -- Run the compiler job

45 -- Run the compiler job

47 CompiledItem result <- runCompilerJob

46 CompiledItem result <- runCompilerJob

48− compiler identifier provider lookup' route store modified

47+ compiler identifier provider route store modified

50 -- Store a copy in the cache and return

49 -- Store a copy in the cache and return

51 storeSet store "Hakyll.Core.Compiler.runCompiler" identifier result

50 storeSet store "Hakyll.Core.Compiler.runCompiler" identifier result

@@ -72,17 +71,12 @@ getResourceString = getIdentifier >>> getResourceString'

73-- | Auxiliary: get a dependency

72-- | Auxiliary: get a dependency

74--

73--

75−getDependencyOrResult :: (Binary a, Writable a, Typeable a)

74+getDependency :: (Binary a, Writable a, Typeable a)

76 => Identifier -> CompilerM a

75 => Identifier -> CompilerM a

77−getDependencyOrResult identifier = CompilerM $ do

76+getDependency identifier = CompilerM $ do

78− lookup' <- compilerDependencyLookup <$> ask

79 store <- compilerStore <$> ask

77 store <- compilerStore <$> ask

80− case lookup' identifier of

81− -- Found in the dependency lookup

82− Just r -> return $ unCompiledItem r

83− -- Not found here, try the main cache

84− Nothing -> fmap (fromMaybe error') $ liftIO $

78+ fmap (fromMaybe error') $ liftIO $

85− storeGet store "Hakyll.Core.Compiler.runCompiler" identifier

79+ storeGet store "Hakyll.Core.Compiler.runCompiler" identifier

86 where

80 where

87 error' = error $ "Hakyll.Core.Compiler.getDependency: "

81 error' = error $ "Hakyll.Core.Compiler.getDependency: "

88 ++ show identifier

82 ++ show identifier

@@ -99,7 +93,7 @@ require identifier f =

99 fromDependencies (const [identifier]) >>> fromJob require'

93 fromDependencies (const [identifier]) >>> fromJob require'

100 where

94 where

101 require' x = do

95 require' x = do

102− y <- getDependencyOrResult identifier

96+ y <- getDependency identifier

103 return $ f x y

97 return $ f x y

104

105-- | Require a number of targets. Using this function ensures automatic handling

99-- | Require a number of targets. Using this function ensures automatic handling

@@ -115,10 +109,10 @@ requireAll pattern f =

115 getDeps = matches pattern . resourceList

109 getDeps = matches pattern . resourceList

116 requireAll' x = CompilerM $ do

110 requireAll' x = CompilerM $ do

117 deps <- getDeps . compilerResourceProvider <$> ask

111 deps <- getDeps . compilerResourceProvider <$> ask

118− items <- mapM (unCompilerM . getDependencyOrResult) deps

112+ items <- mapM (unCompilerM . getDependency) deps

119 return $ f x items

113 return $ f x items

120

114

121−cached :: (Binary a)

115+cached :: (Binary a, Typeable a, Writable a)

122 => String

116 => String

123 -> Compiler () a

117 -> Compiler () a

124 -> Compiler () a

118 -> Compiler () a

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

@@ -3,7 +3,6 @@

3{-# LANGUAGE GeneralizedNewtypeDeriving #-}

4module Hakyll.Core.Compiler.Internal

5 ( Dependencies

6− , DependencyLookup

7 , CompilerEnvironment (..)

6 , CompilerEnvironment (..)

8 , CompilerM (..)

7 , CompilerM (..)

9 , Compiler (..)

8 , Compiler (..)

@@ -23,7 +22,6 @@ import Control.Category (Category, (.), id)

23import Control.Arrow (Arrow, arr, first)

22import Control.Arrow (Arrow, arr, first)

25import Hakyll.Core.Identifier

24import Hakyll.Core.Identifier

26−import Hakyll.Core.CompiledItem

27import Hakyll.Core.ResourceProvider

25import Hakyll.Core.ResourceProvider

28import Hakyll.Core.Store

26import Hakyll.Core.Store

@@ -31,10 +29,6 @@ import Hakyll.Core.Store

31--

29--

32type Dependencies = Set Identifier

30type Dependencies = Set Identifier

34−-- | A lookup with which we can get dependencies

35−--

36−type DependencyLookup = Identifier -> Maybe CompiledItem

37−

38-- | Environment in which a compiler runs

32-- | Environment in which a compiler runs

39--

33--

40data CompilerEnvironment = CompilerEnvironment

34data CompilerEnvironment = CompilerEnvironment

@@ -42,8 +36,6 @@ data CompilerEnvironment = CompilerEnvironment

42 compilerIdentifier :: Identifier

36 compilerIdentifier :: Identifier

43 , -- | Resource provider

37 , -- | Resource provider

44 compilerResourceProvider :: ResourceProvider

38 compilerResourceProvider :: ResourceProvider

45− , -- | Dependency lookup

46− compilerDependencyLookup :: DependencyLookup

47 , -- | Site route

39 , -- | Site route

48 compilerRoute :: Maybe FilePath

40 compilerRoute :: Maybe FilePath

49 , -- | Compiler store

41 , -- | Compiler store

@@ -81,18 +73,16 @@ instance Arrow Compiler where

81runCompilerJob :: Compiler () a -- ^ Compiler to run

73runCompilerJob :: Compiler () a -- ^ Compiler to run

82 -> Identifier -- ^ Target identifier

74 -> Identifier -- ^ Target identifier

83 -> ResourceProvider -- ^ Resource provider

75 -> ResourceProvider -- ^ Resource provider

84− -> DependencyLookup -- ^ Dependency lookup table

85 -> Maybe FilePath -- ^ Route

76 -> Maybe FilePath -- ^ Route

86 -> Store -- ^ Store

77 -> Store -- ^ Store

87 -> Bool -- ^ Was the resource modified?

78 -> Bool -- ^ Was the resource modified?

88 -> IO a

79 -> IO a

89−runCompilerJob compiler identifier provider lookup' route store modified =

80+runCompilerJob compiler identifier provider route store modified =

90 runReaderT (unCompilerM $ compilerJob compiler ()) env

81 runReaderT (unCompilerM $ compilerJob compiler ()) env

91 where

82 where

92 env = CompilerEnvironment

83 env = CompilerEnvironment

93 { compilerIdentifier = identifier

84 { compilerIdentifier = identifier

94 , compilerResourceProvider = provider

85 , compilerResourceProvider = provider

95− , compilerDependencyLookup = lookup'

96 , compilerRoute = route

86 , compilerRoute = route

97 , compilerStore = store

87 , compilerStore = store

98 , compilerResourceModified = modified

88 , compilerResourceModified = modified

src/Hakyll/Core/Run.hs+3−7

@@ -80,19 +80,18 @@ hakyllWith rules provider store = do

80 putStrLn $ show ordered

82 -- Generate all the targets in order

83− _ <- foldM (addTarget route' modified') M.empty orderedCompilers

83+ _ <- mapM (addTarget route' modified') orderedCompilers

85 putStrLn "DONE."

86 where

87− addTarget route' modified' map' (id', comp) = do

87+ addTarget route' modified' (id', comp) = do

88 let url = runRoute route' id'

90 -- Check if the resource was modified

91 let isModified = id' `S.member` modified'

93 -- Run the compiler

94− compiled <- runCompiler comp id' provider (dependencyLookup map')

94+ compiled <- runCompiler comp id' provider url store isModified

95− url store isModified

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

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

98 case url of

97 case url of

@@ -104,9 +103,6 @@ hakyllWith rules provider store = do

104 write path compiled

103 write path compiled

105

104

106 putStrLn ""

105 putStrLn ""

107− return $ M.insert id' compiled map'

108−

109− dependencyLookup map' id' = M.lookup id' map'

110

106

111-- | Return a set of modified identifiers

107-- | Return a set of modified identifiers

112--

108--

src/Hakyll/Core/Store.hs+43−8

@@ -7,25 +7,45 @@ module Hakyll.Core.Store

7 , storeGet

8 ) where

10−import Control.Applicative ((<$>))

10+import Control.Concurrent.MVar (MVar, newMVar, readMVar, modifyMVar_)

11import System.FilePath ((</>))

12import System.Directory (doesFileExist)

13+import Data.Map (Map)

14+import qualified Data.Map as M

14import Data.Binary (Binary, encodeFile, decodeFile)

16import Data.Binary (Binary, encodeFile, decodeFile)

17+import Data.Typeable (Typeable)

19+import Hakyll.Core.CompiledItem

20+import Hakyll.Core.Writable

16import Hakyll.Core.Identifier

21import Hakyll.Core.Identifier

17import Hakyll.Core.Util.File

22import Hakyll.Core.Util.File

19-- | Data structure used for the store

24-- | Data structure used for the store

20--

25--

21data Store = Store

26data Store = Store

27+ { -- | All items are stored on the filesystem

22− { storeDirectory :: FilePath

28+ storeDirectory :: FilePath

29+ , -- | And some items are also kept in-memory

30+ storeMap :: MVar (Map FilePath CompiledItem)

23 }

31 }

25-- | Initialize the store

33-- | Initialize the store

26--

34--

27makeStore :: FilePath -> IO Store

35makeStore :: FilePath -> IO Store

36+makeStore directory = do

37+ mvar <- newMVar M.empty

38+ return Store

28−makeStore directory = return Store {storeDirectory = directory}

39+ { storeDirectory = directory

40+ , storeMap = mvar

41+ }

42+

43+-- | Auxiliary: add an item to the map

44+--

45+addToMap :: (Binary a, Typeable a, Writable a)

46+ => Store -> FilePath -> a -> IO ()

47+addToMap store path value =

48+ modifyMVar_ (storeMap store) $ return . M.insert path (compiledItem value)

30-- | Create a path

50-- | Create a path

31--

51--

@@ -35,19 +55,34 @@ makePath store name identifier =

36-- | Store an item

56-- | Store an item

37--

57--

58+storeSet :: (Binary a, Typeable a, Writable a)

38−storeSet :: Binary a => Store -> String -> Identifier -> a -> IO ()

59+ => Store -> String -> Identifier -> a -> IO ()

39storeSet store name identifier value = do

60storeSet store name identifier value = do

40 makeDirectories path

61 makeDirectories path

41 encodeFile path value

62 encodeFile path value

63+ addToMap store path value

42 where

64 where

43 path = makePath store name identifier

65 path = makePath store name identifier

45-- | Load an item

67-- | Load an item

46--

68--

69+storeGet :: (Binary a, Typeable a, Writable a)

47−storeGet :: Binary a => Store -> String -> Identifier -> IO (Maybe a)

70+ => Store -> String -> Identifier -> IO (Maybe a)

48storeGet store name identifier = do

71storeGet store name identifier = do

72+ -- First check the in-memory map

73+ map' <- readMVar $ storeMap store

74+ case M.lookup path map' of

75+ -- Found in the in-memory map

76+ Just c -> return $ Just $ unCompiledItem c

77+ -- Not found in the map, try the filesystem

78+ Nothing -> do

49− exists <- doesFileExist path

79+ exists <- doesFileExist path

80+ if not exists

81+ -- Not found in the filesystem either

82+ then return Nothing

83+ -- Found in the filesystem

50− if exists then Just <$> decodeFile path

84+ else do v <- decodeFile path

85+ addToMap store path v

51− else return Nothing

86+ return $ Just v

52 where

87 where

53 path = makePath store name identifier

88 path = makePath store name identifier

src/Hakyll/Core/Writable.hs+5

@@ -8,7 +8,9 @@ module Hakyll.Core.Writable

8 ) where

10import System.Directory (copyFile)

11+import Data.Word (Word8)

13+import qualified Data.ByteString as SB

12import Data.Binary (Binary)

14import Data.Binary (Binary)

13import Data.Typeable (Typeable)

15import Data.Typeable (Typeable)

@@ -21,6 +23,9 @@ class Writable a where

21instance Writable [Char] where

23instance Writable [Char] where

22 write = writeFile

24 write = writeFile

26+instance Writable [Word8] where

27+ write p = SB.writeFile p . SB.pack

28+

24-- | Newtype construct around 'FilePath' which will copy the file directly

29-- | Newtype construct around 'FilePath' which will copy the file directly

25--

30--

26newtype CopyFile = CopyFile {unCopyFile :: FilePath}

31newtype CopyFile = CopyFile {unCopyFile :: FilePath}