diff options
Diffstat (limited to 'src')
-rw-r--r-- | src/Hakyll/Core/Compiler.hs | 9 | ||||
-rw-r--r-- | src/Hakyll/Core/Routes.hs | 52 | ||||
-rw-r--r-- | src/Hakyll/Core/Runtime.hs | 9 |
3 files changed, 45 insertions, 25 deletions
diff --git a/src/Hakyll/Core/Compiler.hs b/src/Hakyll/Core/Compiler.hs index b23b69b..b711719 100644 --- a/src/Hakyll/Core/Compiler.hs +++ b/src/Hakyll/Core/Compiler.hs @@ -39,6 +39,7 @@ import System.FilePath (takeExtension) -------------------------------------------------------------------------------- import Hakyll.Core.Compiler.Internal import qualified Hakyll.Core.Compiler.Require as Internal +import Hakyll.Core.Dependencies import Hakyll.Core.Identifier import Hakyll.Core.Item import Hakyll.Core.Logger as Logger @@ -71,8 +72,12 @@ makeItem x = do -- | Get the route for a specified item getRoute :: Identifier -> Compiler (Maybe FilePath) getRoute identifier = do - routes <- compilerRoutes <$> compilerAsk - return $ runRoutes routes identifier + provider <- compilerProvider <$> compilerAsk + routes <- compilerRoutes <$> compilerAsk + -- Note that this makes us dependend on that identifier: when the metadata + -- of that item changes, the route may change, hence we have to recompile + compilerTellDependencies [IdentifierDependency identifier] + compilerUnsafeIO $ runRoutes routes provider identifier -------------------------------------------------------------------------------- diff --git a/src/Hakyll/Core/Routes.hs b/src/Hakyll/Core/Routes.hs index f653fa5..fe5fb1f 100644 --- a/src/Hakyll/Core/Routes.hs +++ b/src/Hakyll/Core/Routes.hs @@ -35,36 +35,42 @@ module Hakyll.Core.Routes , customRoute , constRoute , gsubRoute + , metadataRoute , composeRoutes ) where -------------------------------------------------------------------------------- -import Data.Monoid (Monoid, mempty, mappend) -import Control.Monad (mplus) -import System.FilePath (replaceExtension) +import Data.Monoid (Monoid, mappend, mempty) +import System.FilePath (replaceExtension) -------------------------------------------------------------------------------- -import Hakyll.Core.Identifier -import Hakyll.Core.Identifier.Pattern -import Hakyll.Core.Util.String +import Hakyll.Core.Identifier +import Hakyll.Core.Identifier.Pattern +import Hakyll.Core.Metadata +import Hakyll.Core.Provider +import Hakyll.Core.Util.String -------------------------------------------------------------------------------- -- | Type used for a route -newtype Routes = Routes {unRoutes :: Identifier -> Maybe FilePath} +newtype Routes = Routes + { unRoutes :: Provider -> Identifier -> IO (Maybe FilePath) + } -------------------------------------------------------------------------------- instance Monoid Routes where - mempty = Routes $ const Nothing - mappend (Routes f) (Routes g) = Routes $ \id' -> f id' `mplus` g id' + mempty = Routes $ \_ _ -> return Nothing + mappend (Routes f) (Routes g) = Routes $ \p id' -> do + mfp <- f p id' + maybe (g p id') (return . Just) mfp -------------------------------------------------------------------------------- -- | Apply a route to an identifier -runRoutes :: Routes -> Identifier -> Maybe FilePath +runRoutes :: Routes -> Provider -> Identifier -> IO (Maybe FilePath) runRoutes = unRoutes @@ -72,7 +78,7 @@ runRoutes = unRoutes -- | A route that uses the identifier as filepath. For example, the target with -- ID @foo\/bar@ will be written to the file @foo\/bar@. idRoute :: Routes -idRoute = Routes $ Just . toFilePath +idRoute = customRoute toFilePath -------------------------------------------------------------------------------- @@ -94,23 +100,23 @@ idRoute = Routes $ Just . toFilePath -- -- > Just "posts/the-art-of-trolling.html" setExtension :: String -> Routes -setExtension extension = Routes $ - fmap (`replaceExtension` extension) . unRoutes idRoute +setExtension extension = customRoute $ + (`replaceExtension` extension) . toFilePath -------------------------------------------------------------------------------- -- | Apply the route if the identifier matches the given pattern, fail -- otherwise matchRoute :: Pattern -> Routes -> Routes -matchRoute pattern (Routes route) = Routes $ \id' -> - if matches pattern id' then route id' else Nothing +matchRoute pattern (Routes route) = Routes $ \p id' -> + if matches pattern id' then route p id' else return Nothing -------------------------------------------------------------------------------- -- | Create a custom route. This should almost always be used with -- 'matchRoute' customRoute :: (Identifier -> FilePath) -> Routes -customRoute f = Routes $ Just . f +customRoute f = Routes $ const $ return . Just . f -------------------------------------------------------------------------------- @@ -138,6 +144,14 @@ gsubRoute pattern replacement = customRoute $ -------------------------------------------------------------------------------- +-- | Get access to the metadata in order to determine the route +metadataRoute :: (Metadata -> Routes) -> Routes +metadataRoute f = Routes $ \p i -> do + metadata <- resourceMetadata p i + unRoutes (f metadata) p i + + +-------------------------------------------------------------------------------- -- | Compose routes so that @f \`composeRoutes\` g@ is more or less equivalent -- with @g . f@. -- @@ -154,6 +168,6 @@ gsubRoute pattern replacement = customRoute $ composeRoutes :: Routes -- ^ First route to apply -> Routes -- ^ Second route to apply -> Routes -- ^ Resulting route -composeRoutes (Routes f) (Routes g) = Routes $ \i -> do - p <- f i - g $ fromFilePath p +composeRoutes (Routes f) (Routes g) = Routes $ \p i -> do + mfp <- f p i + maybe (return Nothing) (g p . fromFilePath) mfp diff --git a/src/Hakyll/Core/Runtime.hs b/src/Hakyll/Core/Runtime.hs index 150cc60..9f27969 100644 --- a/src/Hakyll/Core/Runtime.hs +++ b/src/Hakyll/Core/Runtime.hs @@ -219,10 +219,11 @@ chase trail id' "(you probably want to call makeItem to solve this problem)" -- Write if necessary - case runRoutes routes id' of - Nothing -> return () - Just url -> do - let path = destinationDirectory config </> url + mroute <- liftIO $ runRoutes routes provider id' + case mroute of + Nothing -> return () + Just route -> do + let path = destinationDirectory config </> route liftIO $ makeDirectories path liftIO $ write path item Logger.debug logger $ "Routed to " ++ path |