Added an option for categories instead/in addition to tags. Experimental.

3 files changed, 14 insertions, 6 deletions

diff --git a/src/Text/Hakyll/Hakyll.hs b/src/Text/Hakyll/Hakyll.hs
index b33bbda..3eb1e6b 100644
--- a/src/Text/Hakyll/Hakyll.hs
+++ b/src/Text/Hakyll/Hakyll.hs
@@ -19,6 +19,8 @@ data HakyllConfiguration = HakyllConfiguration
       siteDirectory :: FilePath
     , -- | Directory for cache files.
       cacheDirectory :: FilePath
+      -- | Use categories in addition to tags.
+    , enableCategories :: Bool
     }
 
 -- | Our custom monad stack.
diff --git a/src/Text/Hakyll/Internal/Template.hs b/src/Text/Hakyll/Internal/Template.hs
index b6f73b7..6349dce 100644
--- a/src/Text/Hakyll/Internal/Template.hs
+++ b/src/Text/Hakyll/Internal/Template.hs
@@ -12,6 +12,7 @@ import Data.List (isPrefixOf)
 import Data.Char (isAlphaNum)
 import Data.Binary
 import Control.Monad (liftM, liftM2, replicateM)
+import Control.Applicative ((<$>))
 import Data.Maybe (fromMaybe)
 import System.FilePath ((</>))
 import Control.Monad.Reader (liftIO)
@@ -95,10 +96,10 @@ instance Binary Template where
 arbitraryTemplate :: Int -> Gen Template
 arbitraryTemplate 0 = return End
 arbitraryTemplate length' = oneof [ do chunk <- chunk'
-                                       template' >>= return . Chunk chunk
+                                       Chunk chunk <$> template'
                                   , do key <- key'
-                                       template' >>= return . Identifier key
-                                  , template' >>= return . EscapeCharacter
+                                       Identifier key <$> template'
+                                  , EscapeCharacter <$> template'
                                   ]
   where
     template' = arbitraryTemplate (length' - 1)
diff --git a/src/Text/Hakyll/Tags.hs b/src/Text/Hakyll/Tags.hs
index 8c1cee2..1665e7a 100644
--- a/src/Text/Hakyll/Tags.hs
+++ b/src/Text/Hakyll/Tags.hs
@@ -25,9 +25,9 @@ import Data.List (intercalate)
 import Control.Monad (foldM)
 import Control.Arrow (second)
 import Control.Applicative ((<$>))
-import System.FilePath ((</>))
+import System.FilePath
 
-import Text.Hakyll.Hakyll (Hakyll)
+import Text.Hakyll.Hakyll
 import Text.Hakyll.Context (ContextManipulation, changeValue)
 import Text.Hakyll.Regex
 import Text.Hakyll.Util
@@ -55,8 +55,13 @@ readTagMap identifier paths = do
     readTagMap' = foldM addPaths M.empty paths
     addPaths current path = do
         page <- readPage path
+        categoriesEnabled <- askHakyll enableCategories
         let tags = map trim $ splitRegex "," $ getValue "tags" page
-        return $ foldr (flip (M.insertWith (++)) [path]) current tags
+            category = [getCategory path | categoriesEnabled]
+            addPaths' = flip (M.insertWith (++)) [path]
+        return $ foldr addPaths' current (category ++ tags)
+
+    getCategory = last . splitDirectories . takeDirectory
 
 -- | Render a tag cloud.
 renderTagCloud :: M.Map String [FilePath] -- ^ Map as produced by @readTagMap@.