lucienne-0.0.1: Lucienne/Database.hs

module Lucienne.Database
  ( addUser, deleteUser, users, usernameExists, userByNameAndPassword, changePassword
  , addFeed, feedExists, feedsByUser, feedById, deleteFeedById
  , addFeedItems, upsertFeedItem, feedItems, feedItemsByFeedId, feedItemById, feedItemExists
  , deleteMarkedFeedItems, deleteFeedItemsByFeedId
  , countUsers)
where

import           Data.Maybe (isJust)
import           Control.Applicative ((<$>))
import           Data.CompactString.UTF8 (CompactString)
import           Data.Bson ((=:),ObjectId)
import           Database.MongoDB (Document,Value)
import qualified Database.MongoDB as DB
import           Lucienne.ConnectionReader (ConnectionReader,accessDb)
import           Lucienne.DatabaseAble (DatabaseAble(..))
import           Lucienne.Model.Util (showValue,objectId,readObjectId)
import           Lucienne.Model.User (User,name)
import qualified Lucienne.Model.User as U
import           Lucienne.Model.Feed (Feed)
import qualified Lucienne.Model.Feed as F
import           Lucienne.Model.FeedItem (FeedItem)
import qualified Lucienne.Model.FeedItem as FI

type Collection = CompactString

userCollection     = "users"
feedCollection     = "feeds"
feedItemCollection = "feedItems"

addUser :: User -> ConnectionReader String
addUser user = 
  showValue <$> addDatabaseAble userCollection user

deleteUser :: User -> ConnectionReader ()
deleteUser user =
  let deleteFeedItemsQuery = FI.feedItemsQuery (name user)
      deleteFeedsQuery     = F.feedsQuery (name user)
      deleteUserQuery      = U.userByNameQuery (name user)
  in do
    deleteDocuments feedItemCollection deleteFeedItemsQuery
    deleteDocuments feedCollection     deleteFeedsQuery
    deleteDocuments userCollection     deleteUserQuery

addFeed :: Feed -> ConnectionReader ObjectId
addFeed feed = 
  objectId <$> addDatabaseAble feedCollection feed

addFeedItems :: [FeedItem] -> ConnectionReader [ObjectId]
addFeedItems items =
  map objectId <$> addDatabaseAbles feedItemCollection items
  
upsertFeedItem :: FeedItem -> ConnectionReader ()
upsertFeedItem = upsertDatabaseAble feedItemCollection

users :: ConnectionReader [User]
users = do
  users <- readDocuments userCollection [] [] []
  return $ map fromDocument users

usernameExists :: String -> ConnectionReader Bool
usernameExists = querySucceeds userCollection . U.userByNameQuery

userByNameAndPassword :: String -> String -> ConnectionReader (Maybe User)
userByNameAndPassword name password = do
  user <- readDocument userCollection (U.userByNameAndPasswordQuery name password) []
  return $ fmap fromDocument user

changePassword :: User -> String -> ConnectionReader ()
changePassword user = upsertDatabaseAble userCollection . U.changePassword user  

feedExists :: User -> String -> ConnectionReader Bool
feedExists user url = 
  querySucceeds feedCollection $ F.feedByUrlQuery (name user) url

feedsByUser :: User -> ConnectionReader [Feed]
feedsByUser user = do
  docs <- readDocuments feedCollection (F.feedsQuery $ name user) [] []
  return $ map fromDocument docs

feedById :: User -> String -> ConnectionReader (Maybe Feed)
feedById user feedId = 
  let queryDocument = F.feedByIdQuery (name user) (readObjectId feedId)
  in do
    feed <- readDocument feedCollection queryDocument []
    return $ fmap fromDocument feed
    
deleteFeedById :: User -> ObjectId -> ConnectionReader ()
deleteFeedById user feedId =
  let queryDocument = F.feedByIdQuery (name user) feedId
  in
   deleteDocuments feedCollection queryDocument

feedItemsByFeedId :: User -> String -> ConnectionReader [FeedItem]
feedItemsByFeedId user feedId = 
  let queryDocument = FI.feedItemsByFeedIdQuery (name user) feedId
  in do
    docs <- readDocuments feedItemCollection queryDocument FI.feedItemHeaderProjector FI.feedItemsSort
    return $ map fromDocument docs

feedItems :: User -> ConnectionReader [FeedItem]
feedItems user = 
  let queryDocument = FI.readableFeedItemsQuery $ name user
  in do
    docs <- readDocuments feedItemCollection queryDocument FI.feedItemHeaderProjector FI.feedItemsSort
    return $ map fromDocument docs

feedItemById :: User -> String -> ConnectionReader (Maybe FeedItem)
feedItemById user feedItemId = 
  let queryDocument = FI.feedItemByIdQuery (name user) feedItemId
  in do
    item <- readDocument feedItemCollection queryDocument []
    return $ fmap fromDocument item

feedItemExists :: ObjectId -> String -> String -> ConnectionReader Bool
feedItemExists feedId title url = 
  let queryDocument = FI.feedItemExistsQuery feedId title url
  in 
    querySucceeds feedItemCollection queryDocument

deleteMarkedFeedItems :: ObjectId -> [String] -> [String] -> ConnectionReader ()
deleteMarkedFeedItems feedId titlesToRemain urlsToRemain = 
  let queryDocument = FI.deleteMarkedFeedItemsQuery feedId titlesToRemain urlsToRemain 
  in
   deleteDocuments feedItemCollection queryDocument

deleteFeedItemsByFeedId :: ObjectId -> ConnectionReader ()
deleteFeedItemsByFeedId feedId =
  let queryDocument = FI.deleteFeedItemsByFeedIdQuery feedId
  in
   deleteDocuments feedItemCollection queryDocument
   
countUsers :: ConnectionReader Int
countUsers = countDocuments userCollection

readDocument :: Collection -> Document -> Document -> ConnectionReader (Maybe Document)
readDocument collection queryDocument projector =
  let query = (DB.select queryDocument collection) {DB.project = projector}
  in
    accessDb $ DB.findOne query

readDocuments :: Collection -> Document -> Document -> Document -> ConnectionReader [Document]
readDocuments collection queryDocument projector sort =
  let query = (DB.select queryDocument collection) {DB.project = projector, DB.sort = sort}
  in
    accessDb $ DB.find query >>= DB.rest

countDocuments :: Collection -> ConnectionReader Int
countDocuments = accessDb . DB.count . DB.select []

addDatabaseAble :: (DatabaseAble a) => Collection -> a -> ConnectionReader Value
addDatabaseAble collection = 
  accessDb . DB.insert collection . toDocument
  
addDatabaseAbles :: (DatabaseAble a) => Collection -> [a] -> ConnectionReader [Value]
addDatabaseAbles collection = 
  accessDb . DB.insertMany collection . map toDocument

upsertDatabaseAble :: (DatabaseAble a) => Collection -> a -> ConnectionReader ()
upsertDatabaseAble collection = 
  accessDb . DB.save collection . toDocument
  
deleteDocuments :: Collection -> Document -> ConnectionReader ()
deleteDocuments collection queryDocument = 
  accessDb $ DB.delete $ DB.select queryDocument collection

-- |Returns @True@ when at least on result was found
querySucceeds :: Collection -> Document -> ConnectionReader Bool
querySucceeds collection queryDocument =
  let query = (DB.select queryDocument collection) {DB.project = [ "_id" =: (1::Int) ]}
  in
    isJust <$> (accessDb $ DB.findOne query)