git.iko.soy/hakyll
on master help sign in
Start provider rewrite
commit86d0b68aed6e82fd4a6c935ce6113937023f6e6b authorJasper Van der Jeugt <m@jaspervdj.be> dateSat 9 Feb 2013, 15:11 (14 years ago) parentea953d3
13 files changed+173−174
compare with master
unifiedsplit
hakyll.cabal−1 src/Hakyll/Core/Compiler.hs+1−1 src/Hakyll/Core/Provider.hs+25−26 src/Hakyll/Core/Provider/Internal.hs+132−23 src/Hakyll/Core/Provider/Metadata.hs+4−3 src/Hakyll/Core/Provider/MetadataCache.hs+1 src/Hakyll/Core/Provider/Modified.hs−115 src/Hakyll/Core/Runtime.hs+4−3 src/Hakyll/Web/Template/Context.hs+1−2 tests/Hakyll/Core/Provider/Tests.hs+1 tests/Hakyll/Core/Rules/Tests.hs+1 tests/Hakyll/Core/Store/Tests.hs+1 tests/Hakyll/Web/Template/Tests.hs+2
hakyll.cabal−1
@@ -151,7 +151,6 @@ Library
151151 Hakyll.Core.Provider.Internal
152152 Hakyll.Core.Provider.Metadata
153153 Hakyll.Core.Provider.MetadataCache
154− Hakyll.Core.Provider.Modified
155154 Hakyll.Core.Rules.Internal
156155 Hakyll.Core.Runtime
157156 Hakyll.Core.Store
src/Hakyll/Core/Compiler.hs+1−1
@@ -131,7 +131,7 @@ cached name compiler = do
131131 id' <- compilerUnderlying <$> compilerAsk
132132 store <- compilerStore <$> compilerAsk
133133 provider <- compilerProvider <$> compilerAsk
134− modified <- compilerUnsafeIO $ resourceModified provider id'
134+ let modified = resourceModified provider id'
135135 if modified
136136 then do
137137 x <- compiler
src/Hakyll/Core/Provider.hs+25−26
@@ -3,44 +3,43 @@
33-- caching.
44module Hakyll.Core.Provider
55 ( -- * Constructing resource providers
6− Provider
6+ Internal.Provider
77 , newProvider
88
99 -- * Querying resource properties
10− , resourceList
11− , resourceExists
12− , resourceModified
13− , resourceModificationTime
10+ , Internal.resourceList
11+ , Internal.resourceExists
12+ , Internal.resourceModified
13+ , Internal.resourceModificationTime
1414
1515 -- * Access to raw resource content
16− , resourceString
17− , resourceLBS
16+ , Internal.resourceString
17+ , Internal.resourceLBS
1818
1919 -- * Access to metadata and body content
20− , resourceMetadata
21− , resourceBody
20+ , Internal.resourceMetadata
21+ , Internal.resourceBody
2222 ) where
2323
2424
2525--------------------------------------------------------------------------------
26−import Hakyll.Core.Identifier
27−import Hakyll.Core.Metadata
28−import Hakyll.Core.Provider.Internal
26+import Control.Monad (forM_)
27+import qualified Hakyll.Core.Provider.Internal as Internal
2928import qualified Hakyll.Core.Provider.MetadataCache as Internal
30−import Hakyll.Core.Provider.Modified
29+import Hakyll.Core.Store (Store)
3130
3231
3332--------------------------------------------------------------------------------
34−-- | Wrapper to ensure metadata cache is invalidated if necessary
35−resourceMetadata :: Provider -> Identifier -> IO Metadata
36−resourceMetadata rp r = do
37− _ <- resourceModified rp r
38− Internal.resourceMetadata rp r
39−
40−
41−--------------------------------------------------------------------------------
42−-- | Wrapper to ensure metadata cache is invalidated if necessary
43−resourceBody :: Provider -> Identifier -> IO String
44−resourceBody rp r = do
45− _ <- resourceModified rp r
46− Internal.resourceBody rp r
33+-- | Create a resource provider
34+newProvider :: Store -- ^ Store to use
35+ -> (FilePath -> Bool) -- ^ Should we ignore this file?
36+ -> FilePath -- ^ Search directory
37+ -> IO Internal.Provider -- ^ Resulting provider
38+newProvider store ignore directory = do
39+ -- Delete metadata cache where necessary
40+ provider <- Internal.newProvider store ignore directory
41+ forM_ (Internal.resourceList provider) $ \identifier ->
42+ if Internal.resourceModified provider identifier
43+ then Internal.resourceInvalidateMetadataCache provider identifier
44+ else return ()
45+ return provider
src/Hakyll/Core/Provider/Internal.hs+132−23
@@ -1,46 +1,103 @@
11--------------------------------------------------------------------------------
2+{-# LANGUAGE CPP #-}
3+{-# LANGUAGE DeriveDataTypeable #-}
4+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
25module Hakyll.Core.Provider.Internal
3− ( Provider (..)
6+ ( ResourceInfo (..)
7+ , Provider (..)
48 , newProvider
59
610 , resourceList
711 , resourceExists
8− , resourceMetadataResource
912
1013 , resourceFilePath
1114 , resourceString
1215 , resourceLBS
16+
17+ , resourceModified
18+ , resourceModificationTime
1319 ) where
1420
1521
1622--------------------------------------------------------------------------------
17−import Control.Applicative ((<$>))
23+import Control.Applicative ((<$>), (<*>))
24+import Control.DeepSeq (NFData (..), deepseq)
25+import Control.Monad (forM)
26+import Data.Binary (Binary (..))
1827import qualified Data.ByteString.Lazy as BL
19−import Data.IORef
2028import Data.Map (Map)
2129import qualified Data.Map as M
30+import Data.Maybe (fromMaybe)
31+import Data.Monoid (mempty)
2232import Data.Set (Set)
2333import qualified Data.Set as S
34+import Data.Time (Day (..), UTCTime (..),
35+ secondsToDiffTime)
36+import Data.Typeable (Typeable)
37+import System.Directory (getModificationTime)
2438import System.FilePath (addExtension, (</>))
2539
2640
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)
46+#endif
47+
48+
2749--------------------------------------------------------------------------------
2850import Hakyll.Core.Identifier
29−import Hakyll.Core.Store
51+import Hakyll.Core.Store (Store)
52+import qualified Hakyll.Core.Store as Store
3053import Hakyll.Core.Util.File
3154
3255
56+--------------------------------------------------------------------------------
57+-- | Because UTCTime doesn't have a Binary instance...
58+newtype BinaryTime = BinaryTime {unBinaryTime :: UTCTime}
59+ deriving (Eq, NFData, Ord, Show, Typeable)
60+
61+
62+--------------------------------------------------------------------------------
63+instance Binary BinaryTime where
64+ put (BinaryTime (UTCTime (ModifiedJulianDay d) dt)) =
65+ put d >> put (floor dt :: Integer)
66+
67+ get = fmap BinaryTime $ UTCTime
68+ <$> (ModifiedJulianDay <$> get)
69+ <*> (secondsToDiffTime <$> get)
70+
71+
72+--------------------------------------------------------------------------------
73+data ResourceInfo = ResourceInfo
74+ { resourceInfoModified :: BinaryTime
75+ , resourceInfoMetadata :: Maybe Identifier
76+ } deriving (Show, Typeable)
77+
78+
79+--------------------------------------------------------------------------------
80+instance Binary ResourceInfo where
81+ put (ResourceInfo mtime meta) = put mtime >> put meta
82+ get = ResourceInfo <$> get <*> get
83+
84+
85+--------------------------------------------------------------------------------
86+instance NFData ResourceInfo where
87+ rnf (ResourceInfo mtime meta) = rnf mtime `seq` rnf meta `seq` ()
88+
89+
3390--------------------------------------------------------------------------------
3491-- | Responsible for retrieving and listing resources
3592data Provider = Provider
3693 { -- Top of the provided directory
37− providerDirectory :: FilePath
94+ providerDirectory :: FilePath
3895 , -- | A list of all files found
39− providerSet :: Set Identifier
40− , -- | Cache keeping track of modified files
41− providerModifiedCache :: IORef (Map Identifier Bool)
96+ providerFiles :: Map Identifier ResourceInfo
97+ , -- | A list of the files from the previous run
98+ providerOldFiles :: Map Identifier ResourceInfo
4299 , -- | Underlying persistent store for caching
43− providerStore :: Store
100+ providerStore :: Store
44101 }
45102
46103
@@ -51,29 +108,47 @@ newProvider :: Store -- ^ Store to use
51108 -> FilePath -- ^ Search directory
52109 -> IO Provider -- ^ Resulting provider
53110newProvider store ignore directory = do
54− list <- map fromFilePath <$> getRecursiveContents ignore directory
55− cache <- newIORef M.empty
56− return $ Provider directory (S.fromList list) cache store
111+ list <- map fromFilePath <$> getRecursiveContents ignore directory
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)
116+
117+ -- Get the old files from the store, and then immediately replace them by
118+ -- the new files.
119+ oldFiles <- fromMaybe mempty . Store.toMaybe <$> Store.get store oldKey
120+ oldFiles `deepseq` Store.set store oldKey files
121+
122+ return $ Provider directory files oldFiles store
123+ where
124+ oldKey = ["Hakyll.Core.Provider.Internal.newProvider", "oldFiles"]
125+
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}
130+
131+
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
138+ where
139+ mdRsc = fromFilePath $ flip addExtension "metadata" $ toFilePath identifier
57140
58141
59142--------------------------------------------------------------------------------
60143resourceList :: Provider -> [Identifier]
61−resourceList = S.toList . providerSet
144+resourceList = M.keys . providerFiles
62145
63146
64147--------------------------------------------------------------------------------
65148-- | Check if a given resource exists
66149resourceExists :: Provider -> Identifier -> Bool
67150resourceExists provider =
68− (`S.member` providerSet provider) . setVersion Nothing
69−
70−
71−--------------------------------------------------------------------------------
72−-- | Each resource may have an associated metadata resource (with a @.metadata@
73−-- filename)
74−resourceMetadataResource :: Identifier -> Identifier
75−resourceMetadataResource =
76− fromFilePath . flip addExtension "metadata" . toFilePath
151+ (`M.member` providerFiles provider) . setVersion Nothing
77152
78153
79154--------------------------------------------------------------------------------
@@ -91,3 +166,37 @@ resourceString p i = readFile $ resourceFilePath p i
91166-- | Get the raw body of a resource of a lazy bytestring
92167resourceLBS :: Provider -> Identifier -> IO BL.ByteString
93168resourceLBS p i = BL.readFile $ resourceFilePath p i
169+
170+
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
178+ where
179+ ri = M.lookup (setVersion Nothing r) (providerFiles p)
180+ oldRi = ri >>= resourceInfoMetadata >>= flip M.lookup (providerFiles p)
181+
182+
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
188+ Nothing -> error $
189+ "Hakyll.Core.Provider.Internal.resourceModificationTime: " ++
190+ "resource " ++ show i ++ " does not exist"
191+
192+
193+--------------------------------------------------------------------------------
194+fileModificationTime :: FilePath -> IO UTCTime
195+fileModificationTime fp = do
196+#if MIN_VERSION_directory(1,2,0)
197+ getModificationTime fp
198+#else
199+ ct <- toCalendarTime =<< getModificationTime fp
200+ let str = formatCalendarTime defaultTimeLocale "%s" ct
201+ return $ readTime defaultTimeLocale "%s" str
202+#endif
src/Hakyll/Core/Provider/Metadata.hs+4−3
@@ -31,13 +31,14 @@ loadMetadata p identifier = do
3131 then second Just <$> loadMetadataHeader fp
3232 else return (M.empty, Nothing)
3333
34− emd <- if resourceExists p mi then loadMetadataFile mfp else return M.empty
34+ emd <- case mi of
35+ Nothing -> return M.empty
36+ Just mi' -> loadMetadataFile $ resourceFilePath p mi'
3537
3638 return (M.union md emd, body)
3739 where
3840 fp = resourceFilePath p identifier
39− mi = resourceMetadataResource identifier
40− mfp = resourceFilePath p mi
41+ mi = M.lookup identifier (providerFiles p) >>= resourceInfoMetadata
4142
4243
4344--------------------------------------------------------------------------------
src/Hakyll/Core/Provider/MetadataCache.hs+1
@@ -23,6 +23,7 @@ resourceMetadata :: Provider -> Identifier -> IO Metadata
2323resourceMetadata p r
2424 | not (resourceExists p r) = return M.empty
2525 | otherwise = do
26+ -- TODO keep time in md cache
2627 load p r
2728 Store.Found md <- Store.get (providerStore p)
2829 [name, toFilePath r, "metadata"]
src/Hakyll/Core/Provider/Modified.hsdeleted−115
@@ -1,115 +0,0 @@
1−--------------------------------------------------------------------------------
2−{-# LANGUAGE CPP #-}
3−{-# LANGUAGE DeriveDataTypeable #-}
4−module Hakyll.Core.Provider.Modified
5− ( resourceModified
6− , resourceModificationTime
7− ) where
8−
9−
10−--------------------------------------------------------------------------------
11−import Control.Applicative ((<$>), (<*>))
12−import Control.Monad (when)
13−import Data.Binary (Binary (..))
14−import Data.IORef
15−import qualified Data.Map as M
16−import Data.Time (Day (..), UTCTime (..),
17− secondsToDiffTime)
18−import Data.Typeable (Typeable)
19−import System.Directory (getModificationTime)
20−
21−
22−--------------------------------------------------------------------------------
23−#if !MIN_VERSION_directory(1,2,0)
24−import Data.Time (readTime)
25−import System.Locale (defaultTimeLocale)
26−import System.Time (formatCalendarTime,
27− toCalendarTime)
28−#endif
29−
30−
31−--------------------------------------------------------------------------------
32−import Hakyll.Core.Identifier
33−import Hakyll.Core.Provider.Internal
34−import Hakyll.Core.Provider.MetadataCache
35−import Hakyll.Core.Store (Store)
36−import qualified Hakyll.Core.Store as Store
37−
38−
39−--------------------------------------------------------------------------------
40−-- | A resource is modified if it or its metadata has changed
41−resourceModified :: Provider -> Identifier -> IO Bool
42−resourceModified 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)
55−
56− -- Important! (But ugly)
57− when m $ resourceInvalidateMetadataCache p r
58−
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
66−
67−
68−--------------------------------------------------------------------------------
69−-- | Utility: Check if a file was modified recently
70−fileModified :: Store -> FilePath -> IO Bool
71−fileModified 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]
83−
84−
85−--------------------------------------------------------------------------------
86−resourceModificationTime :: Provider -> Identifier -> IO UTCTime
87−resourceModificationTime p i = fileModificationTime $ resourceFilePath p i
88−
89−
90−--------------------------------------------------------------------------------
91−fileModificationTime :: FilePath -> IO UTCTime
92−fileModificationTime 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
100−
101−
102−--------------------------------------------------------------------------------
103−-- | Because UTCTime doesn't have a Binary instance...
104−newtype BinaryTime = BinaryTime UTCTime
105− deriving (Eq, Ord, Typeable)
106−
107−
108−--------------------------------------------------------------------------------
109−instance Binary BinaryTime where
110− put (BinaryTime (UTCTime (ModifiedJulianDay d) dt)) =
111− put d >> put (floor dt :: Integer)
112−
113− get = fmap BinaryTime $ UTCTime
114− <$> (ModifiedJulianDay <$> get)
115− <*> (secondsToDiffTime <$> get)
src/Hakyll/Core/Runtime.hs+4−3
@@ -6,7 +6,7 @@ module Hakyll.Core.Runtime
66
77--------------------------------------------------------------------------------
88import Control.Applicative ((<$>))
9−import Control.Monad (filterM, unless)
9+import Control.Monad (unless)
1010import Control.Monad.Error (ErrorT, runErrorT, throwError)
1111import Control.Monad.Reader (ask)
1212import Control.Monad.RWS (RWST, runRWST)
@@ -140,8 +140,9 @@ scheduleOutOfDate = do
140140 todo <- runtimeTodo <$> get
141141
142142 let identifiers = M.keys universe
143− modified <- fmap S.fromList $ flip filterM identifiers $
144− liftIO . resourceModified provider
143+ modified = S.fromList $ flip filter identifiers $
144+ resourceModified provider
145+
145146 let (ood, facts', msgs) = outOfDate identifiers modified facts
146147 todo' = M.filterWithKey
147148 (\id' _ -> id' `S.member` ood) universe
src/Hakyll/Web/Template/Context.hs+1−2
@@ -207,8 +207,7 @@ modificationTimeFieldWith :: TimeLocale -- ^ Time output locale
207207 -> Context a -- ^ Resulting context
208208modificationTimeFieldWith locale key fmt = field key $ \i -> do
209209 provider <- compilerProvider <$> compilerAsk
210− mtime <- compilerUnsafeIO $
211− resourceModificationTime provider $ itemIdentifier i
210+ let mtime = resourceModificationTime provider $ itemIdentifier i
212211 return $ formatTime locale fmt mtime
213212
214213
tests/Hakyll/Core/Provider/Tests.hs+1
@@ -37,3 +37,4 @@ case01 = do
3737
3838 doesntExist <- resourceMetadata provider "doesntexist.md"
3939 M.empty @=? doesntExist
40+ cleanTestEnv
tests/Hakyll/Core/Rules/Tests.hs+1
@@ -51,6 +51,7 @@ rulesTest = do
5151 Just "example.mv1" @=? runRoutes routes (sv "mv1" "example.md")
5252 Just "example.mv2" @=? runRoutes routes (sv "mv2" "example.md")
5353 readIORef ioref >>= assert
54+ cleanTestEnv
5455 where
5556 sv g = setVersion (Just g)
5657 expected =
tests/Hakyll/Core/Store/Tests.hs+1
@@ -67,3 +67,4 @@ wrongType = do
6767 e == typeOf (undefined :: Int) &&
6868 t == typeOf (undefined :: String)
6969 _ -> False
70+ cleanTestEnv
tests/Hakyll/Web/Template/Tests.hs+2
@@ -44,6 +44,7 @@ case01 = do
4444 pandocCompiler >>= applyTemplate (itemBody tpl) testContext
4545
4646 out @=? itemBody item
47+ cleanTestEnv
4748
4849
4950--------------------------------------------------------------------------------
@@ -63,6 +64,7 @@ testApplyJoinTemplateList = do
6364 applyJoinTemplateList ", " tpl defaultContext [i1, i2]
6465
6566 str @?= "<b>Hello</b>, <b>World</b>"
67+ cleanTestEnv
6668 where
6769 i1 = Item "item1" "Hello"
6870 i2 = Item "item2" "World"