diff options
| author | Jasper Van der Jeugt <m@jaspervdj.be> | 2012-11-18 21:56:52 +0100 |
|---|---|---|
| committer | Jasper Van der Jeugt <m@jaspervdj.be> | 2012-11-18 21:56:52 +0100 |
| commit | 877cb21d1630d32c6e40eb7c6f0ecc7e1da2bd52 (patch) | |
| tree | 57ce11325adbbb7502086450dd1d1a9f1e81b8f2 /src/Hakyll/Core/ResourceProvider | |
| parent | 1347b0fa6cdd98986f927368e76e849068f69e1a (diff) | |
| download | hakyll-877cb21d1630d32c6e40eb7c6f0ecc7e1da2bd52.tar.gz | |
Add Item abstraction
Diffstat (limited to 'src/Hakyll/Core/ResourceProvider')
| -rw-r--r-- | src/Hakyll/Core/ResourceProvider/Internal.hs | 86 | ||||
| -rw-r--r-- | src/Hakyll/Core/ResourceProvider/Metadata.hs | 125 | ||||
| -rw-r--r-- | src/Hakyll/Core/ResourceProvider/MetadataCache.hs | 62 | ||||
| -rw-r--r-- | src/Hakyll/Core/ResourceProvider/Modified.hs | 83 |
4 files changed, 0 insertions, 356 deletions
diff --git a/src/Hakyll/Core/ResourceProvider/Internal.hs b/src/Hakyll/Core/ResourceProvider/Internal.hs deleted file mode 100644 index 628d1b5..0000000 --- a/src/Hakyll/Core/ResourceProvider/Internal.hs +++ /dev/null @@ -1,86 +0,0 @@ --------------------------------------------------------------------------------- -module Hakyll.Core.ResourceProvider.Internal - ( ResourceProvider (..) - , newResourceProvider - - , resourceList - , resourceExists - , resourceMetadataResource - - , resourceString - , resourceLBS - ) where - - --------------------------------------------------------------------------------- -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 Hakyll.Core.Store -import Hakyll.Core.Util.File -import Hakyll.Core.Identifier - - --------------------------------------------------------------------------------- --- | Responsible for retrieving and listing resources -data ResourceProvider = ResourceProvider - { -- | A list of all files found - resourceSet :: Set Identifier - , -- | Cache keeping track of modified files - resourceModifiedCache :: IORef (Map Identifier Bool) - , -- | Underlying persistent store for caching - resourceStore :: Store - } - - --------------------------------------------------------------------------------- --- | Create a resource provider -newResourceProvider :: Store -- ^ Store to use - -> (FilePath -> Bool) -- ^ Should we ignore this file? - -> FilePath -- ^ Search directory - -> IO ResourceProvider -- ^ Resulting provider -newResourceProvider store ignore directory = do - list <- map fromFilePath . filter (not . ignore) <$> - getRecursiveContents False directory - cache <- newIORef M.empty - return $ ResourceProvider (S.fromList list) cache store - - --------------------------------------------------------------------------------- -resourceList :: ResourceProvider -> [Identifier] -resourceList = S.toList . resourceSet - - --------------------------------------------------------------------------------- --- | Check if a given resource exists -resourceExists :: ResourceProvider -> Identifier -> Bool -resourceExists provider = - (`S.member` resourceSet provider) . setVersion Nothing - - --------------------------------------------------------------------------------- --- | Each resource may have an associated metadata resource (with a @.metadata@ --- filename) -resourceMetadataResource :: Identifier -> Identifier -resourceMetadataResource = - fromFilePath . flip addExtension "metadata" . toFilePath - - --------------------------------------------------------------------------------- --- | Get the raw body of a resource as string -resourceString :: Identifier -> IO String -resourceString = readFile . toFilePath - - --------------------------------------------------------------------------------- --- | Get the raw body of a resource of a lazy bytestring -resourceLBS :: Identifier -> IO BL.ByteString -resourceLBS = BL.readFile . toFilePath diff --git a/src/Hakyll/Core/ResourceProvider/Metadata.hs b/src/Hakyll/Core/ResourceProvider/Metadata.hs deleted file mode 100644 index 50af0c9..0000000 --- a/src/Hakyll/Core/ResourceProvider/Metadata.hs +++ /dev/null @@ -1,125 +0,0 @@ --------------------------------------------------------------------------------- --- | Internal module to parse metadata -module Hakyll.Core.ResourceProvider.Metadata - ( loadMetadata - ) where - - --------------------------------------------------------------------------------- -import Control.Applicative -import Control.Arrow (second) -import qualified Data.ByteString.Char8 as BC -import qualified Data.Map as M -import System.IO as IO -import Text.Parsec ((<?>)) -import qualified Text.Parsec as P -import Text.Parsec.String (Parser) - - --------------------------------------------------------------------------------- -import Hakyll.Core.Identifier -import Hakyll.Core.Metadata -import Hakyll.Core.ResourceProvider.Internal -import Hakyll.Core.Util.String - - --------------------------------------------------------------------------------- -loadMetadata :: ResourceProvider -> Identifier -> IO (Metadata, Maybe String) -loadMetadata rp 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 - - return (M.union md emd, body) - where - fp = toFilePath identifier - mi = resourceMetadataResource identifier - mfp = toFilePath mi - - --------------------------------------------------------------------------------- -loadMetadataHeader :: FilePath -> IO (Metadata, String) -loadMetadataHeader fp = do - contents <- readFile fp - case P.parse page fp contents of - Left err -> error (show err) - Right (md, b) -> return (M.fromList md, b) - - --------------------------------------------------------------------------------- -loadMetadataFile :: FilePath -> IO Metadata -loadMetadataFile fp = do - contents <- readFile fp - case P.parse metadata fp contents of - Left err -> error (show err) - Right md -> return $ M.fromList md - - --------------------------------------------------------------------------------- --- | Check if a file "probably" has a metadata header. The main goal of this is --- to exclude binary files (which are unlikely to start with "---"). -probablyHasMetadataHeader :: FilePath -> IO Bool -probablyHasMetadataHeader fp = do - handle <- IO.openFile fp IO.ReadMode - bs <- BC.hGet handle 1024 - IO.hClose handle - return $ isMetadataHeader bs - where - isMetadataHeader bs = - let pre = BC.takeWhile (\x -> x /= '\n' && x /= '\r') bs - in BC.length pre >= 3 && BC.all (== '-') pre - - --------------------------------------------------------------------------------- --- | Space or tab, no newline -inlineSpace :: Parser Char -inlineSpace = P.oneOf ['\t', ' '] <?> "space" - - --------------------------------------------------------------------------------- --- | Parse Windows newlines as well (i.e. "\n" or "\r\n") -newline :: Parser String -newline = P.string "\n" <|> P.string "\r\n" - - --------------------------------------------------------------------------------- --- | Parse a single metadata field -metadataField :: Parser (String, String) -metadataField = do - key <- P.manyTill P.alphaNum $ P.char ':' - P.skipMany1 inlineSpace <?> "space followed by metadata for: " ++ key - value <- P.manyTill P.anyChar newline - trailing' <- P.many trailing - return (key, trim $ value ++ concat trailing') - where - trailing = (++) <$> P.many1 inlineSpace <*> P.manyTill P.anyChar newline - - --------------------------------------------------------------------------------- --- | Parse a metadata block -metadata :: Parser [(String, String)] -metadata = P.many metadataField - - --------------------------------------------------------------------------------- --- | Parse a metadata block, including delimiters and trailing newlines -metadataBlock :: Parser [(String, String)] -metadataBlock = do - open <- P.many1 (P.char '-') <* P.many inlineSpace <* newline - metadata' <- metadata - _ <- P.choice $ map (P.string . replicate (length open)) ['-', '.'] - P.skipMany inlineSpace - P.skipMany1 newline - return metadata' - - --------------------------------------------------------------------------------- --- | Parse a page consisting of a metadata header and a body -page :: Parser ([(String, String)], String) -page = do - metadata' <- P.option [] metadataBlock - body <- P.many P.anyChar - return (metadata', body) diff --git a/src/Hakyll/Core/ResourceProvider/MetadataCache.hs b/src/Hakyll/Core/ResourceProvider/MetadataCache.hs deleted file mode 100644 index 959cdde..0000000 --- a/src/Hakyll/Core/ResourceProvider/MetadataCache.hs +++ /dev/null @@ -1,62 +0,0 @@ --------------------------------------------------------------------------------- -module Hakyll.Core.ResourceProvider.MetadataCache - ( resourceMetadata - , resourceBody - , resourceInvalidateMetadataCache - ) where - - --------------------------------------------------------------------------------- -import Hakyll.Core.Identifier -import Hakyll.Core.Metadata -import Hakyll.Core.ResourceProvider.Internal -import Hakyll.Core.ResourceProvider.Metadata -import qualified Hakyll.Core.Store as Store - - --------------------------------------------------------------------------------- -resourceMetadata :: ResourceProvider -> Identifier -> IO Metadata -resourceMetadata rp r = do - load rp r - Store.Found md <- Store.get (resourceStore rp) - [name, toFilePath r, "metadata"] - return md - - --------------------------------------------------------------------------------- -resourceBody :: ResourceProvider -> Identifier -> IO String -resourceBody rp r = do - load rp r - Store.Found bd <- Store.get (resourceStore rp) - [name, toFilePath r, "body"] - maybe (resourceString r) return bd - - --------------------------------------------------------------------------------- -resourceInvalidateMetadataCache :: ResourceProvider -> Identifier -> IO () -resourceInvalidateMetadataCache rp r = do - Store.delete (resourceStore rp) [name, toFilePath r, "metadata"] - Store.delete (resourceStore rp) [name, toFilePath r, "body"] - - --------------------------------------------------------------------------------- -load :: ResourceProvider -> Identifier -> IO () -load rp r = do - mmd <- Store.get store mdk :: IO (Store.Result Metadata) - case mmd of - -- Already loaded - Store.Found _ -> return () - -- Not yet loaded - _ -> do - (metadata, body) <- loadMetadata rp r - Store.set store mdk metadata - Store.set store bk body - where - store = resourceStore rp - mdk = [name, toFilePath r, "metadata"] - bk = [name, toFilePath r, "body"] - - --------------------------------------------------------------------------------- -name :: String -name = "Hakyll.Core.Resource.Provider.MetadataCache" diff --git a/src/Hakyll/Core/ResourceProvider/Modified.hs b/src/Hakyll/Core/ResourceProvider/Modified.hs deleted file mode 100644 index 761f13c..0000000 --- a/src/Hakyll/Core/ResourceProvider/Modified.hs +++ /dev/null @@ -1,83 +0,0 @@ --------------------------------------------------------------------------------- -module Hakyll.Core.ResourceProvider.Modified - ( resourceModified - , resourceModificationTime - ) where - - --------------------------------------------------------------------------------- -import Control.Applicative ((<$>), (<*>)) -import Control.Monad (when) -import qualified Crypto.Hash.MD5 as MD5 -import qualified Data.ByteString as B -import qualified Data.ByteString.Lazy as BL -import Data.IORef -import qualified Data.Map as M -import Data.Time (UTCTime) -import System.Directory (getModificationTime) - - --------------------------------------------------------------------------------- -import Hakyll.Core.Identifier -import Hakyll.Core.ResourceProvider.Internal -import Hakyll.Core.ResourceProvider.MetadataCache -import Hakyll.Core.Store (Store) -import qualified Hakyll.Core.Store as Store - - --------------------------------------------------------------------------------- --- | A resource is modified if it or its metadata has changed -resourceModified :: ResourceProvider -> Identifier -> IO Bool -resourceModified rp r - | not exists = return False - | otherwise = do - cache <- readIORef cacheRef - case M.lookup normalized cache of - Just m -> return m - Nothing -> do - -- 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) - modifyIORef cacheRef (M.insert normalized m) - - -- Important! (But ugly) - when m $ resourceInvalidateMetadataCache rp r - - return m - where - normalized = setVersion Nothing r - exists = resourceExists rp r - store = resourceStore rp - cacheRef = resourceModifiedCache rp - - --------------------------------------------------------------------------------- --- | Utility: Check if a the digest of a file was modified -fileDigestModified :: Store -> FilePath -> IO Bool -fileDigestModified store fp = do - -- Get the latest seen digest from the store, and calculate the current - -- digest for the - lastDigest <- Store.get store key - newDigest <- fileDigest fp - if Store.Found newDigest == lastDigest - -- All is fine, not modified - then return False - -- Resource modified; store new digest - else do - Store.set store key newDigest - return True - where - key = ["Hakyll.Core.Resource.Provider.fileModified", fp] - - --------------------------------------------------------------------------------- --- | Utility: Retrieve a digest for a given file -fileDigest :: FilePath -> IO B.ByteString -fileDigest = fmap MD5.hashlazy . BL.readFile - - --------------------------------------------------------------------------------- -resourceModificationTime :: Identifier -> IO UTCTime -resourceModificationTime = getModificationTime . toFilePath |
