summaryrefslogtreecommitdiff
path: root/src/Hakyll
diff options
context:
space:
mode:
Diffstat (limited to 'src/Hakyll')
-rw-r--r--src/Hakyll/Web/Page.hs10
-rw-r--r--src/Hakyll/Web/Tags.hs42
-rw-r--r--src/Hakyll/Web/Util/String.hs15
3 files changed, 67 insertions, 0 deletions
diff --git a/src/Hakyll/Web/Page.hs b/src/Hakyll/Web/Page.hs
index 883da74..00d143e 100644
--- a/src/Hakyll/Web/Page.hs
+++ b/src/Hakyll/Web/Page.hs
@@ -5,6 +5,7 @@
{-# LANGUAGE DeriveDataTypeable #-}
module Hakyll.Web.Page
( Page (..)
+ , getField
, addField
, toMap
, pageRead
@@ -15,6 +16,7 @@ import Prelude hiding (id)
import Control.Category (id)
import Control.Arrow ((>>^), (&&&), (>>>))
import System.FilePath (takeBaseName, takeDirectory)
+import Data.Maybe (fromMaybe)
import Data.Map (Map)
import qualified Data.Map as M
@@ -24,6 +26,14 @@ import Hakyll.Web.Page.Internal
import Hakyll.Web.Page.Read
import Hakyll.Web.Util.String
+-- | Get a metadata field. If the field does not exist, the empty string is
+-- returned.
+--
+getField :: String -- ^ Key
+ -> Page a -- ^ Page
+ -> String -- ^ Value
+getField key = fromMaybe "" . M.lookup key . pageMetadata
+
-- | Add a metadata field. If the field already exists, it is not overwritten.
--
addField :: String -- ^ Key
diff --git a/src/Hakyll/Web/Tags.hs b/src/Hakyll/Web/Tags.hs
new file mode 100644
index 0000000..4986a31
--- /dev/null
+++ b/src/Hakyll/Web/Tags.hs
@@ -0,0 +1,42 @@
+module Hakyll.Web.Tags
+ ( Tags (..)
+ , readTagsWith
+ , readTags
+ , readCategories
+ ) where
+
+import Data.Map (Map)
+import qualified Data.Map as M
+
+import Hakyll.Web.Page
+import Hakyll.Web.Util.String
+
+-- | Data about tags
+--
+data Tags a = Tags
+ { tagsMap :: Map String [Page a]
+ } deriving (Show)
+
+-- | Higher-level function to read tags
+--
+readTagsWith :: (Page a -> [String]) -- ^ Function extracting tags from a page
+ -> [Page a] -- ^ Pages
+ -> Tags a -- ^ Resulting tags
+readTagsWith f pages = Tags
+ { tagsMap = foldl (M.unionWith (++)) M.empty (map readTagsWith' pages)
+ }
+ where
+ -- Create a tag map for one page
+ readTagsWith' page =
+ let tags = f page
+ in M.fromList $ zip tags $ repeat [page]
+
+-- | Read a tagmap using the @tags@ metadata field
+--
+readTags :: [Page a] -> Tags a
+readTags = readTagsWith $ map trim . splitAll "," . getField "tags"
+
+-- | Read a tagmap using the @category@ metadata field
+--
+readCategories :: [Page a] -> Tags a
+readCategories = readTagsWith $ return . getField "category"
diff --git a/src/Hakyll/Web/Util/String.hs b/src/Hakyll/Web/Util/String.hs
index ed8b904..0dde74a 100644
--- a/src/Hakyll/Web/Util/String.hs
+++ b/src/Hakyll/Web/Util/String.hs
@@ -3,6 +3,7 @@
module Hakyll.Web.Util.String
( trim
, replaceAll
+ , splitAll
, toUrl
, toSiteRoot
) where
@@ -35,6 +36,20 @@ replaceAll pattern f source = replaceAll' source
(capture, after) = splitAt l tmp
in before ++ f capture ++ replaceAll' after
+-- | A simple regex split function. The resulting list will contain no empty
+-- strings.
+--
+splitAll :: String -- ^ Pattern
+ -> String -- ^ String to split
+ -> [String] -- ^ Result
+splitAll pattern = filter (not . null) . splitAll'
+ where
+ splitAll' src = case listToMaybe (src =~~ pattern) of
+ Nothing -> [src]
+ Just (o, l) ->
+ let (before, tmp) = splitAt o src
+ in before : splitAll' (drop l tmp)
+
-- | Convert a filepath to an URL starting from the site root
--
-- Example: