RepAtomRss

This commit is contained in:
Michael Snoyman 2011-02-04 07:22:41 +02:00
parent b246471efb
commit c961daa099
5 changed files with 63 additions and 37 deletions

View File

@ -19,22 +19,23 @@ module Yesod.Helpers.AtomFeed
( atomFeed ( atomFeed
, atomLink , atomLink
, RepAtom (..) , RepAtom (..)
, module Yesod.Helpers.Feed , module Yesod.Helpers.FeedTypes
) where ) where
import Yesod.Content import Yesod.Content
import Yesod.Handler import Yesod.Handler
import Yesod.Widget import Yesod.Widget
import Yesod.Helpers.Feed import Yesod.Helpers.FeedTypes
import Text.Hamlet (Hamlet, xhamlet, hamlet, cdata) import Text.Hamlet (Hamlet, xhamlet, hamlet, cdata)
import qualified Data.ByteString.Char8 as S8 import qualified Data.ByteString.Char8 as S8
import Control.Monad (liftM)
newtype RepAtom = RepAtom Content newtype RepAtom = RepAtom Content
instance HasReps RepAtom where instance HasReps RepAtom where
chooseRep (RepAtom c) _ = return (typeAtom, c) chooseRep (RepAtom c) _ = return (typeAtom, c)
atomFeed :: Feed (Route master) -> GHandler sub master RepAtom atomFeed :: Monad mo => Feed (Route master) -> GGHandler sub master mo RepAtom
atomFeed = fmap RepAtom . hamletToContent . template atomFeed = liftM RepAtom . hamletToContent . template
template :: Feed url -> Hamlet url template :: Feed url -> Hamlet url
template arg = template arg =

View File

@ -16,35 +16,25 @@
-- --
------------------------------------------------------------------------------- -------------------------------------------------------------------------------
module Yesod.Helpers.Feed module Yesod.Helpers.Feed
( Feed(..) ( newsFeed
, FeedEntry(..) , RepAtomRss (..)
, module Yesod.Helpers.FeedTypes
) where ) where
import Text.Hamlet (Html) import Yesod.Helpers.FeedTypes
import Data.Time.Clock (UTCTime) import Yesod.Helpers.AtomFeed
import Yesod.Helpers.RssFeed
import Yesod.Content (HasReps (chooseRep), typeAtom, typeRss)
import Yesod.Handler (Route, GGHandler)
-- | The overal feed data RepAtomRss = RepAtomRss RepAtom RepRss
data Feed url = Feed instance HasReps RepAtomRss where
{ feedTitle :: String chooseRep (RepAtomRss (RepAtom a) (RepRss r)) = chooseRep
, feedLinkSelf :: url [ (typeAtom, a)
, feedLinkHome :: url , (typeRss, r)
]
newsFeed :: Monad mo => Feed (Route master) -> GGHandler sub master mo RepAtomRss
-- | note: currently only used for Rss newsFeed f = do
, feedDescription :: Html a <- atomFeed f
r <- rssFeed f
-- | note: currently only used for Rss, possible values: return $ RepAtomRss a r
-- <http://www.rssboard.org/rss-language-codes>
, feedLanguage :: String
, feedUpdated :: UTCTime
, feedEntries :: [FeedEntry url]
}
-- | Each feed entry
data FeedEntry url = FeedEntry
{ feedEntryLink :: url
, feedEntryUpdated :: UTCTime
, feedEntryTitle :: String
, feedEntryContent :: Html
}

View File

@ -0,0 +1,33 @@
module Yesod.Helpers.FeedTypes
( Feed (..)
, FeedEntry (..)
) where
import Text.Hamlet (Html)
import Data.Time.Clock (UTCTime)
-- | The overal feed
data Feed url = Feed
{ feedTitle :: String
, feedLinkSelf :: url
, feedLinkHome :: url
-- | note: currently only used for Rss
, feedDescription :: Html
-- | note: currently only used for Rss, possible values:
-- <http://www.rssboard.org/rss-language-codes>
, feedLanguage :: String
, feedUpdated :: UTCTime
, feedEntries :: [FeedEntry url]
}
-- | Each feed entry
data FeedEntry url = FeedEntry
{ feedEntryLink :: url
, feedEntryUpdated :: UTCTime
, feedEntryTitle :: String
, feedEntryContent :: Html
}

View File

@ -15,23 +15,24 @@ module Yesod.Helpers.RssFeed
( rssFeed ( rssFeed
, rssLink , rssLink
, RepRss (..) , RepRss (..)
, module Yesod.Helpers.Feed , module Yesod.Helpers.FeedTypes
) where ) where
import Yesod.Handler import Yesod.Handler
import Yesod.Content import Yesod.Content
import Yesod.Widget import Yesod.Widget
import Yesod.Helpers.Feed import Yesod.Helpers.FeedTypes
import Text.Hamlet (Hamlet, xhamlet, hamlet) import Text.Hamlet (Hamlet, xhamlet, hamlet)
import qualified Data.ByteString.Char8 as S8 import qualified Data.ByteString.Char8 as S8
import Control.Monad (liftM)
newtype RepRss = RepRss Content newtype RepRss = RepRss Content
instance HasReps RepRss where instance HasReps RepRss where
chooseRep (RepRss c) _ = return (typeRss, c) chooseRep (RepRss c) _ = return (typeRss, c)
-- | Generate the feed -- | Generate the feed
rssFeed :: Feed (Route master) -> GHandler sub master RepRss rssFeed :: Monad mo => Feed (Route master) -> GGHandler sub master mo RepRss
rssFeed = fmap RepRss . hamletToContent . template rssFeed = liftM RepRss . hamletToContent . template
template :: Feed url -> Hamlet url template :: Feed url -> Hamlet url
template arg = template arg =

View File

@ -20,6 +20,7 @@ library
exposed-modules: Yesod.Helpers.AtomFeed exposed-modules: Yesod.Helpers.AtomFeed
, Yesod.Helpers.RssFeed , Yesod.Helpers.RssFeed
, Yesod.Helpers.Feed , Yesod.Helpers.Feed
other-modules: Yesod.Helpers.FeedTypes
ghc-options: -Wall ghc-options: -Wall
source-repository head source-repository head