Backport ContextManipulations → Metadata
This commit is contained in:
parent
78391b9be2
commit
c576424325
3 changed files with 119 additions and 23 deletions
|
@ -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
|
||||
|
|
110
src/Hakyll/Web/Page/Metadata.hs
Normal file
110
src/Hakyll/Web/Page/Metadata.hs
Normal file
|
@ -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
|
|
@ -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
|
||||
|
||||
|
|
Loading…
Reference in a new issue