b9e843e · hakyll · git.iko.soy

git.iko.soy/hakyll

on master help sign in

Started a cleanup of Text.Hakyll.Tags.

b9e843eJasper Van der Jeugt17 years ago

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

compare with master

unifiedsplit

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

13import Data.Maybe (fromMaybe)

14import Control.Monad (liftM, replicateM)

15import Control.Monad.Reader (liftIO)

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

16+import System.FilePath

18import Test.QuickCheck

19import Text.Pandoc

20import Data.Binary

22import Text.Hakyll.Internal.Cache

23−import Text.Hakyll.Hakyll (Hakyll)

23+import Text.Hakyll.Hakyll

24import Text.Hakyll.File

25import Text.Hakyll.Util (trim)

26import Text.Hakyll.Context (Context)

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

124

125 -- Read file.

126 contents <- liftIO $ readFile path

127+ enableCategories' <- askHakyll enableCategories

127 let sections = splitAtDelimiters $ lines contents

128 let sections = splitAtDelimiters $ lines contents

128 context = concat $ zipWith ($) sectionFunctions sections

129 context = concat $ zipWith ($) sectionFunctions sections

129 page = fromContext $ M.fromList $

130 page = fromContext $ M.fromList $

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

130 [ ("url", url)

132 [ ("url", url)

131 , ("path", path)

133 , ("path", path)

132 ] ++ context

134 ] ++ context

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

134 return page

136 return page

135 where

137 where

136 url = toURL path

138 url = toURL path

139+ getCategory = last . splitDirectories . takeDirectory

137

140

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

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

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

142-- 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

13import qualified Data.Map as M

14import Control.Arrow (second)

15+import Control.Monad (liftM)

16+

17+import Data.Binary

16import Text.Hakyll.Hakyll (Hakyll)

19import Text.Hakyll.Hakyll (Hakyll)

17import Text.Hakyll.Page

20import Text.Hakyll.Page

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

95 getURL (PagePath path) = toURL path

98 getURL (PagePath path) = toURL path

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

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

100

101+-- We can serialize filepaths

102+instance Binary PagePath where

103+ put (PagePath path) = put path

104+ get = liftM PagePath get

105+

98-- | A combination of two other renderables.

106-- | A combination of two other renderables.

99data CombinedRenderable a b = CombinedRenderable a b

107data CombinedRenderable a b = CombinedRenderable a b

100 | CombinedRenderableWithURL FilePath a b

108 | CombinedRenderableWithURL FilePath a b

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

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

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

17module Text.Hakyll.Tags

18 ( readTagMap

19+ , readCategoryMap

19 , renderTagCloud

20 , renderTagCloud

20 , renderTagLinks

21 , renderTagLinks

21 ) where

22 ) where

23import qualified Data.Map as M

24import qualified Data.Map as M

24import Data.List (intercalate)

25import Data.List (intercalate)

26+import Data.Maybe (fromMaybe, maybeToList)

25import Control.Monad (foldM)

27import Control.Monad (foldM)

26import Control.Arrow (second)

28import Control.Arrow (second)

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

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

28import System.FilePath

30import System.FilePath

30import Text.Hakyll.Hakyll

32import Text.Hakyll.Hakyll

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

33+import Text.Hakyll.Context

32import Text.Hakyll.Regex

34import Text.Hakyll.Regex

35+import Text.Hakyll.Renderable

36+import Text.Hakyll.Renderables

33import Text.Hakyll.Util

37import Text.Hakyll.Util

34−import Text.Hakyll.Page

35import Text.Hakyll.Internal.Cache

38import Text.Hakyll.Internal.Cache

36import Text.Hakyll.Internal.Template

39import Text.Hakyll.Internal.Template

41+-- | Type for a tag map.

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

43+

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

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

39--

45--

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

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

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

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

42-- @_cache/_tagmap/identifier@.

48-- @_cache/_tagmap/identifier@.

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

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

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

44− -> [FilePath]

51+ -> [PagePath]

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

52+ -> Hakyll TagMap

46−readTagMap identifier paths = do

53+readMap getTagsFunction identifier paths = do

47− isCacheMoreRecent' <- isCacheMoreRecent fileName paths

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

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

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

49 else do tagMap <- readTagMap'

56 else do tagMap <- readTagMap'

50 storeInCache (M.toAscList tagMap) fileName

57 storeInCache (M.toAscList tagMap) fileName

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

55 readTagMap' = foldM addPaths M.empty paths

62 readTagMap' = foldM addPaths M.empty paths

56 addPaths current path = do

63 addPaths current path = do

57− page <- readPage path

64+ context <- toContext path

58− categoriesEnabled <- askHakyll enableCategories

65+ let tags = getTagsFunction context

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

60− category = [getCategory path | categoriesEnabled]

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

66 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"

64− getCategory = last . splitDirectories . takeDirectory

77+readCategoryMap :: String

78+ -> [PagePath]

79+ -> Hakyll TagMap

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

66-- | Render a tag cloud.

82-- | Render a tag cloud.

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

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

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

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

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

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

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

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