@@ -1,239 +0,0 @@
1−-- | Provides various functions to manipulate the metadata fields of a page
3−module Hakyll.Web.Page.Metadata
15− , renderDateFieldWith
16− , renderModificationTime
17− , renderModificationTimeWith
25−import Control.Arrow (Arrow, arr, (>>>), (***), (&&&))
26−import Control.Category (id)
27−import Control.Monad (msum)
28−import Data.List (intercalate)
29−import Data.Maybe (fromMaybe)
30−import Data.Ord (comparing)
31−import Prelude hiding (id)
32−import System.FilePath (takeFileName)
33−import System.Locale (TimeLocale, defaultTimeLocale)
34−import qualified Data.Map as M
36−import Data.Time.Calendar (Day (..))
37−import Data.Time.Clock (UTCTime (..))
38−import Data.Time.Format (parseTime, formatTime)
40−import Hakyll.Web.Page.Internal
41−import Hakyll.Core.Util.String
42−import Hakyll.Core.Identifier
43−import Hakyll.Core.Compiler
44−import Hakyll.Core.ResourceProvider
46−-- | Get a metadata field. If the field does not exist, the empty string is
49−getField :: String -- ^ Key
52−getField key = fromMaybe "" . getFieldMaybe key
54−-- | Get a field in a 'Maybe' wrapper
56−getFieldMaybe :: String -- ^ Key
58− -> Maybe String -- ^ Value, if found
59−getFieldMaybe key = M.lookup key . pageMetadata
61−-- | Version of 'trySetField' which overrides any previous value
63−setField :: String -- ^ Key
65− -> Page a -- ^ Page to add it to
66− -> Page a -- ^ Resulting page
67−setField k v (Page m b) = Page (M.insert k v m) b
69−-- | Add a metadata field. If the field already exists, it is not overwritten.
71−trySetField :: String -- ^ Key
73− -> Page a -- ^ Page to add it to
74− -> Page a -- ^ Resulting page
75−trySetField k v (Page m b) = Page (M.insertWith (flip const) k v m) b
77−-- | Arrow-based variant of 'setField'. Because of it's type, this function is
78−-- very usable together with the different 'require' functions.
82− -> a x String -- ^ Value arrow
83− -> a (Page b, x) (Page b) -- ^ Resulting arrow
84−setFieldA k v = id *** v >>> arr (uncurry $ flip $ setField k)
86−-- | Set a field of a page to the contents of another page
88−setFieldPage :: String -- ^ Key to add the page under
89− -> Identifier (Page String) -- ^ Page to add
90− -> Compiler (Page a) (Page a) -- ^ Page compiler
91−setFieldPage key page = id &&& require_ page >>> setFieldA key (arr pageBody)
93−-- | Do something with a metadata value, but keep the old value as well. If the
94−-- key given is not present in the metadata, nothing will happen. If the source
95−-- and destination keys are the same, the value will be changed (but you should
96−-- use 'changeField' for this purpose).
98−renderField :: String -- ^ Key of which the value should be copied
99− -> String -- ^ Key the value should be copied to
100− -> (String -> String) -- ^ Function to apply on the value
101− -> Page a -- ^ Page on which this should be applied
102− -> Page a -- ^ Resulting page
103−renderField src dst f page = case M.lookup src (pageMetadata page) of
105− Just value -> setField dst (f value) page
107−-- | Change a metadata value.
109−-- > import Data.Char (toUpper)
110−-- > changeField "title" (map toUpper)
112−-- Will put the title in UPPERCASE.
114−changeField :: String -- ^ Key to change.
115− -> (String -> String) -- ^ Function to apply on the value.
116− -> Page a -- ^ Page to change
117− -> Page a -- ^ Resulting page
118−changeField key = renderField key key
120−-- | Make a copy of a metadata field (put the value belonging to a certain key
121−-- under some other key as well)
123−copyField :: String -- ^ Key to copy
124− -> String -- ^ Destination to copy to
125− -> Page a -- ^ Page on which this should be applied
126− -> Page a -- ^ Resulting page
127−copyField src dst = renderField src dst id
129−-- | When the metadata has a field called @published@ in one of the
130−-- following formats then this function can render the date.
132−-- * @Sun, 01 Feb 2000 13:00:00 UT@ (RSS date format)
134−-- * @2000-02-01T13:00:00Z@ (Atom date format)
136−-- * @February 1, 2000 1:00 PM@ (PM is usually uppercase)
138−-- * @February 1, 2000@ (assumes 12:00 AM for the time)
140−-- Alternatively, when the metadata has a field called @path@ in a
141−-- @folder/yyyy-mm-dd-title.extension@ format (the convention for pages)
142−-- and no @published@ metadata field set, this function can render
145−-- > renderDateField "date" "%B %e, %Y" "Date unknown"
147−-- Will render something like @January 32, 2010@.
149−renderDateField :: String -- ^ Key in which the rendered date should be placed
150− -> String -- ^ Format to use on the date
151− -> String -- ^ Default value, in case the date cannot be parsed
152− -> Page a -- ^ Page on which this should be applied
153− -> Page a -- ^ Resulting page
154−renderDateField = renderDateFieldWith defaultTimeLocale
156−-- | This is an extended version of 'renderDateField' that allows you to
157−-- specify a time locale that is used for outputting the date. For more
158−-- details, see 'renderDateField'.
160−renderDateFieldWith :: TimeLocale -- ^ Output time locale
161− -> String -- ^ Destination key
162− -> String -- ^ Format to use on the date
163− -> String -- ^ Default value
164− -> Page a -- ^ Target page
165− -> Page a -- ^ Resulting page
166−renderDateFieldWith locale key format defaultValue page =
167− setField key renderTimeString page
169− renderTimeString = fromMaybe defaultValue $ do
170− time <- getUTCMaybe locale page
171− return $ formatTime locale format time
173−-- | Parser to try to extract and parse the time from the @published@
174−-- field or from the filename. See 'renderDateField' for more information.
175−getUTCMaybe :: TimeLocale -- ^ Output time locale
176− -> Page a -- ^ Input page
177− -> Maybe UTCTime -- ^ Parsed UTCTime
178−getUTCMaybe locale page = msum $
179− [fromField "published" fmt | fmt <- formats] ++
180− [fromField "date" fmt | fmt <- formats] ++
181− [ getFieldMaybe "path" page >>= parseTime' "%Y-%m-%d" .
182− intercalate "-" . take 3 . splitAll "-" . takeFileName
185− parseTime' f str = parseTime locale f str
186− fromField k fmt = getFieldMaybe k page >>= parseTime' fmt
189− [ "%a, %d %b %Y %H:%M:%S UT"
190− , "%Y-%m-%dT%H:%M:%SZ"
191− , "%Y-%m-%d %H:%M:%S"
193− , "%B %e, %Y %l:%M %p"
197−-- | Set the modification time as a field in the page
198−renderModificationTime :: String
199− -- ^ Destination key
201− -- ^ Format to use on the time
202− -> Compiler (Page String) (Page String)
203− -- ^ Resulting compiler
204−renderModificationTime = renderModificationTimeWith defaultTimeLocale
206−renderModificationTimeWith :: TimeLocale
207− -- ^ Output time locale
209− -- ^ Destination key
211− -- ^ Format to use on the time
212− -> Compiler (Page String) (Page String)
213− -- ^ Resulting compiler
214−renderModificationTimeWith locale key format =
215− id &&& (getResourceWith $ const resourceModificationTime) >>>
216− setFieldA key (arr (formatTime locale format))
218−-- | Copy the body of a page to a metadata field
220−copyBodyToField :: String -- ^ Destination key
221− -> Page String -- ^ Target page
222− -> Page String -- ^ Resulting page
223−copyBodyToField key page = setField key (pageBody page) page
225−-- | Copy a metadata field to the page body
227−copyBodyFromField :: String -- ^ Source key
228− -> Page String -- ^ Target page
229− -> Page String -- ^ Resulting page
230−copyBodyFromField key page = fmap (const $ getField key page) page
232−-- | Compare pages by the date and time parsed as in 'renderDateField',
233−-- where 'LT' implies earlier, and 'GT' implies later. For more details,
234−-- see 'renderDateField'.
235−comparePagesByDate :: Page a -> Page a -> Ordering
236−comparePagesByDate = comparing $ fromMaybe zero . getUTCMaybe defaultTimeLocale
238− zero = UTCTime (ModifiedJulianDay 0) 0