1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
|
-- | Module containing some specialized functions to deal with tags.
-- This Module follows certain conventions. Stick with them.
--
-- 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:
--
-- > ---
-- > author: Philip K. Dick
-- > title: Do androids dream of electric sheep?
-- > tags: future, science fiction, humanoid
-- > ---
-- > 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.
module Text.Hakyll.Tags
( readTagMap
, renderTagCloud
, renderTagLinks
) where
import qualified Data.Map as M
import Data.List (intercalate)
import Control.Monad (foldM)
import Control.Arrow (second)
import Control.Applicative ((<$>))
import System.FilePath ((</>))
import Text.Hakyll.Hakyll (Hakyll)
import Text.Hakyll.Context (ContextManipulation, changeValue)
import Text.Hakyll.Render.Internal (finalSubstitute)
import Text.Hakyll.Regex
import Text.Hakyll.Util
import Text.Hakyll.Page
import Text.Hakyll.Internal.Cache
-- | 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
if isCacheMoreRecent' then M.fromAscList <$> getFromCache fileName
else do tagMap <- readTagMap'
storeInCache (M.toAscList tagMap) fileName
return tagMap
where
fileName = "_tagmap" </> identifier
readTagMap' = foldM addPaths M.empty paths
addPaths current path = do
page <- readPage path
let tags = map trim $ splitRegex "," $ getValue "tags" page
return $ foldr (flip (M.insertWith (++)) [path]) current tags
-- | Render a tag cloud.
renderTagCloud :: M.Map String [FilePath] -- ^ 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.
-> String -- ^ Result of the render.
renderTagCloud tagMap urlFunction minSize maxSize =
intercalate " " $ map renderTag tagCount
where
renderTag :: (String, Float) -> String
renderTag (tag, count) =
finalSubstitute "<a style=\"font-size: $size\" href=\"$url\">$tag</a>" $
M.fromList [ ("size", sizeTag count)
, ("url", urlFunction tag)
, ("tag", tag)
]
sizeTag :: Float -> String
sizeTag count = show size' ++ "%"
where
size' :: Int
size' = floor $ minSize + relative count * (maxSize - minSize)
minCount = minimum $ map snd tagCount
maxCount = maximum $ map snd tagCount
relative count = (count - minCount) / (maxCount - minCount)
tagCount :: [(String, Float)]
tagCount = map (second $ fromIntegral . length) $ M.toList tagMap
-- | Render all tags to links.
--
-- On your side, it is nice if you can display the tags on a page, but
-- naturally, most people would expect these are clickable.
--
-- So, this function takes a function to produce an url for a given tag, and
-- applies it on all tags.
--
-- Note that it is your own responsibility to ensure a page which such an url
-- exists.
renderTagLinks :: (String -> String) -- ^ Function to produce an url for a tag.
-> ContextManipulation
renderTagLinks urlFunction = changeValue "tags" renderTagLinks'
where
renderTagLinks' = intercalate ", "
. map ((\t -> link t $ urlFunction t) . trim)
. splitRegex ","
|
