summaryrefslogtreecommitdiff
path: root/src/Hakyll/Core/ResourceProvider
diff options
context:
space:
mode:
authorJasper Van der Jeugt <m@jaspervdj.be>2012-11-18 21:56:52 +0100
committerJasper Van der Jeugt <m@jaspervdj.be>2012-11-18 21:56:52 +0100
commit877cb21d1630d32c6e40eb7c6f0ecc7e1da2bd52 (patch)
tree57ce11325adbbb7502086450dd1d1a9f1e81b8f2 /src/Hakyll/Core/ResourceProvider
parent1347b0fa6cdd98986f927368e76e849068f69e1a (diff)
downloadhakyll-877cb21d1630d32c6e40eb7c6f0ecc7e1da2bd52.tar.gz
Add Item abstraction
Diffstat (limited to 'src/Hakyll/Core/ResourceProvider')
-rw-r--r--src/Hakyll/Core/ResourceProvider/Internal.hs86
-rw-r--r--src/Hakyll/Core/ResourceProvider/Metadata.hs125
-rw-r--r--src/Hakyll/Core/ResourceProvider/MetadataCache.hs62
-rw-r--r--src/Hakyll/Core/ResourceProvider/Modified.hs83
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