RepAtomRss
This commit is contained in:
parent
b246471efb
commit
c961daa099
@ -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 =
|
||||||
|
|||||||
@ -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
|
|
||||||
}
|
|
||||||
|
|||||||
33
Yesod/Helpers/FeedTypes.hs
Normal file
33
Yesod/Helpers/FeedTypes.hs
Normal 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
|
||||||
|
}
|
||||||
@ -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 =
|
||||||
|
|||||||
@ -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
|
||||||
|
|||||||
Loading…
Reference in New Issue
Block a user