diff options
-rw-r--r-- | src/Hakyll/Core/Compiler.hs | 6 | ||||
-rw-r--r-- | src/Hakyll/Core/Routes.hs | 34 | ||||
-rw-r--r-- | src/Hakyll/Core/Runtime.hs | 2 | ||||
-rw-r--r-- | src/Hakyll/Core/Store.hs | 39 | ||||
-rw-r--r-- | tests/Hakyll/Core/Routes/Tests.hs | 3 | ||||
-rw-r--r-- | tests/Hakyll/Core/Rules/Tests.hs | 2 | ||||
-rw-r--r-- | web/examples.markdown | 8 |
7 files changed, 62 insertions, 32 deletions
diff --git a/src/Hakyll/Core/Compiler.hs b/src/Hakyll/Core/Compiler.hs index a672395..a6814f9 100644 --- a/src/Hakyll/Core/Compiler.hs +++ b/src/Hakyll/Core/Compiler.hs @@ -29,6 +29,7 @@ module Hakyll.Core.Compiler -------------------------------------------------------------------------------- import Control.Applicative ((<$>)) +import Control.Monad (when) import Data.Binary (Binary) import Data.ByteString.Lazy (ByteString) import Data.Typeable (Typeable) @@ -76,8 +77,9 @@ getRoute identifier = do routes <- compilerRoutes <$> compilerAsk -- Note that this makes us dependend on that identifier: when the metadata -- of that item changes, the route may change, hence we have to recompile - compilerTellDependencies [IdentifierDependency identifier] - compilerUnsafeIO $ runRoutes routes provider identifier + (mfp, um) <- compilerUnsafeIO $ runRoutes routes provider identifier + when um $ compilerTellDependencies [IdentifierDependency identifier] + return mfp -------------------------------------------------------------------------------- diff --git a/src/Hakyll/Core/Routes.hs b/src/Hakyll/Core/Routes.hs index fe5fb1f..34a613d 100644 --- a/src/Hakyll/Core/Routes.hs +++ b/src/Hakyll/Core/Routes.hs @@ -27,7 +27,8 @@ -- * If an item matches multiple routes, the first rule will be chosen. {-# LANGUAGE Rank2Types #-} module Hakyll.Core.Routes - ( Routes + ( UsedMetadata + , Routes , runRoutes , idRoute , setExtension @@ -54,23 +55,32 @@ import Hakyll.Core.Util.String -------------------------------------------------------------------------------- +-- | When you ran a route, it's useful to know whether or not this used +-- metadata. This allows us to do more granular dependency analysis. +type UsedMetadata = Bool + + +-------------------------------------------------------------------------------- -- | Type used for a route newtype Routes = Routes - { unRoutes :: Provider -> Identifier -> IO (Maybe FilePath) + { unRoutes :: Provider -> Identifier -> IO (Maybe FilePath, UsedMetadata) } -------------------------------------------------------------------------------- instance Monoid Routes where - mempty = Routes $ \_ _ -> return Nothing + mempty = Routes $ \_ _ -> return (Nothing, False) mappend (Routes f) (Routes g) = Routes $ \p id' -> do - mfp <- f p id' - maybe (g p id') (return . Just) mfp + (mfp, um) <- f p id' + case mfp of + Nothing -> g p id' + Just _ -> return (mfp, um) -------------------------------------------------------------------------------- -- | Apply a route to an identifier -runRoutes :: Routes -> Provider -> Identifier -> IO (Maybe FilePath) +runRoutes :: Routes -> Provider -> Identifier + -> IO (Maybe FilePath, UsedMetadata) runRoutes = unRoutes @@ -109,14 +119,14 @@ setExtension extension = customRoute $ -- otherwise matchRoute :: Pattern -> Routes -> Routes matchRoute pattern (Routes route) = Routes $ \p id' -> - if matches pattern id' then route p id' else return Nothing + if matches pattern id' then route p id' else return (Nothing, False) -------------------------------------------------------------------------------- -- | Create a custom route. This should almost always be used with -- 'matchRoute' customRoute :: (Identifier -> FilePath) -> Routes -customRoute f = Routes $ const $ return . Just . f +customRoute f = Routes $ const $ \id' -> return (Just (f id'), False) -------------------------------------------------------------------------------- @@ -169,5 +179,9 @@ composeRoutes :: Routes -- ^ First route to apply -> Routes -- ^ Second route to apply -> Routes -- ^ Resulting route composeRoutes (Routes f) (Routes g) = Routes $ \p i -> do - mfp <- f p i - maybe (return Nothing) (g p . fromFilePath) mfp + (mfp, um) <- f p i + case mfp of + Nothing -> return (Nothing, um) + Just fp -> do + (mfp', um') <- g p (fromFilePath fp) + return (mfp', um || um') diff --git a/src/Hakyll/Core/Runtime.hs b/src/Hakyll/Core/Runtime.hs index 0e1ceb2..824d11b 100644 --- a/src/Hakyll/Core/Runtime.hs +++ b/src/Hakyll/Core/Runtime.hs @@ -221,7 +221,7 @@ chase trail id' "(you probably want to call makeItem to solve this problem)" -- Write if necessary - mroute <- liftIO $ runRoutes routes provider id' + (mroute, _) <- liftIO $ runRoutes routes provider id' case mroute of Nothing -> return () Just route -> do diff --git a/src/Hakyll/Core/Store.hs b/src/Hakyll/Core/Store.hs index e3bcce3..1208c84 100644 --- a/src/Hakyll/Core/Store.hs +++ b/src/Hakyll/Core/Store.hs @@ -15,20 +15,22 @@ module Hakyll.Core.Store -------------------------------------------------------------------------------- -import Control.Applicative ((<$>)) -import Control.Exception (IOException, handle) -import qualified Crypto.Hash.MD5 as MD5 -import Data.Binary (Binary, decodeFile, encodeFile) -import qualified Data.ByteString as B -import qualified Data.Cache.LRU.IO as Lru -import Data.List (intercalate) -import qualified Data.Text as T -import qualified Data.Text.Encoding as T -import Data.Typeable (TypeRep, Typeable, cast, typeOf) -import System.Directory (createDirectoryIfMissing) -import System.Directory (doesFileExist, removeFile) -import System.FilePath ((</>)) -import Text.Printf (printf) +import Control.Applicative ((<$>)) +import Control.Exception (IOException, handle) +import qualified Crypto.Hash.MD5 as MD5 +import Data.Binary (Binary, decode, encodeFile) +import qualified Data.ByteString as B +import qualified Data.ByteString.Lazy as BL +import qualified Data.Cache.LRU.IO as Lru +import Data.List (intercalate) +import qualified Data.Text as T +import qualified Data.Text.Encoding as T +import Data.Typeable (TypeRep, Typeable, cast, typeOf) +import System.Directory (createDirectoryIfMissing) +import System.Directory (doesFileExist, removeFile) +import System.FilePath ((</>)) +import System.IO (IOMode (..), hClose, openFile) +import Text.Printf (printf) -------------------------------------------------------------------------------- @@ -132,7 +134,7 @@ get store identifier = do then return NotFound -- Found in the filesystem else do - v <- decodeFile path + v <- decodeClose cacheInsert store key v return $ Found v -- Found in the in-memory map (or wrong type), just return @@ -141,6 +143,13 @@ get store identifier = do key = hash identifier path = storeDirectory store </> key + -- 'decodeFile' from Data.Binary which closes the file ASAP + decodeClose = do + h <- openFile path ReadMode + lbs <- BL.hGetContents h + BL.length lbs `seq` hClose h + return $ decode lbs + -------------------------------------------------------------------------------- -- | Delete an item diff --git a/tests/Hakyll/Core/Routes/Tests.hs b/tests/Hakyll/Core/Routes/Tests.hs index c14a878..c681c99 100644 --- a/tests/Hakyll/Core/Routes/Tests.hs +++ b/tests/Hakyll/Core/Routes/Tests.hs @@ -39,5 +39,6 @@ tests = testGroup "Hakyll.Core.Routes.Tests" $ fromAssertions "runRoutes" -------------------------------------------------------------------------------- testRoutes :: FilePath -> Routes -> Identifier -> Assertion testRoutes expected r id' = do - route <- runRoutes r (error "Hakyll.Core.Routes.Tests: no provider") id' + (route, _) <- runRoutes r + (error "Hakyll.Core.Routes.Tests: no provider") id' Just expected @=? route diff --git a/tests/Hakyll/Core/Rules/Tests.hs b/tests/Hakyll/Core/Rules/Tests.hs index 6461b9d..12258f9 100644 --- a/tests/Hakyll/Core/Rules/Tests.hs +++ b/tests/Hakyll/Core/Rules/Tests.hs @@ -41,7 +41,7 @@ case01 = do let identifiers = S.fromList $ map fst $ rulesCompilers ruleSet routes = rulesRoutes ruleSet checkRoute ex i = - runRoutes routes provider i >>= \r -> Just ex @=? r + runRoutes routes provider i >>= \(r, _) -> Just ex @=? r -- Test that we have some identifiers and that the routes work out assert $ all (`S.member` identifiers) expected diff --git a/web/examples.markdown b/web/examples.markdown index 7bc1046..f113f30 100644 --- a/web/examples.markdown +++ b/web/examples.markdown @@ -39,6 +39,12 @@ this list. This list has no particular ordering. [source](https://github.com/AustinRochford/blog) - <http://www.regisfoucault.com/>, [source](https://github.com/regisfoucault/blog) +- <http://www.chaoxuprime.com/>, + [source](https://github.com/Mgccl/blog) +- <https://benjeffrey.com/>, + [source](https://github.com/jeffbr13/benjeffrey.com) +- <http://www.skybluetrades.net/>, + [source](https://github.com/ian-ross/blog) ## Hakyll 3.X @@ -56,8 +62,6 @@ this list. This list has no particular ordering. [source](https://github.com/robertseaton/rs.io/) - <http://www.gwern.net/>, source: `darcs get http://www.gwern.net` -- <http://www.skybluetrades.net/>, - [source](https://github.com/ian-ross/blog) - <http://blog.coldflake.com/>, [source](https://github.com/marcmo/blog.coldflake) - <http://deepak.jois.name>, |