* added RSS.hs: functions to create an RSS feed
* added RSS feed handler * FromReqURI instance for BlogLang * fixed RSS-feed link
This commit is contained in:
parent
a405e185ba
commit
efbec9ff76
5 changed files with 85 additions and 13 deletions
42
src/RSS.hs
Normal file
42
src/RSS.hs
Normal file
|
|
@ -0,0 +1,42 @@
|
|||
{-# LANGUAGE RecordWildCards #-}
|
||||
|
||||
module RSS (renderFeed) where
|
||||
|
||||
import qualified Data.Text as T
|
||||
|
||||
import Data.Maybe (fromMaybe)
|
||||
import Data.Time (getCurrentTime, UTCTime)
|
||||
import Network.URI
|
||||
import Text.RSS
|
||||
|
||||
import Locales
|
||||
import BlogDB hiding (Title)
|
||||
|
||||
createChannel :: BlogLang -> UTCTime -> [ChannelElem]
|
||||
createChannel l now = [ Language $ show l
|
||||
, Copyright "Vincent Ambo"
|
||||
, WebMaster "tazjin@googlemail.com"
|
||||
, ChannelPubDate now
|
||||
]
|
||||
|
||||
createRSS :: BlogLang -> UTCTime -> [Item] -> RSS
|
||||
createRSS l t i = RSS (rssTitle l) (rssLink l) (rssDesc l) (createChannel l t) i
|
||||
|
||||
createItem :: Entry -> Item
|
||||
createItem Entry{..} = [ Title $ T.unpack title
|
||||
, Link $ makeLink lang entryId
|
||||
, Description $ T.unpack btext
|
||||
, PubDate edate]
|
||||
|
||||
makeLink :: BlogLang -> EntryId -> URI
|
||||
makeLink l i = let url = "http://tazj.in/" ++ show l ++ "/" ++ show i
|
||||
in fromMaybe nullURI $ parseURI url
|
||||
|
||||
createItems :: [Entry] -> [Item]
|
||||
createItems = map createItem
|
||||
|
||||
createFeed :: BlogLang -> [Entry] -> IO RSS
|
||||
createFeed l e = getCurrentTime >>= (\t -> return $ createRSS l t $ createItems e )
|
||||
|
||||
renderFeed :: BlogLang -> [Entry] -> IO String
|
||||
renderFeed l e = createFeed l e >>= (\feed -> return $ showXML $ rssToXML feed)
|
||||
Loading…
Add table
Add a link
Reference in a new issue