diff options
| -rw-r--r-- | src/Hakyll/Web/Page.hs | 31 | ||||
| -rw-r--r-- | src/Hakyll/Web/Page/Metadata.hs | 110 | ||||
| -rw-r--r-- | src/Hakyll/Web/Tags.hs | 1 |
3 files changed, 119 insertions, 23 deletions
diff --git a/src/Hakyll/Web/Page.hs b/src/Hakyll/Web/Page.hs index 00d143e..35a58ff 100644 --- a/src/Hakyll/Web/Page.hs +++ b/src/Hakyll/Web/Page.hs @@ -5,8 +5,6 @@ {-# LANGUAGE DeriveDataTypeable #-} module Hakyll.Web.Page ( Page (..) - , getField - , addField , toMap , pageRead , addDefaultFields @@ -16,7 +14,6 @@ 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,24 +21,9 @@ import Hakyll.Core.Identifier import Hakyll.Core.Compiler import Hakyll.Web.Page.Internal import Hakyll.Web.Page.Read +import Hakyll.Web.Page.Metadata 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 - -> String -- ^ Value - -> Page a -- ^ Page to add it to - -> Page a -- ^ Resulting page -addField k v (Page m b) = Page (M.insertWith (flip const) k v m) b - -- | Convert a page to a map. The body will be placed in the @body@ key. -- toMap :: Page String -> Map String String @@ -56,20 +38,23 @@ pageRead = getResourceString >>^ readPage -- -- * @$url@ -- --- * @$root@ +-- * @$category@ -- -- * @$title@ -- +-- * @$path@ +-- addDefaultFields :: Compiler (Page a) (Page a) addDefaultFields = (getRoute &&& id >>^ uncurry addRoute) >>> (getIdentifier &&& id >>^ uncurry addIdentifier) where -- Add root and url, based on route addRoute Nothing = id - addRoute (Just r) = addField "url" (toUrl r) + addRoute (Just r) = setField "url" (toUrl r) -- Add title and category, based on identifier - addIdentifier i = addField "title" (takeBaseName p) - . addField "category" (takeBaseName $ takeDirectory p) + addIdentifier i = setField "title" (takeBaseName p) + . setField "category" (takeBaseName $ takeDirectory p) + . setField "path" p where p = toFilePath i diff --git a/src/Hakyll/Web/Page/Metadata.hs b/src/Hakyll/Web/Page/Metadata.hs new file mode 100644 index 0000000..28be7d5 --- /dev/null +++ b/src/Hakyll/Web/Page/Metadata.hs @@ -0,0 +1,110 @@ +-- | Provides various functions to manipulate the metadata fields of a page +-- +module Hakyll.Web.Page.Metadata + ( getField + , setField + , renderField + , changeField + , copyField + , renderDateField + , renderDateFieldWith + ) where + +import Data.List (intercalate) +import Data.Maybe (fromMaybe) +import Data.Time.Clock (UTCTime) +import Data.Time.Format (parseTime, formatTime) +import qualified Data.Map as M +import System.FilePath (takeFileName) +import System.Locale (TimeLocale, defaultTimeLocale) + +import Hakyll.Web.Page.Internal +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. +-- +setField :: String -- ^ Key + -> String -- ^ Value + -> Page a -- ^ Page to add it to + -> Page a -- ^ Resulting page +setField k v (Page m b) = Page (M.insertWith (flip const) k v m) b + +-- | Do something with a metadata value, but keep the old value as well. If the +-- key given is not present in the metadata, nothing will happen. If the source +-- and destination keys are the same, the value will be changed (but you should +-- use 'changeField' for this purpose). +-- +renderField :: String -- ^ Key of which the value should be copied + -> String -- ^ Key the value should be copied to + -> (String -> String) -- ^ Function to apply on the value + -> Page a -- ^ Page on which this should be applied + -> Page a -- ^ Resulting page +renderField src dst f page = case M.lookup src (pageMetadata page) of + Nothing -> page + (Just value) -> setField dst (f value) page + +-- | Change a metadata value. +-- +-- > import Data.Char (toUpper) +-- > changeField "title" (map toUpper) +-- +-- Will put the title in UPPERCASE. +-- +changeField :: String -- ^ Key to change. + -> (String -> String) -- ^ Function to apply on the value. + -> Page a -- ^ Page to change + -> Page a -- ^ Resulting page +changeField key = renderField key key + +-- | Make a copy of a metadata field (put the value belonging to a certain key +-- under some other key as well) +-- +copyField :: String -- ^ Key to copy + -> String -- ^ Destination to copy to + -> Page a -- ^ Page on which this should be applied + -> Page a -- ^ Resulting page +copyField src dst = renderField src dst id + +-- | When the metadata has a field called @path@ in a +-- @folder/yyyy-mm-dd-title.extension@ format (the convention for pages), +-- this function can render the date. +-- +-- > renderDate "date" "%B %e, %Y" "Date unknown" +-- +-- Will render something like @January 32, 2010@. +-- +renderDateField :: String -- ^ Key in which the rendered date should be placed + -> String -- ^ Format to use on the date + -> String -- ^ Default value, in case the date cannot be parsed + -> Page a -- ^ Page on which this should be applied + -> Page a -- ^ Resulting page +renderDateField = renderDateFieldWith defaultTimeLocale + +-- | This is an extended version of 'renderDateField' that allows you to +-- specify a time locale that is used for outputting the date. For more +-- details, see 'renderDateField'. +-- +renderDateFieldWith :: TimeLocale -- ^ Output time locale + -> String -- ^ Destination key + -> String -- ^ Format to use on the date + -> String -- ^ Default value + -> Page a -- ^ Target page + -> Page a -- ^ Resulting page +renderDateFieldWith locale key format defaultValue = + renderField "path" key renderDate' + where + renderDate' filePath = fromMaybe defaultValue $ do + let dateString = intercalate "-" $ take 3 + $ splitAll "-" $ takeFileName filePath + time <- parseTime defaultTimeLocale + "%Y-%m-%d" + dateString :: Maybe UTCTime + return $ formatTime locale format time diff --git a/src/Hakyll/Web/Tags.hs b/src/Hakyll/Web/Tags.hs index 14aaab5..62a99fc 100644 --- a/src/Hakyll/Web/Tags.hs +++ b/src/Hakyll/Web/Tags.hs @@ -49,6 +49,7 @@ import qualified Text.Blaze.Html5 as H import qualified Text.Blaze.Html5.Attributes as A import Hakyll.Web.Page +import Hakyll.Web.Page.Metadata import Hakyll.Web.Util.String import Hakyll.Core.Writable |