Start provider rewrite
This commit is contained in:
parent
ea953d3415
commit
86d0b68aed
13 changed files with 173 additions and 174 deletions
|
@ -151,7 +151,6 @@ Library
|
||||||
Hakyll.Core.Provider.Internal
|
Hakyll.Core.Provider.Internal
|
||||||
Hakyll.Core.Provider.Metadata
|
Hakyll.Core.Provider.Metadata
|
||||||
Hakyll.Core.Provider.MetadataCache
|
Hakyll.Core.Provider.MetadataCache
|
||||||
Hakyll.Core.Provider.Modified
|
|
||||||
Hakyll.Core.Rules.Internal
|
Hakyll.Core.Rules.Internal
|
||||||
Hakyll.Core.Runtime
|
Hakyll.Core.Runtime
|
||||||
Hakyll.Core.Store
|
Hakyll.Core.Store
|
||||||
|
|
|
@ -131,7 +131,7 @@ cached name compiler = do
|
||||||
id' <- compilerUnderlying <$> compilerAsk
|
id' <- compilerUnderlying <$> compilerAsk
|
||||||
store <- compilerStore <$> compilerAsk
|
store <- compilerStore <$> compilerAsk
|
||||||
provider <- compilerProvider <$> compilerAsk
|
provider <- compilerProvider <$> compilerAsk
|
||||||
modified <- compilerUnsafeIO $ resourceModified provider id'
|
let modified = resourceModified provider id'
|
||||||
if modified
|
if modified
|
||||||
then do
|
then do
|
||||||
x <- compiler
|
x <- compiler
|
||||||
|
|
|
@ -3,44 +3,43 @@
|
||||||
-- caching.
|
-- caching.
|
||||||
module Hakyll.Core.Provider
|
module Hakyll.Core.Provider
|
||||||
( -- * Constructing resource providers
|
( -- * Constructing resource providers
|
||||||
Provider
|
Internal.Provider
|
||||||
, newProvider
|
, newProvider
|
||||||
|
|
||||||
-- * Querying resource properties
|
-- * Querying resource properties
|
||||||
, resourceList
|
, Internal.resourceList
|
||||||
, resourceExists
|
, Internal.resourceExists
|
||||||
, resourceModified
|
, Internal.resourceModified
|
||||||
, resourceModificationTime
|
, Internal.resourceModificationTime
|
||||||
|
|
||||||
-- * Access to raw resource content
|
-- * Access to raw resource content
|
||||||
, resourceString
|
, Internal.resourceString
|
||||||
, resourceLBS
|
, Internal.resourceLBS
|
||||||
|
|
||||||
-- * Access to metadata and body content
|
-- * Access to metadata and body content
|
||||||
, resourceMetadata
|
, Internal.resourceMetadata
|
||||||
, resourceBody
|
, Internal.resourceBody
|
||||||
) where
|
) where
|
||||||
|
|
||||||
|
|
||||||
--------------------------------------------------------------------------------
|
--------------------------------------------------------------------------------
|
||||||
import Hakyll.Core.Identifier
|
import Control.Monad (forM_)
|
||||||
import Hakyll.Core.Metadata
|
import qualified Hakyll.Core.Provider.Internal as Internal
|
||||||
import Hakyll.Core.Provider.Internal
|
|
||||||
import qualified Hakyll.Core.Provider.MetadataCache as Internal
|
import qualified Hakyll.Core.Provider.MetadataCache as Internal
|
||||||
import Hakyll.Core.Provider.Modified
|
import Hakyll.Core.Store (Store)
|
||||||
|
|
||||||
|
|
||||||
--------------------------------------------------------------------------------
|
--------------------------------------------------------------------------------
|
||||||
-- | Wrapper to ensure metadata cache is invalidated if necessary
|
-- | Create a resource provider
|
||||||
resourceMetadata :: Provider -> Identifier -> IO Metadata
|
newProvider :: Store -- ^ Store to use
|
||||||
resourceMetadata rp r = do
|
-> (FilePath -> Bool) -- ^ Should we ignore this file?
|
||||||
_ <- resourceModified rp r
|
-> FilePath -- ^ Search directory
|
||||||
Internal.resourceMetadata rp r
|
-> IO Internal.Provider -- ^ Resulting provider
|
||||||
|
newProvider store ignore directory = do
|
||||||
|
-- Delete metadata cache where necessary
|
||||||
--------------------------------------------------------------------------------
|
provider <- Internal.newProvider store ignore directory
|
||||||
-- | Wrapper to ensure metadata cache is invalidated if necessary
|
forM_ (Internal.resourceList provider) $ \identifier ->
|
||||||
resourceBody :: Provider -> Identifier -> IO String
|
if Internal.resourceModified provider identifier
|
||||||
resourceBody rp r = do
|
then Internal.resourceInvalidateMetadataCache provider identifier
|
||||||
_ <- resourceModified rp r
|
else return ()
|
||||||
Internal.resourceBody rp r
|
return provider
|
||||||
|
|
|
@ -1,44 +1,101 @@
|
||||||
--------------------------------------------------------------------------------
|
--------------------------------------------------------------------------------
|
||||||
|
{-# LANGUAGE CPP #-}
|
||||||
|
{-# LANGUAGE DeriveDataTypeable #-}
|
||||||
|
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
|
||||||
module Hakyll.Core.Provider.Internal
|
module Hakyll.Core.Provider.Internal
|
||||||
( Provider (..)
|
( ResourceInfo (..)
|
||||||
|
, Provider (..)
|
||||||
, newProvider
|
, newProvider
|
||||||
|
|
||||||
, resourceList
|
, resourceList
|
||||||
, resourceExists
|
, resourceExists
|
||||||
, resourceMetadataResource
|
|
||||||
|
|
||||||
, resourceFilePath
|
, resourceFilePath
|
||||||
, resourceString
|
, resourceString
|
||||||
, resourceLBS
|
, resourceLBS
|
||||||
|
|
||||||
|
, resourceModified
|
||||||
|
, resourceModificationTime
|
||||||
) where
|
) 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 qualified Data.ByteString.Lazy as BL
|
||||||
import Data.IORef
|
|
||||||
import Data.Map (Map)
|
import Data.Map (Map)
|
||||||
import qualified Data.Map as M
|
import qualified Data.Map as M
|
||||||
|
import Data.Maybe (fromMaybe)
|
||||||
|
import Data.Monoid (mempty)
|
||||||
import Data.Set (Set)
|
import Data.Set (Set)
|
||||||
import qualified Data.Set as S
|
import qualified Data.Set as S
|
||||||
|
import Data.Time (Day (..), UTCTime (..),
|
||||||
|
secondsToDiffTime)
|
||||||
|
import Data.Typeable (Typeable)
|
||||||
|
import System.Directory (getModificationTime)
|
||||||
import System.FilePath (addExtension, (</>))
|
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.Identifier
|
||||||
import Hakyll.Core.Store
|
import Hakyll.Core.Store (Store)
|
||||||
|
import qualified Hakyll.Core.Store as Store
|
||||||
import Hakyll.Core.Util.File
|
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
|
-- | Responsible for retrieving and listing resources
|
||||||
data Provider = Provider
|
data Provider = Provider
|
||||||
{ -- Top of the provided directory
|
{ -- Top of the provided directory
|
||||||
providerDirectory :: FilePath
|
providerDirectory :: FilePath
|
||||||
, -- | A list of all files found
|
, -- | A list of all files found
|
||||||
providerSet :: Set Identifier
|
providerFiles :: Map Identifier ResourceInfo
|
||||||
, -- | Cache keeping track of modified files
|
, -- | A list of the files from the previous run
|
||||||
providerModifiedCache :: IORef (Map Identifier Bool)
|
providerOldFiles :: Map Identifier ResourceInfo
|
||||||
, -- | Underlying persistent store for caching
|
, -- | Underlying persistent store for caching
|
||||||
providerStore :: Store
|
providerStore :: Store
|
||||||
}
|
}
|
||||||
|
@ -52,28 +109,46 @@ newProvider :: Store -- ^ Store to use
|
||||||
-> IO Provider -- ^ Resulting provider
|
-> IO Provider -- ^ Resulting provider
|
||||||
newProvider store ignore directory = do
|
newProvider store ignore directory = do
|
||||||
list <- map fromFilePath <$> getRecursiveContents ignore directory
|
list <- map fromFilePath <$> getRecursiveContents ignore directory
|
||||||
cache <- newIORef M.empty
|
let universe = S.fromList list
|
||||||
return $ Provider directory (S.fromList list) cache store
|
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 :: Provider -> [Identifier]
|
||||||
resourceList = S.toList . providerSet
|
resourceList = M.keys . providerFiles
|
||||||
|
|
||||||
|
|
||||||
--------------------------------------------------------------------------------
|
--------------------------------------------------------------------------------
|
||||||
-- | Check if a given resource exists
|
-- | Check if a given resource exists
|
||||||
resourceExists :: Provider -> Identifier -> Bool
|
resourceExists :: Provider -> Identifier -> Bool
|
||||||
resourceExists provider =
|
resourceExists provider =
|
||||||
(`S.member` providerSet provider) . setVersion Nothing
|
(`M.member` providerFiles provider) . setVersion Nothing
|
||||||
|
|
||||||
|
|
||||||
--------------------------------------------------------------------------------
|
|
||||||
-- | Each resource may have an associated metadata resource (with a @.metadata@
|
|
||||||
-- filename)
|
|
||||||
resourceMetadataResource :: Identifier -> Identifier
|
|
||||||
resourceMetadataResource =
|
|
||||||
fromFilePath . flip addExtension "metadata" . toFilePath
|
|
||||||
|
|
||||||
|
|
||||||
--------------------------------------------------------------------------------
|
--------------------------------------------------------------------------------
|
||||||
|
@ -91,3 +166,37 @@ resourceString p i = readFile $ resourceFilePath p i
|
||||||
-- | Get the raw body of a resource of a lazy bytestring
|
-- | Get the raw body of a resource of a lazy bytestring
|
||||||
resourceLBS :: Provider -> Identifier -> IO BL.ByteString
|
resourceLBS :: Provider -> Identifier -> IO BL.ByteString
|
||||||
resourceLBS p i = BL.readFile $ resourceFilePath p i
|
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
|
||||||
|
|
|
@ -31,13 +31,14 @@ loadMetadata p identifier = do
|
||||||
then second Just <$> loadMetadataHeader fp
|
then second Just <$> loadMetadataHeader fp
|
||||||
else return (M.empty, Nothing)
|
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)
|
return (M.union md emd, body)
|
||||||
where
|
where
|
||||||
fp = resourceFilePath p identifier
|
fp = resourceFilePath p identifier
|
||||||
mi = resourceMetadataResource identifier
|
mi = M.lookup identifier (providerFiles p) >>= resourceInfoMetadata
|
||||||
mfp = resourceFilePath p mi
|
|
||||||
|
|
||||||
|
|
||||||
--------------------------------------------------------------------------------
|
--------------------------------------------------------------------------------
|
||||||
|
|
|
@ -23,6 +23,7 @@ resourceMetadata :: Provider -> Identifier -> IO Metadata
|
||||||
resourceMetadata p r
|
resourceMetadata p r
|
||||||
| not (resourceExists p r) = return M.empty
|
| not (resourceExists p r) = return M.empty
|
||||||
| otherwise = do
|
| otherwise = do
|
||||||
|
-- TODO keep time in md cache
|
||||||
load p r
|
load p r
|
||||||
Store.Found md <- Store.get (providerStore p)
|
Store.Found md <- Store.get (providerStore p)
|
||||||
[name, toFilePath r, "metadata"]
|
[name, toFilePath r, "metadata"]
|
||||||
|
|
|
@ -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)
|
|
|
@ -6,7 +6,7 @@ module Hakyll.Core.Runtime
|
||||||
|
|
||||||
--------------------------------------------------------------------------------
|
--------------------------------------------------------------------------------
|
||||||
import Control.Applicative ((<$>))
|
import Control.Applicative ((<$>))
|
||||||
import Control.Monad (filterM, unless)
|
import Control.Monad (unless)
|
||||||
import Control.Monad.Error (ErrorT, runErrorT, throwError)
|
import Control.Monad.Error (ErrorT, runErrorT, throwError)
|
||||||
import Control.Monad.Reader (ask)
|
import Control.Monad.Reader (ask)
|
||||||
import Control.Monad.RWS (RWST, runRWST)
|
import Control.Monad.RWS (RWST, runRWST)
|
||||||
|
@ -140,8 +140,9 @@ scheduleOutOfDate = do
|
||||||
todo <- runtimeTodo <$> get
|
todo <- runtimeTodo <$> get
|
||||||
|
|
||||||
let identifiers = M.keys universe
|
let identifiers = M.keys universe
|
||||||
modified <- fmap S.fromList $ flip filterM identifiers $
|
modified = S.fromList $ flip filter identifiers $
|
||||||
liftIO . resourceModified provider
|
resourceModified provider
|
||||||
|
|
||||||
let (ood, facts', msgs) = outOfDate identifiers modified facts
|
let (ood, facts', msgs) = outOfDate identifiers modified facts
|
||||||
todo' = M.filterWithKey
|
todo' = M.filterWithKey
|
||||||
(\id' _ -> id' `S.member` ood) universe
|
(\id' _ -> id' `S.member` ood) universe
|
||||||
|
|
|
@ -207,8 +207,7 @@ modificationTimeFieldWith :: TimeLocale -- ^ Time output locale
|
||||||
-> Context a -- ^ Resulting context
|
-> Context a -- ^ Resulting context
|
||||||
modificationTimeFieldWith locale key fmt = field key $ \i -> do
|
modificationTimeFieldWith locale key fmt = field key $ \i -> do
|
||||||
provider <- compilerProvider <$> compilerAsk
|
provider <- compilerProvider <$> compilerAsk
|
||||||
mtime <- compilerUnsafeIO $
|
let mtime = resourceModificationTime provider $ itemIdentifier i
|
||||||
resourceModificationTime provider $ itemIdentifier i
|
|
||||||
return $ formatTime locale fmt mtime
|
return $ formatTime locale fmt mtime
|
||||||
|
|
||||||
|
|
||||||
|
|
|
@ -37,3 +37,4 @@ case01 = do
|
||||||
|
|
||||||
doesntExist <- resourceMetadata provider "doesntexist.md"
|
doesntExist <- resourceMetadata provider "doesntexist.md"
|
||||||
M.empty @=? doesntExist
|
M.empty @=? doesntExist
|
||||||
|
cleanTestEnv
|
||||||
|
|
|
@ -51,6 +51,7 @@ rulesTest = do
|
||||||
Just "example.mv1" @=? runRoutes routes (sv "mv1" "example.md")
|
Just "example.mv1" @=? runRoutes routes (sv "mv1" "example.md")
|
||||||
Just "example.mv2" @=? runRoutes routes (sv "mv2" "example.md")
|
Just "example.mv2" @=? runRoutes routes (sv "mv2" "example.md")
|
||||||
readIORef ioref >>= assert
|
readIORef ioref >>= assert
|
||||||
|
cleanTestEnv
|
||||||
where
|
where
|
||||||
sv g = setVersion (Just g)
|
sv g = setVersion (Just g)
|
||||||
expected =
|
expected =
|
||||||
|
|
|
@ -67,3 +67,4 @@ wrongType = do
|
||||||
e == typeOf (undefined :: Int) &&
|
e == typeOf (undefined :: Int) &&
|
||||||
t == typeOf (undefined :: String)
|
t == typeOf (undefined :: String)
|
||||||
_ -> False
|
_ -> False
|
||||||
|
cleanTestEnv
|
||||||
|
|
|
@ -44,6 +44,7 @@ case01 = do
|
||||||
pandocCompiler >>= applyTemplate (itemBody tpl) testContext
|
pandocCompiler >>= applyTemplate (itemBody tpl) testContext
|
||||||
|
|
||||||
out @=? itemBody item
|
out @=? itemBody item
|
||||||
|
cleanTestEnv
|
||||||
|
|
||||||
|
|
||||||
--------------------------------------------------------------------------------
|
--------------------------------------------------------------------------------
|
||||||
|
@ -63,6 +64,7 @@ testApplyJoinTemplateList = do
|
||||||
applyJoinTemplateList ", " tpl defaultContext [i1, i2]
|
applyJoinTemplateList ", " tpl defaultContext [i1, i2]
|
||||||
|
|
||||||
str @?= "<b>Hello</b>, <b>World</b>"
|
str @?= "<b>Hello</b>, <b>World</b>"
|
||||||
|
cleanTestEnv
|
||||||
where
|
where
|
||||||
i1 = Item "item1" "Hello"
|
i1 = Item "item1" "Hello"
|
||||||
i2 = Item "item2" "World"
|
i2 = Item "item2" "World"
|
||||||
|
|
Loading…
Reference in a new issue