From f9a4b4f6f4b4e5f9b8c0121a4a45529059dae48a Mon Sep 17 00:00:00 2001
From: Jasper Van der Jeugt <jaspervdj@gmail.com>
Date: Wed, 27 Jan 2010 18:52:11 +0100
Subject: [PATCH] Added an option for categories instead/in addition to tags.
 Experimental.

---
 src/Text/Hakyll.hs                   |  1 +
 src/Text/Hakyll/Hakyll.hs            |  2 ++
 src/Text/Hakyll/Internal/Template.hs |  7 ++++---
 src/Text/Hakyll/Tags.hs              | 11 ++++++++---
 4 files changed, 15 insertions(+), 6 deletions(-)

diff --git a/src/Text/Hakyll.hs b/src/Text/Hakyll.hs
index 33b1b57..0157f05 100644
--- a/src/Text/Hakyll.hs
+++ b/src/Text/Hakyll.hs
@@ -19,6 +19,7 @@ defaultHakyllConfiguration = HakyllConfiguration
     { additionalContext = M.empty
     , siteDirectory = "_site"
     , cacheDirectory = "_cache"
+    , enableCategories = False
     }
 
 -- | Hakyll with a default configuration.
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@.