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

This commit is contained in:
Jasper Van der Jeugt 2010-01-27 18:52:11 +01:00
parent 5928459858
commit f9a4b4f6f4
4 changed files with 15 additions and 6 deletions

View file

@ -19,6 +19,7 @@ defaultHakyllConfiguration = HakyllConfiguration
{ additionalContext = M.empty
, siteDirectory = "_site"
, cacheDirectory = "_cache"
, enableCategories = False
}
-- | Hakyll with a default configuration.

View file

@ -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.

View file

@ -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)

View file

@ -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@.