From a97b74b0d2f72722cd86619c01878acb01aa5167 Mon Sep 17 00:00:00 2001 From: Jasper Van der Jeugt Date: Tue, 20 Nov 2012 21:57:15 +0100 Subject: Port page list module a bit --- src/Hakyll/Core/Provider/MetadataCache.hs | 16 +- src/Hakyll/Web/Page/Metadata.hs | 239 ------------------------------ src/Hakyll/Web/Template/List.hs | 53 +++++++ 3 files changed, 64 insertions(+), 244 deletions(-) delete mode 100644 src/Hakyll/Web/Page/Metadata.hs create mode 100644 src/Hakyll/Web/Template/List.hs (limited to 'src/Hakyll') diff --git a/src/Hakyll/Core/Provider/MetadataCache.hs b/src/Hakyll/Core/Provider/MetadataCache.hs index 03652e7..b813303 100644 --- a/src/Hakyll/Core/Provider/MetadataCache.hs +++ b/src/Hakyll/Core/Provider/MetadataCache.hs @@ -6,6 +6,10 @@ module Hakyll.Core.Provider.MetadataCache ) where +-------------------------------------------------------------------------------- +import qualified Data.Map as M + + -------------------------------------------------------------------------------- import Hakyll.Core.Identifier import Hakyll.Core.Metadata @@ -16,11 +20,13 @@ import qualified Hakyll.Core.Store as Store -------------------------------------------------------------------------------- resourceMetadata :: Provider -> Identifier -> IO Metadata -resourceMetadata p r = do - load p r - Store.Found md <- Store.get (providerStore p) - [name, toFilePath r, "metadata"] - return md +resourceMetadata p r + | not (resourceExists p r) = return M.empty + | otherwise = do + load p r + Store.Found md <- Store.get (providerStore p) + [name, toFilePath r, "metadata"] + return md -------------------------------------------------------------------------------- diff --git a/src/Hakyll/Web/Page/Metadata.hs b/src/Hakyll/Web/Page/Metadata.hs deleted file mode 100644 index d9f330e..0000000 --- a/src/Hakyll/Web/Page/Metadata.hs +++ /dev/null @@ -1,239 +0,0 @@ --- | Provides various functions to manipulate the metadata fields of a page --- TODO: PORT -module Hakyll.Web.Page.Metadata - ( - {- getField - , getFieldMaybe - , setField - , trySetField - , setFieldA - , setFieldPage - , renderField - , changeField - , copyField - , renderDateField - , renderDateFieldWith - , renderModificationTime - , renderModificationTimeWith - , copyBodyToField - , copyBodyFromField - , comparePagesByDate - -} - ) where - -{- -import Control.Arrow (Arrow, arr, (>>>), (***), (&&&)) -import Control.Category (id) -import Control.Monad (msum) -import Data.List (intercalate) -import Data.Maybe (fromMaybe) -import Data.Ord (comparing) -import Prelude hiding (id) -import System.FilePath (takeFileName) -import System.Locale (TimeLocale, defaultTimeLocale) -import qualified Data.Map as M - -import Data.Time.Calendar (Day (..)) -import Data.Time.Clock (UTCTime (..)) -import Data.Time.Format (parseTime, formatTime) - -import Hakyll.Web.Page.Internal -import Hakyll.Core.Util.String -import Hakyll.Core.Identifier -import Hakyll.Core.Compiler -import Hakyll.Core.ResourceProvider - --- | 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 "" . getFieldMaybe key - --- | Get a field in a 'Maybe' wrapper --- -getFieldMaybe :: String -- ^ Key - -> Page a -- ^ Page - -> Maybe String -- ^ Value, if found -getFieldMaybe key = M.lookup key . pageMetadata - --- | Version of 'trySetField' which overrides any previous value --- -setField :: String -- ^ Key - -> String -- ^ Value - -> Page a -- ^ Page to add it to - -> Page a -- ^ Resulting page -setField k v (Page m b) = Page (M.insert k v m) b - --- | Add a metadata field. If the field already exists, it is not overwritten. --- -trySetField :: String -- ^ Key - -> String -- ^ Value - -> Page a -- ^ Page to add it to - -> Page a -- ^ Resulting page -trySetField k v (Page m b) = Page (M.insertWith (flip const) k v m) b - --- | Arrow-based variant of 'setField'. Because of it's type, this function is --- very usable together with the different 'require' functions. --- -setFieldA :: Arrow a - => String -- ^ Key - -> a x String -- ^ Value arrow - -> a (Page b, x) (Page b) -- ^ Resulting arrow -setFieldA k v = id *** v >>> arr (uncurry $ flip $ setField k) - --- | Set a field of a page to the contents of another page --- -setFieldPage :: String -- ^ Key to add the page under - -> Identifier (Page String) -- ^ Page to add - -> Compiler (Page a) (Page a) -- ^ Page compiler -setFieldPage key page = id &&& require_ page >>> setFieldA key (arr pageBody) - --- | 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 @published@ in one of the --- following formats then this function can render the date. --- --- * @Sun, 01 Feb 2000 13:00:00 UT@ (RSS date format) --- --- * @2000-02-01T13:00:00Z@ (Atom date format) --- --- * @February 1, 2000 1:00 PM@ (PM is usually uppercase) --- --- * @February 1, 2000@ (assumes 12:00 AM for the time) --- --- Alternatively, when the metadata has a field called @path@ in a --- @folder/yyyy-mm-dd-title.extension@ format (the convention for pages) --- and no @published@ metadata field set, this function can render --- the date. --- --- > renderDateField "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 page = - setField key renderTimeString page - where - renderTimeString = fromMaybe defaultValue $ do - time <- getUTCMaybe locale page - return $ formatTime locale format time - --- | Parser to try to extract and parse the time from the @published@ --- field or from the filename. See 'renderDateField' for more information. -getUTCMaybe :: TimeLocale -- ^ Output time locale - -> Page a -- ^ Input page - -> Maybe UTCTime -- ^ Parsed UTCTime -getUTCMaybe locale page = msum $ - [fromField "published" fmt | fmt <- formats] ++ - [fromField "date" fmt | fmt <- formats] ++ - [ getFieldMaybe "path" page >>= parseTime' "%Y-%m-%d" . - intercalate "-" . take 3 . splitAll "-" . takeFileName - ] - where - parseTime' f str = parseTime locale f str - fromField k fmt = getFieldMaybe k page >>= parseTime' fmt - - formats = - [ "%a, %d %b %Y %H:%M:%S UT" - , "%Y-%m-%dT%H:%M:%SZ" - , "%Y-%m-%d %H:%M:%S" - , "%Y-%m-%d" - , "%B %e, %Y %l:%M %p" - , "%B %e, %Y" - ] - --- | Set the modification time as a field in the page -renderModificationTime :: String - -- ^ Destination key - -> String - -- ^ Format to use on the time - -> Compiler (Page String) (Page String) - -- ^ Resulting compiler -renderModificationTime = renderModificationTimeWith defaultTimeLocale - -renderModificationTimeWith :: TimeLocale - -- ^ Output time locale - -> String - -- ^ Destination key - -> String - -- ^ Format to use on the time - -> Compiler (Page String) (Page String) - -- ^ Resulting compiler -renderModificationTimeWith locale key format = - id &&& (getResourceWith $ const resourceModificationTime) >>> - setFieldA key (arr (formatTime locale format)) - --- | Copy the body of a page to a metadata field --- -copyBodyToField :: String -- ^ Destination key - -> Page String -- ^ Target page - -> Page String -- ^ Resulting page -copyBodyToField key page = setField key (pageBody page) page - --- | Copy a metadata field to the page body --- -copyBodyFromField :: String -- ^ Source key - -> Page String -- ^ Target page - -> Page String -- ^ Resulting page -copyBodyFromField key page = fmap (const $ getField key page) page - --- | Compare pages by the date and time parsed as in 'renderDateField', --- where 'LT' implies earlier, and 'GT' implies later. For more details, --- see 'renderDateField'. -comparePagesByDate :: Page a -> Page a -> Ordering -comparePagesByDate = comparing $ fromMaybe zero . getUTCMaybe defaultTimeLocale - where - zero = UTCTime (ModifiedJulianDay 0) 0 --} diff --git a/src/Hakyll/Web/Template/List.hs b/src/Hakyll/Web/Template/List.hs new file mode 100644 index 0000000..e8da74f --- /dev/null +++ b/src/Hakyll/Web/Template/List.hs @@ -0,0 +1,53 @@ +-------------------------------------------------------------------------------- +-- | Provides an easy way to combine several items in a list. The applications +-- are obvious: +-- +-- * A post list on a blog +-- +-- * An image list in a gallery +-- +-- * A sitemap +module Hakyll.Web.Template.List + ( applyTemplateList + , chronological + , recentFirst + ) where + + +-------------------------------------------------------------------------------- +import Data.List (sortBy) +import Data.Ord (comparing) +import System.FilePath (takeBaseName) + + +-------------------------------------------------------------------------------- +import Hakyll.Core.Compiler +import Hakyll.Core.Identifier +import Hakyll.Core.Item +import Hakyll.Web.Template +import Hakyll.Web.Template.Context + + +-------------------------------------------------------------------------------- +-- | Set a field of a page to a listing of pages +applyTemplateList :: Template + -> Context a + -> [Item a] + -> Compiler String +applyTemplateList tpl context items = do + items' <- mapM (applyTemplate tpl context) items + return $ concat $ map itemBody items' + + +-------------------------------------------------------------------------------- +-- | Sort pages chronologically. This function assumes that the pages have a +-- @year-month-day-title.extension@ naming scheme -- as is the convention in +-- Hakyll. +chronological :: [Item a] -> [Item a] +chronological = sortBy $ comparing $ takeBaseName . toFilePath . itemIdentifier + + +-------------------------------------------------------------------------------- +-- | The reverse of 'chronological' +recentFirst :: [Item a] -> [Item a] +recentFirst = reverse . chronological -- cgit v1.2.3