Simplify stuff

1 files changed, 31 insertions, 34 deletions

diff --git a/src/Hakyll/Core/Rules.hs b/src/Hakyll/Core/Rules.hs
index c481977..24b65dd 100644
--- a/src/Hakyll/Core/Rules.hs
+++ b/src/Hakyll/Core/Rules.hs
@@ -2,7 +2,7 @@
 -- | This module provides a declarative DSL in which the user can specify the
 -- different rules used to run the compilers.
 --
--- The convention is to just list all items in the 'RulesM' monad, routes and
+-- The convention is to just list all items in the 'Rules' monad, routes and
 -- compilation rules.
 --
 -- A typical usage example would be:
@@ -17,8 +17,7 @@
 {-# LANGUAGE GeneralizedNewtypeDeriving #-}
 {-# LANGUAGE OverloadedStrings          #-}
 module Hakyll.Core.Rules
-    ( RulesM
-    , Rules
+    ( Rules
     , match
     , group
     , compile
@@ -31,7 +30,7 @@ module Hakyll.Core.Rules
 
 --------------------------------------------------------------------------------
 import           Control.Applicative            ((<$>))
-import           Control.Arrow                  ((***))
+import           Control.Arrow                  (second)
 import           Control.Monad.Reader           (ask, local)
 import           Control.Monad.State            (get, put)
 import           Control.Monad.Writer           (tell)
@@ -57,36 +56,36 @@ import           Hakyll.Core.Writable
 
 --------------------------------------------------------------------------------
 -- | Add a route
-tellRoute :: Routes -> Rules
-tellRoute route' = RulesM $ tell $ RuleSet route' mempty mempty
+tellRoute :: Routes -> Rules ()
+tellRoute route' = Rules $ tell $ RuleSet route' mempty mempty
 
 
 --------------------------------------------------------------------------------
 -- | Add a number of compilers
 tellCompilers :: (Binary a, Typeable a, Writable a)
-             => [(Identifier a, Compiler a)]
-             -> Rules
-tellCompilers compilers = RulesM $ do
+             => [(Identifier, Compiler a)]
+             -> Rules ()
+tellCompilers compilers = Rules $ do
     -- We box the compilers so they have a more simple type
-    let compilers' = map (castIdentifier *** fmap compiledItem) compilers
+    let compilers' = map (second $ fmap compiledItem) compilers
     tell $ RuleSet mempty compilers' mempty
 
 
 --------------------------------------------------------------------------------
 -- | Add resources
-tellResources :: [Identifier a]
-              -> Rules
-tellResources resources' = RulesM $ tell $
-    RuleSet mempty mempty $ S.fromList $ map castIdentifier resources'
+tellResources :: [Identifier]
+              -> Rules ()
+tellResources resources' = Rules $ tell $
+    RuleSet mempty mempty $ S.fromList resources'
 
 
 --------------------------------------------------------------------------------
 -- | Only compile/route items satisfying the given predicate
-match :: Pattern a -> RulesM b -> RulesM b
-match pattern = RulesM . local addPredicate . unRulesM
+match :: Pattern -> Rules b -> Rules b
+match pattern = Rules . local addPredicate . unRules
   where
     addPredicate env = env
-        { rulesPattern = rulesPattern env `mappend` castPattern pattern
+        { rulesPattern = rulesPattern env `mappend` pattern
         }
 
 
@@ -120,8 +119,8 @@ match pattern = RulesM . local addPredicate . unRulesM
 --
 -- This will put the compiler for the raw content in a separate group
 -- (@\"raw\"@), which causes it to be compiled as well.
-group :: String -> RulesM a -> RulesM a
-group g = RulesM . local setVersion' . unRulesM
+group :: String -> Rules a -> Rules a
+group g = Rules . local setVersion' . unRules
   where
     setVersion' env = env {rulesVersion = Just g}
 
@@ -133,12 +132,11 @@ group g = RulesM . local setVersion' . 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 a -> RulesM (Pattern a)
+        => Compiler a -> Rules ()
 compile compiler = do
     ids <- resources
-    tellCompilers [(castIdentifier id', compiler) | id' <- ids]
+    tellCompilers [(id', compiler) | id' <- ids]
     tellResources ids
-    return $ fromList $ map castIdentifier ids
 
 
 --------------------------------------------------------------------------------
@@ -151,33 +149,32 @@ compile compiler = do
 -- replaced by the group set via 'group' (or 'Nothing', if 'group' has not been
 -- used).
 create :: (Binary a, Typeable a, Writable a)
-       => Identifier a -> Compiler a -> RulesM (Identifier a)
-create id' compiler = RulesM $ do
+       => Identifier -> Compiler a -> Rules ()
+create id' compiler = Rules $ do
     version' <- rulesVersion <$> ask
     let id'' = setVersion version' id'
-    unRulesM $ tellCompilers [(id'', compiler)]
-    return id''
+    unRules $ tellCompilers [(id'', compiler)]
 
 
 --------------------------------------------------------------------------------
 -- | Add a route.
 --
 -- This adds a route for all items matching the current pattern.
-route :: Routes -> Rules
-route route' = RulesM $ do
+route :: Routes -> Rules ()
+route route' = Rules $ do
     -- We want the route only to be applied if we match the current pattern and
     -- version
     pattern  <- rulesPattern <$> ask
     version' <- rulesVersion <$> ask
-    unRulesM $ tellRoute $ matchRoute
+    unRules $ tellRoute $ matchRoute
         (pattern `mappend` fromVersion version') route'
 
 
 --------------------------------------------------------------------------------
 -- | Get a list of resources matching the current pattern. This will also set
 -- the correct group to the identifiers.
-resources :: RulesM [Identifier ()]
-resources = RulesM $ do
+resources :: Rules [Identifier]
+resources = Rules $ do
     pattern  <- rulesPattern <$> ask
     provider <- rulesResourceProvider <$> ask
     g        <- rulesVersion <$> ask
@@ -187,9 +184,9 @@ resources = RulesM $ do
 --------------------------------------------------------------------------------
 -- | Generate a fresh Identifier with a given prefix
 -- TODO: remove?
-freshIdentifier :: String                 -- ^ Prefix
-                -> RulesM (Identifier a)  -- ^ Fresh identifier
-freshIdentifier prefix = RulesM $ do
+freshIdentifier :: String            -- ^ Prefix
+                -> Rules Identifier  -- ^ Fresh identifier
+freshIdentifier prefix = Rules $ do
     state <- get
     let index = rulesNextIdentifier state
         id'   = fromFilePath $ prefix ++ "/" ++ show index