summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--src/Hakyll/Core/Compiler.hs6
-rw-r--r--src/Hakyll/Core/Routes.hs34
-rw-r--r--src/Hakyll/Core/Runtime.hs2
-rw-r--r--src/Hakyll/Core/Store.hs39
-rw-r--r--tests/Hakyll/Core/Routes/Tests.hs3
-rw-r--r--tests/Hakyll/Core/Rules/Tests.hs2
-rw-r--r--web/examples.markdown8
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>,