diff options
Diffstat (limited to 'src/Hakyll/Core/Provider')
| -rw-r--r-- | src/Hakyll/Core/Provider/Internal.hs | 155 | ||||
| -rw-r--r-- | src/Hakyll/Core/Provider/Metadata.hs | 7 | ||||
| -rw-r--r-- | src/Hakyll/Core/Provider/MetadataCache.hs | 1 | ||||
| -rw-r--r-- | src/Hakyll/Core/Provider/Modified.hs | 115 |
4 files changed, 137 insertions, 141 deletions
diff --git a/src/Hakyll/Core/Provider/Internal.hs b/src/Hakyll/Core/Provider/Internal.hs index 301c25c..64b19c8 100644 --- a/src/Hakyll/Core/Provider/Internal.hs +++ b/src/Hakyll/Core/Provider/Internal.hs @@ -1,46 +1,103 @@ -------------------------------------------------------------------------------- +{-# LANGUAGE CPP #-} +{-# LANGUAGE DeriveDataTypeable #-} +{-# LANGUAGE GeneralizedNewtypeDeriving #-} module Hakyll.Core.Provider.Internal - ( Provider (..) + ( ResourceInfo (..) + , Provider (..) , newProvider , resourceList , resourceExists - , resourceMetadataResource , resourceFilePath , resourceString , resourceLBS + + , resourceModified + , resourceModificationTime ) where -------------------------------------------------------------------------------- -import Control.Applicative ((<$>)) +import Control.Applicative ((<$>), (<*>)) +import Control.DeepSeq (NFData (..), deepseq) +import Control.Monad (forM) +import Data.Binary (Binary (..)) import qualified Data.ByteString.Lazy as BL -import Data.IORef import Data.Map (Map) import qualified Data.Map as M +import Data.Maybe (fromMaybe) +import Data.Monoid (mempty) import Data.Set (Set) import qualified Data.Set as S +import Data.Time (Day (..), UTCTime (..), + secondsToDiffTime) +import Data.Typeable (Typeable) +import System.Directory (getModificationTime) import System.FilePath (addExtension, (</>)) -------------------------------------------------------------------------------- +#if !MIN_VERSION_directory(1,2,0) +import Data.Time (readTime) +import System.Locale (defaultTimeLocale) +import System.Time (formatCalendarTime, toCalendarTime) +#endif + + +-------------------------------------------------------------------------------- import Hakyll.Core.Identifier -import Hakyll.Core.Store +import Hakyll.Core.Store (Store) +import qualified Hakyll.Core.Store as Store import Hakyll.Core.Util.File -------------------------------------------------------------------------------- +-- | Because UTCTime doesn't have a Binary instance... +newtype BinaryTime = BinaryTime {unBinaryTime :: UTCTime} + deriving (Eq, NFData, Ord, Show, Typeable) + + +-------------------------------------------------------------------------------- +instance Binary BinaryTime where + put (BinaryTime (UTCTime (ModifiedJulianDay d) dt)) = + put d >> put (floor dt :: Integer) + + get = fmap BinaryTime $ UTCTime + <$> (ModifiedJulianDay <$> get) + <*> (secondsToDiffTime <$> get) + + +-------------------------------------------------------------------------------- +data ResourceInfo = ResourceInfo + { resourceInfoModified :: BinaryTime + , resourceInfoMetadata :: Maybe Identifier + } deriving (Show, Typeable) + + +-------------------------------------------------------------------------------- +instance Binary ResourceInfo where + put (ResourceInfo mtime meta) = put mtime >> put meta + get = ResourceInfo <$> get <*> get + + +-------------------------------------------------------------------------------- +instance NFData ResourceInfo where + rnf (ResourceInfo mtime meta) = rnf mtime `seq` rnf meta `seq` () + + +-------------------------------------------------------------------------------- -- | Responsible for retrieving and listing resources data Provider = Provider { -- Top of the provided directory - providerDirectory :: FilePath + providerDirectory :: FilePath , -- | A list of all files found - providerSet :: Set Identifier - , -- | Cache keeping track of modified files - providerModifiedCache :: IORef (Map Identifier Bool) + providerFiles :: Map Identifier ResourceInfo + , -- | A list of the files from the previous run + providerOldFiles :: Map Identifier ResourceInfo , -- | Underlying persistent store for caching - providerStore :: Store + providerStore :: Store } @@ -51,29 +108,47 @@ newProvider :: Store -- ^ Store to use -> FilePath -- ^ Search directory -> IO Provider -- ^ Resulting provider newProvider store ignore directory = do - list <- map fromFilePath <$> getRecursiveContents ignore directory - cache <- newIORef M.empty - return $ Provider directory (S.fromList list) cache store + list <- map fromFilePath <$> getRecursiveContents ignore directory + let universe = S.fromList list + files <- fmap (maxmtime . M.fromList) $ forM list $ \identifier -> do + rInfo <- getResourceInfo directory universe identifier + return (identifier, rInfo) + + -- Get the old files from the store, and then immediately replace them by + -- the new files. + oldFiles <- fromMaybe mempty . Store.toMaybe <$> Store.get store oldKey + oldFiles `deepseq` Store.set store oldKey files + + return $ Provider directory files oldFiles store + where + oldKey = ["Hakyll.Core.Provider.Internal.newProvider", "oldFiles"] + + -- Update modified if metadata is modified + maxmtime files = flip M.map files $ \rInfo@(ResourceInfo mtime meta) -> + let metaMod = fmap resourceInfoModified $ meta >>= flip M.lookup files + in rInfo {resourceInfoModified = maybe mtime (max mtime) metaMod} + + +-------------------------------------------------------------------------------- +getResourceInfo :: FilePath -> Set Identifier -> Identifier -> IO ResourceInfo +getResourceInfo directory universe identifier = do + mtime <- fileModificationTime $ directory </> toFilePath identifier + return $ ResourceInfo (BinaryTime mtime) $ + if mdRsc `S.member` universe then Just mdRsc else Nothing + where + mdRsc = fromFilePath $ flip addExtension "metadata" $ toFilePath identifier -------------------------------------------------------------------------------- resourceList :: Provider -> [Identifier] -resourceList = S.toList . providerSet +resourceList = M.keys . providerFiles -------------------------------------------------------------------------------- -- | Check if a given resource exists resourceExists :: Provider -> Identifier -> Bool resourceExists provider = - (`S.member` providerSet provider) . setVersion Nothing - - --------------------------------------------------------------------------------- --- | Each resource may have an associated metadata resource (with a @.metadata@ --- filename) -resourceMetadataResource :: Identifier -> Identifier -resourceMetadataResource = - fromFilePath . flip addExtension "metadata" . toFilePath + (`M.member` providerFiles provider) . setVersion Nothing -------------------------------------------------------------------------------- @@ -91,3 +166,37 @@ resourceString p i = readFile $ resourceFilePath p i -- | Get the raw body of a resource of a lazy bytestring resourceLBS :: Provider -> Identifier -> IO BL.ByteString resourceLBS p i = BL.readFile $ resourceFilePath p i + + +-------------------------------------------------------------------------------- +-- | A resource is modified if it or its metadata has changed +resourceModified :: Provider -> Identifier -> Bool +resourceModified p r = case (ri, oldRi) of + (Nothing, _) -> True + (Just _, Nothing) -> True + (Just n, Just o) -> resourceInfoModified n > resourceInfoModified o + where + ri = M.lookup (setVersion Nothing r) (providerFiles p) + oldRi = ri >>= resourceInfoMetadata >>= flip M.lookup (providerFiles p) + + +-------------------------------------------------------------------------------- +resourceModificationTime :: Provider -> Identifier -> UTCTime +resourceModificationTime p i = + case M.lookup (setVersion Nothing i) (providerFiles p) of + Just ri -> unBinaryTime $ resourceInfoModified ri + Nothing -> error $ + "Hakyll.Core.Provider.Internal.resourceModificationTime: " ++ + "resource " ++ show i ++ " does not exist" + + +-------------------------------------------------------------------------------- +fileModificationTime :: FilePath -> IO UTCTime +fileModificationTime fp = do +#if MIN_VERSION_directory(1,2,0) + getModificationTime fp +#else + ct <- toCalendarTime =<< getModificationTime fp + let str = formatCalendarTime defaultTimeLocale "%s" ct + return $ readTime defaultTimeLocale "%s" str +#endif diff --git a/src/Hakyll/Core/Provider/Metadata.hs b/src/Hakyll/Core/Provider/Metadata.hs index 52c07cb..276483b 100644 --- a/src/Hakyll/Core/Provider/Metadata.hs +++ b/src/Hakyll/Core/Provider/Metadata.hs @@ -31,13 +31,14 @@ loadMetadata p identifier = do then second Just <$> loadMetadataHeader fp else return (M.empty, Nothing) - emd <- if resourceExists p mi then loadMetadataFile mfp else return M.empty + emd <- case mi of + Nothing -> return M.empty + Just mi' -> loadMetadataFile $ resourceFilePath p mi' return (M.union md emd, body) where fp = resourceFilePath p identifier - mi = resourceMetadataResource identifier - mfp = resourceFilePath p mi + mi = M.lookup identifier (providerFiles p) >>= resourceInfoMetadata -------------------------------------------------------------------------------- diff --git a/src/Hakyll/Core/Provider/MetadataCache.hs b/src/Hakyll/Core/Provider/MetadataCache.hs index b813303..2c97baa 100644 --- a/src/Hakyll/Core/Provider/MetadataCache.hs +++ b/src/Hakyll/Core/Provider/MetadataCache.hs @@ -23,6 +23,7 @@ resourceMetadata :: Provider -> Identifier -> IO Metadata resourceMetadata p r | not (resourceExists p r) = return M.empty | otherwise = do + -- TODO keep time in md cache load p r Store.Found md <- Store.get (providerStore p) [name, toFilePath r, "metadata"] diff --git a/src/Hakyll/Core/Provider/Modified.hs b/src/Hakyll/Core/Provider/Modified.hs deleted file mode 100644 index 4c3bdc5..0000000 --- a/src/Hakyll/Core/Provider/Modified.hs +++ /dev/null @@ -1,115 +0,0 @@ --------------------------------------------------------------------------------- -{-# LANGUAGE CPP #-} -{-# LANGUAGE DeriveDataTypeable #-} -module Hakyll.Core.Provider.Modified - ( resourceModified - , resourceModificationTime - ) where - - --------------------------------------------------------------------------------- -import Control.Applicative ((<$>), (<*>)) -import Control.Monad (when) -import Data.Binary (Binary (..)) -import Data.IORef -import qualified Data.Map as M -import Data.Time (Day (..), UTCTime (..), - secondsToDiffTime) -import Data.Typeable (Typeable) -import System.Directory (getModificationTime) - - --------------------------------------------------------------------------------- -#if !MIN_VERSION_directory(1,2,0) -import Data.Time (readTime) -import System.Locale (defaultTimeLocale) -import System.Time (formatCalendarTime, - toCalendarTime) -#endif - - --------------------------------------------------------------------------------- -import Hakyll.Core.Identifier -import Hakyll.Core.Provider.Internal -import Hakyll.Core.Provider.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 :: Provider -> Identifier -> IO Bool -resourceModified p 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 <- (||) - <$> fileModified store filePath - <*> resourceModified p (resourceMetadataResource r) - modifyIORef cacheRef (M.insert normalized m) - - -- Important! (But ugly) - when m $ resourceInvalidateMetadataCache p r - - return m - where - normalized = setVersion Nothing r - exists = resourceExists p r - store = providerStore p - cacheRef = providerModifiedCache p - filePath = resourceFilePath p r - - --------------------------------------------------------------------------------- --- | Utility: Check if a file was modified recently -fileModified :: Store -> FilePath -> IO Bool -fileModified store fp = do - lastModified <- Store.get store key - newModified <- BinaryTime <$> fileModificationTime fp - if maybe False (>= newModified) (Store.toMaybe lastModified) - -- All is fine, not modified - then return False - -- Resource modified; store new digest - else do - Store.set store key newModified - return True - where - key = ["Hakyll.Core.Resource.Provider.fileModified", fp] - - --------------------------------------------------------------------------------- -resourceModificationTime :: Provider -> Identifier -> IO UTCTime -resourceModificationTime p i = fileModificationTime $ resourceFilePath p i - - --------------------------------------------------------------------------------- -fileModificationTime :: FilePath -> IO UTCTime -fileModificationTime fp = do -#if MIN_VERSION_directory(1,2,0) - getModificationTime fp -#else - ct <- toCalendarTime =<< getModificationTime fp - let str = formatCalendarTime defaultTimeLocale "%s" ct - return $ readTime defaultTimeLocale "%s" str -#endif - - --------------------------------------------------------------------------------- --- | Because UTCTime doesn't have a Binary instance... -newtype BinaryTime = BinaryTime UTCTime - deriving (Eq, Ord, Typeable) - - --------------------------------------------------------------------------------- -instance Binary BinaryTime where - put (BinaryTime (UTCTime (ModifiedJulianDay d) dt)) = - put d >> put (floor dt :: Integer) - - get = fmap BinaryTime $ UTCTime - <$> (ModifiedJulianDay <$> get) - <*> (secondsToDiffTime <$> get) |