toying around with the feeds

This commit is contained in:
nek0 2014-12-19 21:59:55 +01:00
parent 69ab9059c2
commit 16472c49d5
2 changed files with 22 additions and 12 deletions

View file

@ -2,8 +2,7 @@ module Handler.RootFeed where
import Import import Import
import Yesod import Yesod
import Helper import Yesod.Static
import qualified Data.ByteString.Lazy as LB
import qualified Data.Text as T import qualified Data.Text as T
import Data.Maybe import Data.Maybe
import Data.Time import Data.Time
@ -46,9 +45,6 @@ instance RepFeed RepAtom where
return $ Left $ map (\ent -> (entityKey ent, url $ MediumR $ commentOrigin $ entityVal ent)) commEnts return $ Left $ map (\ent -> (entityKey ent, url $ MediumR $ commentOrigin $ entityVal ent)) commEnts
Right mediaEnts -> Right mediaEnts ->
return $ Right $ map (\ent -> (entityKey ent, url $ MediumR $ entityKey ent)) mediaEnts return $ Right $ map (\ent -> (entityKey ent, url $ MediumR $ entityKey ent)) mediaEnts
-- media <- case items of
-- [Entity _ (Medium _ _ _ _ _ _ _ _ _)] -> return $ True
-- [Entity _ (Comment _ _ _ _ _ _)] -> return $ False
return $ RepAtom $ toContent $ return $ RepAtom $ toContent $
[xhamlet|$newline always [xhamlet|$newline always
<feed version="1.0" <feed version="1.0"
@ -76,11 +72,11 @@ instance RepFeed RepAtom where
<published>#{iso8601 $ utcToZonedTime tz $ mediumTime medium} <published>#{iso8601 $ utcToZonedTime tz $ mediumTime medium}
<summary>#{mediumDescription medium} <summary>#{mediumDescription medium}
<link rel="icon" <link rel="icon"
href=#{mediumThumb medium} href=#{url $ StaticR $ mediumStaticThumbRoute medium}
> >
<link rel="enclosure" <link rel="enclosure"
type=#{mediumMime medium} type=#{mediumMime medium}
href=#{fromJust $ lookup mediumId $ fromRight [] links} href=#{url $ StaticR $ mediumStaticImageRoute medium}
> >
$of Left comments $of Left comments
$forall (Entity commentId comment) <- comments $forall (Entity commentId comment) <- comments
@ -93,7 +89,7 @@ instance RepFeed RepAtom where
<id>#{fromJust $ lookup commentId $ fromLeft [] links} <id>#{fromJust $ lookup commentId $ fromLeft [] links}
<published>#{iso8601 $ utcToZonedTime tz $ commentTime comment} <published>#{iso8601 $ utcToZonedTime tz $ commentTime comment}
<summary>#{commentContent comment} <summary>#{commentContent comment}
|] url |] url
newtype RepRss = RepRss Content newtype RepRss = RepRss Content
deriving (ToContent) deriving (ToContent)
@ -134,8 +130,8 @@ instance RepFeed RepRss where
<pubDate>#{rfc822 $ mediumTime medium} <pubDate>#{rfc822 $ mediumTime medium}
<image> <image>
<url>#{fromJust $ lookup mediumId $ fromRight [] links} <url>#{fromJust $ lookup mediumId $ fromRight [] links}
<enclosure type="#{mediumMime medium}" <enclosure type=#{mediumMime medium}
url="#{fromJust $ lookup mediumId $ fromRight [] links}"> url=#{url $ StaticR $ mediumStaticImageRoute medium}>
$of Left comments $of Left comments
$forall (Entity commentId comment) <- comments $forall (Entity commentId comment) <- comments
<item> <item>
@ -170,11 +166,13 @@ getAlbumFeedRssR = getAlbumFeedR
getAlbumFeedR :: RepFeed a => AlbumId -> Handler a getAlbumFeedR :: RepFeed a => AlbumId -> Handler a
getAlbumFeedR albumId = do getAlbumFeedR albumId = do
album <- runDB $ get404 albumId album <- runDB $ get404 albumId
url <- getUrlRender
recentMedia <- runDB $ selectList [MediumAlbum ==. albumId] [Desc MediumTime, LimitTo 10] recentMedia <- runDB $ selectList [MediumAlbum ==. albumId] [Desc MediumTime, LimitTo 10]
renderFeed Parameters renderFeed Parameters
{ pTitle = "Eidolon :: Latest media in album " `T.append` (albumTitle album) { pTitle = "Eidolon :: Latest media in album " `T.append` (albumTitle album)
, pLink = AlbumR albumId , pLink = AlbumR albumId
, pImage = T.pack $ fromMaybe "" (albumSamplePic album) , pImage = url $ StaticR $ StaticRoute
(drop 2 $ T.splitOn "/" $ T.pack $ fromMaybe "/static/img/album.jpg" $ albumSamplePic album) []
} (Right recentMedia) } (Right recentMedia)
getCommentFeedAtomR :: MediumId -> Handler RepAtom getCommentFeedAtomR :: MediumId -> Handler RepAtom
@ -186,9 +184,10 @@ getCommentFeedRssR = getCommentFeedR
getCommentFeedR :: RepFeed a => MediumId -> Handler a getCommentFeedR :: RepFeed a => MediumId -> Handler a
getCommentFeedR mediumId = do getCommentFeedR mediumId = do
medium <- runDB $ get404 mediumId medium <- runDB $ get404 mediumId
url <- getUrlRender
recentComments <- runDB $ selectList [CommentOrigin ==. mediumId] [Desc CommentTime, LimitTo 10] recentComments <- runDB $ selectList [CommentOrigin ==. mediumId] [Desc CommentTime, LimitTo 10]
renderFeed Parameters renderFeed Parameters
{ pTitle = "Eidolon :: Newest comments on " `T.append` (mediumTitle medium) { pTitle = "Eidolon :: Newest comments on " `T.append` (mediumTitle medium)
, pLink = MediumR mediumId , pLink = MediumR mediumId
, pImage = T.pack $ mediumThumb medium , pImage = url $ StaticR $ mediumStaticThumbRoute medium
} (Left recentComments) } (Left recentComments)

View file

@ -16,10 +16,13 @@ module Helper
, iso8601 , iso8601
, localTimeToZonedTime , localTimeToZonedTime
, rfc822 , rfc822
, mediumStaticImageRoute
, mediumStaticThumbRoute
) )
where where
import Prelude import Prelude
import Yesod.Static
import Model import Model
import Control.Applicative import Control.Applicative
import Control.Monad.Trans.Class import Control.Monad.Trans.Class
@ -174,3 +177,11 @@ localTimeToZonedTime tz =
--rfc822 :: LocalTime -> String --rfc822 :: LocalTime -> String
rfc822 = formatTime defaultTimeLocale rfc822DateFormat rfc822 = formatTime defaultTimeLocale rfc822DateFormat
mediumStaticImageRoute :: Medium -> Route Static
mediumStaticImageRoute medium =
StaticRoute (drop 2 $ T.splitOn "/" $ T.pack $ mediumPath medium) []
mediumStaticThumbRoute :: Medium -> Route Static
mediumStaticThumbRoute medium =
StaticRoute (drop 2 $ T.splitOn "/" $ T.pack $ mediumThumb medium) []