diff options
Diffstat (limited to 'src/Hakyll')
| -rw-r--r-- | src/Hakyll/Core/Compiler.hs | 5 | ||||
| -rw-r--r-- | src/Hakyll/Core/Resource.hs | 40 | ||||
| -rw-r--r-- | src/Hakyll/Core/Resource/Metadata.hs | 118 | ||||
| -rw-r--r-- | src/Hakyll/Core/Resource/MetadataCache.hs | 61 | ||||
| -rw-r--r-- | src/Hakyll/Core/Resource/Modified.hs | 82 | ||||
| -rw-r--r-- | src/Hakyll/Core/Resource/Pattern.hs | 160 | ||||
| -rw-r--r-- | src/Hakyll/Core/Resource/Provider.hs | 138 | ||||
| -rw-r--r-- | src/Hakyll/Core/Resource/Provider/Dummy.hs | 25 | ||||
| -rw-r--r-- | src/Hakyll/Core/Resource/Provider/File.hs | 39 | ||||
| -rw-r--r-- | src/Hakyll/Core/Resource/Provider/Internal.hs | 84 | ||||
| -rw-r--r-- | src/Hakyll/Core/Run.hs | 10 | ||||
| -rw-r--r-- | src/Hakyll/Core/Util/File.hs | 4 |
12 files changed, 571 insertions, 195 deletions
diff --git a/src/Hakyll/Core/Compiler.hs b/src/Hakyll/Core/Compiler.hs index 3c62a3a..92fcff8 100644 --- a/src/Hakyll/Core/Compiler.hs +++ b/src/Hakyll/Core/Compiler.hs @@ -210,13 +210,12 @@ getResourceLBS = getResourceWith resourceLBS -- | Overloadable function for 'getResourceString' and 'getResourceLBS' -- -getResourceWith :: (ResourceProvider -> Resource -> IO a) - -> Compiler Resource a +getResourceWith :: (Resource -> IO a) -> Compiler Resource a getResourceWith reader = fromJob $ \r -> CompilerM $ do let filePath = unResource r provider <- compilerResourceProvider <$> ask if resourceExists provider r - then liftIO $ reader provider r + then liftIO $ reader r else throwError $ error' filePath where error' id' = "Hakyll.Core.Compiler.getResourceWith: resource " diff --git a/src/Hakyll/Core/Resource.hs b/src/Hakyll/Core/Resource.hs index 566bb26..0a43fc2 100644 --- a/src/Hakyll/Core/Resource.hs +++ b/src/Hakyll/Core/Resource.hs @@ -1,31 +1,51 @@ +-------------------------------------------------------------------------------- -- | Module exporting the simple 'Resource' type --- module Hakyll.Core.Resource - ( Resource - , unResource + ( -- * Constructing and deconstructing resources + Resource , resource + , unResource + + -- * Conversions to and from identifiers , fromIdentifier , toIdentifier + + -- * TODO: Move me + , Metadata ) where -import Hakyll.Core.Identifier +-------------------------------------------------------------------------------- +import Data.Map (Map) + + +-------------------------------------------------------------------------------- +import Hakyll.Core.Identifier + + +-------------------------------------------------------------------------------- -- | A resource --- newtype Resource = Resource {unResource :: FilePath} deriving (Eq, Show, Ord) + +-------------------------------------------------------------------------------- -- | Smart constructor to ensure we have @/@ as path separator --- resource :: FilePath -> Resource resource = fromIdentifier . parseIdentifier --- | Create a resource from an identifier --- + +-------------------------------------------------------------------------------- +-- | Find the resource for an identifier fromIdentifier :: Identifier a -> Resource fromIdentifier = Resource . toFilePath --- | Map the resource to an identifier. Note that the group will not be set! --- + +-------------------------------------------------------------------------------- +-- | Convert a resource to an identifier toIdentifier :: Resource -> Identifier a toIdentifier = parseIdentifier . unResource + + +-------------------------------------------------------------------------------- +type Metadata = Map String String diff --git a/src/Hakyll/Core/Resource/Metadata.hs b/src/Hakyll/Core/Resource/Metadata.hs new file mode 100644 index 0000000..44b0721 --- /dev/null +++ b/src/Hakyll/Core/Resource/Metadata.hs @@ -0,0 +1,118 @@ +-------------------------------------------------------------------------------- +-- | Internal module to parse metadata +module Hakyll.Core.Resource.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.Resource +import Hakyll.Core.Resource.Provider.Internal +import Hakyll.Core.Util.String + + +-------------------------------------------------------------------------------- +loadMetadata :: ResourceProvider -> Resource -> IO (Metadata, Maybe String) +loadMetadata rp r = do + hasHeader <- probablyHasMetadataHeader fp + (md, body) <- if hasHeader + then second Just <$> loadMetadataHeader fp + else return (M.empty, Nothing) + + emd <- if resourceExists rp mr then loadMetadataFile mfp else return M.empty + + return (M.union md emd, body) + where + fp = unResource r + mr = resourceMetadataResource r + mfp = unResource mr + + +-------------------------------------------------------------------------------- +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 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 P.newline + trailing' <- P.many trailing + return (key, trim $ value ++ concat trailing') + where + trailing = (++) <$> P.many1 inlineSpace <*> P.manyTill P.anyChar P.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 <* P.newline + metadata' <- metadata + _ <- P.choice $ map (P.string . replicate (length open)) ['-', '.'] + P.skipMany inlineSpace + P.skipMany1 P.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/Resource/MetadataCache.hs b/src/Hakyll/Core/Resource/MetadataCache.hs new file mode 100644 index 0000000..b459674 --- /dev/null +++ b/src/Hakyll/Core/Resource/MetadataCache.hs @@ -0,0 +1,61 @@ +-------------------------------------------------------------------------------- +module Hakyll.Core.Resource.MetadataCache + ( resourceMetadata + , resourceBody + , resourceInvalidateMetadataCache + ) where + + +-------------------------------------------------------------------------------- +import Hakyll.Core.Resource +import Hakyll.Core.Resource.Metadata +import Hakyll.Core.Resource.Provider.Internal +import qualified Hakyll.Core.Store as Store + + +-------------------------------------------------------------------------------- +resourceMetadata :: ResourceProvider -> Resource -> IO Metadata +resourceMetadata rp r = do + load rp r + Store.Found md <- Store.get (resourceStore rp) + [name, unResource r, "metadata"] + return md + + +-------------------------------------------------------------------------------- +resourceBody :: ResourceProvider -> Resource -> IO String +resourceBody rp r = do + load rp r + Store.Found bd <- Store.get (resourceStore rp) + [name, unResource r, "body"] + maybe (resourceString r) return bd + + +-------------------------------------------------------------------------------- +resourceInvalidateMetadataCache :: ResourceProvider -> Resource -> IO () +resourceInvalidateMetadataCache rp r = do + Store.delete (resourceStore rp) [name, unResource r, "metadata"] + Store.delete (resourceStore rp) [name, unResource r, "body"] + + +-------------------------------------------------------------------------------- +load :: ResourceProvider -> Resource -> 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, unResource r, "metadata"] + bk = [name, unResource r, "body"] + + +-------------------------------------------------------------------------------- +name :: String +name = "Hakyll.Core.Resource.Provider.MetadataCache" diff --git a/src/Hakyll/Core/Resource/Modified.hs b/src/Hakyll/Core/Resource/Modified.hs new file mode 100644 index 0000000..1dbaf76 --- /dev/null +++ b/src/Hakyll/Core/Resource/Modified.hs @@ -0,0 +1,82 @@ +-------------------------------------------------------------------------------- +module Hakyll.Core.Resource.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.Resource +import Hakyll.Core.Resource.MetadataCache +import Hakyll.Core.Resource.Provider.Internal +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 -> Resource -> IO Bool +resourceModified rp r + | not exists = return False + | otherwise = do + cache <- readIORef cacheRef + case M.lookup r 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 (unResource r) + <*> resourceModified rp (resourceMetadataResource r) + modifyIORef cacheRef (M.insert r m) + + -- Important! + when m $ resourceInvalidateMetadataCache rp r + + return m + where + 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 :: Resource -> IO UTCTime +resourceModificationTime = getModificationTime . unResource diff --git a/src/Hakyll/Core/Resource/Pattern.hs b/src/Hakyll/Core/Resource/Pattern.hs new file mode 100644 index 0000000..c2f1132 --- /dev/null +++ b/src/Hakyll/Core/Resource/Pattern.hs @@ -0,0 +1,160 @@ +-------------------------------------------------------------------------------- +-- | Module providing pattern matching and capturing on file names. +-- 'Pattern's come in two kinds: +-- +-- * Simple glob patterns, like @foo\/*@; +-- +-- * Custom, arbitrary predicates of the type @Identifier -> Bool@. +-- +-- They both have advantages and disadvantages. By default, globs are used, +-- unless you construct your 'Pattern' using the 'predicate' function. +-- +-- A very simple pattern could be, for example, @foo\/bar@. This pattern will +-- only match the exact @foo\/bar@ identifier. +-- +-- To match more than one identifier, there are different captures that one can +-- use: +-- +-- * @*@: matches at most one element of an identifier; +-- +-- * @**@: matches one or more elements of an identifier. +-- +-- Some examples: +-- +-- * @foo\/*@ will match @foo\/bar@ and @foo\/foo@, but not @foo\/bar\/qux@; +-- +-- * @**@ will match any identifier; +-- +-- * @foo\/**@ will match @foo\/bar@ and @foo\/bar\/qux@, but not @bar\/foo@; +-- +-- * @foo\/*.html@ will match all HTML files in the @foo\/@ directory. +-- +-- The 'capture' function allows the user to get access to the elements captured +-- by the capture elements in the pattern. +-- +-- Like an 'Identifier', a 'Pattern' also has a type parameter. This is simply +-- an extra layer of safety, and can be discarded using the 'castPattern' +-- function. +module Hakyll.Core.Resource.Pattern + ( Pattern + , parsePattern + , capture + ) where + + +-------------------------------------------------------------------------------- +import Control.Arrow ((&&&), (>>>)) +import Control.Monad (msum) +import Data.List (inits, isPrefixOf, tails) +import GHC.Exts (IsString, fromString) + + +-------------------------------------------------------------------------------- +import Hakyll.Core.Resource + + +-------------------------------------------------------------------------------- +-- | One base element of a pattern +data GlobComponent + = Capture + | CaptureMany + | Literal String + deriving (Eq, Show) + + +-------------------------------------------------------------------------------- +-- | Type that allows matching on identifiers +newtype Pattern = Pattern [GlobComponent] + deriving (Show) + + +-------------------------------------------------------------------------------- +instance IsString Pattern where + fromString = parsePattern + + +-------------------------------------------------------------------------------- +-- | Parse a pattern from a string +parsePattern :: String -> Pattern +parsePattern = Pattern . parse + where + parse str = + let (chunk, rest) = break (`elem` "\\*") str + in case rest of + ('\\' : x : xs) -> Literal (chunk ++ [x]) : parse xs + ('*' : '*' : xs) -> Literal chunk : CaptureMany : parse xs + ('*' : xs) -> Literal chunk : Capture : parse xs + xs -> Literal chunk : Literal xs : [] + + +-------------------------------------------------------------------------------- +-- | Split a list at every possible point, generate a list of (init, tail) +-- cases. The result is sorted with inits decreasing in length. +splits :: [a] -> [([a], [a])] +splits = inits &&& tails >>> uncurry zip >>> reverse + + +-------------------------------------------------------------------------------- +-- | Match a glob against a pattern, generating a list of captures +capture :: Pattern -> Resource -> Maybe [String] +capture (Pattern p) rs = capture' p (unResource rs) + + +-------------------------------------------------------------------------------- +-- | Internal verion of 'capture' +capture' :: [GlobComponent] -> String -> Maybe [String] +capture' [] [] = Just [] -- An empty match +capture' [] _ = Nothing -- No match +capture' (Literal l : ms) str + -- Match the literal against the string + | l `isPrefixOf` str = capture' ms $ drop (length l) str + | otherwise = Nothing +capture' (Capture : ms) str = + -- Match until the next / + let (chunk, rest) = break (== '/') str + in msum $ [ fmap (i :) (capture' ms (t ++ rest)) | (i, t) <- splits chunk ] +capture' (CaptureMany : ms) str = + -- Match everything + msum $ [ fmap (i :) (capture' ms t) | (i, t) <- splits str ] + + +-------------------------------------------------------------------------------- +-- | Create an identifier from a pattern by filling in the captures with a given +-- string +-- +-- Example: +-- +-- > fromCapture (parsePattern "tags/*") "foo" +-- +-- Result: +-- +-- > "tags/foo" +{- +fromCapture :: Pattern -> String -> Identifier +fromCapture pattern = fromCaptures pattern . repeat +-} + + +-------------------------------------------------------------------------------- +-- | Create an identifier from a pattern by filling in the captures with the +-- given list of strings +-- +{- +fromCaptures :: Pattern -> [String] -> String +fromCaptures (Pattern p) = fromCaptures' p +-} + + +-------------------------------------------------------------------------------- +-- | Internally used version of 'fromCaptures' +{- +fromCaptures' :: [GlobComponent] -> [String] -> String +fromCaptures' [] _ = mempty +fromCaptures' (m : ms) [] = case m of + Literal l -> l `mappend` fromCaptures' ms [] + _ -> error $ "Hakyll.Core.Identifier.Pattern.fromCaptures': " + ++ "identifier list exhausted" +fromCaptures' (m : ms) ids@(i : is) = case m of + Literal l -> l `mappend` fromCaptures' ms ids + _ -> i `mappend` fromCaptures' ms is +-} diff --git a/src/Hakyll/Core/Resource/Provider.hs b/src/Hakyll/Core/Resource/Provider.hs index 2ed7797..8f4c83f 100644 --- a/src/Hakyll/Core/Resource/Provider.hs +++ b/src/Hakyll/Core/Resource/Provider.hs @@ -1,125 +1,45 @@ -------------------------------------------------------------------------------- --- | This module provides an API for resource providers. Resource providers --- allow Hakyll to get content from resources; the type of resource depends on --- the concrete instance. --- --- A resource is represented by the 'Resource' type. This is basically just a --- newtype wrapper around 'Identifier' -- but it has an important effect: it --- guarantees that a resource with this identifier can be provided by one or --- more resource providers. --- --- Therefore, it is not recommended to read files directly -- you should use the --- provided 'Resource' methods. --- +-- | This module provides an wrapper API around the file system which does some +-- caching. module Hakyll.Core.Resource.Provider - ( ResourceProvider (..) + ( -- * Constructing resource providers + ResourceProvider + , newResourceProvider + + -- * Querying resource properties , resourceList - , makeResourceProvider , resourceExists - , resourceDigest , resourceModified - ) where - - --------------------------------------------------------------------------------- -import Control.Applicative ((<$>)) -import Control.Concurrent (MVar, readMVar, modifyMVar_, newMVar) -import Data.Map (Map) -import qualified Data.Map as M -import qualified Data.Set as S - - --------------------------------------------------------------------------------- -import Data.Time (UTCTime) -import qualified Crypto.Hash.MD5 as MD5 -import qualified Data.ByteString as B -import qualified Data.ByteString.Lazy as LB - - --------------------------------------------------------------------------------- -import Hakyll.Core.Store (Store) -import Hakyll.Core.Resource -import qualified Hakyll.Core.Store as Store + , resourceModificationTime + -- * Access to raw resource content + , resourceString + , resourceLBS --------------------------------------------------------------------------------- --- | A value responsible for retrieving and listing resources -data ResourceProvider = ResourceProvider - { -- | A set of all resources this provider is able to provide - resourceSet :: S.Set Resource - , -- | Retrieve a certain resource as string - resourceString :: Resource -> IO String - , -- | Retrieve a certain resource as lazy bytestring - resourceLBS :: Resource -> IO LB.ByteString - , -- | Check when a resource was last modified - resourceModificationTime :: Resource -> IO UTCTime - , -- | Cache keeping track of modified items - resourceModifiedCache :: MVar (Map Resource Bool) - } - - --------------------------------------------------------------------------------- --- | Create a resource provider -makeResourceProvider :: [Resource] -- ^ Resource list - -> (Resource -> IO String) -- ^ String reader - -> (Resource -> IO LB.ByteString) -- ^ ByteString reader - -> (Resource -> IO UTCTime) -- ^ Time checker - -> IO ResourceProvider -- ^ Resulting provider -makeResourceProvider l s b t = - ResourceProvider (S.fromList l) s b t <$> newMVar M.empty - - --------------------------------------------------------------------------------- --- | Get the list of all resources -resourceList :: ResourceProvider -> [Resource] -resourceList = S.toList . resourceSet - - --------------------------------------------------------------------------------- --- | Check if a given identifier has a resource -resourceExists :: ResourceProvider -> Resource -> Bool -resourceExists provider = flip S.member $ resourceSet provider + -- * Access to metadata and body content + , resourceMetadata + , resourceBody + ) where -------------------------------------------------------------------------------- --- | Retrieve a digest for a given resource -resourceDigest :: ResourceProvider -> Resource -> IO B.ByteString -resourceDigest provider = fmap MD5.hashlazy . resourceLBS provider +import Hakyll.Core.Resource +import qualified Hakyll.Core.Resource.MetadataCache as Internal +import Hakyll.Core.Resource.Modified +import Hakyll.Core.Resource.Provider.Internal -------------------------------------------------------------------------------- --- | Check if a resource was modified -resourceModified :: ResourceProvider -> Store -> Resource -> IO Bool -resourceModified provider store r = do - cache <- readMVar mvar - case M.lookup r cache of - -- Already in the cache - Just m -> return m - -- Not yet in the cache, check digests (if it exists) - Nothing -> do - m <- if resourceExists provider r - then digestModified provider store r - else return False - modifyMVar_ mvar (return . M.insert r m) - return m - where - mvar = resourceModifiedCache provider +-- | Wrapper to ensure metadata cache is invalidated if necessary +resourceMetadata :: ResourceProvider -> Resource -> IO Metadata +resourceMetadata rp r = do + _ <- resourceModified rp r + Internal.resourceMetadata rp r -------------------------------------------------------------------------------- --- | Check if a resource digest was modified -digestModified :: ResourceProvider -> Store -> Resource -> IO Bool -digestModified provider store r = do - -- Get the latest seen digest from the store - lastDigest <- Store.get store key - -- Calculate the digest for the resource - newDigest <- resourceDigest provider r - -- Check digests - 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.ResourceProvider.digestModified", unResource r] +-- | Wrapper to ensure metadata cache is invalidated if necessary +resourceBody :: ResourceProvider -> Resource -> IO String +resourceBody rp r = do + _ <- resourceModified rp r + Internal.resourceBody rp r diff --git a/src/Hakyll/Core/Resource/Provider/Dummy.hs b/src/Hakyll/Core/Resource/Provider/Dummy.hs deleted file mode 100644 index 548f845..0000000 --- a/src/Hakyll/Core/Resource/Provider/Dummy.hs +++ /dev/null @@ -1,25 +0,0 @@ --- | Dummy resource provider for testing purposes --- -module Hakyll.Core.Resource.Provider.Dummy - ( dummyResourceProvider - ) where - -import Data.Map (Map) -import qualified Data.Map as M - -import Data.Time (getCurrentTime) -import Data.ByteString.Lazy (ByteString) -import qualified Data.Text.Lazy as TL -import qualified Data.Text.Lazy.Encoding as TL - -import Hakyll.Core.Resource -import Hakyll.Core.Resource.Provider - --- | Create a dummy 'ResourceProvider' --- -dummyResourceProvider :: Map String ByteString -> IO ResourceProvider -dummyResourceProvider vfs = makeResourceProvider - (map resource (M.keys vfs)) - (return . TL.unpack . TL.decodeUtf8 . (vfs M.!) . unResource) - (return . (vfs M.!) . unResource) - (const getCurrentTime) diff --git a/src/Hakyll/Core/Resource/Provider/File.hs b/src/Hakyll/Core/Resource/Provider/File.hs deleted file mode 100644 index 3a67817..0000000 --- a/src/Hakyll/Core/Resource/Provider/File.hs +++ /dev/null @@ -1,39 +0,0 @@ --- | A concrete 'ResourceProvider' that gets it's resources from the filesystem --- -{-# LANGUAGE CPP #-} -module Hakyll.Core.Resource.Provider.File - ( fileResourceProvider - ) where - -import Control.Applicative ((<$>)) - -import Data.Time (readTime) -import System.Directory (getModificationTime) -import System.Locale (defaultTimeLocale) -import System.Time (formatCalendarTime, toCalendarTime) -import qualified Data.ByteString.Lazy as LB - -import Hakyll.Core.Resource -import Hakyll.Core.Resource.Provider -import Hakyll.Core.Util.File -import Hakyll.Core.Configuration - --- | Create a filesystem-based 'ResourceProvider' --- -fileResourceProvider :: HakyllConfiguration -> IO ResourceProvider -fileResourceProvider configuration = do - -- Retrieve a list of paths - list <- map resource . filter (not . shouldIgnoreFile configuration) <$> - getRecursiveContents False "." - makeResourceProvider list (readFile . unResource) - (LB.readFile . unResource) - (mtime . unResource) - where - mtime r = do -#if MIN_VERSION_directory(1,2,0) - getModificationTime r -#else - ct <- toCalendarTime =<< getModificationTime r - let str = formatCalendarTime defaultTimeLocale "%s" ct - return $ readTime defaultTimeLocale "%s" str -#endif diff --git a/src/Hakyll/Core/Resource/Provider/Internal.hs b/src/Hakyll/Core/Resource/Provider/Internal.hs new file mode 100644 index 0000000..fb93fcc --- /dev/null +++ b/src/Hakyll/Core/Resource/Provider/Internal.hs @@ -0,0 +1,84 @@ +-------------------------------------------------------------------------------- +module Hakyll.Core.Resource.Provider.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.Resource +import Hakyll.Core.Store +import Hakyll.Core.Util.File + + +-------------------------------------------------------------------------------- +-- | Responsible for retrieving and listing resources +data ResourceProvider = ResourceProvider + { -- | A list of all files found + resourceSet :: Set Resource + , -- | Cache keeping track of modified files + resourceModifiedCache :: IORef (Map Resource 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 resource . filter (not . ignore) <$> + getRecursiveContents False directory + cache <- newIORef M.empty + return $ ResourceProvider (S.fromList list) cache store + + +-------------------------------------------------------------------------------- +resourceList :: ResourceProvider -> [Resource] +resourceList = S.toList . resourceSet + + +-------------------------------------------------------------------------------- +-- | Check if a given resiyrce exists +resourceExists :: ResourceProvider -> Resource -> Bool +resourceExists provider = (`S.member` resourceSet provider) + + +-------------------------------------------------------------------------------- +-- | Each resource may have an associated metadata resource (with a @.metadata@ +-- filename) +resourceMetadataResource :: Resource -> Resource +resourceMetadataResource = resource . flip addExtension "metadata" . unResource + + +-------------------------------------------------------------------------------- +-- | Get the raw body of a resource as string +resourceString :: Resource -> IO String +resourceString = readFile . unResource + + +-------------------------------------------------------------------------------- +-- | Get the raw body of a resource of a lazy bytestring +resourceLBS :: Resource -> IO BL.ByteString +resourceLBS = BL.readFile . unResource diff --git a/src/Hakyll/Core/Run.hs b/src/Hakyll/Core/Run.hs index 0bc3625..a777d0a 100644 --- a/src/Hakyll/Core/Run.hs +++ b/src/Hakyll/Core/Run.hs @@ -27,7 +27,6 @@ import Hakyll.Core.Identifier import Hakyll.Core.Logger import Hakyll.Core.Resource import Hakyll.Core.Resource.Provider -import Hakyll.Core.Resource.Provider.File import Hakyll.Core.Routes import Hakyll.Core.Rules.Internal import Hakyll.Core.Store (Store) @@ -44,8 +43,8 @@ run configuration rules = do section logger "Initialising" store <- timed logger "Creating store" $ Store.new (inMemoryCache configuration) $ storeDirectory configuration - provider <- timed logger "Creating provider" $ - fileResourceProvider configuration + provider <- timed logger "Creating provider" $ newResourceProvider + store (ignoreFile configuration) "." -- Fetch the old graph from the store. If we don't find it, we consider this -- to be the first run @@ -114,7 +113,6 @@ addNewCompilers newCompilers = Runtime $ do logger <- hakyllLogger <$> ask section logger "Adding new compilers" provider <- hakyllResourceProvider <$> ask - store <- hakyllStore <$> ask firstRun <- hakyllFirstRun <$> ask -- Old state information @@ -134,7 +132,7 @@ addNewCompilers newCompilers = Runtime $ do -- Check which items have been modified modified <- fmap S.fromList $ flip filterM (map fst newCompilers) $ - liftIO . resourceModified provider store . fromIdentifier + liftIO . resourceModified provider . fromIdentifier let checkModified = if firstRun then const True else (`S.member` modified) -- Create a new analyzer and append it to the currect one @@ -185,7 +183,7 @@ build id' = Runtime $ do let compiler = compilers M.! id' -- Check if the resource was modified - isModified <- liftIO $ resourceModified provider store $ fromIdentifier id' + isModified <- liftIO $ resourceModified provider $ fromIdentifier id' -- Run the compiler result <- timed logger "Total compile time" $ liftIO $ diff --git a/src/Hakyll/Core/Util/File.hs b/src/Hakyll/Core/Util/File.hs index 06a4f78..160ee6f 100644 --- a/src/Hakyll/Core/Util/File.hs +++ b/src/Hakyll/Core/Util/File.hs @@ -24,9 +24,7 @@ import Hakyll.Core.Configuration makeDirectories :: FilePath -> IO () makeDirectories = createDirectoryIfMissing True . takeDirectory --- | Get all contents of a directory. Note that files starting with a dot (.) --- will be ignored. --- +-- | Get all contents of a directory. getRecursiveContents :: Bool -- ^ Include directories? -> FilePath -- ^ Directory to search -> IO [FilePath] -- ^ List of files found |