diff options
Diffstat (limited to 'src/Hakyll')
21 files changed, 183 insertions, 365 deletions
diff --git a/src/Hakyll/Core/Compiler.hs b/src/Hakyll/Core/Compiler.hs index 92fcff8..e1eab79 100644 --- a/src/Hakyll/Core/Compiler.hs +++ b/src/Hakyll/Core/Compiler.hs @@ -93,7 +93,6 @@ module Hakyll.Core.Compiler ( Compiler , runCompiler , getIdentifier - , getResource , getRoute , getRouteFor , getResourceString @@ -135,8 +134,7 @@ import Hakyll.Core.Identifier import Hakyll.Core.Identifier.Pattern import Hakyll.Core.CompiledItem import Hakyll.Core.Writable -import Hakyll.Core.Resource -import Hakyll.Core.Resource.Provider +import Hakyll.Core.ResourceProvider import Hakyll.Core.Compiler.Internal import Hakyll.Core.Store (Store) import Hakyll.Core.Rules.Internal @@ -181,11 +179,6 @@ getIdentifier :: Compiler a (Identifier b) getIdentifier = fromJob $ const $ CompilerM $ castIdentifier . compilerIdentifier <$> ask --- | Get the resource that is currently being compiled --- -getResource :: Compiler a Resource -getResource = getIdentifier >>> arr fromIdentifier - -- | Get the route we are using for this item -- getRoute :: Compiler a (Maybe FilePath) @@ -200,22 +193,23 @@ getRouteFor = fromJob $ \identifier -> CompilerM $ do -- | Get the resource we are compiling as a string -- -getResourceString :: Compiler Resource String +getResourceString :: Compiler a String getResourceString = getResourceWith resourceString -- | Get the resource we are compiling as a lazy bytestring -- -getResourceLBS :: Compiler Resource ByteString +getResourceLBS :: Compiler a ByteString getResourceLBS = getResourceWith resourceLBS -- | Overloadable function for 'getResourceString' and 'getResourceLBS' -- -getResourceWith :: (Resource -> IO a) -> Compiler Resource a -getResourceWith reader = fromJob $ \r -> CompilerM $ do - let filePath = unResource r +getResourceWith :: (Identifier a -> IO b) -> Compiler c b +getResourceWith reader = fromJob $ \_ -> CompilerM $ do provider <- compilerResourceProvider <$> ask + r <- compilerIdentifier <$> ask + let filePath = toFilePath r if resourceExists provider r - then liftIO $ reader r + then liftIO $ reader $ castIdentifier r else throwError $ error' filePath where error' id' = "Hakyll.Core.Compiler.getResourceWith: resource " @@ -299,17 +293,17 @@ requireAllA pattern = (id &&& requireAll_ pattern >>>) cached :: (Binary a, Typeable a, Writable a) => String - -> Compiler Resource a - -> Compiler Resource a + -> Compiler () a + -> Compiler () a cached name (Compiler d j) = Compiler d $ const $ CompilerM $ do - logger <- compilerLogger <$> ask + logger <- compilerLogger <$> ask identifier <- castIdentifier . compilerIdentifier <$> ask - store <- compilerStore <$> ask - modified <- compilerResourceModified <$> ask - progName <- liftIO getProgName + store <- compilerStore <$> ask + modified <- compilerResourceModified <$> ask + progName <- liftIO getProgName report logger $ "Checking cache: " ++ if modified then "modified" else "OK" if modified - then do v <- unCompilerM $ j $ fromIdentifier identifier + then do v <- unCompilerM $ j () liftIO $ Store.set store [name, show identifier] v return v else do v <- liftIO $ Store.get store [name, show identifier] diff --git a/src/Hakyll/Core/Compiler/Internal.hs b/src/Hakyll/Core/Compiler/Internal.hs index 8ed822d..a8c0989 100644 --- a/src/Hakyll/Core/Compiler/Internal.hs +++ b/src/Hakyll/Core/Compiler/Internal.hs @@ -26,7 +26,7 @@ import Control.Category (Category, (.), id) import Control.Arrow (Arrow, ArrowChoice, arr, first, left) import Hakyll.Core.Identifier -import Hakyll.Core.Resource.Provider +import Hakyll.Core.ResourceProvider import Hakyll.Core.Store import Hakyll.Core.Routes import Hakyll.Core.Logger diff --git a/src/Hakyll/Core/Identifier.hs b/src/Hakyll/Core/Identifier.hs index 90f0eea..d7bb8c6 100644 --- a/src/Hakyll/Core/Identifier.hs +++ b/src/Hakyll/Core/Identifier.hs @@ -34,6 +34,7 @@ module Hakyll.Core.Identifier ( Identifier (..) , castIdentifier , parseIdentifier + , fromFilePath , toFilePath , setGroup ) where @@ -77,16 +78,24 @@ castIdentifier :: Identifier a -> Identifier b castIdentifier (Identifier g p) = Identifier g p {-# INLINE castIdentifier #-} + +-------------------------------------------------------------------------------- -- | Parse an identifier from a string --- parseIdentifier :: String -> Identifier a -parseIdentifier = Identifier Nothing - . intercalate "/" . filter (not . null) . split' +parseIdentifier = Identifier Nothing . + intercalate "/" . filter (not . null) . split' where split' = map dropTrailingPathSeparator . splitPath + +-------------------------------------------------------------------------------- +-- | Create an identifier from a filepath +fromFilePath :: FilePath -> Identifier a +fromFilePath = parseIdentifier + + +-------------------------------------------------------------------------------- -- | Convert an identifier to a relative 'FilePath' --- toFilePath :: Identifier a -> FilePath toFilePath = identifierPath diff --git a/src/Hakyll/Core/Metadata.hs b/src/Hakyll/Core/Metadata.hs new file mode 100644 index 0000000..79922e1 --- /dev/null +++ b/src/Hakyll/Core/Metadata.hs @@ -0,0 +1,24 @@ +-------------------------------------------------------------------------------- +module Hakyll.Core.Metadata + ( Metadata + , MonadMetadata (..) + ) where + + +-------------------------------------------------------------------------------- +import Data.Map (Map) + + +-------------------------------------------------------------------------------- +import Hakyll.Core.Identifier + + +-------------------------------------------------------------------------------- +type Metadata = Map String String + + +-------------------------------------------------------------------------------- +class MonadMetadata m where + identifierMetadata :: Identifier a -> m Metadata + -- allMetadata :: m [(Resource, Metadata)] + -- patternMetadata :: Pattern a -> m [(Resource, Metadata)] diff --git a/src/Hakyll/Core/Resource.hs b/src/Hakyll/Core/Resource.hs deleted file mode 100644 index 0a43fc2..0000000 --- a/src/Hakyll/Core/Resource.hs +++ /dev/null @@ -1,51 +0,0 @@ --------------------------------------------------------------------------------- --- | Module exporting the simple 'Resource' type -module Hakyll.Core.Resource - ( -- * Constructing and deconstructing resources - Resource - , resource - , unResource - - -- * Conversions to and from identifiers - , fromIdentifier - , toIdentifier - - -- * TODO: Move me - , Metadata - ) where - - --------------------------------------------------------------------------------- -import Data.Map (Map) - - --------------------------------------------------------------------------------- -import Hakyll.Core.Identifier - - --------------------------------------------------------------------------------- --- | A resource -newtype Resource = Resource {unResource :: FilePath} - deriving (Eq, Show, Ord) - - --------------------------------------------------------------------------------- --- | Smart constructor to ensure we have @/@ as path separator -resource :: FilePath -> Resource -resource = fromIdentifier . parseIdentifier - - --------------------------------------------------------------------------------- --- | Find the resource for an identifier -fromIdentifier :: Identifier a -> Resource -fromIdentifier = Resource . toFilePath - - --------------------------------------------------------------------------------- --- | Convert a resource to an identifier -toIdentifier :: Resource -> Identifier a -toIdentifier = parseIdentifier . unResource - - --------------------------------------------------------------------------------- -type Metadata = Map String String diff --git a/src/Hakyll/Core/Resource/Pattern.hs b/src/Hakyll/Core/Resource/Pattern.hs deleted file mode 100644 index c2f1132..0000000 --- a/src/Hakyll/Core/Resource/Pattern.hs +++ /dev/null @@ -1,160 +0,0 @@ --------------------------------------------------------------------------------- --- | Module providing pattern matching and capturing on file names. --- 'Pattern's come in two kinds: --- --- * Simple glob patterns, like @foo\/*@; --- --- * Custom, arbitrary predicates of the type @Identifier -> Bool@. --- --- They both have advantages and disadvantages. By default, globs are used, --- unless you construct your 'Pattern' using the 'predicate' function. --- --- A very simple pattern could be, for example, @foo\/bar@. This pattern will --- only match the exact @foo\/bar@ identifier. --- --- To match more than one identifier, there are different captures that one can --- use: --- --- * @*@: matches at most one element of an identifier; --- --- * @**@: matches one or more elements of an identifier. --- --- Some examples: --- --- * @foo\/*@ will match @foo\/bar@ and @foo\/foo@, but not @foo\/bar\/qux@; --- --- * @**@ will match any identifier; --- --- * @foo\/**@ will match @foo\/bar@ and @foo\/bar\/qux@, but not @bar\/foo@; --- --- * @foo\/*.html@ will match all HTML files in the @foo\/@ directory. --- --- The 'capture' function allows the user to get access to the elements captured --- by the capture elements in the pattern. --- --- Like an 'Identifier', a 'Pattern' also has a type parameter. This is simply --- an extra layer of safety, and can be discarded using the 'castPattern' --- function. -module Hakyll.Core.Resource.Pattern - ( Pattern - , parsePattern - , capture - ) where - - --------------------------------------------------------------------------------- -import Control.Arrow ((&&&), (>>>)) -import Control.Monad (msum) -import Data.List (inits, isPrefixOf, tails) -import GHC.Exts (IsString, fromString) - - --------------------------------------------------------------------------------- -import Hakyll.Core.Resource - - --------------------------------------------------------------------------------- --- | One base element of a pattern -data GlobComponent - = Capture - | CaptureMany - | Literal String - deriving (Eq, Show) - - --------------------------------------------------------------------------------- --- | Type that allows matching on identifiers -newtype Pattern = Pattern [GlobComponent] - deriving (Show) - - --------------------------------------------------------------------------------- -instance IsString Pattern where - fromString = parsePattern - - --------------------------------------------------------------------------------- --- | Parse a pattern from a string -parsePattern :: String -> Pattern -parsePattern = Pattern . parse - where - parse str = - let (chunk, rest) = break (`elem` "\\*") str - in case rest of - ('\\' : x : xs) -> Literal (chunk ++ [x]) : parse xs - ('*' : '*' : xs) -> Literal chunk : CaptureMany : parse xs - ('*' : xs) -> Literal chunk : Capture : parse xs - xs -> Literal chunk : Literal xs : [] - - --------------------------------------------------------------------------------- --- | Split a list at every possible point, generate a list of (init, tail) --- cases. The result is sorted with inits decreasing in length. -splits :: [a] -> [([a], [a])] -splits = inits &&& tails >>> uncurry zip >>> reverse - - --------------------------------------------------------------------------------- --- | Match a glob against a pattern, generating a list of captures -capture :: Pattern -> Resource -> Maybe [String] -capture (Pattern p) rs = capture' p (unResource rs) - - --------------------------------------------------------------------------------- --- | Internal verion of 'capture' -capture' :: [GlobComponent] -> String -> Maybe [String] -capture' [] [] = Just [] -- An empty match -capture' [] _ = Nothing -- No match -capture' (Literal l : ms) str - -- Match the literal against the string - | l `isPrefixOf` str = capture' ms $ drop (length l) str - | otherwise = Nothing -capture' (Capture : ms) str = - -- Match until the next / - let (chunk, rest) = break (== '/') str - in msum $ [ fmap (i :) (capture' ms (t ++ rest)) | (i, t) <- splits chunk ] -capture' (CaptureMany : ms) str = - -- Match everything - msum $ [ fmap (i :) (capture' ms t) | (i, t) <- splits str ] - - --------------------------------------------------------------------------------- --- | Create an identifier from a pattern by filling in the captures with a given --- string --- --- Example: --- --- > fromCapture (parsePattern "tags/*") "foo" --- --- Result: --- --- > "tags/foo" -{- -fromCapture :: Pattern -> String -> Identifier -fromCapture pattern = fromCaptures pattern . repeat --} - - --------------------------------------------------------------------------------- --- | Create an identifier from a pattern by filling in the captures with the --- given list of strings --- -{- -fromCaptures :: Pattern -> [String] -> String -fromCaptures (Pattern p) = fromCaptures' p --} - - --------------------------------------------------------------------------------- --- | Internally used version of 'fromCaptures' -{- -fromCaptures' :: [GlobComponent] -> [String] -> String -fromCaptures' [] _ = mempty -fromCaptures' (m : ms) [] = case m of - Literal l -> l `mappend` fromCaptures' ms [] - _ -> error $ "Hakyll.Core.Identifier.Pattern.fromCaptures': " - ++ "identifier list exhausted" -fromCaptures' (m : ms) ids@(i : is) = case m of - Literal l -> l `mappend` fromCaptures' ms ids - _ -> i `mappend` fromCaptures' ms is --} diff --git a/src/Hakyll/Core/Resource/Provider.hs b/src/Hakyll/Core/ResourceProvider.hs index 8f4c83f..f18d462 100644 --- a/src/Hakyll/Core/Resource/Provider.hs +++ b/src/Hakyll/Core/ResourceProvider.hs @@ -1,7 +1,7 @@ -------------------------------------------------------------------------------- -- | This module provides an wrapper API around the file system which does some -- caching. -module Hakyll.Core.Resource.Provider +module Hakyll.Core.ResourceProvider ( -- * Constructing resource providers ResourceProvider , newResourceProvider @@ -23,15 +23,16 @@ module Hakyll.Core.Resource.Provider -------------------------------------------------------------------------------- -import Hakyll.Core.Resource -import qualified Hakyll.Core.Resource.MetadataCache as Internal -import Hakyll.Core.Resource.Modified -import Hakyll.Core.Resource.Provider.Internal +import Hakyll.Core.Identifier +import Hakyll.Core.Metadata +import Hakyll.Core.ResourceProvider.Internal +import qualified Hakyll.Core.ResourceProvider.MetadataCache as Internal +import Hakyll.Core.ResourceProvider.Modified -------------------------------------------------------------------------------- -- | Wrapper to ensure metadata cache is invalidated if necessary -resourceMetadata :: ResourceProvider -> Resource -> IO Metadata +resourceMetadata :: ResourceProvider -> Identifier a -> IO Metadata resourceMetadata rp r = do _ <- resourceModified rp r Internal.resourceMetadata rp r @@ -39,7 +40,7 @@ resourceMetadata rp r = do -------------------------------------------------------------------------------- -- | Wrapper to ensure metadata cache is invalidated if necessary -resourceBody :: ResourceProvider -> Resource -> IO String +resourceBody :: ResourceProvider -> Identifier a -> IO String resourceBody rp r = do _ <- resourceModified rp r Internal.resourceBody rp r diff --git a/src/Hakyll/Core/Resource/Provider/Internal.hs b/src/Hakyll/Core/ResourceProvider/Internal.hs index fb93fcc..1f8f776 100644 --- a/src/Hakyll/Core/Resource/Provider/Internal.hs +++ b/src/Hakyll/Core/ResourceProvider/Internal.hs @@ -1,5 +1,5 @@ -------------------------------------------------------------------------------- -module Hakyll.Core.Resource.Provider.Internal +module Hakyll.Core.ResourceProvider.Internal ( ResourceProvider (..) , newResourceProvider @@ -24,18 +24,18 @@ import System.FilePath (addExtension) -------------------------------------------------------------------------------- -import Hakyll.Core.Resource import Hakyll.Core.Store import Hakyll.Core.Util.File +import Hakyll.Core.Identifier -------------------------------------------------------------------------------- -- | Responsible for retrieving and listing resources data ResourceProvider = ResourceProvider { -- | A list of all files found - resourceSet :: Set Resource + resourceSet :: Set (Identifier ()) , -- | Cache keeping track of modified files - resourceModifiedCache :: IORef (Map Resource Bool) + resourceModifiedCache :: IORef (Map (Identifier ()) Bool) , -- | Underlying persistent store for caching resourceStore :: Store } @@ -48,37 +48,39 @@ newResourceProvider :: Store -- ^ Store to use -> FilePath -- ^ Search directory -> IO ResourceProvider -- ^ Resulting provider newResourceProvider store ignore directory = do - list <- map resource . filter (not . ignore) <$> + list <- map parseIdentifier . filter (not . ignore) <$> getRecursiveContents False directory cache <- newIORef M.empty return $ ResourceProvider (S.fromList list) cache store -------------------------------------------------------------------------------- -resourceList :: ResourceProvider -> [Resource] +resourceList :: ResourceProvider -> [Identifier ()] resourceList = S.toList . resourceSet -------------------------------------------------------------------------------- -- | Check if a given resiyrce exists -resourceExists :: ResourceProvider -> Resource -> Bool -resourceExists provider = (`S.member` resourceSet provider) +resourceExists :: ResourceProvider -> Identifier a -> Bool +resourceExists provider = + (`S.member` resourceSet provider) . setGroup Nothing . castIdentifier -------------------------------------------------------------------------------- -- | Each resource may have an associated metadata resource (with a @.metadata@ -- filename) -resourceMetadataResource :: Resource -> Resource -resourceMetadataResource = resource . flip addExtension "metadata" . unResource +resourceMetadataResource :: Identifier a -> Identifier () +resourceMetadataResource = + parseIdentifier . flip addExtension "metadata" . toFilePath -------------------------------------------------------------------------------- -- | Get the raw body of a resource as string -resourceString :: Resource -> IO String -resourceString = readFile . unResource +resourceString :: Identifier a -> IO String +resourceString = readFile . toFilePath -------------------------------------------------------------------------------- -- | Get the raw body of a resource of a lazy bytestring -resourceLBS :: Resource -> IO BL.ByteString -resourceLBS = BL.readFile . unResource +resourceLBS :: Identifier a -> IO BL.ByteString +resourceLBS = BL.readFile . toFilePath diff --git a/src/Hakyll/Core/Resource/Metadata.hs b/src/Hakyll/Core/ResourceProvider/Metadata.hs index 44b0721..e297f2c 100644 --- a/src/Hakyll/Core/Resource/Metadata.hs +++ b/src/Hakyll/Core/ResourceProvider/Metadata.hs @@ -1,42 +1,43 @@ -------------------------------------------------------------------------------- -- | Internal module to parse metadata -module Hakyll.Core.Resource.Metadata +module Hakyll.Core.ResourceProvider.Metadata ( loadMetadata ) where -------------------------------------------------------------------------------- -import Control.Applicative ((<$>), (<*), (<*>)) -import Control.Arrow (second) -import qualified Data.ByteString.Char8 as BC -import qualified Data.Map as M -import System.IO as IO -import Text.Parsec ((<?>)) -import qualified Text.Parsec as P -import Text.Parsec.String (Parser) +import Control.Applicative ((<$>), (<*), (<*>)) +import Control.Arrow (second) +import qualified Data.ByteString.Char8 as BC +import qualified Data.Map as M +import System.IO as IO +import Text.Parsec ((<?>)) +import qualified Text.Parsec as P +import Text.Parsec.String (Parser) -------------------------------------------------------------------------------- -import Hakyll.Core.Resource -import Hakyll.Core.Resource.Provider.Internal +import Hakyll.Core.Identifier +import Hakyll.Core.Metadata +import Hakyll.Core.ResourceProvider.Internal import Hakyll.Core.Util.String -------------------------------------------------------------------------------- -loadMetadata :: ResourceProvider -> Resource -> IO (Metadata, Maybe String) -loadMetadata rp r = do +loadMetadata :: ResourceProvider -> Identifier a -> IO (Metadata, Maybe String) +loadMetadata rp identifier = do hasHeader <- probablyHasMetadataHeader fp (md, body) <- if hasHeader then second Just <$> loadMetadataHeader fp else return (M.empty, Nothing) - emd <- if resourceExists rp mr then loadMetadataFile mfp else return M.empty + emd <- if resourceExists rp mi then loadMetadataFile mfp else return M.empty return (M.union md emd, body) where - fp = unResource r - mr = resourceMetadataResource r - mfp = unResource mr + fp = toFilePath identifier + mi = resourceMetadataResource identifier + mfp = toFilePath mi -------------------------------------------------------------------------------- diff --git a/src/Hakyll/Core/Resource/MetadataCache.hs b/src/Hakyll/Core/ResourceProvider/MetadataCache.hs index b459674..85062a0 100644 --- a/src/Hakyll/Core/Resource/MetadataCache.hs +++ b/src/Hakyll/Core/ResourceProvider/MetadataCache.hs @@ -1,5 +1,5 @@ -------------------------------------------------------------------------------- -module Hakyll.Core.Resource.MetadataCache +module Hakyll.Core.ResourceProvider.MetadataCache ( resourceMetadata , resourceBody , resourceInvalidateMetadataCache @@ -7,39 +7,40 @@ module Hakyll.Core.Resource.MetadataCache -------------------------------------------------------------------------------- -import Hakyll.Core.Resource -import Hakyll.Core.Resource.Metadata -import Hakyll.Core.Resource.Provider.Internal -import qualified Hakyll.Core.Store as Store +import Hakyll.Core.Identifier +import Hakyll.Core.Metadata +import Hakyll.Core.ResourceProvider.Internal +import Hakyll.Core.ResourceProvider.Metadata +import qualified Hakyll.Core.Store as Store -------------------------------------------------------------------------------- -resourceMetadata :: ResourceProvider -> Resource -> IO Metadata +resourceMetadata :: ResourceProvider -> Identifier a -> IO Metadata resourceMetadata rp r = do load rp r Store.Found md <- Store.get (resourceStore rp) - [name, unResource r, "metadata"] + [name, toFilePath r, "metadata"] return md -------------------------------------------------------------------------------- -resourceBody :: ResourceProvider -> Resource -> IO String +resourceBody :: ResourceProvider -> Identifier a -> IO String resourceBody rp r = do load rp r Store.Found bd <- Store.get (resourceStore rp) - [name, unResource r, "body"] + [name, toFilePath r, "body"] maybe (resourceString r) return bd -------------------------------------------------------------------------------- -resourceInvalidateMetadataCache :: ResourceProvider -> Resource -> IO () +resourceInvalidateMetadataCache :: ResourceProvider -> Identifier a -> IO () resourceInvalidateMetadataCache rp r = do - Store.delete (resourceStore rp) [name, unResource r, "metadata"] - Store.delete (resourceStore rp) [name, unResource r, "body"] + Store.delete (resourceStore rp) [name, toFilePath r, "metadata"] + Store.delete (resourceStore rp) [name, toFilePath r, "body"] -------------------------------------------------------------------------------- -load :: ResourceProvider -> Resource -> IO () +load :: ResourceProvider -> Identifier a -> IO () load rp r = do mmd <- Store.get store mdk :: IO (Store.Result Metadata) case mmd of @@ -52,8 +53,8 @@ load rp r = do Store.set store bk body where store = resourceStore rp - mdk = [name, unResource r, "metadata"] - bk = [name, unResource r, "body"] + mdk = [name, toFilePath r, "metadata"] + bk = [name, toFilePath r, "body"] -------------------------------------------------------------------------------- diff --git a/src/Hakyll/Core/Resource/Modified.hs b/src/Hakyll/Core/ResourceProvider/Modified.hs index 8492108..837bc8c 100644 --- a/src/Hakyll/Core/Resource/Modified.hs +++ b/src/Hakyll/Core/ResourceProvider/Modified.hs @@ -1,55 +1,56 @@ -------------------------------------------------------------------------------- -module Hakyll.Core.Resource.Modified +module Hakyll.Core.ResourceProvider.Modified ( resourceModified , resourceModificationTime ) where -------------------------------------------------------------------------------- -import Control.Applicative ((<$>), (<*>)) -import Control.Monad (when) -import qualified Crypto.Hash.MD5 as MD5 -import qualified Data.ByteString as B -import qualified Data.ByteString.Lazy as BL +import Control.Applicative ((<$>), (<*>)) +import Control.Monad (when) +import qualified Crypto.Hash.MD5 as MD5 +import qualified Data.ByteString as B +import qualified Data.ByteString.Lazy as BL import Data.IORef -import qualified Data.Map as M -import Data.Time (UTCTime) -import System.Directory (getModificationTime) +import qualified Data.Map as M +import Data.Time (UTCTime) +import System.Directory (getModificationTime) -------------------------------------------------------------------------------- -import Hakyll.Core.Resource -import Hakyll.Core.Resource.MetadataCache -import Hakyll.Core.Resource.Provider.Internal -import Hakyll.Core.Store (Store) -import qualified Hakyll.Core.Store as Store +import Hakyll.Core.Identifier +import Hakyll.Core.ResourceProvider.Internal +import Hakyll.Core.ResourceProvider.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 :: ResourceProvider -> Resource -> IO Bool +resourceModified :: ResourceProvider -> Identifier a -> IO Bool resourceModified rp r | not exists = return False | otherwise = do cache <- readIORef cacheRef - case M.lookup r cache of + 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 <- (||) - <$> fileDigestModified store (unResource r) + <$> fileDigestModified store (toFilePath r) <*> resourceModified rp (resourceMetadataResource r) - modifyIORef cacheRef (M.insert r m) + modifyIORef cacheRef (M.insert normalized m) -- Important! (But ugly) when m $ resourceInvalidateMetadataCache rp r return m where - exists = resourceExists rp r - store = resourceStore rp - cacheRef = resourceModifiedCache rp + normalized = castIdentifier $ setGroup Nothing r + exists = resourceExists rp r + store = resourceStore rp + cacheRef = resourceModifiedCache rp -------------------------------------------------------------------------------- @@ -78,5 +79,5 @@ fileDigest = fmap MD5.hashlazy . BL.readFile -------------------------------------------------------------------------------- -resourceModificationTime :: Resource -> IO UTCTime -resourceModificationTime = getModificationTime . unResource +resourceModificationTime :: Identifier a -> IO UTCTime +resourceModificationTime = getModificationTime . toFilePath diff --git a/src/Hakyll/Core/Rules.hs b/src/Hakyll/Core/Rules.hs index ff68c56..5ac63bc 100644 --- a/src/Hakyll/Core/Rules.hs +++ b/src/Hakyll/Core/Rules.hs @@ -51,11 +51,9 @@ import Hakyll.Core.CompiledItem import Hakyll.Core.Compiler.Internal import Hakyll.Core.Identifier import Hakyll.Core.Identifier.Pattern -import Hakyll.Core.Resource -import Hakyll.Core.Resource.Provider +import Hakyll.Core.ResourceProvider import Hakyll.Core.Routes import Hakyll.Core.Rules.Internal -import Hakyll.Core.Util.Arrow import Hakyll.Core.Writable @@ -80,10 +78,10 @@ tellCompilers compilers = RulesM $ do -------------------------------------------------------------------------------- -- | Add resources -tellResources :: [Resource] +tellResources :: [Identifier a] -> Rules tellResources resources' = RulesM $ tell $ - RuleSet mempty mempty $ S.fromList resources' + RuleSet mempty mempty $ S.fromList $ map castIdentifier resources' -------------------------------------------------------------------------------- @@ -139,13 +137,12 @@ group g = RulesM . local setGroup' . unRulesM -- no resources match the current selection, nothing will happen. In this case, -- you might want to have a look at 'create'. compile :: (Binary a, Typeable a, Writable a) - => Compiler Resource a -> RulesM (Pattern a) + => Compiler () a -> RulesM (Pattern a) compile compiler = do ids <- resources - tellCompilers $ flip map ids $ \identifier -> - (identifier, constA (fromIdentifier identifier) >>> compiler) - tellResources $ map fromIdentifier ids - return $ list ids + tellCompilers [(castIdentifier id', compiler) | id' <- ids] + tellResources ids + return $ list $ map castIdentifier ids -------------------------------------------------------------------------------- @@ -182,14 +179,12 @@ route route' = RulesM $ do -------------------------------------------------------------------------------- -- | Get a list of resources matching the current pattern. This will also set -- the correct group to the identifiers. -resources :: RulesM [Identifier a] +resources :: RulesM [Identifier ()] resources = RulesM $ do - pattern <- rulesPattern <$> ask + pattern <- rulesPattern <$> ask provider <- rulesResourceProvider <$> ask - group' <- rulesGroup <$> ask - return $ filterMatches pattern $ map (toId group') $ resourceList provider - where - toId g = setGroup g . toIdentifier + g <- rulesGroup <$> ask + return $ filterMatches pattern $ map (setGroup g) $ resourceList provider -------------------------------------------------------------------------------- diff --git a/src/Hakyll/Core/Rules/Internal.hs b/src/Hakyll/Core/Rules/Internal.hs index 9d6a979..245d935 100644 --- a/src/Hakyll/Core/Rules/Internal.hs +++ b/src/Hakyll/Core/Rules/Internal.hs @@ -26,8 +26,7 @@ import Hakyll.Core.CompiledItem import Hakyll.Core.Compiler.Internal import Hakyll.Core.Identifier import Hakyll.Core.Identifier.Pattern -import Hakyll.Core.Resource -import Hakyll.Core.Resource.Provider +import Hakyll.Core.ResourceProvider import Hakyll.Core.Routes @@ -49,8 +48,8 @@ data RuleSet = RuleSet rulesRoutes :: Routes , -- | Compilation rules rulesCompilers :: [(Identifier (), Compiler () CompileRule)] - , -- | A list of the used resources - rulesResources :: Set Resource + , -- | A set of the actually used files + rulesResources :: Set (Identifier ()) } diff --git a/src/Hakyll/Core/Run.hs b/src/Hakyll/Core/Run.hs index 4842ea7..ff7acac 100644 --- a/src/Hakyll/Core/Run.hs +++ b/src/Hakyll/Core/Run.hs @@ -25,8 +25,7 @@ import Hakyll.Core.DependencyAnalyzer import Hakyll.Core.DirectedGraph import Hakyll.Core.Identifier import Hakyll.Core.Logger -import Hakyll.Core.Resource -import Hakyll.Core.Resource.Provider +import Hakyll.Core.ResourceProvider import Hakyll.Core.Routes import Hakyll.Core.Rules.Internal import Hakyll.Core.Store (Store) @@ -132,7 +131,7 @@ addNewCompilers newCompilers = Runtime $ do -- Check which items have been modified modified <- fmap S.fromList $ flip filterM (map fst newCompilers) $ - liftIO . resourceModified provider . fromIdentifier + liftIO . resourceModified provider let checkModified = if firstRun then const True else (`S.member` modified) -- Create a new analyzer and append it to the currect one @@ -183,7 +182,7 @@ build id' = Runtime $ do let compiler = compilers M.! id' -- Check if the resource was modified - isModified <- liftIO $ resourceModified provider $ fromIdentifier id' + isModified <- liftIO $ resourceModified provider id' -- Run the compiler result <- timed logger "Total compile time" $ liftIO $ diff --git a/src/Hakyll/Core/Writable/CopyFile.hs b/src/Hakyll/Core/Writable/CopyFile.hs index ab9c698..6cc08f2 100644 --- a/src/Hakyll/Core/Writable/CopyFile.hs +++ b/src/Hakyll/Core/Writable/CopyFile.hs @@ -1,29 +1,36 @@ +-------------------------------------------------------------------------------- -- | Exports simple compilers to just copy files --- {-# LANGUAGE GeneralizedNewtypeDeriving, DeriveDataTypeable #-} module Hakyll.Core.Writable.CopyFile ( CopyFile (..) , copyFileCompiler ) where + +-------------------------------------------------------------------------------- import Control.Arrow ((>>^)) import System.Directory (copyFile) - import Data.Typeable (Typeable) import Data.Binary (Binary) -import Hakyll.Core.Resource + +-------------------------------------------------------------------------------- import Hakyll.Core.Writable import Hakyll.Core.Compiler import Hakyll.Core.Identifier + +-------------------------------------------------------------------------------- -- | Newtype construct around 'FilePath' which will copy the file directly --- newtype CopyFile = CopyFile {unCopyFile :: FilePath} - deriving (Show, Eq, Ord, Binary, Typeable) + deriving (Show, Eq, Ord, Binary, Typeable) + +-------------------------------------------------------------------------------- instance Writable CopyFile where write dst (CopyFile src) = copyFile src dst -copyFileCompiler :: Compiler Resource CopyFile + +-------------------------------------------------------------------------------- +copyFileCompiler :: Compiler a CopyFile copyFileCompiler = getIdentifier >>^ CopyFile . toFilePath diff --git a/src/Hakyll/Main.hs b/src/Hakyll/Main.hs index d97dc31..6c9103f 100644 --- a/src/Hakyll/Main.hs +++ b/src/Hakyll/Main.hs @@ -12,6 +12,7 @@ import System.Environment (getProgName, getArgs) import System.Process (system) import Hakyll.Core.Configuration +import Hakyll.Core.Identifier import Hakyll.Core.Run import Hakyll.Core.Rules @@ -20,7 +21,6 @@ import Control.Applicative ((<$>)) import Control.Concurrent (forkIO) import qualified Data.Set as S -import Hakyll.Core.Resource import Hakyll.Core.Rules.Internal import Hakyll.Web.Preview.Poll import Hakyll.Web.Preview.Server @@ -106,7 +106,7 @@ preview conf rules port = do -- Run the server in the main thread server conf port where - update = map unResource . S.toList . rulesResources <$> run conf rules + update = map toFilePath . S.toList . rulesResources <$> run conf rules #else preview _ _ _ = previewServerDisabled #endif diff --git a/src/Hakyll/Web/CompressCss.hs b/src/Hakyll/Web/CompressCss.hs index 52b5396..d0ca8cd 100644 --- a/src/Hakyll/Web/CompressCss.hs +++ b/src/Hakyll/Web/CompressCss.hs @@ -11,12 +11,11 @@ import Data.List (isPrefixOf) import Control.Arrow ((>>^)) import Hakyll.Core.Compiler -import Hakyll.Core.Resource import Hakyll.Core.Util.String -- | Compiler form of 'compressCss' -- -compressCssCompiler :: Compiler Resource String +compressCssCompiler :: Compiler a String compressCssCompiler = getResourceString >>^ compressCss -- | Compress CSS to speed up your site. diff --git a/src/Hakyll/Web/Page.hs b/src/Hakyll/Web/Page.hs index e92bb14..7f2430f 100644 --- a/src/Hakyll/Web/Page.hs +++ b/src/Hakyll/Web/Page.hs @@ -72,7 +72,6 @@ import Text.Pandoc (Pandoc, ParserState, WriterOptions) import Hakyll.Core.Identifier import Hakyll.Core.Compiler -import Hakyll.Core.Resource import Hakyll.Web.Page.Internal import Hakyll.Web.Page.Read import Hakyll.Web.Page.Metadata @@ -87,12 +86,12 @@ fromBody = Page M.empty -- | Read a page (do not render it) -- -readPageCompiler :: Compiler Resource (Page String) +readPageCompiler :: Compiler () (Page String) readPageCompiler = getResourceString >>^ readPage -- | Read a page, add default fields, substitute fields and render using pandoc -- -pageCompiler :: Compiler Resource (Page String) +pageCompiler :: Compiler () (Page String) pageCompiler = pageCompilerWith defaultHakyllParserState defaultHakyllWriterOptions @@ -100,7 +99,7 @@ pageCompiler = -- options -- pageCompilerWith :: ParserState -> WriterOptions - -> Compiler Resource (Page String) + -> Compiler () (Page String) pageCompilerWith state options = pageCompilerWithPandoc state options id -- | An extension of 'pageCompilerWith' which allows you to specify a custom @@ -108,7 +107,7 @@ pageCompilerWith state options = pageCompilerWithPandoc state options id -- pageCompilerWithPandoc :: ParserState -> WriterOptions -> (Pandoc -> Pandoc) - -> Compiler Resource (Page String) + -> Compiler () (Page String) pageCompilerWithPandoc state options f = cached cacheName $ readPageCompiler >>> addDefaultFields >>> arr applySelf >>> pageReadPandocWith state @@ -124,7 +123,7 @@ pageCompilerWithPandoc state options f = cached cacheName $ pageCompilerWithFields :: ParserState -> WriterOptions -> (Pandoc -> Pandoc) -> Compiler (Page String) (Page String) - -> Compiler Resource (Page String) + -> Compiler () (Page String) pageCompilerWithFields state options f g = readPageCompiler >>> addDefaultFields >>> g >>> arr applySelf >>> pageReadPandocWith state diff --git a/src/Hakyll/Web/Page/Metadata.hs b/src/Hakyll/Web/Page/Metadata.hs index 764022a..742bf06 100644 --- a/src/Hakyll/Web/Page/Metadata.hs +++ b/src/Hakyll/Web/Page/Metadata.hs @@ -38,7 +38,7 @@ import Hakyll.Web.Page.Internal import Hakyll.Core.Util.String import Hakyll.Core.Identifier import Hakyll.Core.Compiler -import Hakyll.Core.Resource.Provider +import Hakyll.Core.ResourceProvider -- | Get a metadata field. If the field does not exist, the empty string is -- returned. @@ -208,7 +208,7 @@ renderModificationTimeWith :: TimeLocale -> Compiler (Page String) (Page String) -- ^ Resulting compiler renderModificationTimeWith locale key format = - id &&& (getResource >>> getResourceWith resourceModificationTime) >>> + id &&& (getResourceWith resourceModificationTime) >>> setFieldA key (arr (formatTime locale format)) -- | Copy the body of a page to a metadata field diff --git a/src/Hakyll/Web/Pandoc/Biblio.hs b/src/Hakyll/Web/Pandoc/Biblio.hs index 48f7982..64a702b 100644 --- a/src/Hakyll/Web/Pandoc/Biblio.hs +++ b/src/Hakyll/Web/Pandoc/Biblio.hs @@ -17,7 +17,7 @@ module Hakyll.Web.Pandoc.Biblio ) where import Control.Applicative ((<$>)) -import Control.Arrow (arr, returnA) +import Control.Arrow (arr, returnA, (>>>)) import Data.Typeable (Typeable) import Data.Binary (Binary (..)) @@ -27,7 +27,6 @@ import qualified Text.CSL as CSL import Hakyll.Core.Compiler import Hakyll.Core.Identifier -import Hakyll.Core.Resource import Hakyll.Core.Writable import Hakyll.Web.Page import Hakyll.Web.Pandoc @@ -35,8 +34,8 @@ import Hakyll.Web.Pandoc newtype CSL = CSL FilePath deriving (Binary, Show, Typeable, Writable) -cslCompiler :: Compiler Resource CSL -cslCompiler = arr (CSL . unResource) +cslCompiler :: Compiler () CSL +cslCompiler = getIdentifier >>> arr (CSL . toFilePath) newtype Biblio = Biblio [CSL.Reference] deriving (Show, Typeable) @@ -49,9 +48,9 @@ instance Binary Biblio where instance Writable Biblio where write _ _ = return () -biblioCompiler :: Compiler Resource Biblio -biblioCompiler = unsafeCompiler $ - fmap Biblio . CSL.readBiblioFile . unResource +biblioCompiler :: Compiler () Biblio +biblioCompiler = getIdentifier >>> + arr toFilePath >>> unsafeCompiler CSL.readBiblioFile >>> arr Biblio pageReadPandocBiblio :: ParserState -> Identifier CSL diff --git a/src/Hakyll/Web/Template.hs b/src/Hakyll/Web/Template.hs index b33d1f3..6b2f915 100644 --- a/src/Hakyll/Web/Template.hs +++ b/src/Hakyll/Web/Template.hs @@ -79,7 +79,6 @@ import Text.Hamlet (HamletSettings, defaultHamletSettings) import Hakyll.Core.Compiler import Hakyll.Core.Identifier -import Hakyll.Core.Resource import Hakyll.Web.Template.Internal import Hakyll.Web.Template.Read import Hakyll.Web.Page.Internal @@ -119,12 +118,12 @@ applySelf page = applyTemplate (readTemplate $ pageBody page) page -- @.hml@ or @.hamlet@, it will be considered as a Hamlet template, and parsed -- as such. -- -templateCompiler :: Compiler Resource Template +templateCompiler :: Compiler () Template templateCompiler = templateCompilerWith defaultHamletSettings -- | Version of 'templateCompiler' that enables custom settings. -- -templateCompilerWith :: HamletSettings -> Compiler Resource Template +templateCompilerWith :: HamletSettings -> Compiler () Template templateCompilerWith settings = cached "Hakyll.Web.Template.templateCompilerWith" $ getIdentifier &&& getResourceString >>^ uncurry read' |