toying around with the feeds
This commit is contained in:
parent
69ab9059c2
commit
16472c49d5
2 changed files with 22 additions and 12 deletions
|
@ -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)
|
||||||
|
|
11
Helper.hs
11
Helper.hs
|
@ -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) []
|
||||||
|
|
Loading…
Reference in a new issue