git.iko.soy/hakyll
on 505cf50 help sign in
hakyll/src/Hakyll/Core/Provider/Modified.hs
115 lines 4.5 kB history raw
1--------------------------------------------------------------------------------
2{-# LANGUAGE CPP #-}
3{-# LANGUAGE DeriveDataTypeable #-}
4module Hakyll.Core.Provider.Modified
5 ( resourceModified
6 , resourceModificationTime
7 ) where
10--------------------------------------------------------------------------------
11import Control.Applicative ((<$>), (<*>))
12import Control.Monad (when)
13import Data.Binary (Binary (..))
14import Data.IORef
15import qualified Data.Map as M
16import Data.Time (Day (..), UTCTime (..),
17 secondsToDiffTime)
18import Data.Typeable (Typeable)
19import System.Directory (getModificationTime)
22--------------------------------------------------------------------------------
23#if !MIN_VERSION_directory(1,2,0)
24import Data.Time (readTime)
25import System.Locale (defaultTimeLocale)
26import System.Time (formatCalendarTime,
27 toCalendarTime)
28#endif
31--------------------------------------------------------------------------------
32import Hakyll.Core.Identifier
33import Hakyll.Core.Provider.Internal
34import Hakyll.Core.Provider.MetadataCache
35import Hakyll.Core.Store (Store)
36import qualified Hakyll.Core.Store as Store
39--------------------------------------------------------------------------------
40-- | A resource is modified if it or its metadata has changed
41resourceModified :: Provider -> Identifier -> IO Bool
42resourceModified p r
43 | not exists = return False
44 | otherwise = do
45 cache <- readIORef cacheRef
46 case M.lookup normalized cache of
47 Just m -> return m
48 Nothing -> do
49 -- Check if the actual file was modified, and do a recursive
50 -- call to check if the metadata file was modified
51 m <- (||)
52 <$> fileModified store filePath
53 <*> resourceModified p (resourceMetadataResource r)
54 modifyIORef cacheRef (M.insert normalized m)
56 -- Important! (But ugly)
57 when m $ resourceInvalidateMetadataCache p r
59 return m
60 where
61 normalized = setVersion Nothing r
62 exists = resourceExists p r
63 store = providerStore p
64 cacheRef = providerModifiedCache p
65 filePath = resourceFilePath p r
68--------------------------------------------------------------------------------
69-- | Utility: Check if a file was modified recently
70fileModified :: Store -> FilePath -> IO Bool
71fileModified store fp = do
72 lastModified <- Store.get store key
73 newModified <- BinaryTime <$> fileModificationTime fp
74 if maybe False (>= newModified) (Store.toMaybe lastModified)
75 -- All is fine, not modified
76 then return False
77 -- Resource modified; store new digest
78 else do
79 Store.set store key newModified
80 return True
81 where
82 key = ["Hakyll.Core.Resource.Provider.fileModified", fp]
85--------------------------------------------------------------------------------
86resourceModificationTime :: Provider -> Identifier -> IO UTCTime
87resourceModificationTime p i = fileModificationTime $ resourceFilePath p i
90--------------------------------------------------------------------------------
91fileModificationTime :: FilePath -> IO UTCTime
92fileModificationTime fp = do
93#if MIN_VERSION_directory(1,2,0)
94 getModificationTime fp
95#else
96 ct <- toCalendarTime =<< getModificationTime fp
97 let str = formatCalendarTime defaultTimeLocale "%s" ct
98 return $ readTime defaultTimeLocale "%s" str
99#endif
102--------------------------------------------------------------------------------
103-- | Because UTCTime doesn't have a Binary instance...
104newtype BinaryTime = BinaryTime UTCTime
105 deriving (Eq, Ord, Typeable)
108--------------------------------------------------------------------------------
109instance Binary BinaryTime where
110 put (BinaryTime (UTCTime (ModifiedJulianDay d) dt)) =
111 put d >> put (floor dt :: Integer)
113 get = fmap BinaryTime $ UTCTime
114 <$> (ModifiedJulianDay <$> get)
115 <*> (secondsToDiffTime <$> get)