From c093761e8941c1605b6131c411ca995588c10c2e Mon Sep 17 00:00:00 2001 From: Jasper Van der Jeugt Date: Thu, 3 Feb 2011 16:07:49 +0100 Subject: Route → Routes MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit --- src/Hakyll/Core/Compiler.hs | 12 ++++-- src/Hakyll/Core/Compiler/Internal.hs | 9 +++-- src/Hakyll/Core/Route.hs | 71 ------------------------------------ src/Hakyll/Core/Routes.hs | 71 ++++++++++++++++++++++++++++++++++++ src/Hakyll/Core/Rules.hs | 8 ++-- src/Hakyll/Core/Run.hs | 25 ++++++------- 6 files changed, 99 insertions(+), 97 deletions(-) delete mode 100644 src/Hakyll/Core/Route.hs create mode 100644 src/Hakyll/Core/Routes.hs (limited to 'src/Hakyll') diff --git a/src/Hakyll/Core/Compiler.hs b/src/Hakyll/Core/Compiler.hs index a0fea37..7cfc61f 100644 --- a/src/Hakyll/Core/Compiler.hs +++ b/src/Hakyll/Core/Compiler.hs @@ -37,6 +37,7 @@ import Hakyll.Core.ResourceProvider import Hakyll.Core.Compiler.Internal import Hakyll.Core.Store import Hakyll.Core.Rules +import Hakyll.Core.Routes -- | Run a compiler, yielding the resulting target and it's dependencies. This -- version of 'runCompilerJob' also stores the result @@ -44,13 +45,13 @@ import Hakyll.Core.Rules runCompiler :: Compiler () CompileRule -- ^ Compiler to run -> Identifier -- ^ Target identifier -> ResourceProvider -- ^ Resource provider - -> Maybe FilePath -- ^ Route + -> Routes -- ^ Route -> Store -- ^ Store -> Bool -- ^ Was the resource modified? -> IO CompileRule -- ^ Resulting item -runCompiler compiler identifier provider route' store modified = do +runCompiler compiler identifier provider routes store modified = do -- Run the compiler job - result <- runCompilerJob compiler identifier provider route' store modified + result <- runCompilerJob compiler identifier provider routes store modified -- Inspect the result case result of @@ -73,7 +74,10 @@ getIdentifier = fromJob $ const $ CompilerM $ compilerIdentifier <$> ask -- | Get the route we are using for this item -- getRoute :: Compiler a (Maybe FilePath) -getRoute = fromJob $ const $ CompilerM $ compilerRoute <$> ask +getRoute = fromJob $ const $ CompilerM $ do + identifier <- compilerIdentifier <$> ask + routes <- compilerRoutes <$> ask + return $ runRoutes routes identifier -- | Get the resource we are compiling as a string -- diff --git a/src/Hakyll/Core/Compiler/Internal.hs b/src/Hakyll/Core/Compiler/Internal.hs index f1d591d..ccdd557 100644 --- a/src/Hakyll/Core/Compiler/Internal.hs +++ b/src/Hakyll/Core/Compiler/Internal.hs @@ -25,6 +25,7 @@ import Control.Arrow (Arrow, arr, first) import Hakyll.Core.Identifier import Hakyll.Core.ResourceProvider import Hakyll.Core.Store +import Hakyll.Core.Routes -- | A set of dependencies -- @@ -37,8 +38,8 @@ data CompilerEnvironment = CompilerEnvironment compilerIdentifier :: Identifier , -- | Resource provider compilerResourceProvider :: ResourceProvider - , -- | Site route - compilerRoute :: Maybe FilePath + , -- | Site routes + compilerRoutes :: Routes , -- | Compiler store compilerStore :: Store , -- | Flag indicating if the underlying resource was modified @@ -82,7 +83,7 @@ instance Arrow Compiler where runCompilerJob :: Compiler () a -- ^ Compiler to run -> Identifier -- ^ Target identifier -> ResourceProvider -- ^ Resource provider - -> Maybe FilePath -- ^ Route + -> Routes -- ^ Route -> Store -- ^ Store -> Bool -- ^ Was the resource modified? -> IO a @@ -92,7 +93,7 @@ runCompilerJob compiler identifier provider route store modified = env = CompilerEnvironment { compilerIdentifier = identifier , compilerResourceProvider = provider - , compilerRoute = route + , compilerRoutes = route , compilerStore = store , compilerResourceModified = modified } diff --git a/src/Hakyll/Core/Route.hs b/src/Hakyll/Core/Route.hs deleted file mode 100644 index f3f0b7f..0000000 --- a/src/Hakyll/Core/Route.hs +++ /dev/null @@ -1,71 +0,0 @@ --- | Once a target is compiled, the user usually wants to save it to the disk. --- This is where the 'Route' type comes in; it determines where a certain target --- should be written. --- --- When a route is applied (using 'runRoute'), it either returns a 'Just' --- 'FilePath' (meaning the target should be written to that file path), or --- 'Nothing' (meaning this target should not be written anywhere). --- -module Hakyll.Core.Route - ( Route - , runRoute - , idRoute - , setExtension - , ifMatch - ) where - -import Data.Monoid (Monoid, mempty, mappend) -import Control.Monad (mplus) -import System.FilePath (replaceExtension) - -import Hakyll.Core.Identifier -import Hakyll.Core.Identifier.Pattern - --- | Type used for a route --- -newtype Route = Route {unRoute :: Identifier -> Maybe FilePath} - -instance Monoid Route where - mempty = Route $ const Nothing - mappend (Route f) (Route g) = Route $ \id' -> f id' `mplus` g id' - --- | Apply a route to an identifier --- -runRoute :: Route -> Identifier -> Maybe FilePath -runRoute = unRoute - --- | 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 :: Route -idRoute = Route $ Just . toFilePath - --- | Set (or replace) the extension of a route. --- --- Example: --- --- > runRoute (setExtension "html") "foo/bar" --- --- Result: --- --- > Just "foo/bar.html" --- --- Example: --- --- > runRoute (setExtension "html") "posts/the-art-of-trolling.markdown" --- --- Result: --- --- > Just "posts/the-art-of-trolling.html" --- -setExtension :: String -> Route -setExtension extension = Route $ fmap (`replaceExtension` extension) - . unRoute idRoute - --- | Modify a route: apply the route if the identifier matches the given --- pattern, fail otherwise. --- -ifMatch :: Pattern -> Route -> Route -ifMatch pattern (Route route) = Route $ \id' -> - if doesMatch pattern id' then route id' - else Nothing diff --git a/src/Hakyll/Core/Routes.hs b/src/Hakyll/Core/Routes.hs new file mode 100644 index 0000000..c1a034f --- /dev/null +++ b/src/Hakyll/Core/Routes.hs @@ -0,0 +1,71 @@ +-- | Once a target is compiled, the user usually wants to save it to the disk. +-- This is where the 'Routes' type comes in; it determines where a certain +-- target should be written. +-- +-- When a route is applied (using 'runRoute'), it either returns a 'Just' +-- 'FilePath' (meaning the target should be written to that file path), or +-- 'Nothing' (meaning this target should not be written anywhere). +-- +module Hakyll.Core.Routes + ( Routes + , runRoutes + , idRoute + , setExtension + , ifMatch + ) where + +import Data.Monoid (Monoid, mempty, mappend) +import Control.Monad (mplus) +import System.FilePath (replaceExtension) + +import Hakyll.Core.Identifier +import Hakyll.Core.Identifier.Pattern + +-- | Type used for a route +-- +newtype Routes = Routes {unRoutes :: Identifier -> Maybe FilePath} + +instance Monoid Routes where + mempty = Routes $ const Nothing + mappend (Routes f) (Routes g) = Routes $ \id' -> f id' `mplus` g id' + +-- | Apply a route to an identifier +-- +runRoutes :: Routes -> Identifier -> Maybe FilePath +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 + +-- | Set (or replace) the extension of a route. +-- +-- Example: +-- +-- > runRoute (setExtension "html") "foo/bar" +-- +-- Result: +-- +-- > Just "foo/bar.html" +-- +-- Example: +-- +-- > runRoute (setExtension "html") "posts/the-art-of-trolling.markdown" +-- +-- Result: +-- +-- > Just "posts/the-art-of-trolling.html" +-- +setExtension :: String -> Routes +setExtension extension = Routes $ fmap (`replaceExtension` extension) + . unRoutes idRoute + +-- | Modify a route: apply the route if the identifier matches the given +-- pattern, fail otherwise. +-- +ifMatch :: Pattern -> Routes -> Routes +ifMatch pattern (Routes route) = Routes $ \id' -> + if doesMatch pattern id' then route id' + else Nothing diff --git a/src/Hakyll/Core/Rules.hs b/src/Hakyll/Core/Rules.hs index d772775..4aa497c 100644 --- a/src/Hakyll/Core/Rules.hs +++ b/src/Hakyll/Core/Rules.hs @@ -28,7 +28,7 @@ import Hakyll.Core.ResourceProvider import Hakyll.Core.Identifier import Hakyll.Core.Identifier.Pattern import Hakyll.Core.Compiler.Internal -import Hakyll.Core.Route +import Hakyll.Core.Routes import Hakyll.Core.CompiledItem import Hakyll.Core.Writable @@ -45,7 +45,7 @@ data CompileRule = CompileRule CompiledItem -- | A collection of rules for the compilation process -- data RuleSet = RuleSet - { rulesRoute :: Route + { rulesRoutes :: Routes , rulesCompilers :: [(Identifier, Compiler () CompileRule)] } @@ -81,7 +81,7 @@ runRules rules provider = -- | Add a route -- -tellRoute :: Route -> Rules +tellRoute :: Routes -> Rules tellRoute route' = RulesM $ tell $ RuleSet route' mempty -- | Add a number of compilers @@ -115,7 +115,7 @@ create identifier compiler = tellCompilers [(identifier, compiler)] -- | Add a route -- -route :: Pattern -> Route -> Rules +route :: Pattern -> Routes -> Rules route pattern route' = tellRoute $ ifMatch pattern route' -- | Add a compiler that produces other compilers over time diff --git a/src/Hakyll/Core/Run.hs b/src/Hakyll/Core/Run.hs index a21ea33..17a5f79 100644 --- a/src/Hakyll/Core/Run.hs +++ b/src/Hakyll/Core/Run.hs @@ -16,7 +16,7 @@ import System.FilePath (()) import Data.Set (Set) import qualified Data.Set as S -import Hakyll.Core.Route +import Hakyll.Core.Routes import Hakyll.Core.Identifier import Hakyll.Core.Util.File import Hakyll.Core.Compiler @@ -48,7 +48,7 @@ run configuration rules = do where env ruleSet provider store = RuntimeEnvironment { hakyllConfiguration = configuration - , hakyllRoute = rulesRoute ruleSet + , hakyllRoutes = rulesRoutes ruleSet , hakyllResourceProvider = provider , hakyllStore = store } @@ -60,7 +60,7 @@ run configuration rules = do data RuntimeEnvironment = RuntimeEnvironment { hakyllConfiguration :: HakyllConfiguration - , hakyllRoute :: Route + , hakyllRoutes :: Routes , hakyllResourceProvider :: ResourceProvider , hakyllStore :: Store } @@ -156,31 +156,28 @@ runCompilers :: [(Identifier, Compiler () CompileRule)] runCompilers [] = return () runCompilers ((id', compiler) : compilers) = Runtime $ do -- Obtain information - route' <- hakyllRoute <$> ask + routes <- hakyllRoutes <$> ask provider <- hakyllResourceProvider <$> ask store <- hakyllStore <$> ask modified' <- hakyllModified <$> get - let -- Determine the URL - url = runRoute route' id' - - -- Check if the resource was modified + let -- Check if the resource was modified isModified = id' `S.member` modified' -- Run the compiler - result <- liftIO $ runCompiler compiler id' provider url store isModified + result <- liftIO $ runCompiler compiler id' provider routes store isModified liftIO $ putStrLn $ "Generated target: " ++ show id' case result of -- Compile rule for one item, easy stuff CompileRule compiled -> do - case url of - Nothing -> return () - Just r -> do - liftIO $ putStrLn $ "Routing " ++ show id' ++ " to " ++ r + case runRoutes routes id' of + Nothing -> return () + Just url -> do + liftIO $ putStrLn $ "Routing " ++ show id' ++ " to " ++ url destination <- destinationDirectory . hakyllConfiguration <$> ask - let path = destination r + let path = destination url liftIO $ makeDirectories path liftIO $ write path compiled -- cgit v1.2.3