diff --git a/LICENSE b/LICENSE new file mode 100644 --- /dev/null +++ b/LICENSE @@ -0,0 +1,25 @@ +The following license covers this documentation, and the source code, except +where otherwise indicated. + +Copyright 2010, Michael Snoyman. All rights reserved. + +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions are met: + +* Redistributions of source code must retain the above copyright notice, this + list of conditions and the following disclaimer. + +* Redistributions in binary form must reproduce the above copyright notice, + this list of conditions and the following disclaimer in the documentation + and/or other materials provided with the distribution. + +THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS "AS IS" AND ANY EXPRESS OR +IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF +MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO +EVENT SHALL THE COPYRIGHT HOLDERS BE LIABLE FOR ANY DIRECT, INDIRECT, +INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT +NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, +OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF +LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE +OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF +ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. diff --git a/Setup.hs b/Setup.hs new file mode 100644 --- /dev/null +++ b/Setup.hs @@ -0,0 +1,2 @@ +import Distribution.Simple +main = defaultMain diff --git a/Yesod/Helpers/AtomFeed.hs b/Yesod/Helpers/AtomFeed.hs new file mode 100644 --- /dev/null +++ b/Yesod/Helpers/AtomFeed.hs @@ -0,0 +1,84 @@ +{-# LANGUAGE QuasiQuotes #-} +{-# LANGUAGE CPP #-} +--------------------------------------------------------- +-- +-- Module : Yesod.Helpers.AtomFeed +-- Copyright : Michael Snoyman +-- License : BSD3 +-- +-- Maintainer : Michael Snoyman +-- Stability : Stable +-- Portability : portable +-- +-- Generating atom news feeds. +-- +--------------------------------------------------------- + +-- | Generation of Atom newsfeeds. +module Yesod.Helpers.AtomFeed + ( atomFeed + , atomLink + , RepAtom (..) + , module Yesod.Helpers.FeedTypes + ) where + +import Yesod.Content +import Yesod.Handler +import Yesod.Widget +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 :: Monad mo => Feed (Route master) -> GGHandler sub master mo RepAtom +atomFeed = liftM RepAtom . hamletToContent . template + +template :: Feed url -> Hamlet url +template arg = +#if __GLASGOW_HASKELL__ >= 700 + [xhamlet| +#else + [$xhamlet| +#endif +\ +#{feedTitle arg} + #{formatW3 $ feedUpdated arg} + @{feedLinkHome arg} + $forall entry <- feedEntries arg + ^{entryTemplate entry} +|] + +entryTemplate :: FeedEntry url -> Hamlet url +entryTemplate arg = +#if __GLASGOW_HASKELL__ >= 700 + [xhamlet| +#else + [$xhamlet| +#endif +@{feedEntryLink arg} + #{formatW3 $ feedEntryUpdated arg} + #{feedEntryTitle arg} + <content type=html>#{cdata $ feedEntryContent arg} +|] + +-- | Generates a link tag in the head of a widget. +atomLink :: Route m + -> String -- ^ title + -> GWidget s m () +atomLink u title = addHamletHead +#if __GLASGOW_HASKELL__ >= 700 + [hamlet| +#else + [$hamlet| +#endif +<link href=@{u} type=#{S8.unpack typeAtom} rel="alternate" title=#{title} +|] diff --git a/Yesod/Helpers/Feed.hs b/Yesod/Helpers/Feed.hs new file mode 100644 --- /dev/null +++ b/Yesod/Helpers/Feed.hs @@ -0,0 +1,40 @@ +------------------------------------------------------------------------------- +-- +-- Module : Yesod.Helpers.Feed +-- Copyright : Patrick Brisbin +-- License : as-is +-- +-- Maintainer : Patrick Brisbin <me@pbrisbin.com> +-- Stability : Stable +-- Portability : Portable +-- +-- Generic Feed and Feed Entry data types that can be used as either an +-- Rss feed or an Atom feed (or both, or other). +-- +-- Atom spec: <http://en.wikipedia.org/wiki/Atom_(standard)> +-- Rss spec: <http://www.rssboard.org/rss-specification> +-- +------------------------------------------------------------------------------- +module Yesod.Helpers.Feed + ( newsFeed + , RepAtomRss (..) + , module Yesod.Helpers.FeedTypes + ) where + +import Yesod.Helpers.FeedTypes +import Yesod.Helpers.AtomFeed +import Yesod.Helpers.RssFeed +import Yesod.Content (HasReps (chooseRep), typeAtom, typeRss) +import Yesod.Handler (Route, GGHandler) + +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 diff --git a/Yesod/Helpers/FeedTypes.hs b/Yesod/Helpers/FeedTypes.hs new file mode 100644 --- /dev/null +++ b/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 + } diff --git a/Yesod/Helpers/RssFeed.hs b/Yesod/Helpers/RssFeed.hs new file mode 100644 --- /dev/null +++ b/Yesod/Helpers/RssFeed.hs @@ -0,0 +1,84 @@ +{-# LANGUAGE QuasiQuotes #-} +{-# LANGUAGE CPP #-} +------------------------------------------------------------------------------- +-- +-- Module : Yesod.Helpers.RssFeed +-- Copyright : Patrick Brisbin +-- License : as-is +-- +-- Maintainer : Patrick Brisbin <me@pbrisbin.com> +-- Stability : Stable +-- Portability : Portable +-- +------------------------------------------------------------------------------- +module Yesod.Helpers.RssFeed + ( rssFeed + , rssLink + , RepRss (..) + , module Yesod.Helpers.FeedTypes + ) where + +import Yesod.Handler +import Yesod.Content +import Yesod.Widget +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 :: Monad mo => Feed (Route master) -> GGHandler sub master mo RepRss +rssFeed = liftM RepRss . hamletToContent . template + +template :: Feed url -> Hamlet 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} + + $forall entry <- feedEntries arg + ^{entryTemplate entry} + |] + +entryTemplate :: FeedEntry url -> Hamlet 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} + |] + +-- | Generates a link tag in the head of a widget. +rssLink :: Route m + -> String -- ^ title + -> GWidget s m () +rssLink u title = addHamletHead +#if __GLASGOW_HASKELL__ >= 700 + [hamlet| +#else + [$hamlet| +#endif + <link href=@{u} type=#{S8.unpack typeRss} rel="alternate" title=#{title} + |] diff --git a/yesod-newsfeed.cabal b/yesod-newsfeed.cabal new file mode 100644 --- /dev/null +++ b/yesod-newsfeed.cabal @@ -0,0 +1,28 @@ +name: yesod-newsfeed +version: 0.0.0 +license: BSD3 +license-file: LICENSE +author: Michael Snoyman, Patrick Brisbin +maintainer: Michael Snoyman <michael@snoyman.com> +synopsis: Helper functions and data types for producing News feeds. +category: Web, Yesod +stability: Stable +cabal-version: >= 1.6 +build-type: Simple +homepage: http://docs.yesodweb.com/ + +library + build-depends: base >= 4 && < 5 + , yesod-core >= 0.7 && < 0.8 + , time >= 1.1.4 && < 1.3 + , hamlet >= 0.7 && < 0.8 + , bytestring >= 0.9 && < 0.10 + exposed-modules: Yesod.Helpers.AtomFeed + , Yesod.Helpers.RssFeed + , Yesod.Helpers.Feed + other-modules: Yesod.Helpers.FeedTypes + ghc-options: -Wall + +source-repository head + type: git + location: git://github.com/snoyberg/yesod-newsfeed.git