diff options
| -rw-r--r-- | src/Hakyll/Core/Compiler.hs | 24 | ||||
| -rw-r--r-- | src/Hakyll/Core/Compiler/Internal.hs | 12 | ||||
| -rw-r--r-- | src/Hakyll/Core/Run.hs | 10 | ||||
| -rw-r--r-- | src/Hakyll/Core/Store.hs | 51 | ||||
| -rw-r--r-- | src/Hakyll/Core/Writable.hs | 5 |
5 files changed, 61 insertions, 41 deletions
diff --git a/src/Hakyll/Core/Compiler.hs b/src/Hakyll/Core/Compiler.hs index 0c13c78..e862dd8 100644 --- a/src/Hakyll/Core/Compiler.hs +++ b/src/Hakyll/Core/Compiler.hs @@ -37,15 +37,14 @@ import Hakyll.Core.Store runCompiler :: Compiler () CompiledItem -- ^ Compiler to run -> Identifier -- ^ Target identifier -> ResourceProvider -- ^ Resource provider - -> DependencyLookup -- ^ Dependency lookup table -> Maybe FilePath -- ^ Route -> Store -- ^ Store -> Bool -- ^ Was the resource modified? -> IO CompiledItem -- ^ Resulting item -runCompiler compiler identifier provider lookup' route store modified = do +runCompiler compiler identifier provider route store modified = do -- Run the compiler job CompiledItem result <- runCompilerJob - compiler identifier provider lookup' route store modified + compiler identifier provider route store modified -- Store a copy in the cache and return storeSet store "Hakyll.Core.Compiler.runCompiler" identifier result @@ -72,17 +71,12 @@ getResourceString = getIdentifier >>> getResourceString' -- | Auxiliary: get a dependency -- -getDependencyOrResult :: (Binary a, Writable a, Typeable a) +getDependency :: (Binary a, Writable a, Typeable a) => Identifier -> CompilerM a -getDependencyOrResult identifier = CompilerM $ do - lookup' <- compilerDependencyLookup <$> ask +getDependency identifier = CompilerM $ do store <- compilerStore <$> ask - case lookup' identifier of - -- Found in the dependency lookup - Just r -> return $ unCompiledItem r - -- Not found here, try the main cache - Nothing -> fmap (fromMaybe error') $ liftIO $ - storeGet store "Hakyll.Core.Compiler.runCompiler" identifier + fmap (fromMaybe error') $ liftIO $ + storeGet store "Hakyll.Core.Compiler.runCompiler" identifier where error' = error $ "Hakyll.Core.Compiler.getDependency: " ++ show identifier @@ -99,7 +93,7 @@ require identifier f = fromDependencies (const [identifier]) >>> fromJob require' where require' x = do - y <- getDependencyOrResult identifier + y <- getDependency identifier return $ f x y -- | Require a number of targets. Using this function ensures automatic handling @@ -115,10 +109,10 @@ requireAll pattern f = getDeps = matches pattern . resourceList requireAll' x = CompilerM $ do deps <- getDeps . compilerResourceProvider <$> ask - items <- mapM (unCompilerM . getDependencyOrResult) deps + items <- mapM (unCompilerM . getDependency) deps return $ f x items -cached :: (Binary a) +cached :: (Binary a, Typeable a, Writable a) => String -> Compiler () a -> Compiler () a diff --git a/src/Hakyll/Core/Compiler/Internal.hs b/src/Hakyll/Core/Compiler/Internal.hs index 1796565..0642b85 100644 --- a/src/Hakyll/Core/Compiler/Internal.hs +++ b/src/Hakyll/Core/Compiler/Internal.hs @@ -3,7 +3,6 @@ {-# LANGUAGE GeneralizedNewtypeDeriving #-} module Hakyll.Core.Compiler.Internal ( Dependencies - , DependencyLookup , CompilerEnvironment (..) , CompilerM (..) , Compiler (..) @@ -23,7 +22,6 @@ import Control.Category (Category, (.), id) import Control.Arrow (Arrow, arr, first) import Hakyll.Core.Identifier -import Hakyll.Core.CompiledItem import Hakyll.Core.ResourceProvider import Hakyll.Core.Store @@ -31,10 +29,6 @@ import Hakyll.Core.Store -- type Dependencies = Set Identifier --- | A lookup with which we can get dependencies --- -type DependencyLookup = Identifier -> Maybe CompiledItem - -- | Environment in which a compiler runs -- data CompilerEnvironment = CompilerEnvironment @@ -42,8 +36,6 @@ data CompilerEnvironment = CompilerEnvironment compilerIdentifier :: Identifier , -- | Resource provider compilerResourceProvider :: ResourceProvider - , -- | Dependency lookup - compilerDependencyLookup :: DependencyLookup , -- | Site route compilerRoute :: Maybe FilePath , -- | Compiler store @@ -81,18 +73,16 @@ instance Arrow Compiler where runCompilerJob :: Compiler () a -- ^ Compiler to run -> Identifier -- ^ Target identifier -> ResourceProvider -- ^ Resource provider - -> DependencyLookup -- ^ Dependency lookup table -> Maybe FilePath -- ^ Route -> Store -- ^ Store -> Bool -- ^ Was the resource modified? -> IO a -runCompilerJob compiler identifier provider lookup' route store modified = +runCompilerJob compiler identifier provider route store modified = runReaderT (unCompilerM $ compilerJob compiler ()) env where env = CompilerEnvironment { compilerIdentifier = identifier , compilerResourceProvider = provider - , compilerDependencyLookup = lookup' , compilerRoute = route , compilerStore = store , compilerResourceModified = modified diff --git a/src/Hakyll/Core/Run.hs b/src/Hakyll/Core/Run.hs index 9e6a6ee..7121068 100644 --- a/src/Hakyll/Core/Run.hs +++ b/src/Hakyll/Core/Run.hs @@ -80,19 +80,18 @@ hakyllWith rules provider store = do putStrLn $ show ordered -- Generate all the targets in order - _ <- foldM (addTarget route' modified') M.empty orderedCompilers + _ <- mapM (addTarget route' modified') orderedCompilers putStrLn "DONE." where - addTarget route' modified' map' (id', comp) = do + addTarget route' modified' (id', comp) = do let url = runRoute route' id' -- Check if the resource was modified let isModified = id' `S.member` modified' -- Run the compiler - compiled <- runCompiler comp id' provider (dependencyLookup map') - url store isModified + compiled <- runCompiler comp id' provider url store isModified putStrLn $ "Generated target: " ++ show id' case url of @@ -104,9 +103,6 @@ hakyllWith rules provider store = do write path compiled putStrLn "" - return $ M.insert id' compiled map' - - dependencyLookup map' id' = M.lookup id' map' -- | Return a set of modified identifiers -- diff --git a/src/Hakyll/Core/Store.hs b/src/Hakyll/Core/Store.hs index 02b9b4e..ab739a1 100644 --- a/src/Hakyll/Core/Store.hs +++ b/src/Hakyll/Core/Store.hs @@ -7,25 +7,45 @@ module Hakyll.Core.Store , storeGet ) where -import Control.Applicative ((<$>)) +import Control.Concurrent.MVar (MVar, newMVar, readMVar, modifyMVar_) import System.FilePath ((</>)) import System.Directory (doesFileExist) +import Data.Map (Map) +import qualified Data.Map as M import Data.Binary (Binary, encodeFile, decodeFile) +import Data.Typeable (Typeable) +import Hakyll.Core.CompiledItem +import Hakyll.Core.Writable import Hakyll.Core.Identifier import Hakyll.Core.Util.File -- | Data structure used for the store -- data Store = Store - { storeDirectory :: FilePath + { -- | All items are stored on the filesystem + storeDirectory :: FilePath + , -- | And some items are also kept in-memory + storeMap :: MVar (Map FilePath CompiledItem) } -- | Initialize the store -- makeStore :: FilePath -> IO Store -makeStore directory = return Store {storeDirectory = directory} +makeStore directory = do + mvar <- newMVar M.empty + return Store + { storeDirectory = directory + , storeMap = mvar + } + +-- | Auxiliary: add an item to the map +-- +addToMap :: (Binary a, Typeable a, Writable a) + => Store -> FilePath -> a -> IO () +addToMap store path value = + modifyMVar_ (storeMap store) $ return . M.insert path (compiledItem value) -- | Create a path -- @@ -35,19 +55,34 @@ makePath store name identifier = -- | Store an item -- -storeSet :: Binary a => Store -> String -> Identifier -> a -> IO () +storeSet :: (Binary a, Typeable a, Writable a) + => Store -> String -> Identifier -> a -> IO () storeSet store name identifier value = do makeDirectories path encodeFile path value + addToMap store path value where path = makePath store name identifier -- | Load an item -- -storeGet :: Binary a => Store -> String -> Identifier -> IO (Maybe a) +storeGet :: (Binary a, Typeable a, Writable a) + => Store -> String -> Identifier -> IO (Maybe a) storeGet store name identifier = do - exists <- doesFileExist path - if exists then Just <$> decodeFile path - else return Nothing + -- First check the in-memory map + map' <- readMVar $ storeMap store + case M.lookup path map' of + -- Found in the in-memory map + Just c -> return $ Just $ unCompiledItem c + -- Not found in the map, try the filesystem + Nothing -> do + exists <- doesFileExist path + if not exists + -- Not found in the filesystem either + then return Nothing + -- Found in the filesystem + else do v <- decodeFile path + addToMap store path v + return $ Just v where path = makePath store name identifier diff --git a/src/Hakyll/Core/Writable.hs b/src/Hakyll/Core/Writable.hs index a93903f..db53d9a 100644 --- a/src/Hakyll/Core/Writable.hs +++ b/src/Hakyll/Core/Writable.hs @@ -8,7 +8,9 @@ module Hakyll.Core.Writable ) where import System.Directory (copyFile) +import Data.Word (Word8) +import qualified Data.ByteString as SB import Data.Binary (Binary) import Data.Typeable (Typeable) @@ -21,6 +23,9 @@ class Writable a where instance Writable [Char] where write = writeFile +instance Writable [Word8] where + write p = SB.writeFile p . SB.pack + -- | Newtype construct around 'FilePath' which will copy the file directly -- newtype CopyFile = CopyFile {unCopyFile :: FilePath} |