Compare commits
No commits in common. "d823a678c6f4635f45435976497f6d06557b3292" and "c0ee5d338d66ac2d386a87b84a64cdae296963b2" have entirely different histories.
d823a678c6
...
c0ee5d338d
@ -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
|
||||||
|
@ -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
|
|
||||||
|
Loading…
Reference in New Issue
Block a user