Port page list module a bit

3 files changed, 64 insertions, 244 deletions

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
@@ -7,6 +7,10 @@ module Hakyll.Core.Provider.MetadataCache
 
 
 --------------------------------------------------------------------------------
+import qualified Data.Map                      as M
+
+
+--------------------------------------------------------------------------------
 import           Hakyll.Core.Identifier
 import           Hakyll.Core.Metadata
 import           Hakyll.Core.Provider.Internal
@@ -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