664648c · hakyll · git.iko.soy

src/Hakyll/Web/Page.hs+10

compare with master

unifiedsplit

@@ -5,6 +5,7 @@

5{-# LANGUAGE DeriveDataTypeable #-}

6module Hakyll.Web.Page

7 ( Page (..)

8+ , getField

8 , addField

9 , addField

9 , toMap

10 , toMap

10 , pageRead

11 , pageRead

@@ -15,6 +16,7 @@ import Prelude hiding (id)

15import Control.Category (id)

16import Control.Category (id)

16import Control.Arrow ((>>^), (&&&), (>>>))

17import Control.Arrow ((>>^), (&&&), (>>>))

17import System.FilePath (takeBaseName, takeDirectory)

18import System.FilePath (takeBaseName, takeDirectory)

19+import Data.Maybe (fromMaybe)

18import Data.Map (Map)

20import Data.Map (Map)

19import qualified Data.Map as M

21import qualified Data.Map as M

20

22

@@ -24,6 +26,14 @@ import Hakyll.Web.Page.Internal

24import Hakyll.Web.Page.Read

26import Hakyll.Web.Page.Read

25import Hakyll.Web.Util.String

27import Hakyll.Web.Util.String

26

28

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+

27-- | Add a metadata field. If the field already exists, it is not overwritten.

37-- | Add a metadata field. If the field already exists, it is not overwritten.

28--

38--

29addField :: String -- ^ Key

39addField :: 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 @@

3module Hakyll.Web.Util.String

4 ( trim

5 , replaceAll

6+ , splitAll

6 , toUrl

7 , toUrl

7 , toSiteRoot

8 , toSiteRoot

8 ) where

9 ) where

@@ -35,6 +36,20 @@ replaceAll pattern f source = replaceAll' source

35 (capture, after) = splitAt l tmp

36 (capture, after) = splitAt l tmp

36 in before ++ f capture ++ replaceAll' after

37 in before ++ f capture ++ replaceAll' after

37

38

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+

38-- | Convert a filepath to an URL starting from the site root

53-- | Convert a filepath to an URL starting from the site root

39--

54--

40-- Example:

55-- Example: