lucienne-0.0.1: Lucienne/Model/FeedItem.hs
module Lucienne.Model.FeedItem
( FeedItem, id, feedId, title, url, content, dateFetched, state, newItem
, setOwner, setFeedId
, feedItemsQuery, readableFeedItemsQuery, feedItemsByFeedIdQuery, feedItemByIdQuery
, feedItemExistsQuery
, deleteMarkedFeedItemsQuery, deleteFeedItemsByFeedIdQuery
, feedItemHeaderProjector, feedItemsSort)
where
import Prelude hiding (id)
import System.IO.Unsafe (unsafePerformIO)
import Data.Maybe (fromJust)
import qualified Data.CompactString.UTF8 as CS
import Data.Bson (Document,ObjectId,(=:),at)
import Data.Time.Clock (UTCTime)
import Data.Time.LocalTime (getZonedTime,zonedTimeToUTC)
import Lucienne.DatabaseAble (DatabaseAble(..))
import Lucienne.Model.Util (maybeAddId,readObjectId)
import qualified Lucienne.Model.User as U
import Lucienne.Model.FeedItemState (FeedItemState)
import qualified Lucienne.Model.FeedItemState as S
data FeedItem = FeedItem { _id :: Maybe ObjectId
, _ownerId :: Maybe String
, _feedId :: Maybe ObjectId
, title :: String
, url :: String
, content :: String
, dateFetched :: UTCTime
, state :: FeedItemState
}
newItem :: String -> String -> String -> FeedItem
newItem title url content =
FeedItem Nothing Nothing Nothing title url content currentTimeInUTC S.New
id,feedId :: FeedItem -> ObjectId
id = fromJust . _id
feedId = fromJust . _feedId
setOwner :: U.User -> FeedItem -> FeedItem
setOwner owner item = item { _ownerId = Just $ U.name owner }
setFeedId :: ObjectId -> FeedItem -> FeedItem
setFeedId feedId item = item { _feedId = Just feedId }
{-# NOINLINE currentTimeInUTC #-}
currentTimeInUTC :: UTCTime
currentTimeInUTC =
unsafePerformIO (getZonedTime >>= return . zonedTimeToUTC)
instance DatabaseAble FeedItem where
toDocument item = maybeAddId _id item $
[ "ownerId" =: CS.pack (fromJust $ _ownerId item)
, "feedId" =: (fromJust $ _feedId item)
, "title" =: CS.pack (title item)
, "url" =: CS.pack (url item)
, "content" =: CS.pack (content item)
, "dateFetched" =: dateFetched item
, "state" =: (S.toInteger $ state item)
]
fromDocument document =
let id = "_id" `at` document
ownerId = CS.unpack $ "ownerId" `at` document
feedId = "feedId" `at` document
title = CS.unpack $ "title" `at` document
url = CS.unpack $ "url" `at` document
content = CS.unpack $ "content" `at` document
dateFetched = "dateFetched" `at` document
state = S.fromInteger $ "state" `at` document
in
FeedItem (Just id) (Just ownerId) (Just feedId) title url content dateFetched state
feedItemsQuery :: String -> Document
feedItemsQuery ownerId =
[ "ownerId" =: CS.pack ownerId ]
readableFeedItemsQuery :: String -> Document
readableFeedItemsQuery ownerId =
[ "ownerId" =: CS.pack ownerId
, "state" =: [ "$in" =: [S.toInteger S.New, S.toInteger S.Read] ]
]
feedItemsByFeedIdQuery :: String -> String -> Document
feedItemsByFeedIdQuery ownerId feedId =
[ "ownerId" =: CS.pack ownerId
, "feedId" =: readObjectId feedId
, "state" =: [ "$in" =: [S.toInteger S.New, S.toInteger S.Read] ]
]
feedItemByIdQuery :: String -> String -> Document
feedItemByIdQuery ownerId id =
[ "ownerId" =: CS.pack ownerId
, "_id" =: readObjectId id
]
feedItemExistsQuery :: ObjectId -> String -> String -> Document
feedItemExistsQuery feedId title url =
[ "feedId" =: feedId
, "title" =: CS.pack title
, "url" =: CS.pack url
]
deleteMarkedFeedItemsQuery :: ObjectId -> [String] -> [String] -> Document
deleteMarkedFeedItemsQuery feedId titlesToMaintain urlsToMaintain =
[ "state" =: S.toInteger S.Deleted
, "feedId" =: feedId
, "title" =: [ "$not" =: [ "$in" =: map CS.pack titlesToMaintain ] ]
, "url" =: [ "$not" =: [ "$in" =: map CS.pack urlsToMaintain ] ]
]
deleteFeedItemsByFeedIdQuery :: ObjectId -> Document
deleteFeedItemsByFeedIdQuery feedId = [ "feedId" =: feedId ]
feedItemHeaderProjector :: Document
feedItemHeaderProjector = ["content" =: (0 :: Int)]
feedItemsSort :: Document
feedItemsSort = [ "dateFetched" =: (1 :: Int) ]