Added an option for categories instead/in addition to tags. Experimental.
This commit is contained in:
parent
5928459858
commit
f9a4b4f6f4
4 changed files with 15 additions and 6 deletions
|
@ -19,6 +19,7 @@ defaultHakyllConfiguration = HakyllConfiguration
|
|||
{ additionalContext = M.empty
|
||||
, siteDirectory = "_site"
|
||||
, cacheDirectory = "_cache"
|
||||
, enableCategories = False
|
||||
}
|
||||
|
||||
-- | Hakyll with a default configuration.
|
||||
|
|
|
@ -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.
|
||||
|
|
|
@ -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)
|
||||
|
|
|
@ -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@.
|
||||
|
|
Loading…
Reference in a new issue