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

Attaching tags

Browse Source
This commit is contained in:
Mats Rauhala 2018-08-14 23:20:18 +03:00
parent cae136d38d
commit 100c9e3ee3
1 changed files with 14 additions and 0 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

14
src/Database/Tag.hs
View File

@ -2,9 +2,11 @@
{-# Language TypeOperators #-}
{-# Language DataKinds #-}
{-# Language DuplicateRecordFields #-}
{-# Language NamedFieldPuns #-}
module Database.Tag
( def
, booksTags
, attachTag
, upsertTag
, Tag(..) ) where
@ -12,6 +14,7 @@ import ClassyPrelude
import Database.Schema
import Database
import Database.Selda
import Database.Selda.Generic
upsertTag :: (MonadMask m, MonadIO m, MonadSelda m) => Username -> Text -> m Tag
upsertTag username tag = transaction $ do
@ -41,3 +44,14 @@ booksTags bookId = fromRels <$> query q
restrict (tagId .== tagId')
restrict (bookId' .== literal bookId)
return tag
attachTag :: (MonadMask m, MonadIO m, MonadSelda m) => Username -> BookID -> Text -> m ()
attachTag username bookId tag = transaction $ do
Tag{identifier} <- upsertTag username tag
unlessM (null <$> query (tagQ identifier)) $
void $ insertGen bookTags [BookTag identifier bookId]
where
tagQ tagId = do
(tagId' :*: bookId') <- select (gen bookTags)
restrict (tagId' .== literal tagId .&& bookId' .== literal bookId)
return tagId'