diff options
| -rw-r--r-- | src/Text/Hakyll/Page.hs | 7 | ||||
| -rw-r--r-- | src/Text/Hakyll/Renderables.hs | 8 | ||||
| -rw-r--r-- | src/Text/Hakyll/Tags.hs | 44 |
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. |