diff options
| -rw-r--r-- | src/Hakyll/Web/Page.hs | 10 | ||||
| -rw-r--r-- | src/Hakyll/Web/Tags.hs | 42 | ||||
| -rw-r--r-- | src/Hakyll/Web/Util/String.hs | 15 |
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: |