From 88ffd3c5bea6b5e5cb1004173130b5691a7591f6 Mon Sep 17 00:00:00 2001
From: Jasper Van der Jeugt <m@jaspervdj.be>
Date: Mon, 19 Nov 2012 14:59:55 +0100
Subject: Add tests again
---
src/Hakyll/Core/Compiler.hs | 4 +-
src/Hakyll/Core/Provider/Internal.hs | 38 ++++++++++--------
src/Hakyll/Core/Provider/Metadata.hs | 8 ++--
src/Hakyll/Core/Provider/MetadataCache.hs | 2 +-
src/Hakyll/Core/Provider/Modified.hs | 21 +++++-----
src/Hakyll/Core/Util/File.hs | 64 +++++++++++++++++--------------
src/Hakyll/Web/Template/Context.hs | 4 +-
7 files changed, 81 insertions(+), 60 deletions(-)
(limited to 'src')
diff --git a/src/Hakyll/Core/Compiler.hs b/src/Hakyll/Core/Compiler.hs
index ccd056f..7193e4f 100644
--- a/src/Hakyll/Core/Compiler.hs
+++ b/src/Hakyll/Core/Compiler.hs
@@ -81,13 +81,13 @@ getResourceBody = getResourceWith resourceBody
--------------------------------------------------------------------------------
-- | Get the resource we are compiling as a string
getResourceString :: Compiler (Item String)
-getResourceString = getResourceWith $ const resourceString
+getResourceString = getResourceWith resourceString
--------------------------------------------------------------------------------
-- | Get the resource we are compiling as a lazy bytestring
getResourceLBS :: Compiler (Item ByteString)
-getResourceLBS = getResourceWith $ const resourceLBS
+getResourceLBS = getResourceWith resourceLBS
--------------------------------------------------------------------------------
diff --git a/src/Hakyll/Core/Provider/Internal.hs b/src/Hakyll/Core/Provider/Internal.hs
index 54332a9..1360ef5 100644
--- a/src/Hakyll/Core/Provider/Internal.hs
+++ b/src/Hakyll/Core/Provider/Internal.hs
@@ -7,32 +7,35 @@ module Hakyll.Core.Provider.Internal
, resourceExists
, resourceMetadataResource
+ , resourceFilePath
, resourceString
, resourceLBS
) where
--------------------------------------------------------------------------------
-import Control.Applicative ((<$>))
-import qualified Data.ByteString.Lazy as BL
+import Control.Applicative ((<$>))
+import qualified Data.ByteString.Lazy as BL
import Data.IORef
-import Data.Map (Map)
-import qualified Data.Map as M
-import Data.Set (Set)
-import qualified Data.Set as S
-import System.FilePath (addExtension)
+import Data.Map (Map)
+import qualified Data.Map as M
+import Data.Set (Set)
+import qualified Data.Set as S
+import System.FilePath (addExtension, (</>))
--------------------------------------------------------------------------------
+import Hakyll.Core.Identifier
import Hakyll.Core.Store
import Hakyll.Core.Util.File
-import Hakyll.Core.Identifier
--------------------------------------------------------------------------------
-- | Responsible for retrieving and listing resources
data Provider = Provider
- { -- | A list of all files found
+ { -- Top of the provided directory
+ providerDirectory :: FilePath
+ , -- | A list of all files found
providerSet :: Set Identifier
, -- | Cache keeping track of modified files
providerModifiedCache :: IORef (Map Identifier Bool)
@@ -49,9 +52,9 @@ newProvider :: Store -- ^ Store to use
-> IO Provider -- ^ Resulting provider
newProvider store ignore directory = do
list <- map fromFilePath . filter (not . ignore) <$>
- getRecursiveContents False directory
+ getRecursiveContents directory
cache <- newIORef M.empty
- return $ Provider (S.fromList list) cache store
+ return $ Provider directory (S.fromList list) cache store
--------------------------------------------------------------------------------
@@ -74,13 +77,18 @@ resourceMetadataResource =
fromFilePath . flip addExtension "metadata" . toFilePath
+--------------------------------------------------------------------------------
+resourceFilePath :: Provider -> Identifier -> FilePath
+resourceFilePath p i = providerDirectory p </> toFilePath i
+
+
--------------------------------------------------------------------------------
-- | Get the raw body of a resource as string
-resourceString :: Identifier -> IO String
-resourceString = readFile . toFilePath
+resourceString :: Provider -> Identifier -> IO String
+resourceString p i = readFile $ resourceFilePath p i
--------------------------------------------------------------------------------
-- | Get the raw body of a resource of a lazy bytestring
-resourceLBS :: Identifier -> IO BL.ByteString
-resourceLBS = BL.readFile . toFilePath
+resourceLBS :: Provider -> Identifier -> IO BL.ByteString
+resourceLBS p i = BL.readFile $ resourceFilePath p i
diff --git a/src/Hakyll/Core/Provider/Metadata.hs b/src/Hakyll/Core/Provider/Metadata.hs
index 18536f4..52c07cb 100644
--- a/src/Hakyll/Core/Provider/Metadata.hs
+++ b/src/Hakyll/Core/Provider/Metadata.hs
@@ -25,19 +25,19 @@ import Hakyll.Core.Util.String
--------------------------------------------------------------------------------
loadMetadata :: Provider -> Identifier -> IO (Metadata, Maybe String)
-loadMetadata rp identifier = do
+loadMetadata p identifier = do
hasHeader <- probablyHasMetadataHeader fp
(md, body) <- if hasHeader
then second Just <$> loadMetadataHeader fp
else return (M.empty, Nothing)
- emd <- if resourceExists rp mi then loadMetadataFile mfp else return M.empty
+ emd <- if resourceExists p mi then loadMetadataFile mfp else return M.empty
return (M.union md emd, body)
where
- fp = toFilePath identifier
+ fp = resourceFilePath p identifier
mi = resourceMetadataResource identifier
- mfp = toFilePath mi
+ mfp = resourceFilePath p mi
--------------------------------------------------------------------------------
diff --git a/src/Hakyll/Core/Provider/MetadataCache.hs b/src/Hakyll/Core/Provider/MetadataCache.hs
index cd67370..03652e7 100644
--- a/src/Hakyll/Core/Provider/MetadataCache.hs
+++ b/src/Hakyll/Core/Provider/MetadataCache.hs
@@ -29,7 +29,7 @@ resourceBody p r = do
load p r
Store.Found bd <- Store.get (providerStore p)
[name, toFilePath r, "body"]
- maybe (resourceString r) return bd
+ maybe (resourceString p r) return bd
--------------------------------------------------------------------------------
diff --git a/src/Hakyll/Core/Provider/Modified.hs b/src/Hakyll/Core/Provider/Modified.hs
index 166019d..08bb66a 100644
--- a/src/Hakyll/Core/Provider/Modified.hs
+++ b/src/Hakyll/Core/Provider/Modified.hs
@@ -15,6 +15,7 @@ import Data.IORef
import qualified Data.Map as M
import Data.Time (UTCTime)
import System.Directory (getModificationTime)
+import System.FilePath ((</>))
--------------------------------------------------------------------------------
@@ -28,7 +29,7 @@ import qualified Hakyll.Core.Store as Store
--------------------------------------------------------------------------------
-- | A resource is modified if it or its metadata has changed
resourceModified :: Provider -> Identifier -> IO Bool
-resourceModified rp r
+resourceModified p r
| not exists = return False
| otherwise = do
cache <- readIORef cacheRef
@@ -38,19 +39,20 @@ resourceModified rp r
-- Check if the actual file was modified, and do a recursive
-- call to check if the metadata file was modified
m <- (||)
- <$> fileDigestModified store (toFilePath r)
- <*> resourceModified rp (resourceMetadataResource r)
+ <$> fileDigestModified store filePath
+ <*> resourceModified p (resourceMetadataResource r)
modifyIORef cacheRef (M.insert normalized m)
-- Important! (But ugly)
- when m $ resourceInvalidateMetadataCache rp r
+ when m $ resourceInvalidateMetadataCache p r
return m
where
normalized = setVersion Nothing r
- exists = resourceExists rp r
- store = providerStore rp
- cacheRef = providerModifiedCache rp
+ exists = resourceExists p r
+ store = providerStore p
+ cacheRef = providerModifiedCache p
+ filePath = resourceFilePath p r
--------------------------------------------------------------------------------
@@ -79,5 +81,6 @@ fileDigest = fmap MD5.hashlazy . BL.readFile
--------------------------------------------------------------------------------
-resourceModificationTime :: Identifier -> IO UTCTime
-resourceModificationTime = getModificationTime . toFilePath
+resourceModificationTime :: Provider -> Identifier -> IO UTCTime
+resourceModificationTime p i =
+ getModificationTime $ providerDirectory p </> toFilePath i
diff --git a/src/Hakyll/Core/Util/File.hs b/src/Hakyll/Core/Util/File.hs
index 5889664..85fbd76 100644
--- a/src/Hakyll/Core/Util/File.hs
+++ b/src/Hakyll/Core/Util/File.hs
@@ -1,52 +1,60 @@
+--------------------------------------------------------------------------------
-- | A module containing various file utility functions
---
module Hakyll.Core.Util.File
( makeDirectories
, getRecursiveContents
, isFileInternal
) where
-import Control.Applicative ((<$>))
-import Control.Monad (forM)
-import Data.List (isPrefixOf)
-import System.Directory ( createDirectoryIfMissing, doesDirectoryExist
- , getDirectoryContents
- )
-import System.FilePath ( normalise, takeDirectory, splitPath
- , dropTrailingPathSeparator, (</>)
- )
-import Hakyll.Core.Configuration
+--------------------------------------------------------------------------------
+import Control.Applicative ((<$>))
+import Control.Monad (forM)
+import Data.List (isPrefixOf)
+import System.Directory (createDirectoryIfMissing,
+ doesDirectoryExist,
+ getDirectoryContents)
+import System.FilePath (dropTrailingPathSeparator,
+ splitPath, takeDirectory, (</>))
+
+--------------------------------------------------------------------------------
+import Hakyll.Core.Configuration
+
+
+--------------------------------------------------------------------------------
-- | Given a path to a file, try to make the path writable by making
-- all directories on the path.
---
makeDirectories :: FilePath -> IO ()
makeDirectories = createDirectoryIfMissing True . takeDirectory
+
+--------------------------------------------------------------------------------
-- | Get all contents of a directory.
-getRecursiveContents :: Bool -- ^ Include directories?
- -> FilePath -- ^ Directory to search
+getRecursiveContents :: FilePath -- ^ Directory to search
-> IO [FilePath] -- ^ List of files found
-getRecursiveContents includeDirs topdir = do
- topdirExists <- doesDirectoryExist topdir
- if not topdirExists
- then return []
- else do
- names <- filter isProper <$> getDirectoryContents topdir
- paths <- forM names $ \name -> do
- let path = normalise $ topdir </> name
- isDirectory <- doesDirectoryExist path
- if isDirectory then getRecursiveContents includeDirs path
- else return [path]
- return $ if includeDirs then topdir : concat paths
- else concat paths
+getRecursiveContents top = go ""
where
isProper = (`notElem` [".", ".."])
+ go dir = do
+ dirExists <- doesDirectoryExist (top </> dir)
+ if not dirExists
+ then return []
+ else do
+ names <- filter isProper <$> getDirectoryContents (top </> dir)
+ paths <- forM names $ \name -> do
+ let rel = dir </> name
+ isDirectory <- doesDirectoryExist (top </> rel)
+ if isDirectory
+ then go rel
+ else return [rel]
+
+ return $ concat paths
+
+--------------------------------------------------------------------------------
-- | Check if a file is meant for Hakyll internal use, i.e. if it is located in
-- the destination or store directory
---
isFileInternal :: Configuration -- ^ Configuration
-> FilePath -- ^ File to check
-> Bool -- ^ If the given file is internal
diff --git a/src/Hakyll/Web/Template/Context.hs b/src/Hakyll/Web/Template/Context.hs
index fd9add9..eeec728 100644
--- a/src/Hakyll/Web/Template/Context.hs
+++ b/src/Hakyll/Web/Template/Context.hs
@@ -195,7 +195,9 @@ modificationTimeFieldWith :: TimeLocale -- ^ Time output locale
-> String -- ^ Format
-> Context a -- ^ Resulting context
modificationTimeFieldWith locale key fmt = field key $ \i -> do
- mtime <- compilerUnsafeIO $ resourceModificationTime $ itemIdentifier i
+ provider <- compilerProvider <$> compilerAsk
+ mtime <- compilerUnsafeIO $
+ resourceModificationTime provider $ itemIdentifier i
return $ formatTime locale fmt mtime
--
cgit v1.2.3