#12 Attach channels to books

- Closes #12
This commit is contained in:
Mats Rauhala 2018-08-14 23:48:54 +03:00
parent 3d7f40eac9
commit 5ff629902c
3 changed files with 38 additions and 5 deletions

View File

@ -23,7 +23,8 @@ import Database
import Database.Selda
import Database.Selda.Generic
import Database.Tag (attachTag)
import Database.Tag (attachTag, clearTags)
import Database.Channel (attachChannel, clearChannels)
usersBooks :: (MonadSelda m, MonadMask m, MonadIO m) => Username -> m [Book]
usersBooks username = fromRels <$> query q
@ -67,7 +68,8 @@ data UpdateBook = UpdateBook { identifier :: BookID
, title :: Maybe Text
, description :: Maybe Text
, owner :: Username
, tags :: [Text]}
, tags :: [Text]
, channels :: [Text] }
bookExists :: (MonadSelda m, MonadMask m, MonadIO m) => BookID -> m Bool
bookExists identifier = not . null <$> query q
@ -91,12 +93,12 @@ bookOwner' identifier username = do
updateBook :: (MonadSelda m, MonadMask m, MonadIO m) => UpdateBook -> m (Maybe UpdateBook)
updateBook book@UpdateBook{..} = do
connectChannels
connectTags
clearTags identifier >> connectTags
clearChannels identifier >> connectChannels
updateBook'
where
connectTags = mapM_ (attachTag owner identifier) tags
connectChannels = return ()
connectChannels = mapM_ (attachChannel owner identifier) channels
updateBook' = do
mUserId <- query (bookOwner' identifier owner)
forM (listToMaybe mUserId) $ \_userId -> do

View File

@ -1,8 +1,11 @@
{-# Language TypeApplications #-}
{-# Language DataKinds #-}
{-# Language NamedFieldPuns #-}
module Database.Channel
( userChannels
, insertChannel
, attachChannel
, clearChannels
, booksChannels
, Channel(..)
, ChannelID )
@ -12,6 +15,7 @@ import ClassyPrelude
import Database.Schema
import Database
import Database.Selda
import Database.Selda.Generic
userChannels :: (MonadMask m, MonadIO m) => Username -> SeldaT m [Channel]
userChannels username = fromRels <$> query q
@ -44,3 +48,25 @@ booksChannels bookId = fromRels <$> query q
restrict (channelId .== channelId')
restrict (bookId' .== literal bookId)
return ch
attachChannel :: (MonadMask m, MonadIO m, MonadSelda m) => Username -> BookID -> Text -> m ()
attachChannel username bookId channel = do
-- XXX: test what happens if channel doesn't exist
[Channel{identifier}] <- fromRels <$> query channelQ
whenM (null <$> query (attachQ identifier)) $
void $ insertGen bookChannels [BookChannel identifier bookId]
where
attachQ channelId = do
(channelId' :*: bookId') <- select (gen bookChannels)
restrict (channelId' .== literal channelId .&& bookId' .== literal bookId)
return channelId'
channelQ = do
userId :*: _ :*: username' :*: _ <- select (gen users)
ch@(_ :*: channel' :*: owner) <- select (gen channels)
restrict (username' .== literal username)
restrict (owner .== userId)
restrict (channel' .== literal channel)
return ch
clearChannels :: (MonadMask m, MonadIO m, MonadSelda m) => BookID -> m Int
clearChannels bookId = deleteFrom (gen bookChannels) (\(_ :*: bookId') -> bookId' .== literal bookId)

View File

@ -8,6 +8,7 @@ module Database.Tag
, booksTags
, attachTag
, upsertTag
, clearTags
, Tag(..) ) where
import ClassyPrelude
@ -55,3 +56,7 @@ attachTag username bookId tag = do
(tagId' :*: bookId') <- select (gen bookTags)
restrict (tagId' .== literal tagId .&& bookId' .== literal bookId)
return tagId'
clearTags :: (MonadMask m, MonadIO m, MonadSelda m) => BookID -> m Int
clearTags bookId = deleteFrom (gen bookTags) (\(_ :*: bookId') -> bookId' .== literal bookId)