summaryrefslogtreecommitdiff
path: root/src/Hakyll
diff options
context:
space:
mode:
Diffstat (limited to 'src/Hakyll')
-rw-r--r--src/Hakyll/Core/Compiler.hs1
-rw-r--r--src/Hakyll/Core/Compiler/Require.hs13
-rw-r--r--src/Hakyll/Web/Feed.hs163
-rw-r--r--src/Hakyll/Web/Template/Context.hs11
4 files changed, 100 insertions, 88 deletions
diff --git a/src/Hakyll/Core/Compiler.hs b/src/Hakyll/Core/Compiler.hs
index a5c7a41..ccd056f 100644
--- a/src/Hakyll/Core/Compiler.hs
+++ b/src/Hakyll/Core/Compiler.hs
@@ -12,6 +12,7 @@ module Hakyll.Core.Compiler
, getResourceLBS
, getResourceWith
, require
+ , requireBody
, requireAll
, cached
, unsafeCompiler
diff --git a/src/Hakyll/Core/Compiler/Require.hs b/src/Hakyll/Core/Compiler/Require.hs
index 861c1f1..a7c47ce 100644
--- a/src/Hakyll/Core/Compiler/Require.hs
+++ b/src/Hakyll/Core/Compiler/Require.hs
@@ -2,6 +2,7 @@
module Hakyll.Core.Compiler.Require
( save
, require
+ , requireBody
, requireAll
) where
@@ -17,6 +18,7 @@ import Hakyll.Core.Compiler.Internal
import Hakyll.Core.Dependencies
import Hakyll.Core.Identifier
import Hakyll.Core.Identifier.Pattern
+import Hakyll.Core.Item
import Hakyll.Core.Store (Store)
import qualified Hakyll.Core.Store as Store
@@ -27,7 +29,7 @@ save store identifier x = Store.set store (key identifier) x
--------------------------------------------------------------------------------
-require :: (Binary a, Typeable a) => Identifier -> Compiler a
+require :: (Binary a, Typeable a) => Identifier -> Compiler (Item a)
require id' = do
store <- compilerStore <$> compilerAsk
@@ -37,7 +39,7 @@ require id' = do
case result of
Store.NotFound -> compilerThrow notFound
Store.WrongType e r -> compilerThrow $ wrongType e r
- Store.Found x -> return x
+ Store.Found x -> return $ Item id' x
where
notFound =
"Hakyll.Core.Compiler.Require.require: " ++ show id' ++ " was " ++
@@ -50,7 +52,12 @@ require id' = do
--------------------------------------------------------------------------------
-requireAll :: (Binary a, Typeable a) => Pattern -> Compiler [a]
+requireBody :: (Binary a, Typeable a) => Identifier -> Compiler a
+requireBody = fmap itemBody . require
+
+
+--------------------------------------------------------------------------------
+requireAll :: (Binary a, Typeable a) => Pattern -> Compiler [Item a]
requireAll pattern = do
universe <- compilerUniverse <$> compilerAsk
let matching = filterMatches pattern universe
diff --git a/src/Hakyll/Web/Feed.hs b/src/Hakyll/Web/Feed.hs
index 2cb3292..c0a6213 100644
--- a/src/Hakyll/Web/Feed.hs
+++ b/src/Hakyll/Web/Feed.hs
@@ -1,11 +1,11 @@
--- TODO: port
+--------------------------------------------------------------------------------
-- | A Module that allows easy rendering of RSS feeds.
--
-- The main rendering functions (@renderRss@, @renderAtom@) all assume that
-- you pass the list of items so that the most recent entry in the feed is the
-- first item in the list.
--
--- Also note that the pages should have (at least) the following fields to
+-- Also note that the context should have (at least) the following fields to
-- produce a correct feed:
--
-- - @$title$@: Title of the item
@@ -15,29 +15,33 @@
-- - @$url$@: URL to the item - this is usually set automatically.
--
-- In addition, the posts should be named according to the rules for
--- 'Hakyll.Page.Metadata.renderDateField'.
---
+-- 'Hakyll.Web.Template.Context.dateField'
module Hakyll.Web.Feed
( FeedConfiguration (..)
, renderRss
, renderAtom
) where
-import Prelude hiding (id)
-import Control.Category (id)
-import Control.Arrow ((>>>), arr, (&&&))
-import Control.Monad ((<=<))
-import Data.Maybe (fromMaybe, listToMaybe)
-import Hakyll.Core.Compiler
-import Hakyll.Web.Page
-import Hakyll.Web.Page.Metadata
-import Hakyll.Web.Template
-import Hakyll.Web.Template.Read.Hakyll (readTemplate)
-import Hakyll.Web.Urls
+--------------------------------------------------------------------------------
+import Control.Monad (forM, (<=<))
+import Data.Monoid (mconcat)
+
+
+--------------------------------------------------------------------------------
+import Hakyll.Core.Compiler
+import Hakyll.Core.Compiler.Internal
+import Hakyll.Core.Item
+import Hakyll.Web.Template
+import Hakyll.Web.Template.Context
+import Hakyll.Web.Template.Read.Hakyll (readTemplate)
-import Paths_hakyll
+--------------------------------------------------------------------------------
+import Paths_hakyll
+
+
+--------------------------------------------------------------------------------
-- | This is a data structure to keep the configuration of a feed.
data FeedConfiguration = FeedConfiguration
{ -- | Title of the feed.
@@ -52,83 +56,74 @@ data FeedConfiguration = FeedConfiguration
feedRoot :: String
} deriving (Show, Eq)
--- | This is an auxiliary function to create a listing that is, in fact, a feed.
--- The items should be sorted on date. The @$updated@ field should be set for
--- each item.
---
-createFeed :: Template -- ^ Feed template
- -> Template -- ^ Item template
- -> String -- ^ URL of the feed
- -> FeedConfiguration -- ^ Feed configuration
- -> [Page String] -- ^ Items to include
- -> String -- ^ Resulting feed
-createFeed feedTemplate itemTemplate url configuration items =
- pageBody $ applyTemplateToPage feedTemplate
- $ trySetField "updated" updated
- $ trySetField "title" (feedTitle configuration)
- $ trySetField "description" (feedDescription configuration)
- $ trySetField "authorName" (feedAuthorName configuration)
- $ trySetField "authorEmail" (feedAuthorEmail configuration)
- $ trySetField "root" (feedRoot configuration)
- $ trySetField "url" url
- $ fromBody body
- where
- -- Preprocess items
- items' = flip map items $ applyTemplateToPage itemTemplate
- . trySetField "root" (feedRoot configuration)
-
- -- Body: concatenated items
- body = concat $ map pageBody items'
-
- -- Take the first updated, which should be the most recent
- updated = fromMaybe "Unknown" $ do
- p <- listToMaybe items
- return $ getField "updated" p
-
+--------------------------------------------------------------------------------
-- | Abstract function to render any feed.
---
-renderFeed :: FilePath -- ^ Feed template
- -> FilePath -- ^ Item template
- -> FeedConfiguration -- ^ Feed configuration
- -> Compiler [Page String] String -- ^ Feed compiler
-renderFeed feedTemplate itemTemplate configuration =
- id &&& getRoute >>> renderFeed'
- where
- -- Arrow rendering the feed from the items and the URL
- renderFeed' = unsafeCompiler $ \(items, url) -> do
- feedTemplate' <- loadTemplate feedTemplate
- itemTemplate' <- loadTemplate itemTemplate
- let url' = toUrl $ fromMaybe noUrl url
- return $ createFeed feedTemplate' itemTemplate' url' configuration items
+renderFeed :: FilePath -- ^ Feed template
+ -> FilePath -- ^ Item template
+ -> FeedConfiguration -- ^ Feed configuration
+ -> Context String -- ^ Context for the items
+ -> [Item String] -- ^ Input items
+ -> Compiler (Item String) -- ^ Resulting item
+renderFeed feedPath itemPath config itemContext items = do
+ feedTpl <- compilerUnsafeIO $ loadTemplate feedPath
+ itemTpl <- compilerUnsafeIO $ loadTemplate itemPath
+ items' <- forM items $ applyTemplate itemTpl itemContext'
+ body <- makeItem $ concat $ map itemBody items'
+ applyTemplate feedTpl feedContext body
+ where
-- Auxiliary: load a template from a datafile
loadTemplate = fmap readTemplate . readFile <=< getDataFileName
- -- URL is required to have a valid field
- noUrl = error "Hakyll.Web.Feed.renderFeed: no route specified"
+ itemContext' = mconcat
+ [ constField "root" (feedRoot config)
+ , itemContext
+ ]
+
+ feedContext = mconcat
+ [ bodyField "body"
+ , constField "title" (feedTitle config)
+ , constField "description" (feedDescription config)
+ , constField "authorName" (feedAuthorName config)
+ , constField "authorEmail" (feedAuthorEmail config)
+ , constField "root" (feedRoot config)
+ , urlField "url"
+ , updatedField
+ , missingField
+ ]
+
+ -- Take the first "updated" field from all items -- this should be the most
+ -- recent.
+ updatedField = field "updated" $ \_ -> case items of
+ [] -> return "Unknown"
+ (x : _) -> unContext itemContext' "updated" x
+
+--------------------------------------------------------------------------------
-- | Render an RSS feed with a number of items.
---
-renderRss :: FeedConfiguration -- ^ Feed configuration
- -> Compiler [Page String] String -- ^ Feed compiler
-renderRss configuration = arr (map (addUpdated . renderDate))
- >>> renderFeed "templates/rss.xml" "templates/rss-item.xml" configuration
- where
- renderDate = renderDateField "published" "%a, %d %b %Y %H:%M:%S UT"
- "No date found."
+renderRss :: FeedConfiguration -- ^ Feed configuration
+ -> Context String -- ^ Item context
+ -> [Item String] -- ^ Feed items
+ -> Compiler (Item String) -- ^ Resulting feed
+renderRss config context = renderFeed
+ "templates/rss.xml" "templates/rss-item.xml" config
+ (makeItemContext "%a, %d %b %Y %H:%M:%S UT" context)
+
+--------------------------------------------------------------------------------
-- | Render an Atom feed with a number of items.
---
-renderAtom :: FeedConfiguration -- ^ Feed configuration
- -> Compiler [Page String] String -- ^ Feed compiler
-renderAtom configuration = arr (map (addUpdated . renderDate))
- >>> renderFeed "templates/atom.xml" "templates/atom-item.xml" configuration
- where
- renderDate = renderDateField "published" "%Y-%m-%dT%H:%M:%SZ"
- "No date found."
+renderAtom :: FeedConfiguration -- ^ Feed configuration
+ -> Context String -- ^ Item context
+ -> [Item String] -- ^ Feed items
+ -> Compiler (Item String) -- ^ Resulting feed
+renderAtom config context = renderFeed
+ "templates/atom.xml" "templates/atom-item.xml" config
+ (makeItemContext "%Y-%m-%dT%H:%M:%SZ" context)
+
+--------------------------------------------------------------------------------
-- | Copies @$updated$@ from @$published$@ if it is not already set.
---
-addUpdated :: Page a -> Page a
-addUpdated page = trySetField "updated" (getField "published" page) page
+makeItemContext :: String -> Context a -> Context a
+makeItemContext fmt context = mconcat
+ [dateField "published" fmt, context, dateField "updated" fmt]
diff --git a/src/Hakyll/Web/Template/Context.hs b/src/Hakyll/Web/Template/Context.hs
index 269347b..fd9add9 100644
--- a/src/Hakyll/Web/Template/Context.hs
+++ b/src/Hakyll/Web/Template/Context.hs
@@ -3,6 +3,7 @@ module Hakyll.Web.Template.Context
( Context (..)
, mapContext
, field
+ , constField
, defaultContext
, bodyField
@@ -15,6 +16,7 @@ module Hakyll.Web.Template.Context
, dateFieldWith
, modificationTimeField
, modificationTimeFieldWith
+ , missingField
) where
@@ -64,6 +66,11 @@ field key value = Context $ \k i -> if k == key then value i else empty
--------------------------------------------------------------------------------
+constField :: String -> String -> Context a
+constField key = field key . const . return
+
+
+--------------------------------------------------------------------------------
defaultContext :: Context String
defaultContext =
bodyField "body" `mappend`
@@ -194,4 +201,6 @@ modificationTimeFieldWith locale key fmt = field key $ \i -> do
--------------------------------------------------------------------------------
missingField :: Context a
-missingField = Context $ \k _ -> return $ "$" ++ k ++ "$"
+missingField = Context $ \k i -> compilerThrow $
+ "Missing field $" ++ k ++ "$ in context for item " ++
+ show (itemIdentifier i)
generated by cgit v1.2.3 (git 2.39.1) at 2024-11-23 22:44:38 +0000