@@ -1,239 +0,0 @@
1−-- | Provides various functions to manipulate the metadata fields of a page
2−-- TODO: PORT
3−module Hakyll.Web.Page.Metadata
4− (
5− {- getField
6− , getFieldMaybe
7− , setField
8− , trySetField
9− , setFieldA
10− , setFieldPage
11− , renderField
12− , changeField
13− , copyField
14− , renderDateField
15− , renderDateFieldWith
16− , renderModificationTime
17− , renderModificationTimeWith
18− , copyBodyToField
19− , copyBodyFromField
20− , comparePagesByDate
21− -}
22− ) where
23−
24−{-
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
35−
36−import Data.Time.Calendar (Day (..))
37−import Data.Time.Clock (UTCTime (..))
38−import Data.Time.Format (parseTime, formatTime)
39−
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
45−
46−-- | Get a metadata field. If the field does not exist, the empty string is
47−-- returned.
48−--
49−getField :: String -- ^ Key
50− -> Page a -- ^ Page
51− -> String -- ^ Value
52−getField key = fromMaybe "" . getFieldMaybe key
53−
54−-- | Get a field in a 'Maybe' wrapper
55−--
56−getFieldMaybe :: String -- ^ Key
57− -> Page a -- ^ Page
58− -> Maybe String -- ^ Value, if found
59−getFieldMaybe key = M.lookup key . pageMetadata
60−
61−-- | Version of 'trySetField' which overrides any previous value
62−--
63−setField :: String -- ^ Key
64− -> String -- ^ Value
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
68−
69−-- | Add a metadata field. If the field already exists, it is not overwritten.
70−--
71−trySetField :: String -- ^ Key
72− -> String -- ^ Value
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
76−
77−-- | Arrow-based variant of 'setField'. Because of it's type, this function is
78−-- very usable together with the different 'require' functions.
79−--
80−setFieldA :: Arrow a
81− => String -- ^ Key
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)
85−
86−-- | Set a field of a page to the contents of another page
87−--
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)
92−
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).
97−--
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
104− Nothing -> page
105− Just value -> setField dst (f value) page
106−
107−-- | Change a metadata value.
108−--
109−-- > import Data.Char (toUpper)
110−-- > changeField "title" (map toUpper)
111−--
112−-- Will put the title in UPPERCASE.
113−--
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
119−
120−-- | Make a copy of a metadata field (put the value belonging to a certain key
121−-- under some other key as well)
122−--
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
128−
129−-- | When the metadata has a field called @published@ in one of the
130−-- following formats then this function can render the date.
131−--
132−-- * @Sun, 01 Feb 2000 13:00:00 UT@ (RSS date format)
133−--
134−-- * @2000-02-01T13:00:00Z@ (Atom date format)
135−--
136−-- * @February 1, 2000 1:00 PM@ (PM is usually uppercase)
137−--
138−-- * @February 1, 2000@ (assumes 12:00 AM for the time)
139−--
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
143−-- the date.
144−--
145−-- > renderDateField "date" "%B %e, %Y" "Date unknown"
146−--
147−-- Will render something like @January 32, 2010@.
148−--
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
155−
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'.
159−--
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
168− where
169− renderTimeString = fromMaybe defaultValue $ do
170− time <- getUTCMaybe locale page
171− return $ formatTime locale format time
172−
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
183− ]
184− where
185− parseTime' f str = parseTime locale f str
186− fromField k fmt = getFieldMaybe k page >>= parseTime' fmt
187−
188− formats =
189− [ "%a, %d %b %Y %H:%M:%S UT"
190− , "%Y-%m-%dT%H:%M:%SZ"
191− , "%Y-%m-%d %H:%M:%S"
192− , "%Y-%m-%d"
193− , "%B %e, %Y %l:%M %p"
194− , "%B %e, %Y"
195− ]
196−
197−-- | Set the modification time as a field in the page
198−renderModificationTime :: String
199− -- ^ Destination key
200− -> String
201− -- ^ Format to use on the time
202− -> Compiler (Page String) (Page String)
203− -- ^ Resulting compiler
204−renderModificationTime = renderModificationTimeWith defaultTimeLocale
205−
206−renderModificationTimeWith :: TimeLocale
207− -- ^ Output time locale
208− -> String
209− -- ^ Destination key
210− -> String
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))
217−
218−-- | Copy the body of a page to a metadata field
219−--
220−copyBodyToField :: String -- ^ Destination key
221− -> Page String -- ^ Target page
222− -> Page String -- ^ Resulting page
223−copyBodyToField key page = setField key (pageBody page) page
224−
225−-- | Copy a metadata field to the page body
226−--
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
231−
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
237− where
238− zero = UTCTime (ModifiedJulianDay 0) 0
239−-}