@@ -1,46 +1,103 @@
1--------------------------------------------------------------------------------
1--------------------------------------------------------------------------------
3+{-# LANGUAGE DeriveDataTypeable #-}
4+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
2module Hakyll.Core.Provider.Internal
5module Hakyll.Core.Provider.Internal
3− ( Provider (..)
7+ , Provider (..)
4 , newProvider
8 , newProvider
6 , resourceList
10 , resourceList
7 , resourceExists
11 , resourceExists
8− , resourceMetadataResource
10 , resourceFilePath
13 , resourceFilePath
11 , resourceString
14 , resourceString
12 , resourceLBS
15 , resourceLBS
18+ , resourceModificationTime
16--------------------------------------------------------------------------------
22--------------------------------------------------------------------------------
17−import Control.Applicative ((<$>))
23+import Control.Applicative ((<$>), (<*>))
24+import Control.DeepSeq (NFData (..), deepseq)
25+import Control.Monad (forM)
26+import Data.Binary (Binary (..))
18import qualified Data.ByteString.Lazy as BL
27import qualified Data.ByteString.Lazy as BL
20import Data.Map (Map)
28import Data.Map (Map)
21import qualified Data.Map as M
29import qualified Data.Map as M
30+import Data.Maybe (fromMaybe)
31+import Data.Monoid (mempty)
22import Data.Set (Set)
32import Data.Set (Set)
23import qualified Data.Set as S
33import qualified Data.Set as S
34+import Data.Time (Day (..), UTCTime (..),
36+import Data.Typeable (Typeable)
37+import System.Directory (getModificationTime)
24import System.FilePath (addExtension, (</>))
38import System.FilePath (addExtension, (</>))
41+--------------------------------------------------------------------------------
42+#if !MIN_VERSION_directory(1,2,0)
43+import Data.Time (readTime)
44+import System.Locale (defaultTimeLocale)
45+import System.Time (formatCalendarTime, toCalendarTime)
27--------------------------------------------------------------------------------
49--------------------------------------------------------------------------------
28import Hakyll.Core.Identifier
50import Hakyll.Core.Identifier
29−import Hakyll.Core.Store
51+import Hakyll.Core.Store (Store)
52+import qualified Hakyll.Core.Store as Store
30import Hakyll.Core.Util.File
53import Hakyll.Core.Util.File
56+--------------------------------------------------------------------------------
57+-- | Because UTCTime doesn't have a Binary instance...
58+newtype BinaryTime = BinaryTime {unBinaryTime :: UTCTime}
59+ deriving (Eq, NFData, Ord, Show, Typeable)
62+--------------------------------------------------------------------------------
63+instance Binary BinaryTime where
64+ put (BinaryTime (UTCTime (ModifiedJulianDay d) dt)) =
65+ put d >> put (floor dt :: Integer)
67+ get = fmap BinaryTime $ UTCTime
68+ <$> (ModifiedJulianDay <$> get)
69+ <*> (secondsToDiffTime <$> get)
72+--------------------------------------------------------------------------------
73+data ResourceInfo = ResourceInfo
74+ { resourceInfoModified :: BinaryTime
75+ , resourceInfoMetadata :: Maybe Identifier
76+ } deriving (Show, Typeable)
79+--------------------------------------------------------------------------------
80+instance Binary ResourceInfo where
81+ put (ResourceInfo mtime meta) = put mtime >> put meta
82+ get = ResourceInfo <$> get <*> get
85+--------------------------------------------------------------------------------
86+instance NFData ResourceInfo where
87+ rnf (ResourceInfo mtime meta) = rnf mtime `seq` rnf meta `seq` ()
33--------------------------------------------------------------------------------
90--------------------------------------------------------------------------------
34-- | Responsible for retrieving and listing resources
91-- | Responsible for retrieving and listing resources
35data Provider = Provider
92data Provider = Provider
36 { -- Top of the provided directory
93 { -- Top of the provided directory
37− providerDirectory :: FilePath
94+ providerDirectory :: FilePath
38 , -- | A list of all files found
95 , -- | A list of all files found
39− providerSet :: Set Identifier
96+ providerFiles :: Map Identifier ResourceInfo
40− , -- | Cache keeping track of modified files
97+ , -- | A list of the files from the previous run
41− providerModifiedCache :: IORef (Map Identifier Bool)
98+ providerOldFiles :: Map Identifier ResourceInfo
42 , -- | Underlying persistent store for caching
99 , -- | Underlying persistent store for caching
43− providerStore :: Store
100+ providerStore :: Store
@@ -51,29 +108,47 @@ newProvider :: Store -- ^ Store to use
51 -> FilePath -- ^ Search directory
108 -> FilePath -- ^ Search directory
52 -> IO Provider -- ^ Resulting provider
109 -> IO Provider -- ^ Resulting provider
53newProvider store ignore directory = do
110newProvider store ignore directory = do
54− list <- map fromFilePath <$> getRecursiveContents ignore directory
111+ list <- map fromFilePath <$> getRecursiveContents ignore directory
55− cache <- newIORef M.empty
112+ let universe = S.fromList list
113+ files <- fmap (maxmtime . M.fromList) $ forM list $ \identifier -> do
114+ rInfo <- getResourceInfo directory universe identifier
115+ return (identifier, rInfo)
117+ -- Get the old files from the store, and then immediately replace them by
119+ oldFiles <- fromMaybe mempty . Store.toMaybe <$> Store.get store oldKey
120+ oldFiles `deepseq` Store.set store oldKey files
56− return $ Provider directory (S.fromList list) cache store
122+ return $ Provider directory files oldFiles store
124+ oldKey = ["Hakyll.Core.Provider.Internal.newProvider", "oldFiles"]
126+ -- Update modified if metadata is modified
127+ maxmtime files = flip M.map files $ \rInfo@(ResourceInfo mtime meta) ->
128+ let metaMod = fmap resourceInfoModified $ meta >>= flip M.lookup files
129+ in rInfo {resourceInfoModified = maybe mtime (max mtime) metaMod}
132+--------------------------------------------------------------------------------
133+getResourceInfo :: FilePath -> Set Identifier -> Identifier -> IO ResourceInfo
134+getResourceInfo directory universe identifier = do
135+ mtime <- fileModificationTime $ directory </> toFilePath identifier
136+ return $ ResourceInfo (BinaryTime mtime) $
137+ if mdRsc `S.member` universe then Just mdRsc else Nothing
139+ mdRsc = fromFilePath $ flip addExtension "metadata" $ toFilePath identifier
59--------------------------------------------------------------------------------
142--------------------------------------------------------------------------------
60resourceList :: Provider -> [Identifier]
143resourceList :: Provider -> [Identifier]
61−resourceList = S.toList . providerSet
144+resourceList = M.keys . providerFiles
64--------------------------------------------------------------------------------
147--------------------------------------------------------------------------------
65-- | Check if a given resource exists
148-- | Check if a given resource exists
66resourceExists :: Provider -> Identifier -> Bool
149resourceExists :: Provider -> Identifier -> Bool
67resourceExists provider =
150resourceExists provider =
68− (`S.member` providerSet provider) . setVersion Nothing
151+ (`M.member` providerFiles provider) . setVersion Nothing
71−--------------------------------------------------------------------------------
72−-- | Each resource may have an associated metadata resource (with a @.metadata@
74−resourceMetadataResource :: Identifier -> Identifier
75−resourceMetadataResource =
76− fromFilePath . flip addExtension "metadata" . toFilePath
79--------------------------------------------------------------------------------
154--------------------------------------------------------------------------------
@@ -91,3 +166,37 @@ resourceString p i = readFile $ resourceFilePath p i
91-- | Get the raw body of a resource of a lazy bytestring
166-- | Get the raw body of a resource of a lazy bytestring
92resourceLBS :: Provider -> Identifier -> IO BL.ByteString
167resourceLBS :: Provider -> Identifier -> IO BL.ByteString
93resourceLBS p i = BL.readFile $ resourceFilePath p i
168resourceLBS p i = BL.readFile $ resourceFilePath p i
171+--------------------------------------------------------------------------------
172+-- | A resource is modified if it or its metadata has changed
173+resourceModified :: Provider -> Identifier -> Bool
174+resourceModified p r = case (ri, oldRi) of
175+ (Nothing, _) -> True
176+ (Just _, Nothing) -> True
177+ (Just n, Just o) -> resourceInfoModified n > resourceInfoModified o
179+ ri = M.lookup (setVersion Nothing r) (providerFiles p)
180+ oldRi = ri >>= resourceInfoMetadata >>= flip M.lookup (providerFiles p)
183+--------------------------------------------------------------------------------
184+resourceModificationTime :: Provider -> Identifier -> UTCTime
185+resourceModificationTime p i =
186+ case M.lookup (setVersion Nothing i) (providerFiles p) of
187+ Just ri -> unBinaryTime $ resourceInfoModified ri
189+ "Hakyll.Core.Provider.Internal.resourceModificationTime: " ++
190+ "resource " ++ show i ++ " does not exist"
193+--------------------------------------------------------------------------------
194+fileModificationTime :: FilePath -> IO UTCTime
195+fileModificationTime fp = do
196+#if MIN_VERSION_directory(1,2,0)
197+ getModificationTime fp
199+ ct <- toCalendarTime =<< getModificationTime fp
200+ let str = formatCalendarTime defaultTimeLocale "%s" ct
201+ return $ readTime defaultTimeLocale "%s" str