From ff118fec98ef02e2eead2a752d9c6619a2e891df Mon Sep 17 00:00:00 2001
From: Jasper Van der Jeugt <jaspervdj@gmail.com>
Date: Tue, 5 Apr 2011 11:58:26 +0200
Subject: Simplify match implementation(s)

---
 src/Hakyll/Core/Routes.hs         |  9 +++++----
 src/Hakyll/Core/Rules.hs          | 36 +++++++++++++++++-------------------
 src/Hakyll/Core/Rules/Internal.hs |  5 +++--
 3 files changed, 25 insertions(+), 25 deletions(-)

(limited to 'src')

diff --git a/src/Hakyll/Core/Routes.hs b/src/Hakyll/Core/Routes.hs
index 386635f..abbd0a7 100644
--- a/src/Hakyll/Core/Routes.hs
+++ b/src/Hakyll/Core/Routes.hs
@@ -41,6 +41,7 @@ import Control.Monad (mplus)
 import System.FilePath (replaceExtension)
 
 import Hakyll.Core.Identifier
+import Hakyll.Core.Identifier.Pattern
 import Hakyll.Core.Util.String
 
 -- | Type used for a route
@@ -84,12 +85,12 @@ setExtension :: String -> Routes
 setExtension extension = Routes $ fmap (`replaceExtension` extension)
                                 . unRoutes idRoute
 
--- | Apply the route if the identifier matches the given predicate, fail
+-- | Apply the route if the identifier matches the given pattern, fail
 -- otherwise
 --
-matchRoute :: (Identifier -> Bool) -> Routes -> Routes
-matchRoute predicate (Routes route) = Routes $ \id' ->
-    if predicate id' then route id' else Nothing
+matchRoute :: Pattern -> Routes -> Routes
+matchRoute pattern (Routes route) = Routes $ \id' ->
+    if matches pattern id' then route id' else Nothing
 
 -- | Create a custom route. This should almost always be used with
 -- 'matchRoute'
diff --git a/src/Hakyll/Core/Rules.hs b/src/Hakyll/Core/Rules.hs
index 319e10b..19df85e 100644
--- a/src/Hakyll/Core/Rules.hs
+++ b/src/Hakyll/Core/Rules.hs
@@ -7,15 +7,18 @@
 -- A typical usage example would be:
 --
 -- > main = hakyll $ do
--- >     route   "posts/*" (setExtension "html")
--- >     compile "posts/*" someCompiler
+-- >     match "posts/*" $ do
+-- >         route   (setExtension "html")
+-- >         compile someCompiler
+-- >     match "css/*" $ do
+-- >         route   idRoute
+-- >         compile compressCssCompiler
 --
 {-# LANGUAGE GeneralizedNewtypeDeriving, OverloadedStrings #-}
 module Hakyll.Core.Rules
     ( RulesM
     , Rules
-    , matchPattern
-    , matchPredicate
+    , match
     , compile
     , create
     , route
@@ -28,7 +31,7 @@ import Control.Monad.Writer (tell)
 import Control.Monad.Reader (ask, local)
 import Control.Arrow (second, (>>>), arr, (>>^))
 import Control.Monad.State (get, put)
-import Data.Monoid (mempty)
+import Data.Monoid (mempty, mappend)
 import qualified Data.Set as S
 
 import Data.Typeable (Typeable)
@@ -65,18 +68,13 @@ tellResources :: [Resource]
               -> Rules
 tellResources resources = RulesM $ tell $ RuleSet mempty mempty $ S.fromList resources
 
--- | Only compile/route items matching the given pattern
---
-matchPattern :: Pattern -> Rules -> Rules
-matchPattern pattern = matchPredicate (doesMatch pattern)
-
 -- | Only compile/route items satisfying the given predicate
 --
-matchPredicate :: (Identifier -> Bool) -> Rules -> Rules
-matchPredicate predicate = RulesM . local addPredicate . unRulesM
+match :: Pattern -> Rules -> Rules
+match pattern = RulesM . local addPredicate . unRulesM
   where
     addPredicate env = env
-        { rulesMatcher = \id' -> rulesMatcher env id' && predicate id'
+        { rulesPattern = rulesPattern env `mappend` pattern
         }
 
 -- | Add a compilation rule to the rules.
@@ -88,13 +86,13 @@ matchPredicate predicate = RulesM . local addPredicate . unRulesM
 compile :: (Binary a, Typeable a, Writable a)
         => Compiler Resource a -> Rules
 compile compiler = RulesM $ do
-    matcher <- rulesMatcher <$> ask
+    pattern <- rulesPattern <$> ask
     provider <- rulesResourceProvider <$> ask
-    let identifiers = filter matcher $ map unResource $ resourceList provider
+    let ids = filterMatches pattern $ map unResource $ resourceList provider
     unRulesM $ do
-        tellCompilers $ flip map identifiers $ \identifier ->
+        tellCompilers $ flip map ids $ \identifier ->
             (identifier, constA (Resource identifier) >>> compiler)
-        tellResources $ map Resource identifiers
+        tellResources $ map Resource ids
                    
 -- | Add a compilation rule
 --
@@ -113,8 +111,8 @@ create identifier compiler = tellCompilers [(identifier, compiler)]
 --
 route :: Routes -> Rules
 route route' = RulesM $ do
-    matcher <- rulesMatcher <$> ask
-    unRulesM $ tellRoute $ matchRoute matcher route'
+    pattern <- rulesPattern <$> ask
+    unRulesM $ tellRoute $ matchRoute pattern route'
 
 -- | Apart from regular compilers, one is also able to specify metacompilers.
 -- Metacompilers are a special class of compilers: they are compilers which
diff --git a/src/Hakyll/Core/Rules/Internal.hs b/src/Hakyll/Core/Rules/Internal.hs
index dc669c1..592194d 100644
--- a/src/Hakyll/Core/Rules/Internal.hs
+++ b/src/Hakyll/Core/Rules/Internal.hs
@@ -20,6 +20,7 @@ import Data.Set (Set)
 
 import Hakyll.Core.ResourceProvider
 import Hakyll.Core.Identifier
+import Hakyll.Core.Identifier.Pattern
 import Hakyll.Core.Compiler.Internal
 import Hakyll.Core.Routes
 import Hakyll.Core.CompiledItem
@@ -60,7 +61,7 @@ data RuleState = RuleState
 --
 data RuleEnvironment = RuleEnvironment
     { rulesResourceProvider :: ResourceProvider
-    , rulesMatcher          :: Identifier -> Bool
+    , rulesPattern          :: Pattern
     }
 
 -- | The monad used to compose rules
@@ -82,5 +83,5 @@ runRules rules provider =
   where
     state = RuleState {rulesMetaCompilerIndex = 0}
     env = RuleEnvironment { rulesResourceProvider = provider
-                          , rulesMatcher          = const True
+                          , rulesPattern          = mempty
                           }
-- 
cgit v1.2.3