on master help sign in
Backport ContextManipulations → Metadata
c576424Jasper Van der Jeugt
src/Hakyll/Web/Page.hs+8−23
@@ -5,8 +5,6 @@
5{-# LANGUAGE DeriveDataTypeable #-}
5{-# LANGUAGE DeriveDataTypeable #-}
6module Hakyll.Web.Page
6module Hakyll.Web.Page
7 ( Page (..)
7 ( Page (..)
8− , getField
9− , addField
10 , toMap
8 , toMap
11 , pageRead
9 , pageRead
12 , addDefaultFields
10 , addDefaultFields
@@ -16,7 +14,6 @@ import Prelude hiding (id)
16import Control.Category (id)
14import Control.Category (id)
17import Control.Arrow ((>>^), (&&&), (>>>))
15import Control.Arrow ((>>^), (&&&), (>>>))
18import System.FilePath (takeBaseName, takeDirectory)
16import System.FilePath (takeBaseName, takeDirectory)
19−import Data.Maybe (fromMaybe)
20import Data.Map (Map)
17import Data.Map (Map)
21import qualified Data.Map as M
18import qualified Data.Map as M
22
19
@@ -24,24 +21,9 @@ import Hakyll.Core.Identifier
24import Hakyll.Core.Compiler
21import Hakyll.Core.Compiler
25import Hakyll.Web.Page.Internal
22import Hakyll.Web.Page.Internal
26import Hakyll.Web.Page.Read
23import Hakyll.Web.Page.Read
24+import Hakyll.Web.Page.Metadata
27import Hakyll.Web.Util.String
25import Hakyll.Web.Util.String
28
26
29−-- | Get a metadata field. If the field does not exist, the empty string is
30−-- returned.
31−--
32−getField :: String -- ^ Key
33− -> Page a -- ^ Page
34− -> String -- ^ Value
35−getField key = fromMaybe "" . M.lookup key . pageMetadata
36−
37−-- | Add a metadata field. If the field already exists, it is not overwritten.
38−--
39−addField :: String -- ^ Key
40− -> String -- ^ Value
41− -> Page a -- ^ Page to add it to
42− -> Page a -- ^ Resulting page
43−addField k v (Page m b) = Page (M.insertWith (flip const) k v m) b
44−
45-- | Convert a page to a map. The body will be placed in the @body@ key.
27-- | Convert a page to a map. The body will be placed in the @body@ key.
46--
28--
47toMap :: Page String -> Map String String
29toMap :: Page String -> Map String String
@@ -56,20 +38,23 @@ pageRead = getResourceString >>^ readPage
56--
38--
57-- * @$url@
39-- * @$url@
58--
40--
59−-- * @$root@
41+-- * @$category@
60--
42--
61-- * @$title@
43-- * @$title@
62--
44--
45+-- * @$path@
46+--
63addDefaultFields :: Compiler (Page a) (Page a)
47addDefaultFields :: Compiler (Page a) (Page a)
64addDefaultFields = (getRoute &&& id >>^ uncurry addRoute)
48addDefaultFields = (getRoute &&& id >>^ uncurry addRoute)
65 >>> (getIdentifier &&& id >>^ uncurry addIdentifier)
49 >>> (getIdentifier &&& id >>^ uncurry addIdentifier)
66 where
50 where
67 -- Add root and url, based on route
51 -- Add root and url, based on route
68 addRoute Nothing = id
52 addRoute Nothing = id
69− addRoute (Just r) = addField "url" (toUrl r)
53+ addRoute (Just r) = setField "url" (toUrl r)
70
54
71 -- Add title and category, based on identifier
55 -- Add title and category, based on identifier
72− addIdentifier i = addField "title" (takeBaseName p)
56+ addIdentifier i = setField "title" (takeBaseName p)
73− . addField "category" (takeBaseName $ takeDirectory p)
57+ . setField "category" (takeBaseName $ takeDirectory p)
58+ . setField "path" p
74 where
59 where
75 p = toFilePath i
60 p = toFilePath i
src/Hakyll/Web/Page/Metadata.hsnew file+110
@@ -0,0 +1,110 @@
1+-- | Provides various functions to manipulate the metadata fields of a page
2+--
3+module Hakyll.Web.Page.Metadata
4+ ( getField
5+ , setField
6+ , renderField
7+ , changeField
8+ , copyField
9+ , renderDateField
10+ , renderDateFieldWith
11+ ) where
12+
13+import Data.List (intercalate)
14+import Data.Maybe (fromMaybe)
15+import Data.Time.Clock (UTCTime)
16+import Data.Time.Format (parseTime, formatTime)
17+import qualified Data.Map as M
18+import System.FilePath (takeFileName)
19+import System.Locale (TimeLocale, defaultTimeLocale)
20+
21+import Hakyll.Web.Page.Internal
22+import Hakyll.Web.Util.String
23+
24+-- | Get a metadata field. If the field does not exist, the empty string is
25+-- returned.
26+--
27+getField :: String -- ^ Key
28+ -> Page a -- ^ Page
29+ -> String -- ^ Value
30+getField key = fromMaybe "" . M.lookup key . pageMetadata
31+
32+-- | Add a metadata field. If the field already exists, it is not overwritten.
33+--
34+setField :: String -- ^ Key
35+ -> String -- ^ Value
36+ -> Page a -- ^ Page to add it to
37+ -> Page a -- ^ Resulting page
38+setField k v (Page m b) = Page (M.insertWith (flip const) k v m) b
39+
40+-- | Do something with a metadata value, but keep the old value as well. If the
41+-- key given is not present in the metadata, nothing will happen. If the source
42+-- and destination keys are the same, the value will be changed (but you should
43+-- use 'changeField' for this purpose).
44+--
45+renderField :: String -- ^ Key of which the value should be copied
46+ -> String -- ^ Key the value should be copied to
47+ -> (String -> String) -- ^ Function to apply on the value
48+ -> Page a -- ^ Page on which this should be applied
49+ -> Page a -- ^ Resulting page
50+renderField src dst f page = case M.lookup src (pageMetadata page) of
51+ Nothing -> page
52+ (Just value) -> setField dst (f value) page
53+
54+-- | Change a metadata value.
55+--
56+-- > import Data.Char (toUpper)
57+-- > changeField "title" (map toUpper)
58+--
59+-- Will put the title in UPPERCASE.
60+--
61+changeField :: String -- ^ Key to change.
62+ -> (String -> String) -- ^ Function to apply on the value.
63+ -> Page a -- ^ Page to change
64+ -> Page a -- ^ Resulting page
65+changeField key = renderField key key
66+
67+-- | Make a copy of a metadata field (put the value belonging to a certain key
68+-- under some other key as well)
69+--
70+copyField :: String -- ^ Key to copy
71+ -> String -- ^ Destination to copy to
72+ -> Page a -- ^ Page on which this should be applied
73+ -> Page a -- ^ Resulting page
74+copyField src dst = renderField src dst id
75+
76+-- | When the metadata has a field called @path@ in a
77+-- @folder/yyyy-mm-dd-title.extension@ format (the convention for pages),
78+-- this function can render the date.
79+--
80+-- > renderDate "date" "%B %e, %Y" "Date unknown"
81+--
82+-- Will render something like @January 32, 2010@.
83+--
84+renderDateField :: String -- ^ Key in which the rendered date should be placed
85+ -> String -- ^ Format to use on the date
86+ -> String -- ^ Default value, in case the date cannot be parsed
87+ -> Page a -- ^ Page on which this should be applied
88+ -> Page a -- ^ Resulting page
89+renderDateField = renderDateFieldWith defaultTimeLocale
90+
91+-- | This is an extended version of 'renderDateField' that allows you to
92+-- specify a time locale that is used for outputting the date. For more
93+-- details, see 'renderDateField'.
94+--
95+renderDateFieldWith :: TimeLocale -- ^ Output time locale
96+ -> String -- ^ Destination key
97+ -> String -- ^ Format to use on the date
98+ -> String -- ^ Default value
99+ -> Page a -- ^ Target page
100+ -> Page a -- ^ Resulting page
101+renderDateFieldWith locale key format defaultValue =
102+ renderField "path" key renderDate'
103+ where
104+ renderDate' filePath = fromMaybe defaultValue $ do
105+ let dateString = intercalate "-" $ take 3
106+ $ splitAll "-" $ takeFileName filePath
107+ time <- parseTime defaultTimeLocale
108+ "%Y-%m-%d"
109+ dateString :: Maybe UTCTime
110+ return $ formatTime locale format time
src/Hakyll/Web/Tags.hs+1
@@ -49,6 +49,7 @@ import qualified Text.Blaze.Html5 as H
49import qualified Text.Blaze.Html5.Attributes as A
49import qualified Text.Blaze.Html5.Attributes as A
50
50
51import Hakyll.Web.Page
51import Hakyll.Web.Page
52+import Hakyll.Web.Page.Metadata
52import Hakyll.Web.Util.String
53import Hakyll.Web.Util.String
53import Hakyll.Core.Writable
54import Hakyll.Core.Writable
54
55