From 1736710b9e0685f3c3503519e38e9744ba9bb144 Mon Sep 17 00:00:00 2001 From: Jasper Van der Jeugt Date: Sat, 6 Mar 2010 15:39:45 +0100 Subject: Added RSS module. --- src/Text/Hakyll.hs | 23 +++++++++------ src/Text/Hakyll/Hakyll.hs | 19 +++++++++---- src/Text/Hakyll/Internal/Render.hs | 2 +- src/Text/Hakyll/RenderAction.hs | 3 +- src/Text/Hakyll/Renderables.hs | 2 +- src/Text/Hakyll/Rss.hs | 57 ++++++++++++++++++++++++++++++++++++++ src/Text/Hakyll/Tags.hs | 2 -- 7 files changed, 90 insertions(+), 18 deletions(-) create mode 100644 src/Text/Hakyll/Rss.hs (limited to 'src') diff --git a/src/Text/Hakyll.hs b/src/Text/Hakyll.hs index 9dc8fbb..5a8a37b 100644 --- a/src/Text/Hakyll.hs +++ b/src/Text/Hakyll.hs @@ -28,16 +28,23 @@ import Text.Hakyll.File -- | The default hakyll configuration. defaultHakyllConfiguration :: HakyllConfiguration defaultHakyllConfiguration = HakyllConfiguration - { additionalContext = M.empty - , siteDirectory = "_site" - , cacheDirectory = "_cache" - , enableIndexUrl = False - , previewPollDelay = 1000000 + { absoluteUrl = "" + , additionalContext = M.empty + , siteDirectory = "_site" + , cacheDirectory = "_cache" + , enableIndexUrl = False + , previewPollDelay = 1000000 } --- | Main function to run Hakyll with the default configuration. -hakyll :: Hakyll () -> IO () -hakyll = hakyllWithConfiguration defaultHakyllConfiguration +-- | Main function to run Hakyll with the default configuration. The +-- absolute URL is only used in certain cases, for example RSS feeds et +-- cetera. +hakyll :: String -- ^ Absolute URL of your site. Used in certain cases. + -> Hakyll () -- ^ You code. + -> IO () +hakyll absolute = hakyllWithConfiguration configuration + where + configuration = defaultHakyllConfiguration { absoluteUrl = absolute } -- | Main function to run hakyll with a custom configuration. hakyllWithConfiguration :: HakyllConfiguration -> Hakyll () -> IO () diff --git a/src/Text/Hakyll/Hakyll.hs b/src/Text/Hakyll/Hakyll.hs index 7554972..fab0be6 100644 --- a/src/Text/Hakyll/Hakyll.hs +++ b/src/Text/Hakyll/Hakyll.hs @@ -3,26 +3,30 @@ module Text.Hakyll.Hakyll ( HakyllConfiguration (..) , Hakyll , askHakyll + , getAdditionalContext ) where import Control.Monad.Reader (ReaderT, ask) import Control.Monad (liftM) +import qualified Data.Map as M import Text.Hakyll.Context (Context) -- | Hakyll global configuration type. data HakyllConfiguration = HakyllConfiguration - { -- | An additional context to use when rendering. This additional context + { -- | Absolute URL of the site. + absoluteUrl :: String + , -- | An additional context to use when rendering. This additional context -- is used globally. additionalContext :: Context , -- | Directory where the site is placed. - siteDirectory :: FilePath + siteDirectory :: FilePath , -- | Directory for cache files. - cacheDirectory :: FilePath + cacheDirectory :: FilePath , -- | Enable index links. - enableIndexUrl :: Bool + enableIndexUrl :: Bool , -- | Delay between polls in preview mode. - previewPollDelay :: Int + previewPollDelay :: Int } -- | Our custom monad stack. @@ -39,3 +43,8 @@ type Hakyll = ReaderT HakyllConfiguration IO -- askHakyll :: (HakyllConfiguration -> a) -> Hakyll a askHakyll = flip liftM ask + +getAdditionalContext :: HakyllConfiguration -> Context +getAdditionalContext configuration = + M.insert "absolute" (absoluteUrl configuration) + (additionalContext configuration) diff --git a/src/Text/Hakyll/Internal/Render.hs b/src/Text/Hakyll/Internal/Render.hs index 5432f4d..92f6ad9 100644 --- a/src/Text/Hakyll/Internal/Render.hs +++ b/src/Text/Hakyll/Internal/Render.hs @@ -33,7 +33,7 @@ pureRenderWith manipulation template context = -- chains and such. writePage :: RenderAction Context () writePage = createRenderAction $ \initialContext -> do - additionalContext' <- askHakyll additionalContext + additionalContext' <- askHakyll getAdditionalContext let url = fromMaybe (error "No url defined at write time.") (M.lookup "url" initialContext) body = fromMaybe "" (M.lookup "body" initialContext) diff --git a/src/Text/Hakyll/RenderAction.hs b/src/Text/Hakyll/RenderAction.hs index 0038c9e..62ac713 100644 --- a/src/Text/Hakyll/RenderAction.hs +++ b/src/Text/Hakyll/RenderAction.hs @@ -56,7 +56,8 @@ createManipulationAction :: ContextManipulation -> RenderAction Context Context createManipulationAction = createRenderAction . (return .) chain :: [RenderAction a a] -> RenderAction a a -chain = foldl1 (>>>) +chain [] = id +chain list@(_:_) = foldl1 (>>>) list runRenderAction :: RenderAction () a -> Hakyll a runRenderAction action = actionFunction action () diff --git a/src/Text/Hakyll/Renderables.hs b/src/Text/Hakyll/Renderables.hs index 4c135b3..36fef09 100644 --- a/src/Text/Hakyll/Renderables.hs +++ b/src/Text/Hakyll/Renderables.hs @@ -38,7 +38,7 @@ createCustomPage url dependencies association = RenderAction mtuple (a, b) = b >>= \b' -> return (a, b') toHakyllString = second (either return runRenderAction) assoc' = mapM (mtuple . toHakyllString) $ ("url", Left url) : association - dataDependencies = (map snd association) >>= getDependencies + dataDependencies = map snd association >>= getDependencies getDependencies (Left _) = [] getDependencies (Right x) = actionDependencies x diff --git a/src/Text/Hakyll/Rss.hs b/src/Text/Hakyll/Rss.hs new file mode 100644 index 0000000..d3e5be2 --- /dev/null +++ b/src/Text/Hakyll/Rss.hs @@ -0,0 +1,57 @@ +-- | A Module that allows easy rendering of RSS feeds. +module Text.Hakyll.Rss + ( RssConfiguration (..) + , renderRss + , renderRssWith + ) where + +import Control.Arrow ((>>>), second) +import Control.Monad.Reader (liftIO) + +import Text.Hakyll.Context (ContextManipulation) +import Text.Hakyll.Hakyll (Hakyll) +import Text.Hakyll.Render (render, renderChain) +import Text.Hakyll.Renderables (createListingWith) +import Text.Hakyll.RenderAction (Renderable) + +import Paths_hakyll + +data RssConfiguration = RssConfiguration + { -- | Url of the RSS feed (relative to site root). For example, @rss.xml@. + rssUrl :: String + , -- | Title of the RSS feed. + rssTitle :: String + , -- | Description of the RSS feed. + rssDescription :: String + } + +createRssWith :: ContextManipulation + -> RssConfiguration + -> [Renderable] + -> FilePath + -> FilePath + -> Renderable +createRssWith manipulation configuration renderables template itemTemplate = + listing >>> render template + where + listing = createListingWith manipulation (rssUrl configuration) itemTemplate + renderables additional + + additional = map (second $ Left . ($ configuration)) + [ ("title", rssTitle) + , ("description", rssDescription) + ] + +renderRss :: RssConfiguration -> [Renderable] -> Hakyll () +renderRss = renderRssWith id + +renderRssWith :: ContextManipulation + -> RssConfiguration + -> [Renderable] + -> Hakyll () +renderRssWith manipulation configuration renderables = do + template <- liftIO $ getDataFileName "templates/rss.xml" + itemTemplate <- liftIO $ getDataFileName "templates/rss-item.xml" + let renderRssWith' = createRssWith manipulation configuration + renderables template itemTemplate + renderChain [] renderRssWith' diff --git a/src/Text/Hakyll/Tags.hs b/src/Text/Hakyll/Tags.hs index 3d43abc..6a04b04 100644 --- a/src/Text/Hakyll/Tags.hs +++ b/src/Text/Hakyll/Tags.hs @@ -18,8 +18,6 @@ -- is to place pages in subdirectories. -- -- An example, the page @posts\/coding\/2010-01-28-hakyll-categories.markdown@ --- would be placed under the `coding` category. --- -- Tags or categories are read using the @readTagMap@ and @readCategoryMap@ -- functions. Because categories are implemented using tags - categories can -- be seen as tags, with the restriction that a page can only have one -- cgit v1.2.3