MasseR/ebook-manager
1
0
Fork 0
Code Issues 9 Pull Requests Releases Wiki Activity

Complete functions for tags

Browse Source
This commit is contained in:
Mats Rauhala 2018-08-15 21:50:28 +03:00
parent 5ff629902c
commit f7bc0d420c
1 changed files with 10 additions and 11 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

17
src/Database/Tag.hs
View File

@ -16,15 +16,13 @@ import Database.Schema
import Database
import Database.Selda
import Database.Selda.Generic
import Control.Monad.Trans.Maybe
upsertTag :: (MonadMask m, MonadIO m, MonadSelda m) => Username -> Text -> m Tag
upsertTag username tag = do
-- I want this to error out if some data is invariant is wrong and roll back
-- the transaction. Also as a side note, run this in a transaction plz
[userId] <- query userQ
void $ upsert (gen tags) (predicate userId) id [toRel (Tag def tag userId)]
[t] <- fromRels <$> query (tagQ userId)
return t
upsertTag :: (MonadMask m, MonadIO m, MonadSelda m) => Username -> Text -> m (Maybe Tag)
upsertTag username tag = runMaybeT $ do
userId <- MaybeT (listToMaybe <$> query userQ)
void $ lift $ upsert (gen tags) (predicate userId) id [toRel (Tag def tag userId)]
MaybeT (listToMaybe . fromRels <$> query (tagQ userId))
where
predicate userId (_ :*: tag' :*: owner) = tag' .== literal tag .&& owner .== literal userId
tagQ userId = do
@ -48,7 +46,8 @@ booksTags bookId = fromRels <$> query q
attachTag :: (MonadMask m, MonadIO m, MonadSelda m) => Username -> BookID -> Text -> m ()
attachTag username bookId tag = do
Tag{identifier} <- upsertTag username tag
maybeT <- upsertTag username tag
forM_ maybeT $ \Tag{identifier} -> do
whenM (null <$> query (tagQ identifier)) $
void $ insertGen bookTags [BookTag identifier bookId]
where