git.iko.soy/hakyll
on master help sign in
Proof-of-concept tag module
commit664648c5f9693fa5160a5c67aeabe8a9d38df03d authorJasper Van der Jeugt <jaspervdj@gmail.com> dateWed 5 Jan 2011, 13:12 (16 years ago) parent77c7d8d
3 files changed+67
compare with master
unifiedsplit
src/Hakyll/Web/Page.hs+10 src/Hakyll/Web/Tags.hs+42 src/Hakyll/Web/Util/String.hs+15
src/Hakyll/Web/Page.hs+10
@@ -5,6 +5,7 @@
55{-# LANGUAGE DeriveDataTypeable #-}
66module Hakyll.Web.Page
77 ( Page (..)
8+ , getField
89 , addField
910 , toMap
1011 , pageRead
@@ -15,6 +16,7 @@ import Prelude hiding (id)
1516import Control.Category (id)
1617import Control.Arrow ((>>^), (&&&), (>>>))
1718import System.FilePath (takeBaseName, takeDirectory)
19+import Data.Maybe (fromMaybe)
1820import Data.Map (Map)
1921import qualified Data.Map as M
2022
@@ -24,6 +26,14 @@ import Hakyll.Web.Page.Internal
2426import Hakyll.Web.Page.Read
2527import Hakyll.Web.Util.String
2628
29+-- | Get a metadata field. If the field does not exist, the empty string is
30+-- returned.
31+--
32+getField :: String -- ^ Key
33+ -> Page a -- ^ Page
34+ -> String -- ^ Value
35+getField key = fromMaybe "" . M.lookup key . pageMetadata
36+
2737-- | Add a metadata field. If the field already exists, it is not overwritten.
2838--
2939addField :: String -- ^ Key
src/Hakyll/Web/Tags.hsnew file+42
@@ -0,0 +1,42 @@
1+module Hakyll.Web.Tags
2+ ( Tags (..)
3+ , readTagsWith
4+ , readTags
5+ , readCategories
6+ ) where
7+
8+import Data.Map (Map)
9+import qualified Data.Map as M
10+
11+import Hakyll.Web.Page
12+import Hakyll.Web.Util.String
13+
14+-- | Data about tags
15+--
16+data Tags a = Tags
17+ { tagsMap :: Map String [Page a]
18+ } deriving (Show)
19+
20+-- | Higher-level function to read tags
21+--
22+readTagsWith :: (Page a -> [String]) -- ^ Function extracting tags from a page
23+ -> [Page a] -- ^ Pages
24+ -> Tags a -- ^ Resulting tags
25+readTagsWith f pages = Tags
26+ { tagsMap = foldl (M.unionWith (++)) M.empty (map readTagsWith' pages)
27+ }
28+ where
29+ -- Create a tag map for one page
30+ readTagsWith' page =
31+ let tags = f page
32+ in M.fromList $ zip tags $ repeat [page]
33+
34+-- | Read a tagmap using the @tags@ metadata field
35+--
36+readTags :: [Page a] -> Tags a
37+readTags = readTagsWith $ map trim . splitAll "," . getField "tags"
38+
39+-- | Read a tagmap using the @category@ metadata field
40+--
41+readCategories :: [Page a] -> Tags a
42+readCategories = readTagsWith $ return . getField "category"
src/Hakyll/Web/Util/String.hs+15
@@ -3,6 +3,7 @@
33module Hakyll.Web.Util.String
44 ( trim
55 , replaceAll
6+ , splitAll
67 , toUrl
78 , toSiteRoot
89 ) where
@@ -35,6 +36,20 @@ replaceAll pattern f source = replaceAll' source
3536 (capture, after) = splitAt l tmp
3637 in before ++ f capture ++ replaceAll' after
3738
39+-- | A simple regex split function. The resulting list will contain no empty
40+-- strings.
41+--
42+splitAll :: String -- ^ Pattern
43+ -> String -- ^ String to split
44+ -> [String] -- ^ Result
45+splitAll pattern = filter (not . null) . splitAll'
46+ where
47+ splitAll' src = case listToMaybe (src =~~ pattern) of
48+ Nothing -> [src]
49+ Just (o, l) ->
50+ let (before, tmp) = splitAt o src
51+ in before : splitAll' (drop l tmp)
52+
3853-- | Convert a filepath to an URL starting from the site root
3954--
4055-- Example: