b9e843e · hakyll · git.iko.soy

git.iko.soy/hakyll

Started a cleanup of Text.Hakyll.Tags.

commitb9e843e3672d540d5115176e1795ada18f92a320 authorJasper Van der Jeugt <jaspervdj@gmail.com> dateWed 27 Jan 2010, 23:48 (17 years ago) parentf9a4b4f

3 files changed+43−16

compare with master

unifiedsplit

src/Text/Hakyll/Page.hs+5−2 src/Text/Hakyll/Renderables.hs+8 src/Text/Hakyll/Tags.hs+30−14

src/Text/Hakyll/Page.hs+5−2

@@ -13,14 +13,14 @@ import Data.Char (isSpace)

1313import Data.Maybe (fromMaybe)

1414import Control.Monad (liftM, replicateM)

1515import Control.Monad.Reader (liftIO)

16−import System.FilePath (takeExtension, (</>))

16+import System.FilePath

1717

1818import Test.QuickCheck

1919import Text.Pandoc

2020import Data.Binary

2121

2222import Text.Hakyll.Internal.Cache

23−import Text.Hakyll.Hakyll (Hakyll)

23+import Text.Hakyll.Hakyll

2424import Text.Hakyll.File

2525import Text.Hakyll.Util (trim)

2626import Text.Hakyll.Context (Context)

@@ -124,9 +124,11 @@ readPageFromFile path = do

124124

125125 -- Read file.

126126 contents <- liftIO $ readFile path

127+ enableCategories' <- askHakyll enableCategories

127128 let sections = splitAtDelimiters $ lines contents

128129 context = concat $ zipWith ($) sectionFunctions sections

129130 page = fromContext $ M.fromList $

131+ [ ("category", getCategory path) | enableCategories' ] ++

130132 [ ("url", url)

131133 , ("path", path)

132134 ] ++ context

@@ -134,6 +136,7 @@ readPageFromFile path = do

134136 return page

135137 where

136138 url = toURL path

139+ getCategory = last . splitDirectories . takeDirectory

137140

138141-- | Read a page. Might fetch it from the cache if available. Otherwise, it will

139142-- read it from the file given and store it in the cache.

src/Text/Hakyll/Renderables.hs+8

@@ -12,6 +12,9 @@ module Text.Hakyll.Renderables

1212

1313import qualified Data.Map as M

1414import Control.Arrow (second)

15+import Control.Monad (liftM)

16+

17+import Data.Binary

1518

1619import Text.Hakyll.Hakyll (Hakyll)

1720import Text.Hakyll.Page

@@ -95,6 +98,11 @@ instance Renderable PagePath where

9598 getURL (PagePath path) = toURL path

9699 toContext (PagePath path) = readPage path >>= toContext

97100

101+-- We can serialize filepaths

102+instance Binary PagePath where

103+ put (PagePath path) = put path

104+ get = liftM PagePath get

105+

98106-- | A combination of two other renderables.

99107data CombinedRenderable a b = CombinedRenderable a b

100108 | CombinedRenderableWithURL FilePath a b

src/Text/Hakyll/Tags.hs+30−14

@@ -16,35 +16,42 @@

1616-- All the following functions would work with such a format.

1717module Text.Hakyll.Tags

1818 ( readTagMap

19+ , readCategoryMap

1920 , renderTagCloud

2021 , renderTagLinks

2122 ) where

2223

2324import qualified Data.Map as M

2425import Data.List (intercalate)

26+import Data.Maybe (fromMaybe, maybeToList)

2527import Control.Monad (foldM)

2628import Control.Arrow (second)

2729import Control.Applicative ((<$>))

2830import System.FilePath

2931

3032import Text.Hakyll.Hakyll

31−import Text.Hakyll.Context (ContextManipulation, changeValue)

33+import Text.Hakyll.Context

3234import Text.Hakyll.Regex

35+import Text.Hakyll.Renderable

36+import Text.Hakyll.Renderables

3337import Text.Hakyll.Util

34−import Text.Hakyll.Page

3538import Text.Hakyll.Internal.Cache

3639import Text.Hakyll.Internal.Template

3740

41+-- | Type for a tag map.

42+type TagMap = M.Map String [PagePath]

43+

3844-- | Read a tag map. This creates a map from tags to page paths.

3945--

4046-- You also have to give a unique identifier for every tagmap. This is for

4147-- caching reasons, so the tagmap will be stored in

4248-- @_cache/_tagmap/identifier@.

43−readTagMap :: String -- ^ Unique identifier for the tagmap.

44− -> [FilePath]

45− -> Hakyll (M.Map String [FilePath])

46−readTagMap identifier paths = do

47− isCacheMoreRecent' <- isCacheMoreRecent fileName paths

49+readMap :: (Context -> [String]) -- ^ Function to get tags from a context.

50+ -> String -- ^ Unique identifier for the tagmap.

51+ -> [PagePath]

52+ -> Hakyll TagMap

53+readMap getTagsFunction identifier paths = do

54+ isCacheMoreRecent' <- isCacheMoreRecent fileName (getDependencies =<< paths)

4855 if isCacheMoreRecent' then M.fromAscList <$> getFromCache fileName

4956 else do tagMap <- readTagMap'

5057 storeInCache (M.toAscList tagMap) fileName

@@ -54,17 +61,26 @@ readTagMap identifier paths = do

5461

5562 readTagMap' = foldM addPaths M.empty paths

5663 addPaths current path = do

57− page <- readPage path

58− categoriesEnabled <- askHakyll enableCategories

59− let tags = map trim $ splitRegex "," $ getValue "tags" page

60− category = [getCategory path | categoriesEnabled]

64+ context <- toContext path

65+ let tags = getTagsFunction context

6166 addPaths' = flip (M.insertWith (++)) [path]

62− return $ foldr addPaths' current (category ++ tags)

67+ return $ foldr addPaths' current tags

68+

69+readTagMap :: String

70+ -> [PagePath]

71+ -> Hakyll TagMap

72+readTagMap = readMap getTagsFunction

73+ where

74+ getTagsFunction = map trim . splitRegex ","

75+ . fromMaybe [] . M.lookup "tags"

6376

64− getCategory = last . splitDirectories . takeDirectory

77+readCategoryMap :: String

78+ -> [PagePath]

79+ -> Hakyll TagMap

80+readCategoryMap = readMap $ maybeToList . M.lookup "category"

6581

6682-- | Render a tag cloud.

67−renderTagCloud :: M.Map String [FilePath] -- ^ Map as produced by @readTagMap@.

83+renderTagCloud :: TagMap -- ^ Map as produced by @readTagMap@.

6884 -> (String -> String) -- ^ Function to produce an url for a tag.

6985 -> Float -- ^ Smallest font size, in percent.

7086 -> Float -- ^ Biggest font size, in percent.