Compare commits

..

No commits in common. "d823a678c6f4635f45435976497f6d06557b3292" and "c0ee5d338d66ac2d386a87b84a64cdae296963b2" have entirely different histories.

2 changed files with 7 additions and 36 deletions

View File

@ -36,11 +36,11 @@ insertChannel username channel = do
return userId return userId
booksChannels :: (MonadMask m, MonadIO m) => BookID -> SeldaT m [Channel] booksChannels :: (MonadMask m, MonadIO m) => BookID -> SeldaT m [Channel]
booksChannels bookId = fromRels <$> query q booksChannels contentHash = fromRels <$> query q
where where
q = do q = do
channelId :*: bookId' <- select (gen bookChannels) channelId :*: contentHash' <- select (gen bookChannels)
ch@(channelId' :*: _) <- select (gen channels) ch@(channelId' :*: _) <- select (gen channels)
restrict (channelId .== channelId') restrict (channelId .== channelId')
restrict (bookId' .== literal bookId) restrict (contentHash' .== literal contentHash)
return ch return ch

View File

@ -4,40 +4,11 @@
{-# Language DuplicateRecordFields #-} {-# Language DuplicateRecordFields #-}
module Database.Tag module Database.Tag
( def ( def
, booksTags , Tag(..)
, upsertTag , TagID
, Tag(..) ) where ) where
import ClassyPrelude import ClassyPrelude
import Database.Schema
import Database import Database
import Database.Schema
import Database.Selda import Database.Selda
upsertTag :: (MonadMask m, MonadIO m, MonadSelda m) => Username -> Text -> m Tag
upsertTag username tag = transaction $ do
-- I want this to error out if some data is invariant is wrong and roll back
-- the transaction
[userId] <- query userQ
void $ upsert (gen tags) (predicate userId) id [toRel (Tag def tag userId)]
[t] <- fromRels <$> query (tagQ userId)
return t
where
predicate userId (_ :*: tag' :*: owner) = tag' .== literal tag .&& owner .== literal userId
tagQ userId = do
t@(_ :*: tag' :*: owner) <- select (gen tags)
restrict (tag' .== literal tag .&& owner .== literal userId)
return t
userQ = do
userId :*: _ :*: username' :*: _ <- select (gen users)
restrict (username' .== literal username)
return userId
booksTags :: (MonadMask m, MonadIO m, MonadSelda m) => BookID -> m [Tag]
booksTags bookId = fromRels <$> query q
where
q = do
tagId :*: bookId' <- select (gen bookTags)
tag@(tagId' :*: _) <- select (gen tags)
restrict (tagId .== tagId')
restrict (bookId' .== literal bookId)
return tag