diff --git a/Yesod/AtomFeed.hs b/Yesod/AtomFeed.hs --- a/Yesod/AtomFeed.hs +++ b/Yesod/AtomFeed.hs @@ -1,5 +1,6 @@ {-# LANGUAGE QuasiQuotes #-} -{-# LANGUAGE CPP #-} +{-# LANGUAGE RecordWildCards #-} +{-# LANGUAGE OverloadedStrings #-} --------------------------------------------------------- -- -- Module : Yesod.AtomFeed @@ -24,62 +25,52 @@ import Yesod.Core import Yesod.FeedTypes -import Text.Hamlet (HtmlUrl, xhamlet, hamlet) +import Text.Hamlet (hamlet) import qualified Data.ByteString.Char8 as S8 -import Control.Monad (liftM) +import Data.Text (Text) +import Data.Text.Lazy (toStrict) +import Text.XML +import Text.Blaze.Renderer.Text (renderHtml) newtype RepAtom = RepAtom Content instance HasReps RepAtom where chooseRep (RepAtom c) _ = return (typeAtom, c) atomFeed :: Feed (Route master) -> GHandler sub master RepAtom -atomFeed = liftM RepAtom . hamletToContent . template +atomFeed feed = do + render <- getUrlRender + return $ RepAtom $ toContent $ renderLBS def $ template feed render -template :: Feed url -> HtmlUrl url -template arg = -#if __GLASGOW_HASKELL__ >= 700 - [xhamlet| -#else - [$xhamlet| -#endif -\ -#{feedTitle arg} - #{formatW3 $ feedUpdated arg} - @{feedLinkHome arg} - $forall entry <- feedEntries arg - ^{entryTemplate entry} -|] +template :: Feed url -> (url -> Text) -> Document +template Feed {..} render = + Document (Prologue [] Nothing []) (addNS root) [] + where + addNS (Element (Name ln _ _) as ns) = Element (Name ln (Just namespace) Nothing) as (map addNS' ns) + addNS' (NodeElement e) = NodeElement $ addNS e + addNS' n = n + namespace = "http://www.w3.org/2005/Atom" -entryTemplate :: FeedEntry url -> HtmlUrl url -entryTemplate arg = -#if __GLASGOW_HASKELL__ >= 700 - [xhamlet| -#else - [$xhamlet| -#endif -@{feedEntryLink arg} - #{formatW3 $ feedEntryUpdated arg} - #{feedEntryTitle arg} - <content type=html> - \<![CDATA[ - \#{feedEntryContent arg} - ]]> -|] + root = Element "feed" [] $ map NodeElement + $ Element "title" [] [NodeContent feedTitle] + : Element "link" [("rel", "self"), ("href", render feedLinkSelf)] [] + : Element "link" [("href", render feedLinkHome)] [] + : Element "updated" [] [NodeContent $ formatW3 feedUpdated] + : Element "id" [] [NodeContent $ render feedLinkHome] + : map (flip entryTemplate render) feedEntries +entryTemplate :: FeedEntry url -> (url -> Text) -> Element +entryTemplate FeedEntry {..} render = Element "entry" [] $ map NodeElement + [ Element "id" [] [NodeContent $ render feedEntryLink] + , Element "link" [("href", render feedEntryLink)] [] + , Element "updated" [] [NodeContent $ formatW3 feedEntryUpdated] + , Element "title" [] [NodeContent feedEntryTitle] + , Element "content" [("type", "html")] [NodeContent $ toStrict $ renderHtml feedEntryContent] + ] + -- | Generates a link tag in the head of a widget. atomLink :: Route m - -> String -- ^ title + -> Text -- ^ title -> GWidget s m () -atomLink r title = addHamletHead -#if __GLASGOW_HASKELL__ >= 700 - [hamlet| -#else - [$hamlet| -#endif -<link href=@{r} type=#{S8.unpack typeAtom} rel="alternate" title=#{title} +atomLink r title = toWidgetHead [hamlet| +<link href=@{r} type=#{S8.unpack typeAtom} rel="alternate" title=#{title}> |] diff --git a/Yesod/RssFeed.hs b/Yesod/RssFeed.hs --- a/Yesod/RssFeed.hs +++ b/Yesod/RssFeed.hs @@ -1,5 +1,6 @@ {-# LANGUAGE QuasiQuotes #-} -{-# LANGUAGE CPP #-} +{-# LANGUAGE RecordWildCards #-} +{-# LANGUAGE OverloadedStrings #-} ------------------------------------------------------------------------------- -- -- Module : Yesod.RssFeed @@ -20,9 +21,12 @@ import Yesod.Core import Yesod.FeedTypes -import Text.Hamlet (HtmlUrl, xhamlet, hamlet) +import Text.Hamlet (hamlet) import qualified Data.ByteString.Char8 as S8 -import Control.Monad (liftM) +import Data.Text (Text, pack) +import Data.Text.Lazy (toStrict) +import Text.XML +import Text.Blaze.Renderer.Text (renderHtml) newtype RepRss = RepRss Content instance HasReps RepRss where @@ -30,53 +34,40 @@ -- | Generate the feed rssFeed :: Feed (Route master) -> GHandler sub master RepRss -rssFeed = liftM RepRss . hamletToContent . template - -template :: Feed url -> HtmlUrl url -template arg = -#if __GLASGOW_HASKELL__ >= 700 - [xhamlet| -#else - [$xhamlet| -#endif - \<?xml version="1.0" encoding="utf-8"?> - <rss version="2.0" xmlns:atom="http://www.w3.org/2005/Atom" - <channel - <atom:link href=@{feedLinkSelf arg} rel="self" type=#{S8.unpack typeRss} - <title> #{feedTitle arg} - <link> @{feedLinkHome arg} - <description> #{feedDescription arg} - <lastBuildDate>#{formatRFC822 $ feedUpdated arg} - <language> #{feedLanguage arg} +rssFeed feed = do + render <- getUrlRender + return $ RepRss $ toContent $ renderLBS def $ template feed render - $forall entry <- feedEntries arg - ^{entryTemplate entry} - |] +template :: Feed url -> (url -> Text) -> Document +template Feed {..} render = + Document (Prologue [] Nothing []) root [] + where + root = Element "rss" [("version", "2.0")] $ return $ NodeElement $ Element "channel" [] $ map NodeElement + $ Element "{http://www.w3.org/2005/Atom}link" + [ ("href", render feedLinkSelf) + , ("rel", "self") + , ("type", pack $ S8.unpack typeRss) + ] [] + : Element "title" [] [NodeContent feedTitle] + : Element "link" [] [NodeContent $ render feedLinkHome] + : Element "description" [] [NodeContent $ toStrict $ renderHtml feedDescription] + : Element "lastBuildDate" [] [NodeContent $ formatRFC822 feedUpdated] + : Element "language" [] [NodeContent feedLanguage] + : map (flip entryTemplate render) feedEntries -entryTemplate :: FeedEntry url -> HtmlUrl url -entryTemplate arg = -#if __GLASGOW_HASKELL__ >= 700 - [xhamlet| -#else - [$xhamlet| -#endif - <item - <title> #{feedEntryTitle arg} - <link> @{feedEntryLink arg} - <guid> @{feedEntryLink arg} - <pubDate> #{formatRFC822 $ feedEntryUpdated arg} - <description>#{feedEntryContent arg} - |] +entryTemplate :: FeedEntry url -> (url -> Text) -> Element +entryTemplate FeedEntry {..} render = Element "item" [] $ map NodeElement + [ Element "title" [] [NodeContent feedEntryTitle] + , Element "link" [] [NodeContent $ render feedEntryLink] + , Element "guid" [] [NodeContent $ render feedEntryLink] + , Element "pubDate" [] [NodeContent $ formatRFC822 feedEntryUpdated] + , Element "description" [] [NodeContent $ toStrict $ renderHtml feedEntryContent] + ] -- | Generates a link tag in the head of a widget. rssLink :: Route m - -> String -- ^ title + -> Text -- ^ title -> GWidget s m () -rssLink r title = addHamletHead -#if __GLASGOW_HASKELL__ >= 700 - [hamlet| -#else - [$hamlet| -#endif - <link href=@{r} type=#{S8.unpack typeRss} rel="alternate" title=#{title} +rssLink r title = toWidgetHead [hamlet| + <link href=@{r} type=#{S8.unpack typeRss} rel="alternate" title=#{title}> |] diff --git a/yesod-newsfeed.cabal b/yesod-newsfeed.cabal --- a/yesod-newsfeed.cabal +++ b/yesod-newsfeed.cabal @@ -1,6 +1,6 @@ name: yesod-newsfeed -version: 0.4.1 -license: BSD3 +version: 1.0.0 +license: MIT license-file: LICENSE author: Michael Snoyman, Patrick Brisbin maintainer: Michael Snoyman <michael@snoyman.com> @@ -14,11 +14,13 @@ library build-depends: base >= 4 && < 5 - , yesod-core >= 0.10.1 && < 0.11 + , yesod-core >= 1.0 && < 1.1 , time >= 1.1.4 - , hamlet >= 0.10 && < 0.11 + , hamlet >= 1.0 && < 1.1 , bytestring >= 0.9.1.4 && < 0.10 , text >= 0.9 && < 0.12 + , xml-conduit >= 0.7 && < 0.8 + , blaze-html >= 0.4 && < 0.5 exposed-modules: Yesod.AtomFeed , Yesod.RssFeed , Yesod.Feed