Started a cleanup of Text.Hakyll.Tags.

3 files changed, 43 insertions, 16 deletions

diff --git a/src/Text/Hakyll/Page.hs b/src/Text/Hakyll/Page.hs
index a0d9ed0..fb23d6f 100644
--- a/src/Text/Hakyll/Page.hs
+++ b/src/Text/Hakyll/Page.hs
@@ -13,14 +13,14 @@ import Data.Char (isSpace)
 import Data.Maybe (fromMaybe)
 import Control.Monad (liftM, replicateM)
 import Control.Monad.Reader (liftIO)
-import System.FilePath (takeExtension, (</>))
+import System.FilePath
 
 import Test.QuickCheck
 import Text.Pandoc
 import Data.Binary
 
 import Text.Hakyll.Internal.Cache
-import Text.Hakyll.Hakyll (Hakyll)
+import Text.Hakyll.Hakyll
 import Text.Hakyll.File
 import Text.Hakyll.Util (trim)
 import Text.Hakyll.Context (Context)
@@ -124,9 +124,11 @@ readPageFromFile path = do
 
     -- Read file.
     contents <- liftIO $ readFile path
+    enableCategories' <- askHakyll enableCategories
     let sections = splitAtDelimiters $ lines contents
         context = concat $ zipWith ($) sectionFunctions sections
         page = fromContext $ M.fromList $
+            [ ("category", getCategory path) | enableCategories' ] ++
             [ ("url", url)
             , ("path", path)
             ] ++ context
@@ -134,6 +136,7 @@ readPageFromFile path = do
     return page
   where
     url = toURL path
+    getCategory = last . splitDirectories . takeDirectory
 
 -- | Read a page. Might fetch it from the cache if available. Otherwise, it will
 --   read it from the file given and store it in the cache.
diff --git a/src/Text/Hakyll/Renderables.hs b/src/Text/Hakyll/Renderables.hs
index 85b6fdd..fef88e6 100644
--- a/src/Text/Hakyll/Renderables.hs
+++ b/src/Text/Hakyll/Renderables.hs
@@ -12,6 +12,9 @@ module Text.Hakyll.Renderables
 
 import qualified Data.Map as M
 import Control.Arrow (second)
+import Control.Monad (liftM)
+
+import Data.Binary
 
 import Text.Hakyll.Hakyll (Hakyll)
 import Text.Hakyll.Page
@@ -95,6 +98,11 @@ instance Renderable PagePath where
     getURL (PagePath path) = toURL path
     toContext (PagePath path) = readPage path >>= toContext
 
+-- We can serialize filepaths
+instance Binary PagePath where
+    put (PagePath path) = put path
+    get = liftM PagePath get
+
 -- | A combination of two other renderables.
 data CombinedRenderable a b = CombinedRenderable a b
                             | CombinedRenderableWithURL FilePath a b
diff --git a/src/Text/Hakyll/Tags.hs b/src/Text/Hakyll/Tags.hs
index 1665e7a..7d2c9ea 100644
--- a/src/Text/Hakyll/Tags.hs
+++ b/src/Text/Hakyll/Tags.hs
@@ -16,35 +16,42 @@
 --   All the following functions would work with such a format.
 module Text.Hakyll.Tags
     ( readTagMap
+    , readCategoryMap
     , renderTagCloud
     , renderTagLinks
     ) where
 
 import qualified Data.Map as M
 import Data.List (intercalate)
+import Data.Maybe (fromMaybe, maybeToList)
 import Control.Monad (foldM)
 import Control.Arrow (second)
 import Control.Applicative ((<$>))
 import System.FilePath
 
 import Text.Hakyll.Hakyll
-import Text.Hakyll.Context (ContextManipulation, changeValue)
+import Text.Hakyll.Context
 import Text.Hakyll.Regex
+import Text.Hakyll.Renderable
+import Text.Hakyll.Renderables
 import Text.Hakyll.Util
-import Text.Hakyll.Page
 import Text.Hakyll.Internal.Cache
 import Text.Hakyll.Internal.Template
 
+-- | Type for a tag map.
+type TagMap = M.Map String [PagePath]
+
 -- | Read a tag map. This creates a map from tags to page paths.
 --
 --   You also have to give a unique identifier for every tagmap. This is for
 --   caching reasons, so the tagmap will be stored in
 --   @_cache/_tagmap/identifier@.
-readTagMap :: String -- ^ Unique identifier for the tagmap.
-           -> [FilePath]
-           -> Hakyll (M.Map String [FilePath])
-readTagMap identifier paths = do
-    isCacheMoreRecent' <- isCacheMoreRecent fileName paths
+readMap :: (Context -> [String]) -- ^ Function to get tags from a context.
+        -> String -- ^ Unique identifier for the tagmap.
+        -> [PagePath]
+        -> Hakyll TagMap
+readMap getTagsFunction identifier paths = do
+    isCacheMoreRecent' <- isCacheMoreRecent fileName (getDependencies =<< paths)
     if isCacheMoreRecent' then M.fromAscList <$> getFromCache fileName
                           else do tagMap <- readTagMap'
                                   storeInCache (M.toAscList tagMap) fileName
@@ -54,17 +61,26 @@ 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
-            category = [getCategory path | categoriesEnabled]
+        context <- toContext path
+        let tags = getTagsFunction context
             addPaths' = flip (M.insertWith (++)) [path]
-        return $ foldr addPaths' current (category ++ tags)
+        return $ foldr addPaths' current tags
+
+readTagMap :: String
+           -> [PagePath]
+           -> Hakyll TagMap
+readTagMap = readMap  getTagsFunction
+  where
+    getTagsFunction = map trim . splitRegex ","
+                    . fromMaybe [] . M.lookup "tags"
 
-    getCategory = last . splitDirectories . takeDirectory
+readCategoryMap :: String
+                -> [PagePath]
+                -> Hakyll TagMap
+readCategoryMap = readMap $ maybeToList . M.lookup "category"
 
 -- | Render a tag cloud.
-renderTagCloud :: M.Map String [FilePath] -- ^ Map as produced by @readTagMap@.
+renderTagCloud :: TagMap -- ^ Map as produced by @readTagMap@.
                -> (String -> String) -- ^ Function to produce an url for a tag.
                -> Float -- ^ Smallest font size, in percent.
                -> Float -- ^ Biggest font size, in percent.