summaryrefslogtreecommitdiff
path: root/src/Hakyll
diff options
context:
space:
mode:
Diffstat (limited to 'src/Hakyll')
-rw-r--r--src/Hakyll/Web/Page.hs31
-rw-r--r--src/Hakyll/Web/Page/Metadata.hs110
-rw-r--r--src/Hakyll/Web/Tags.hs1
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
generated by cgit v1.2.3 (git 2.39.1) at 2024-11-24 07:27:32 +0000