packages feed

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) ]