Add `composeRoutes`

2 files changed, 25 insertions, 0 deletions

diff --git a/src/Hakyll/Core/Routes.hs b/src/Hakyll/Core/Routes.hs
index eba35ff..fcab28d 100644
--- a/src/Hakyll/Core/Routes.hs
+++ b/src/Hakyll/Core/Routes.hs
@@ -33,6 +33,7 @@ module Hakyll.Core.Routes
     , ifMatch
     , customRoute
     , gsubRoute
+    , composeRoutes
     ) where
 
 import Data.Monoid (Monoid, mempty, mappend)
@@ -112,3 +113,24 @@ gsubRoute :: String              -- ^ Pattern
           -> Routes              -- ^ Resulting route
 gsubRoute pattern replacement = customRoute $
     replaceAll pattern replacement . toFilePath
+
+-- | Compose routes so that @f `composeRoutes` g@ is more or less equivalent
+-- with @f >>> g@.
+--
+-- Example:
+--
+-- > let routes = gsubRoute "rss/" (const "") `composeRoutes` setExtension "xml"
+-- > in runRoutes routes "tags/rss/bar"
+--
+-- Result:
+--
+-- > Just "tags/bar.xml"
+--
+-- If the first route given fails, Hakyll will not apply the second route.
+--
+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 $ parseIdentifier p
diff --git a/tests/Hakyll/Core/Routes/Tests.hs b/tests/Hakyll/Core/Routes/Tests.hs
index 201c656..3361846 100644
--- a/tests/Hakyll/Core/Routes/Tests.hs
+++ b/tests/Hakyll/Core/Routes/Tests.hs
@@ -18,4 +18,7 @@ tests = fromAssertions "runRoutes"
 
     , Just "tags/bar.xml" @=?
         runRoutes (gsubRoute "rss/" (const "")) "tags/rss/bar.xml"
+    , Just "tags/bar.xml" @=?
+        runRoutes (gsubRoute "rss/" (const "") `composeRoutes`
+            setExtension "xml") "tags/rss/bar"
     ]