RepAtomRss

Yesod/Helpers/AtomFeed.hs

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

Yesod/Helpers/Feed.hs

@@ -16,35 +16,25 @@
 --
 -------------------------------------------------------------------------------
 module Yesod.Helpers.Feed
-    ( Feed(..)
-    , FeedEntry(..)
+    ( newsFeed
+    , RepAtomRss (..)
+    , module Yesod.Helpers.FeedTypes
     ) where
 
-import Text.Hamlet      (Html)
-import Data.Time.Clock  (UTCTime)
+import Yesod.Helpers.FeedTypes
+import Yesod.Helpers.AtomFeed
+import Yesod.Helpers.RssFeed
+import Yesod.Content (HasReps (chooseRep), typeAtom, typeRss)
+import Yesod.Handler (Route, GGHandler)
 
--- | 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
-    }
+data RepAtomRss = RepAtomRss RepAtom RepRss
+instance HasReps RepAtomRss where
+    chooseRep (RepAtomRss (RepAtom a) (RepRss r)) = chooseRep
+        [ (typeAtom, a)
+        , (typeRss, r)
+        ]
+newsFeed :: Monad mo => Feed (Route master) -> GGHandler sub master mo RepAtomRss
+newsFeed f = do
+    a <- atomFeed f
+    r <- rssFeed f
+    return $ RepAtomRss a r

Yesod/Helpers/FeedTypes.hs

@@ -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
+    }

Yesod/Helpers/RssFeed.hs

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

yesod-newsfeed.cabal

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