import Prelude hiding (log) import Control.Monad (forM_) import Control.Monad.Trans (liftIO) import Data.Time.LocalTime (getZonedTime) import Data.Bson (ObjectId) import Database.MongoDB (runIOE,readHostPort,connect,close) import qualified Lucienne.Database as DB import Lucienne.ConnectionReader (ConnectionReader,runConnectionReader) import Lucienne.Fetch (fetchFeed) import Lucienne.Fetch.Util (partitionM) import Lucienne.Model.User (User) import qualified Lucienne.Model.User as User import Lucienne.Model.Feed (Feed) import qualified Lucienne.Model.Feed as F import Lucienne.Model.FeedItem (FeedItem) import qualified Lucienne.Model.FeedItem as FI import Lucienne.Args (getArgs,dbConnectionString) main :: IO () main = do args <- getArgs putStrLn $ "Connecting to database " ++ (dbConnectionString args) ++ " ..." connection <- runIOE $ connect $ readHostPort $ dbConnectionString args runConnectionReader connection fetch close connection fetch :: ConnectionReader () fetch = do users <- DB.users forM_ users fetchFeedsAndUpdate fetchFeedsAndUpdate :: User -> ConnectionReader () fetchFeedsAndUpdate user = do feeds <- DB.feedsByUser user forM_ feeds $ \f -> do log $ concat ["Fetching feed '",F.title f, "' for user '",User.name user,"'"] fetchFeedItemsAndUpdate user f fetchFeedItemsAndUpdate :: User -> Feed -> ConnectionReader () fetchFeedItemsAndUpdate user feed = let fId = F.id feed fUrl = F.url feed in do result <- liftIO $ fetchFeed feed case result of Left message -> log $ "Could not fetch feed '" ++ fUrl ++ "' because of: " ++ message Right (_,items') -> let items = map (FI.setOwner user . FI.setFeedId fId) items' in do (rest,toAdd) <- partitionExistentFeedItems fId items log $ concat ["Fetched ", show $ length items," items (",show $ length toAdd," new)"] forM_ toAdd DB.upsertFeedItem deleteFeedItems fId rest partitionExistentFeedItems :: ObjectId -> [FeedItem] -> ConnectionReader ([FeedItem],[FeedItem]) partitionExistentFeedItems feedId = partitionM $ \i -> DB.feedItemExists feedId (FI.title i) (FI.url i) deleteFeedItems :: ObjectId -> [FeedItem] -> ConnectionReader () deleteFeedItems feedId feedItems = let titlesToRemain = map FI.title feedItems urlsToRemain = map FI.url feedItems in DB.deleteMarkedFeedItems feedId titlesToRemain urlsToRemain log :: String -> ConnectionReader () log s = do time <- liftIO $ getZonedTime liftIO $ putStrLn $ concat ["[",show time,"]\t",s]