diff options
Diffstat (limited to 'src/Hakyll')
| -rw-r--r-- | src/Hakyll/Core/Configuration.hs | 3 | ||||
| -rw-r--r-- | src/Hakyll/Core/Runtime.hs | 1 | ||||
| -rw-r--r-- | src/Hakyll/Web/Tags.hs | 121 |
3 files changed, 70 insertions, 55 deletions
diff --git a/src/Hakyll/Core/Configuration.hs b/src/Hakyll/Core/Configuration.hs index c859585..4d34114 100644 --- a/src/Hakyll/Core/Configuration.hs +++ b/src/Hakyll/Core/Configuration.hs @@ -1,7 +1,8 @@ -------------------------------------------------------------------------------- -- | Exports a datastructure for the top-level hakyll configuration module Hakyll.Core.Configuration - ( Configuration (..) + ( Verbosity (..) + , Configuration (..) , shouldIgnoreFile , defaultConfiguration ) where diff --git a/src/Hakyll/Core/Runtime.hs b/src/Hakyll/Core/Runtime.hs index 46c7d1e..99ba1a4 100644 --- a/src/Hakyll/Core/Runtime.hs +++ b/src/Hakyll/Core/Runtime.hs @@ -175,6 +175,7 @@ chase trail id' routes <- runtimeRoutes <$> ask store <- runtimeStore <$> ask config <- runtimeConfiguration <$> ask + Logger.debug logger $ "Processing " ++ show id' let compiler = todo M.! id' read' = CompilerRead diff --git a/src/Hakyll/Web/Tags.hs b/src/Hakyll/Web/Tags.hs index 2aa1cac..c5f2b1f 100644 --- a/src/Hakyll/Web/Tags.hs +++ b/src/Hakyll/Web/Tags.hs @@ -1,11 +1,11 @@ -------------------------------------------------------------------------------- --- | Module containing some specialized functions to deal with tags. --- This Module follows certain conventions. My advice is to stick with them if --- possible. +-- | This module containing some specialized functions to deal with tags. It +-- assumes you follow some conventions. -- --- More concrete: all functions in this module assume that the tags are --- located in the @tags@ field, and separated by commas. An example file --- @foo.markdown@ could look like: +-- We support two types of tags: tags and categories. +-- +-- To use default tags, use 'buildTags'. Tags are placed in a comma-separated +-- metadata field like this: -- -- > --- -- > author: Philip K. Dick @@ -15,26 +15,38 @@ -- > The novel is set in a post-apocalyptic near future, where the Earth and -- > its populations have been damaged greatly by Nuclear... -- --- All the following functions would work with such a format. In addition to --- tags, Hakyll also supports categories. The convention when using categories --- is to place pages in subdirectories. +-- To use categories, use the 'buildCategories' function. Categories are +-- determined by the direcetory a page is in, for example, the post +-- +-- > posts/coding/2010-01-28-hakyll-categories.markdown +-- +-- will receive the @coding@ category. +-- +-- Advanced users may implement custom systems using 'buildTagsWith' if desired. +-- +-- In the above example, we would want to create a page which lists all pages in +-- the @coding@ category, for example, with the 'Identifier': -- --- An example, the page @posts\/coding\/2010-01-28-hakyll-categories.markdown@ --- Tags or categories are read using the @buildTags@ and @buildCategory@ --- functions. This module only provides functions to work with tags: --- categories are represented as tags. This is perfectly possible: categories --- only have an additional restriction that a page can only have one category --- (instead of multiple tags). +-- > tags/coding.html +-- +-- This is where the first parameter of 'buildTags' and 'buildCategories' comes +-- in. In the above case, we used the function: +-- +-- > fromCapture "tags/*.html" :: String -> Identifier +-- +-- The 'tagsRules' function lets you generate such a page for each tag in the +-- 'Rules' monad. {-# LANGUAGE Arrows #-} {-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE OverloadedStrings #-} module Hakyll.Web.Tags - ( Tags (..) + ( Tags , getTags , buildTagsWith , buildTags - , buildCategory + , buildCategories + , tagsRules , renderTagCloud , renderTagList , tagsField @@ -46,8 +58,7 @@ module Hakyll.Web.Tags -------------------------------------------------------------------------------- import Control.Arrow ((&&&)) -import Control.Monad (foldM, forM) -import Data.Binary (Binary) +import Control.Monad (foldM, forM, forM_) import Data.Char (toLower) import Data.List (intercalate, intersperse, sortBy) @@ -55,7 +66,6 @@ import qualified Data.Map as M import Data.Maybe (catMaybes, fromMaybe) import Data.Monoid (mconcat) import Data.Ord (comparing) -import Data.Typeable (Typeable) import System.FilePath (takeBaseName, takeDirectory) import Text.Blaze.Html (toHtml, toValue, (!)) import Text.Blaze.Html.Renderer.String (renderHtml) @@ -69,23 +79,18 @@ import Hakyll.Core.Identifier import Hakyll.Core.Identifier.Pattern import Hakyll.Core.Item import Hakyll.Core.Metadata +import Hakyll.Core.Rules import Hakyll.Core.Util.String -import Hakyll.Core.Writable import Hakyll.Web.Template.Context import Hakyll.Web.Urls -------------------------------------------------------------------------------- -- | Data about tags --- TODO Make this a map instead of a list? -newtype Tags = Tags - { unTags :: [(String, [Identifier])] - } deriving (Binary, Show, Typeable) - - --------------------------------------------------------------------------------- -instance Writable Tags where - write _ _ = return () +data Tags = Tags + { tagsMap :: [(String, [Identifier])] + , tagsMakeId :: String -> Identifier + } deriving (Show) -------------------------------------------------------------------------------- @@ -105,11 +110,14 @@ getCategory = return . return . takeBaseName . takeDirectory . toFilePath -------------------------------------------------------------------------------- -- | Higher-order function to read tags buildTagsWith :: MonadMetadata m - => (Identifier -> m [String]) -> Pattern -> m Tags -buildTagsWith f pattern = do + => (Identifier -> m [String]) + -> Pattern + -> (String -> Identifier) + -> m Tags +buildTagsWith f pattern makeId = do ids <- getMatches pattern tagMap <- foldM addTags M.empty ids - return $ Tags $ M.toList tagMap + return $ Tags (M.toList tagMap) makeId where -- Create a tag map for one page addTags tagMap id' = do @@ -117,34 +125,42 @@ buildTagsWith f pattern = do let tagMap' = M.fromList $ zip tags $ repeat [id'] return $ M.unionWith (++) tagMap tagMap' + -------------------------------------------------------------------------------- --- | Read a tagmap using the @tags@ metadata field -buildTags :: MonadMetadata m => Pattern -> m Tags +buildTags :: MonadMetadata m => Pattern -> (String -> Identifier) -> m Tags buildTags = buildTagsWith getTags -------------------------------------------------------------------------------- --- | Read a tagmap using the @category@ metadata field -buildCategory :: MonadMetadata m => Pattern -> m Tags -buildCategory = buildTagsWith getCategory +buildCategories :: MonadMetadata m => Pattern -> (String -> Identifier) + -> m Tags +buildCategories = buildTagsWith getCategory + + +-------------------------------------------------------------------------------- +tagsRules :: Tags -> (String -> Pattern -> Rules ()) -> Rules () +tagsRules tags rules = + forM_ (tagsMap tags) $ \(tag, identifiers) -> + match (fromGlob $ toFilePath $ tagsMakeId tags tag) $ + rules tag $ fromList identifiers -------------------------------------------------------------------------------- -- | Render tags in HTML -renderTags :: (String -> Identifier) - -- ^ Produce a tag page id - -> (String -> String -> Int -> Int -> Int -> String) +renderTags :: (String -> String -> Int -> Int -> Int -> String) -- ^ Produce a tag item: tag, url, count, min count, max count -> ([String] -> String) -- ^ Join items -> Tags -- ^ Tag cloud renderer -> Compiler String -renderTags makeTagId makeHtml concatHtml (Tags tags) = do +renderTags makeHtml concatHtml (Tags tags makeTagId) = do -- In tags' we create a list: [((tag, route), count)] tags' <- forM tags $ \(tag, ids) -> do - route <- getRoute $ makeTagId tag - return ((tag, route), length ids) + route' <- getRoute $ makeTagId tag + return ((tag, route'), length ids) + + -- TODO: We actually need to tell a dependency here! let -- Absolute frequencies of the pages freqs = map snd tags' @@ -165,9 +181,7 @@ renderTags makeTagId makeHtml concatHtml (Tags tags) = do -------------------------------------------------------------------------------- -- | Render a tag cloud in HTML -- TODO: Maybe produce a Context here -renderTagCloud :: (String -> Identifier) - -- ^ Produce a link for a tag - -> Double +renderTagCloud :: Double -- ^ Smallest font size, in percent -> Double -- ^ Biggest font size, in percent @@ -175,8 +189,7 @@ renderTagCloud :: (String -> Identifier) -- ^ Input tags -> Compiler String -- ^ Rendered cloud -renderTagCloud makeTagId minSize maxSize = - renderTags makeTagId makeLink (intercalate " ") +renderTagCloud minSize maxSize = renderTags makeLink (intercalate " ") where makeLink tag url count min' max' = renderHtml $ H.a ! A.style (toValue $ "font-size: " ++ size count min' max') @@ -194,8 +207,8 @@ renderTagCloud makeTagId minSize maxSize = -------------------------------------------------------------------------------- -- | Render a simple tag list in HTML, with the tag count next to the item -- TODO: Maybe produce a Context here -renderTagList :: (String -> Identifier) -> Tags -> Compiler (String) -renderTagList makeTagId = renderTags makeTagId makeLink (intercalate ", ") +renderTagList :: Tags -> Compiler (String) +renderTagList = renderTags makeLink (intercalate ", ") where makeLink tag url count _ _ = renderHtml $ H.a ! A.href (toValue url) $ toHtml (tag ++ " (" ++ show count ++ ")") @@ -214,8 +227,8 @@ tagsFieldWith :: (Identifier -> Compiler [String]) -- ^ Get the tags tagsFieldWith getTags' key makeTagId = field key $ \item -> do tags <- getTags' $ itemIdentifier item links <- forM tags $ \tag -> do - route <- getRoute $ makeTagId tag - return $ renderLink tag route + route' <- getRoute $ makeTagId tag + return $ renderLink tag route' return $ renderHtml $ mconcat $ intersperse ", " $ catMaybes $ links where @@ -246,7 +259,7 @@ categoryField = tagsFieldWith getCategory -- the comparing function is the actual tag name. sortTagsBy :: ((String, [Identifier]) -> (String, [Identifier]) -> Ordering) -> Tags -> Tags -sortTagsBy f = Tags . sortBy f . unTags +sortTagsBy f t = t {tagsMap = sortBy f (tagsMap t)} -------------------------------------------------------------------------------- |