diff --git a/hakyll.cabal b/hakyll.cabal --- a/hakyll.cabal +++ b/hakyll.cabal @@ -1,5 +1,5 @@ Name: hakyll -Version: 3.4.2.1 +Version: 3.5.0.0 Synopsis: A static website compiler library Description: @@ -65,7 +65,7 @@ Build-Depends: base >= 4 && < 5, - binary >= 0.5 && < 0.6, + binary >= 0.5 && < 0.7, blaze-html >= 0.5 && < 0.6, blaze-markup >= 0.5.1 && < 0.6, bytestring >= 0.9 && < 0.11, @@ -167,13 +167,13 @@ Build-Depends: HUnit >= 1.2 && < 1.3, - QuickCheck >= 2.4 && < 2.5, + QuickCheck >= 2.4 && < 2.6, test-framework >= 0.4 && < 0.7, test-framework-hunit >= 0.2 && < 0.3, test-framework-quickcheck2 >= 0.2 && < 0.3, -- Copy pasted from hakyll dependencies: base >= 4 && < 5, - binary >= 0.5 && < 0.6, + binary >= 0.5 && < 0.7, blaze-html >= 0.5 && < 0.6, blaze-markup >= 0.5.1 && < 0.6, bytestring >= 0.9 && < 0.11, diff --git a/src/Hakyll/Core/Compiler.hs b/src/Hakyll/Core/Compiler.hs --- a/src/Hakyll/Core/Compiler.hs +++ b/src/Hakyll/Core/Compiler.hs @@ -60,7 +60,7 @@ -- Let's look at it in detail: -- -- > (Binary a, Typeable a, Writable a) --- +-- -- These are constraints for the @a@ type. @a@ (the template) needs to have -- certain properties for it to be required. -- @@ -138,10 +138,11 @@ import Hakyll.Core.Resource import Hakyll.Core.Resource.Provider import Hakyll.Core.Compiler.Internal -import Hakyll.Core.Store +import Hakyll.Core.Store (Store) import Hakyll.Core.Rules.Internal import Hakyll.Core.Routes import Hakyll.Core.Logger +import qualified Hakyll.Core.Store as Store -- | Run a compiler, yielding the resulting target and it's dependencies. This -- version of 'runCompilerJob' also stores the result @@ -167,8 +168,7 @@ -- before we return control. This makes sure the compiled item can later -- be accessed by e.g. require. Right (CompileRule (CompiledItem x)) -> - storeSet store "Hakyll.Core.Compiler.runCompiler" - (castIdentifier id') x + Store.set store ["Hakyll.Core.Compiler.runCompiler", show id'] x -- Otherwise, we do nothing here _ -> return () @@ -227,12 +227,13 @@ getDependency :: (Binary a, Writable a, Typeable a) => Identifier a -> CompilerM a getDependency id' = CompilerM $ do - store <- compilerStore <$> ask - result <- liftIO $ storeGet store "Hakyll.Core.Compiler.runCompiler" id' + store <- compilerStore <$> ask + result <- liftIO $ + Store.get store ["Hakyll.Core.Compiler.runCompiler", show id'] case result of - NotFound -> throwError notFound - WrongType e r -> throwError $ wrongType e r - Found x -> return x + Store.NotFound -> throwError notFound + Store.WrongType e r -> throwError $ wrongType e r + Store.Found x -> return x where notFound = "Hakyll.Core.Compiler.getDependency: " ++ show id' ++ " was " ++ @@ -310,11 +311,11 @@ report logger $ "Checking cache: " ++ if modified then "modified" else "OK" if modified then do v <- unCompilerM $ j $ fromIdentifier identifier - liftIO $ storeSet store name identifier v + liftIO $ Store.set store [name, show identifier] v return v - else do v <- liftIO $ storeGet store name identifier - case v of Found v' -> return v' - _ -> throwError (error' progName) + else do v <- liftIO $ Store.get store [name, show identifier] + case v of Store.Found v' -> return v' + _ -> throwError (error' progName) where error' progName = "Hakyll.Core.Compiler.cached: Cache corrupt! " ++ diff --git a/src/Hakyll/Core/Resource/Provider.hs b/src/Hakyll/Core/Resource/Provider.hs --- a/src/Hakyll/Core/Resource/Provider.hs +++ b/src/Hakyll/Core/Resource/Provider.hs @@ -1,3 +1,4 @@ +-------------------------------------------------------------------------------- -- | This module provides an API for resource providers. Resource providers -- allow Hakyll to get content from resources; the type of resource depends on -- the concrete instance. @@ -19,22 +20,30 @@ , resourceModified ) where + +-------------------------------------------------------------------------------- import Control.Applicative ((<$>)) import Control.Concurrent (MVar, readMVar, modifyMVar_, newMVar) import Data.Map (Map) import qualified Data.Map as M import qualified Data.Set as S + +-------------------------------------------------------------------------------- import Data.Time (UTCTime) import qualified Crypto.Hash.MD5 as MD5 import qualified Data.ByteString as B import qualified Data.ByteString.Lazy as LB -import Hakyll.Core.Store + +-------------------------------------------------------------------------------- +import Hakyll.Core.Store (Store) import Hakyll.Core.Resource +import qualified Hakyll.Core.Store as Store + +-------------------------------------------------------------------------------- -- | A value responsible for retrieving and listing resources --- data ResourceProvider = ResourceProvider { -- | A set of all resources this provider is able to provide resourceSet :: S.Set Resource @@ -48,8 +57,9 @@ resourceModifiedCache :: MVar (Map Resource Bool) } + +-------------------------------------------------------------------------------- -- | Create a resource provider --- makeResourceProvider :: [Resource] -- ^ Resource list -> (Resource -> IO String) -- ^ String reader -> (Resource -> IO LB.ByteString) -- ^ ByteString reader @@ -58,22 +68,27 @@ makeResourceProvider l s b t = ResourceProvider (S.fromList l) s b t <$> newMVar M.empty + +-------------------------------------------------------------------------------- -- | Get the list of all resources resourceList :: ResourceProvider -> [Resource] resourceList = S.toList . resourceSet + +-------------------------------------------------------------------------------- -- | Check if a given identifier has a resource --- resourceExists :: ResourceProvider -> Resource -> Bool resourceExists provider = flip S.member $ resourceSet provider + +-------------------------------------------------------------------------------- -- | Retrieve a digest for a given resource --- resourceDigest :: ResourceProvider -> Resource -> IO B.ByteString resourceDigest provider = fmap MD5.hashlazy . resourceLBS provider + +-------------------------------------------------------------------------------- -- | Check if a resource was modified --- resourceModified :: ResourceProvider -> Store -> Resource -> IO Bool resourceModified provider store r = do cache <- readMVar mvar @@ -90,21 +105,21 @@ where mvar = resourceModifiedCache provider + +-------------------------------------------------------------------------------- -- | Check if a resource digest was modified --- digestModified :: ResourceProvider -> Store -> Resource -> IO Bool digestModified provider store r = do -- Get the latest seen digest from the store - lastDigest <- storeGet store itemName identifier + lastDigest <- Store.get store key -- Calculate the digest for the resource newDigest <- resourceDigest provider r -- Check digests - if Found newDigest == lastDigest + if Store.Found newDigest == lastDigest -- All is fine, not modified then return False -- Resource modified; store new digest - else do storeSet store itemName identifier newDigest + else do Store.set store key newDigest return True where - identifier = toIdentifier r - itemName = "Hakyll.Core.ResourceProvider.digestModified" + key = ["Hakyll.Core.ResourceProvider.digestModified", unResource r] diff --git a/src/Hakyll/Core/Resource/Provider/File.hs b/src/Hakyll/Core/Resource/Provider/File.hs --- a/src/Hakyll/Core/Resource/Provider/File.hs +++ b/src/Hakyll/Core/Resource/Provider/File.hs @@ -1,5 +1,6 @@ -- | A concrete 'ResourceProvider' that gets it's resources from the filesystem -- +{-# LANGUAGE CPP #-} module Hakyll.Core.Resource.Provider.File ( fileResourceProvider ) where @@ -29,6 +30,10 @@ (mtime . unResource) where mtime r = do +#if MIN_VERSION_directory(1,2,0) + getModificationTime r +#else ct <- toCalendarTime =<< getModificationTime r let str = formatCalendarTime defaultTimeLocale "%s" ct return $ readTime defaultTimeLocale "%s" str +#endif diff --git a/src/Hakyll/Core/Run.hs b/src/Hakyll/Core/Run.hs --- a/src/Hakyll/Core/Run.hs +++ b/src/Hakyll/Core/Run.hs @@ -30,9 +30,10 @@ import Hakyll.Core.Resource.Provider.File import Hakyll.Core.Routes import Hakyll.Core.Rules.Internal -import Hakyll.Core.Store +import Hakyll.Core.Store (Store) import Hakyll.Core.Util.File import Hakyll.Core.Writable +import qualified Hakyll.Core.Store as Store -- | Run all rules needed, return the rule set used -- @@ -42,15 +43,15 @@ section logger "Initialising" store <- timed logger "Creating store" $ - makeStore (inMemoryCache configuration) $ storeDirectory configuration + Store.new (inMemoryCache configuration) $ storeDirectory configuration provider <- timed logger "Creating provider" $ fileResourceProvider configuration -- Fetch the old graph from the store. If we don't find it, we consider this -- to be the first run - graph <- storeGet store "Hakyll.Core.Run.run" "dependencies" - let (firstRun, oldGraph) = case graph of Found g -> (False, g) - _ -> (True, mempty) + graph <- Store.get store ["Hakyll.Core.Run.run", "dependencies"] + let (firstRun, oldGraph) = case graph of Store.Found g -> (False, g) + _ -> (True, mempty) let ruleSet = runRules rules provider compilers = rulesCompilers ruleSet @@ -77,7 +78,7 @@ thrown logger e Right ((), state') -> -- We want to save the final dependency graph for the next run - storeSet store "Hakyll.Core.Run.run" "dependencies" $ + Store.set store ["Hakyll.Core.Run.run", "dependencies"] $ analyzerGraph $ hakyllAnalyzer state' -- Flush and return diff --git a/src/Hakyll/Core/Store.hs b/src/Hakyll/Core/Store.hs --- a/src/Hakyll/Core/Store.hs +++ b/src/Hakyll/Core/Store.hs @@ -1,111 +1,120 @@ --- | A store for stroing and retreiving items --- -{-# LANGUAGE ExistentialQuantification, ScopedTypeVariables #-} +-------------------------------------------------------------------------------- +-- | A store for storing and retreiving items +{-# LANGUAGE ExistentialQuantification #-} +{-# LANGUAGE ScopedTypeVariables #-} module Hakyll.Core.Store ( Store - , StoreGet (..) - , makeStore - , storeSet - , storeGet + , Result (..) + , new + , set + , get + , delete ) where -import Control.Applicative ((<$>)) -import System.FilePath (()) -import System.Directory (doesFileExist) -import Data.Maybe (fromMaybe) -import Data.Binary (Binary, encodeFile, decodeFile) -import Data.Typeable (Typeable, TypeRep, cast, typeOf) +-------------------------------------------------------------------------------- +import Control.Applicative ((<$>)) +import Control.Exception (IOException, handle) +import qualified Crypto.Hash.MD5 as MD5 +import Data.Binary (Binary, decodeFile, encodeFile) +import qualified Data.ByteString as B +import qualified Data.Cache.LRU.IO as Lru +import Data.List (intercalate) +import qualified Data.Text as T +import qualified Data.Text.Encoding as T +import Data.Typeable (TypeRep, Typeable, cast, typeOf) +import System.Directory (createDirectoryIfMissing) +import System.Directory (doesFileExist, removeFile) +import System.FilePath (()) +import Text.Printf (printf) -import Hakyll.Core.Identifier -import Hakyll.Core.Util.File -import qualified Data.Cache.LRU.IO as LRU --- | Items we can store --- -data Storable = forall a. (Binary a, Typeable a) => Storable a +-------------------------------------------------------------------------------- +-- | Simple wrapper type +data Box = forall a. Typeable a => Box a --- | Result when an item from the store --- -data StoreGet a = Found a - | NotFound - | WrongType TypeRep TypeRep - deriving (Show, Eq) --- | Data structure used for the store --- +-------------------------------------------------------------------------------- data Store = Store { -- | All items are stored on the filesystem storeDirectory :: FilePath - , -- | And some items are also kept in-memory - storeLRU :: Maybe (LRU.AtomicLRU FilePath Storable) + , -- | Optionally, items are also kept in-memory + storeMap :: Maybe (Lru.AtomicLRU FilePath Box) } --- | The size of the in-memory cache to use in items. -storeLRUSize :: Maybe Integer -storeLRUSize = Just 500 +-------------------------------------------------------------------------------- +-- | Result of a store query +data Result a + = Found a -- ^ Found, result + | NotFound -- ^ Not found + | WrongType TypeRep TypeRep -- ^ Expected, true type + deriving (Show, Eq) + + +-------------------------------------------------------------------------------- -- | Initialize the store --- -makeStore :: Bool -- ^ Use in-memory caching - -> FilePath -- ^ Directory to use for hard disk storage - -> IO Store -- ^ Store -makeStore inMemory directory = do - lru <- if inMemory - then Just <$> LRU.newAtomicLRU storeLRUSize - else return Nothing +new :: Bool -- ^ Use in-memory caching + -> FilePath -- ^ Directory to use for hard disk storage + -> IO Store -- ^ Store +new inMemory directory = do + createDirectoryIfMissing True directory + ref <- if inMemory then Just <$> Lru.newAtomicLRU csize else return Nothing return Store { storeDirectory = directory - , storeLRU = lru + , storeMap = ref } + where + csize = Just 500 --- | Auxiliary: add an item to the map --- -cacheInsert :: (Binary a, Typeable a) => Store -> FilePath -> a -> IO () -cacheInsert (Store _ Nothing) _ _ = return () -cacheInsert (Store _ (Just lru)) path value = - LRU.insert path (Storable value) lru --- | Auxiliary: get an item from the cache --- -cacheLookup :: forall a. (Binary a, Typeable a) - => Store -> FilePath -> IO (StoreGet a) -cacheLookup (Store _ Nothing) _ = return NotFound -cacheLookup (Store _ (Just lru)) path = do - res <- LRU.lookup path lru - case res of - Nothing -> return NotFound - Just (Storable s) -> return $ case cast s of - Nothing -> WrongType (typeOf s) $ typeOf (undefined :: a) - Just s' -> Found s' +-------------------------------------------------------------------------------- +-- | Auxiliary: add an item to the in-memory cache +cacheInsert :: Typeable a => Store -> String -> a -> IO () +cacheInsert (Store _ Nothing) _ _ = return () +cacheInsert (Store _ (Just lru)) key x = + Lru.insert key (Box x) lru --- | Create a path --- -makePath :: Store -> String -> Identifier a -> FilePath -makePath store name identifier = storeDirectory store name - group toFilePath identifier "hakyllstore" - where - group = fromMaybe "" $ identifierGroup identifier +-------------------------------------------------------------------------------- +-- | Auxiliary: get an item from the in-memory cache +cacheLookup :: forall a. Typeable a => Store -> String -> IO (Result a) +cacheLookup (Store _ Nothing) _ = return NotFound +cacheLookup (Store _ (Just lru)) key = do + res <- Lru.lookup key lru + return $ case res of + Nothing -> NotFound + Just (Box x) -> case cast x of + Just x' -> Found x' + Nothing -> WrongType (typeOf (undefined :: a)) (typeOf x) + + +-------------------------------------------------------------------------------- +-- | Auxiliary: delete an item from the in-memory cache +cacheDelete :: Store -> String -> IO () +cacheDelete (Store _ Nothing) _ = return () +cacheDelete (Store _ (Just lru)) key = do + _ <- Lru.delete key lru + return () + + +-------------------------------------------------------------------------------- -- | Store an item --- -storeSet :: (Binary a, Typeable a) - => Store -> String -> Identifier a -> a -> IO () -storeSet store name identifier value = do - makeDirectories path - encodeFile path value - cacheInsert store path value +set :: (Binary a, Typeable a) => Store -> [String] -> a -> IO () +set store identifier value = do + encodeFile (storeDirectory store key) value + cacheInsert store key value where - path = makePath store name identifier + key = hash identifier + +-------------------------------------------------------------------------------- -- | Load an item --- -storeGet :: (Binary a, Typeable a) - => Store -> String -> Identifier a -> IO (StoreGet a) -storeGet store name identifier = do +get :: (Binary a, Typeable a) => Store -> [String] -> IO (Result a) +get store identifier = do -- First check the in-memory map - mv <- cacheLookup store path - case mv of + ref <- cacheLookup store key + case ref of -- Not found in the map, try the filesystem NotFound -> do exists <- doesFileExist path @@ -113,10 +122,34 @@ -- Not found in the filesystem either then return NotFound -- Found in the filesystem - else do v <- decodeFile path - cacheInsert store path v - return $ Found v - -- Found in the in-memory map, just return + else do + v <- decodeFile path + cacheInsert store key v + return $ Found v + -- Found in the in-memory map (or wrong type), just return s -> return s where - path = makePath store name identifier + key = hash identifier + path = storeDirectory store key + + +-------------------------------------------------------------------------------- +-- | Delete an item +delete :: Store -> [String] -> IO () +delete store identifier = do + cacheDelete store key + deleteFile $ storeDirectory store key + where + key = hash identifier + + +-------------------------------------------------------------------------------- +hash :: [String] -> String +hash = concatMap (printf "%02x") . B.unpack . + MD5.hash . T.encodeUtf8 . T.pack . intercalate "/" + + +-------------------------------------------------------------------------------- +-- | Delete a file unless it doesn't exist... +deleteFile :: FilePath -> IO () +deleteFile = handle (\(_ :: IOException) -> return ()) . removeFile diff --git a/src/Hakyll/Core/Util/File.hs b/src/Hakyll/Core/Util/File.hs --- a/src/Hakyll/Core/Util/File.hs +++ b/src/Hakyll/Core/Util/File.hs @@ -3,16 +3,13 @@ module Hakyll.Core.Util.File ( makeDirectories , getRecursiveContents - , isFileObsolete , isFileInternal ) where import Control.Applicative ((<$>)) -import System.Time (ClockTime) -import Control.Monad (forM, filterM) +import Control.Monad (forM) import Data.List (isPrefixOf) import System.Directory ( createDirectoryIfMissing, doesDirectoryExist - , doesFileExist, getModificationTime , getDirectoryContents ) import System.FilePath ( normalise, takeDirectory, splitPath @@ -48,32 +45,6 @@ else concat paths where isProper = (`notElem` [".", ".."]) - --- | Check if a timestamp is obsolete compared to the timestamps of a number of --- files. When they are no files, it is never obsolete. --- -isObsolete :: ClockTime -- ^ The time to check. - -> [FilePath] -- ^ Dependencies of the cached file. - -> IO Bool -isObsolete _ [] = return False -isObsolete timeStamp depends = do - depends' <- filterM doesFileExist depends - dependsModified <- mapM getModificationTime depends' - return (timeStamp < maximum dependsModified) - --- | Check if a file is obsolete, given it's dependencies. When the file does --- not exist, it is always obsolete. Other wise, it is obsolete if any of it's --- dependencies has a more recent modification time than the file. --- -isFileObsolete :: FilePath -- ^ The cached file - -> [FilePath] -- ^ Dependencies of the cached file - -> IO Bool -isFileObsolete file depends = do - exists <- doesFileExist file - if not exists - then return True - else do timeStamp <- getModificationTime file - isObsolete timeStamp depends -- | Check if a file is meant for Hakyll internal use, i.e. if it is located in -- the destination or store directory diff --git a/src/Hakyll/Web/Page/Metadata.hs b/src/Hakyll/Web/Page/Metadata.hs --- a/src/Hakyll/Web/Page/Metadata.hs +++ b/src/Hakyll/Web/Page/Metadata.hs @@ -172,17 +172,23 @@ getUTCMaybe :: TimeLocale -- ^ Output time locale -> Page a -- ^ Input page -> Maybe UTCTime -- ^ Parsed UTCTime -getUTCMaybe locale page = msum - [ fromPublished "%a, %d %b %Y %H:%M:%S UT" - , fromPublished "%Y-%m-%dT%H:%M:%SZ" - , fromPublished "%B %e, %Y %l:%M %p" - , fromPublished "%B %e, %Y" - , getFieldMaybe "path" page >>= parseTime' "%Y-%m-%d" . +getUTCMaybe locale page = msum $ + [fromField "published" fmt | fmt <- formats] ++ + [fromField "date" fmt | fmt <- formats] ++ + [ getFieldMaybe "path" page >>= parseTime' "%Y-%m-%d" . intercalate "-" . take 3 . splitAll "-" . takeFileName ] where - fromPublished f = getFieldMaybe "published" page >>= parseTime' f parseTime' f str = parseTime locale f str + fromField k fmt = getFieldMaybe k page >>= parseTime' fmt + + formats = + [ "%a, %d %b %Y %H:%M:%S UT" + , "%Y-%m-%dT%H:%M:%SZ" + , "%Y-%m-%d %H:%M:%S" + , "%B %e, %Y %l:%M %p" + , "%B %e, %Y" + ] -- | Set the modification time as a field in the page renderModificationTime :: String diff --git a/src/Hakyll/Web/Preview/Poll.hs b/src/Hakyll/Web/Preview/Poll.hs --- a/src/Hakyll/Web/Preview/Poll.hs +++ b/src/Hakyll/Web/Preview/Poll.hs @@ -1,5 +1,6 @@ -- | Interval-based implementation of preview polling -- +{-# LANGUAGE CPP #-} module Hakyll.Web.Preview.Poll ( previewPoll ) where @@ -7,7 +8,11 @@ import Control.Applicative ((<$>)) import Control.Concurrent (threadDelay) import Control.Monad (filterM) +#if MIN_VERSION_directory(1,2,0) +import Data.Time (getCurrentTime) +#else import System.Time (getClockTime) +#endif import System.Directory (getModificationTime, doesFileExist) import Hakyll.Core.Configuration @@ -18,7 +23,11 @@ -> IO [FilePath] -- ^ Updating action -> IO () -- ^ Can block forever previewPoll _ update = do +#if MIN_VERSION_directory(1,2,0) + time <- getCurrentTime +#else time <- getClockTime +#endif loop time =<< update where delay = 1000000 diff --git a/tests/Hakyll/Core/Store/Tests.hs b/tests/Hakyll/Core/Store/Tests.hs --- a/tests/Hakyll/Core/Store/Tests.hs +++ b/tests/Hakyll/Core/Store/Tests.hs @@ -1,67 +1,68 @@ +-------------------------------------------------------------------------------- {-# LANGUAGE OverloadedStrings #-} module Hakyll.Core.Store.Tests ( tests ) where -import Control.Applicative ((<$>)) -import Control.Monad (replicateM) -import Test.Framework -import Test.Framework.Providers.QuickCheck2 -import Test.Framework.Providers.HUnit -import Test.QuickCheck -import Test.QuickCheck.Monadic -import qualified Test.HUnit as H +-------------------------------------------------------------------------------- +import Data.Typeable (typeOf) +import Test.Framework +import Test.Framework.Providers.HUnit +import Test.Framework.Providers.QuickCheck2 +import qualified Test.HUnit as H +import Test.QuickCheck +import Test.QuickCheck.Monadic -import Hakyll.Core.Identifier -import Hakyll.Core.Store -import TestSuite.Util +-------------------------------------------------------------------------------- +import qualified Hakyll.Core.Store as Store +import TestSuite.Util + + +-------------------------------------------------------------------------------- tests :: [Test] tests = - [ testProperty "simple storeGet . storeSet" simpleSetGet - , testProperty "persistent storeGet . storeSet" persistentSetGet - , testCase "WrongType storeGet . storeSet" wrongType + [ testProperty "simple get . set" simpleSetGet + , testProperty "persistent get . set" persistentSetGet + , testCase "WrongType get . set" wrongType ] + +-------------------------------------------------------------------------------- simpleSetGet :: Property simpleSetGet = monadicIO $ do - identifier <- parseIdentifier . unFileName <$> pick arbitrary - FileName name <- pick arbitrary + key <- pick arbitrary value <- pick arbitrary store <- run $ makeStoreTest - run $ storeSet store name identifier (value :: String) - value' <- run $ storeGet store name identifier - assert $ Found value == value' + run $ Store.set store key (value :: String) + value' <- run $ Store.get store key + assert $ Store.Found value == value' + +-------------------------------------------------------------------------------- persistentSetGet :: Property persistentSetGet = monadicIO $ do - identifier <- parseIdentifier . unFileName <$> pick arbitrary - FileName name <- pick arbitrary - value <- pick arbitrary + key <- pick arbitrary + value <- pick arbitrary store1 <- run $ makeStoreTest - run $ storeSet store1 name identifier (value :: String) + run $ Store.set store1 key (value :: String) -- Now Create another store from the same dir to test persistence store2 <- run $ makeStoreTest - value' <- run $ storeGet store2 name identifier - assert $ Found value == value' + value' <- run $ Store.get store2 key + assert $ Store.Found value == value' + +-------------------------------------------------------------------------------- wrongType :: H.Assertion wrongType = do store <- makeStoreTest -- Store a string and try to fetch an int - storeSet store "foo" "bar" ("qux" :: String) - value <- storeGet store "foo" "bar" :: IO (StoreGet Int) - H.assert $ case value of WrongType _ _ -> True - _ -> False - -newtype FileName = FileName {unFileName :: String} - deriving (Show) - -instance Arbitrary FileName where - arbitrary = do - length' <- choose (5, 100) - str <- replicateM length' $ elements cs - return $ FileName str - where - cs = ['a' .. 'z'] ++ ['A' .. 'Z'] ++ ['0' .. '9'] ++ ".- " + Store.set store ["foo", "bar"] ("qux" :: String) + value <- Store.get store ["foo", "bar"] :: IO (Store.Result Int) + print value + H.assert $ case value of + Store.WrongType e t -> + e == typeOf (undefined :: Int) && + t == typeOf (undefined :: String) + _ -> False diff --git a/tests/Hakyll/Web/Page/Metadata/Tests.hs b/tests/Hakyll/Web/Page/Metadata/Tests.hs --- a/tests/Hakyll/Web/Page/Metadata/Tests.hs +++ b/tests/Hakyll/Web/Page/Metadata/Tests.hs @@ -54,6 +54,9 @@ [ ("path", "/posts/2010-01-31-a-post.mkdwn") , ("published", "February 20, 2000 1:00 PM") ] + , (@=?) "October 22, 2012" $ getField "date" $ renderDateField + "date" "%B %e, %Y" "Date unknown" $ Page + (M.singleton "date" "2012-10-22 14:35:24") "" ] , fromAssertions "copyBodyToField" diff --git a/tests/TestSuite/Util.hs b/tests/TestSuite/Util.hs --- a/tests/TestSuite/Util.hs +++ b/tests/TestSuite/Util.hs @@ -16,7 +16,8 @@ import Hakyll.Core.Identifier import Hakyll.Core.Logger import Hakyll.Core.Resource.Provider -import Hakyll.Core.Store +import Hakyll.Core.Store (Store) +import qualified Hakyll.Core.Store as Store fromAssertions :: String -- ^ Name -> [Assertion] -- ^ Cases @@ -28,7 +29,7 @@ -- | Create a store for testing -- makeStoreTest :: IO Store -makeStoreTest = makeStore True "_store" +makeStoreTest = Store.new True "_store" -- | Testing for 'runCompilerJob' --